bug#13160: 24.3.50; [PATCH] man page completion support beyond man-db

[Wolfgang Jenkner]

On Sun, Dec 16 2012, Wolfgang Jenkner wrote:

> On Sat, Dec 15 2012, Kevin Ryde wrote:
>
>> Wolfgang Jenkner <wjenkner@inode.at> writes:
>>>
>>> It's not used for parsing, it's only prepended to the search string
>>> passed to `man -k'.
>>
>> Ah.  I even had a note in my bit about that.  Yes.  Daniel Pittman I
>> think it was reported that on macos man -k '' empty string gives no
>> output, hence "^".
>
> Right, the empty string deserves special attention, also because it has
> the potential to mess up the cache.  Thanks for reminding me of this.

Actually, I think the cache is really the clue here: prepending
completions piecemeal to the cache makes only sense if the user
consciously avoids completing the empty string because of memory
constraints... and even then the cache would have to be a trie or
something to be useful.

So let's just cache all entries at the first completion attempt. This
simplifies things as it seems reasonable to assume that `man -k ^'
outputs all entries (I was unsure about this because of bug#10840, but
that was likely a red herring).

And since the present bug report has been requalified as being of
`wishlist' severity I'd like to commit the patch before christmas :-)

Wolfgang

2012-12-22  Wolfgang Jenkner  <wjenkner@inode.at>

        * man.el (Man-completion-table): Cache aggressively.
        Fill the cache all at once, at the first completion.
        Previously, when a prefix didn't start with the string contained
        in the car of Man-completion-cache the parsed output of `man -k'
        was prepended to the cache.
        Conveniently, the change entails that we don't have to guess the
        output format of `man -k' in order to pass it a useful regexp.

2012-12-22  Wolfgang Jenkner  <wjenkner@inode.at>

        Support man page completion for more man programs.  (Bug#13160)
        * man.el (Man-parse-apropos): New function.
        (Man-completion-table): Use it in parsing `man -k' output to
        replace code peculiar to man-db.
        Thanks to Kevin Ryde for commenting on a previous version of this.

2012-12-22  Wolfgang Jenkner  <wjenkner@inode.at>

        * automated/man-tests.el: New file.

=== modified file 'lisp/man.el'
--- lisp/man.el 2012-08-15 16:29:11 +0000
+++ lisp/man.el 2012-12-21 22:51:54 +0000
@@ -796,15 +796,11 @@
       (when (string-match "\\`\\([[:digit:]].*?\\) " string)
         (setq section (match-string 1 string))
         (setq prefix (substring string (match-end 0))))
-      (unless (and Man-completion-cache
-                   (string-prefix-p (car Man-completion-cache) prefix))
+      (unless Man-completion-cache
         (with-temp-buffer
           (setq default-directory "/") ;; in case inherited doesn't exist
-          ;; Actually for my `man' the arg is a regexp.
-          ;; POSIX says it must be ERE and "man-db" seems to agree,
-          ;; whereas under MacOSX it seems to be BRE-style and doesn't
-          ;; accept backslashes at all.  Let's not bother to
-          ;; quote anything.
+         ;; Actually for `man -k' the arg is a regexp and POSIX says
+         ;; it must be an ERE.  Anyway, only the ^ anchor is needed here.
           (let ((process-environment (copy-sequence process-environment)))
             (setenv "COLUMNS" "999") ;; don't truncate long names
             ;; manual-program might not even exist.  And since it's
@@ -812,15 +808,15 @@
             ;; 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))))
+             ;; Get all entries.
+              (call-process manual-program nil '(t nil) nil "-k" "^")))
           (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)))
+        (setq Man-completion-cache (cons "" (nreverse table))))
       ;; The table may contain false positives since the match is made
       ;; by "man -k" not just on the manpage's name.
       (if section


=== modified file 'lisp/man.el'
--- lisp/man.el 2012-12-21 22:51:54 +0000
+++ lisp/man.el 2012-12-21 22:55:19 +0000
@@ -780,6 +780,44 @@
   ;; 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).")
 
+(defun Man-parse-apropos ()
+  "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))
+  (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))
+           (continue (goto-char (match-end 1))))
+       (while continue
+         ;; 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)
+         (setq continue (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
@@ -810,13 +848,9 @@
             (ignore-errors
              ;; Get all entries.
               (call-process manual-program nil '(t nil) nil "-k" "^")))
-          (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 "" (nreverse table))))
+         ;; Cache the table for later reuse.
+         (setq Man-completion-cache (cons "" (setq table
+                                                   (Man-parse-apropos))))))
       ;; The table may contain false positives since the match is made
       ;; by "man -k" not just on the manpage's name.
       (if section

=== added file 'test/automated/man-tests.el'
--- test/automated/man-tests.el 1970-01-01 00:00:00 +0000
+++ test/automated/man-tests.el 2012-12-21 22:55:19 +0000
@@ -0,0 +1,118 @@
+;;; man-tests.el --- Test suite for man.
+
+;; Copyright (C) 2012  Free Software Foundation, Inc.
+
+;; Author: Wolfgang Jenkner <wjenkner@inode.at>
+;; 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-apropos-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-apropos'.
+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-apropos-test-case (test)
+  (let ((temp-buffer (get-buffer-create " *test-man*"))
+       (apropos-output (car test)))
+    (unwind-protect
+       (save-window-excursion
+         (with-current-buffer temp-buffer
+           (erase-buffer)
+           (insert apropos-output)
+           (let ((result (Man-parse-apropos))
+                 (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-apropos-tests)
+    (should (man-tests-parse-apropos-test-case test))))
+
+(provide 'man-tests)
+
+;;; man-tests.el ends here