Package: emacs;
Reported by: Wolfgang Jenkner <wjenkner <at> inode.at>
Date: Wed, 12 Dec 2012 19:25:02 UTC
Severity: wishlist
Tags: patch
Found in version 24.3.50
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Wolfgang Jenkner <wjenkner <at> inode.at> To: Stefan Monnier <monnier <at> iro.umontreal.ca> Cc: 13160 <at> debbugs.gnu.org, Kevin Ryde <user42 <at> zip.com.au> Subject: bug#13160: 24.3.50; [PATCH] man page completion support beyond man-db Date: Sun, 06 Jan 2013 20:48:06 +0100
On Mon, Dec 24 2012, Stefan Monnier wrote:
> We could replace it with a boolean var like `Man--k-anchor-broken',
> since I think it's a bug for "man -k ^foo" to not match commands that
> start with a "foo" prefix.
With a different name:
-- >8 --
Subject: [PATCH] Support man page completion for more man programs. *
lisp/man.el (Man-parse-man-k): New function. (Man-man-k-use-anchor): New
variable. (Man-completion-table): Use them to replace man-db specific code
for parsing `man -k' output.
* test/automated/man-tests.el: New file.
---
lisp/man.el | 75 +++++++++++++++++++++++-----
test/automated/man-tests.el | 118 ++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 182 insertions(+), 11 deletions(-)
create mode 100644 test/automated/man-tests.el
diff --git a/lisp/man.el b/lisp/man.el
index 8210d63..ee3f507 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -780,6 +780,56 @@ POS defaults to `point'."
;; 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))
+ (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
@@ -811,17 +861,20 @@ POS defaults to `point'."
;; 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))
- (setq table nil)
- (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)))
+ (unless Man-man-k-use-anchor
+ ;; Weed out unwanted page names.
+ (dolist (comp (prog1 table (setq table nil)))
+ (if (string-prefix-p prefix comp)
+ (push comp table))))
+ ;; 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
diff --git a/test/automated/man-tests.el b/test/automated/man-tests.el
new file mode 100644
index 0000000..8a2ec95
--- /dev/null
+++ b/test/automated/man-tests.el
@@ -0,0 +1,118 @@
+;;; man-tests.el --- Test suite for man.
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Wolfgang Jenkner <wjenkner <at> 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-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
--
1.8.0.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.