[Emacs-diffs] /srv/bzr/emacs/trunk r111473: * lisp/man.el: Handle different "man -k" behaviors. Use utf-8.

[Stefan Monnier]

------------------------------------------------------------
revno: 111473
fixes bug: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=13160
author: Wolfgang Jenkner <address@hidden>
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Thu 2013-01-10 10:01:35 -0500
message:
  * lisp/man.el: Handle different "man -k" behaviors.  Use utf-8.
  (Man-man-k-use-anchor): New var.
  (Man-parse-man-k): New function.
  (Man-completion-table): Use it.
  (man): Flush the completion cache between uses.
  * test/automated/man-tests.el: New file.
added:
  test/automated/man-tests.el
modified:
  lisp/ChangeLog
  lisp/man.el
  test/ChangeLog

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-01-10 14:27:48 +0000
+++ b/lisp/ChangeLog    2013-01-10 15:01:35 +0000
@@ -1,3 +1,11 @@
+2013-01-10  Wolfgang Jenkner  <address@hidden>
+
+       * man.el: Handle different "man -k" behaviors (bug#13160).  Use utf-8.
+       (Man-man-k-use-anchor): New var.
+       (Man-parse-man-k): New function.
+       (Man-completion-table): Use it.
+       (man): Flush the completion cache between uses.
+
 2013-01-10  Michael Albinus  <address@hidden>
 
        * autorevert.el: Add file watch support.

=== modified file 'lisp/man.el'
--- a/lisp/man.el       2013-01-01 09:11:05 +0000
+++ b/lisp/man.el       2013-01-10 15:01:35 +0000
@@ -1,4 +1,4 @@
-;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
+;;; man.el --- browse UNIX manual pages  -*- coding: utf-8 -*-
 
 ;; Copyright (C) 1993-1994, 1996-1997, 2001-2013 Free Software
 ;; Foundation, Inc.
@@ -276,7 +276,7 @@
   :type 'hook
   :group 'man)
 
-(defvar Man-name-regexp "[-a-zA-Z0-9_?+][-a-zA-Z0-9_.:?+]*"
+(defvar Man-name-regexp "[-a-zA-Z0-9_??+][-a-zA-Z0-9_.:??+]*"
   "Regular expression describing the name of a manpage (without section).")
 
 (defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]"
@@ -780,6 +780,59 @@
   ;; but apparently that's not the case in all cases, so let's add a cache.
   "Cache of completion table of the form (PREFIX . TABLE).")
 
+(defvar Man-man-k-use-anchor
+  ;; man-db or man-1.*
+  (memq system-type '(gnu gnu/linux gnu/kfreebsd))
+  "If non-nil prepend ^ to the prefix passed to \"man -k\" for completion.
+The value should be nil if \"man -k ^PREFIX\" may omit some man
+pages whose names start with PREFIX.
+
+Currently, the default value depends on `system-type' and is
+non-nil where the standard man programs are known to behave
+properly.  Setting the value to nil always gives correct results
+but computing the list of completions may take a bit longer.")
+
+(defun Man-parse-man-k ()
+  "Parse \"man -k\" output and return the list of page names.
+
+The current buffer should contain the output of a command of the
+form \"man -k keyword\", which is traditionally also available with
+apropos(1).
+
+While POSIX man(1p) is a bit vague about what to expect here,
+this function tries to parse some commonly used formats, which
+can be described in the following informal way, with square brackets
+indicating optional parts and whitespace being interpreted
+somewhat loosely.
+
+foo[, bar [, ...]] [other stuff] (sec) - description
+foo(sec)[, bar(sec) [, ...]] [other stuff] - description
+
+For more details and some regression tests, please see
+test/automated/man-tests.el in the emacs bzr repository."
+  (goto-char (point-min))
+  ;; See man-tests for data about which systems use which format (hopefully we
+  ;; will be able to simplify the code if/when some of those formats aren't
+  ;; used any more).
+  (let (table)
+    (while (search-forward-regexp "^\\([^ \t,\n]+\\)\\(.*?\\)\
+\\(?:[ \t]\\(([^ \t,\n]+?)\\)\\)?\\(?:[ \t]+- ?\\(.*\\)\\)?$" nil t)
+      (let ((section (match-string 3))
+           (description (match-string 4))
+           (bound (match-end 2)))
+        (goto-char (match-end 1))
+       (while
+            (progn
+              ;; The first regexp grouping may already match the section
+              ;; tacked on to the name, which is ok since for the formats we
+              ;; claim to support the third (non-shy) grouping does not
+              ;; match in this case, i.e., section is nil.
+              (push (propertize (concat (match-string 1) section)
+                                'help-echo description)
+                    table)
+              (search-forward-regexp "\\=, *\\([^ \t,]+\\)" bound t)))))
+    (nreverse table)))
+
 (defun Man-completion-table (string pred action)
   (cond
    ;; This ends up returning t for pretty much any string, and hence leads to
@@ -811,16 +864,15 @@
             ;; run differently in Man-getpage-in-background, an error
             ;; here may not necessarily mean that we'll also get an
             ;; error later.
-            (ignore-errors
-              (call-process manual-program nil '(t nil) nil
-                            "-k" (concat "^" prefix))))
-          (goto-char (point-min))
-          (while (re-search-forward "^\\([^ \t\n]+\\)\\(?: ?\\((.+?)\\)\\(?:[ 
\t]+- \\(.*\\)\\)?\\)?" nil t)
-            (push (propertize (concat (match-string 1) (match-string 2))
-                              'help-echo (match-string 3))
-                  table)))
-        ;; Cache the table for later reuse.
-        (setq Man-completion-cache (cons prefix table)))
+           (ignore-errors
+             (call-process manual-program nil '(t nil) nil
+                           "-k" (concat (when (or Man-man-k-use-anchor
+                                                  (string-equal prefix ""))
+                                          "^")
+                                        prefix))))
+         (setq table (Man-parse-man-k)))
+       ;; Cache the table for later reuse.
+       (setq Man-completion-cache (cons prefix table)))
       ;; The table may contain false positives since the match is made
       ;; by "man -k" not just on the manpage's name.
       (if section
@@ -891,6 +943,7 @@
                ;; ("man -k" is case-insensitive similarly, so the
                ;; table has everything available to complete)
                (completion-ignore-case t)
+               Man-completion-cache    ;Don't cache across calls.
                (input (completing-read
                        (format "Manual entry%s"
                                (if (string= default-entry "")
@@ -1395,7 +1448,7 @@
                              ;; Update len, in case a reference spans
                              ;; more than two lines (paranoia).
                              len (1- (length word))))
-                   (if (memq (aref word len) '(?- ??))
+                   (if (memq (aref word len) '(?- ???))
                        (setq hyphenated (substring word 0 len)))
                    (and (string-match Man-reference-regexp word)
                          (not (member word Man--refpages))

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2013-01-09 21:29:27 +0000
+++ b/test/ChangeLog    2013-01-10 15:01:35 +0000
@@ -1,3 +1,7 @@
+2013-01-10  Wolfgang Jenkner  <address@hidden>
+
+       * automated/man-tests.el: New file.
+
 2013-01-09  Aaron S. Hawley  <address@hidden>
 
        * automated/undo-tests.el (undo-test0): Adjust error to code change.

=== added file 'test/automated/man-tests.el'
--- a/test/automated/man-tests.el       1970-01-01 00:00:00 +0000
+++ b/test/automated/man-tests.el       2013-01-10 15:01:35 +0000
@@ -0,0 +1,118 @@
+;;; man-tests.el --- Test suite for man.
+
+;; Copyright (C) 2013  Free Software Foundation, Inc.
+
+;; Author: Wolfgang Jenkner <address@hidden>
+;; Keywords: help, internal, unix
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'man)
+
+(defconst man-tests-parse-man-k-tests
+  '(;; GNU/Linux: man-db-2.6.1
+    ("\
+sin (3)              - sine function
+sinf (3)             - sine function
+sinl (3)             - sine function"
+     . (#("sin(3)" 0 6 (help-echo "sine function")) #("sinf(3)" 0 7 (help-echo 
"sine function")) #("sinl(3)" 0 7 (help-echo "sine function"))))
+    ;; GNU/Linux: man-1.6g
+    ("\
+sin                  (3)  - sine function
+sinf [sin]           (3)  - sine function
+sinl [sin]           (3)  - sine function"
+     . (#("sin(3)" 0 6 (help-echo "sine function")) #("sinf(3)" 0 7 (help-echo 
"sine function")) #("sinl(3)" 0 7 (help-echo "sine function"))))
+    ;; FreeBSD 9
+    ("\
+sin(3), sinf(3), sinl(3) - sine functions"
+     . (#("sin(3)" 0 6 (help-echo "sine functions")) #("sinf(3)" 0 7 
(help-echo "sine functions")) #("sinl(3)" 0 7 (help-echo "sine functions"))))
+    ;; SunOS, Solaris
+    ;; http://docs.oracle.com/cd/E19455-01/805-6331/usradm-7/index.html
+    ;; SunOS 4
+    ("\
+tset, reset (1)    - establish or restore terminal characteristics"
+     . (#("tset(1)" 0 7 (help-echo "establish or restore terminal 
characteristics")) #("reset(1)" 0 8 (help-echo "establish or restore terminal 
characteristics"))))
+    ;; SunOS 5.7, Solaris
+    ("\
+reset  tset (1b)   - establish or restore terminal characteristics
+tset   tset (1b)   - establish or restore terminal characteristics"
+     . (#("reset(1b)" 0 8 (help-echo "establish or restore terminal 
characteristics")) #("tset(1b)" 0 7 (help-echo "establish or restore terminal 
characteristics"))))
+    ;; Minix 3
+    ;; http://www.minix3.org/manpages/html5/whatis.html
+    ("\
+cawf, nroff (1) - C version of the nroff-like, Amazingly Workable (text) 
Formatter
+whatis (5) - database of online manual pages"
+     . (#("cawf(1)" 0 7 (help-echo "C version of the nroff-like, Amazingly 
Workable (text) Formatter")) #("nroff(1)" 0 8 (help-echo "C version of the 
nroff-like, Amazingly Workable (text) Formatter")) #("whatis(5)" 0 9 (help-echo 
"database of online manual pages"))))
+    ;; HP-UX
+    ;; http://docstore.mik.ua/manuals/hp-ux/en/B2355-60130/man.1.html
+    ;; Assuming that the line break in the zgrep description was
+    ;; introduced by the man page formatting.
+    ("\
+grep, egrep, fgrep (1) - search a file for a pattern
+zgrep(1) - search possibly compressed files for a regular expression"
+     . (#("grep(1)" 0 7 (help-echo "search a file for a pattern")) 
#("egrep(1)" 0 8 (help-echo "search a file for a pattern")) #("fgrep(1)" 0 8 
(help-echo "search a file for a pattern")) #("zgrep(1)" 0 8 (help-echo "search 
possibly compressed files for a regular expression"))))
+    ;; AIX
+    ;; 
http://pic.dhe.ibm.com/infocenter/aix/v7r1/topic/com.ibm.aix.cmds/doc/aixcmds6/whatis.htm
+    ("\
+ls(1)  -Displays the contents of a directory."
+    . (#("ls(1)" 0 5 (help-echo "Displays the contents of a directory."))))
+    ;; 
https://www.ibm.com/developerworks/mydeveloperworks/blogs/cgaix/entry/catman_0703_102_usr_lbin_mkwhatis_the_error_number_is_1?lang=en
+    ("\
+loopmount(1)    - Associate an image file to a loopback device."
+     . (#("loopmount(1)" 0 12 (help-echo "Associate an image file to a 
loopback device."))))
+    )
+  "List of tests for `Man-parse-man-k'.
+Each element is a cons cell whose car is a string containing
+man -k output.  That should result in the table which is stored
+in the cdr of the element.")
+
+(defun man-tests-name-equal-p (name description string)
+  (and (equal name string)
+       (not (next-single-property-change 0 'help-echo string))
+       (equal (get-text-property 0 'help-echo string) description)))
+
+(defun man-tests-parse-man-k-test-case (test)
+  (let ((temp-buffer (get-buffer-create " *test-man*"))
+       (man-k-output (car test)))
+    (unwind-protect
+       (save-window-excursion
+         (with-current-buffer temp-buffer
+           (erase-buffer)
+           (insert man-k-output)
+           (let ((result (Man-parse-man-k))
+                 (checklist (cdr test)))
+             (while (and checklist result
+                         (man-tests-name-equal-p
+                          (car checklist)
+                          (get-text-property 0 'help-echo
+                                             (car checklist))
+                          (pop result)))
+               (pop checklist))
+             (and (null checklist) (null result)))))
+      (and (buffer-name temp-buffer)
+          (kill-buffer temp-buffer)))))
+
+(ert-deftest man-tests ()
+  "Test man."
+  (dolist (test man-tests-parse-man-k-tests)
+    (should (man-tests-parse-man-k-test-case test))))
+
+(provide 'man-tests)
+
+;;; man-tests.el ends here