From 327a6ccaa01cdcd220e74df4f71acf0ad7e92f5f Mon Sep 17 00:00:00 2001 From: Wolfgang Jenkner Date: Thu, 10 Jan 2013 10:01:35 -0500 Subject: [PATCH] * 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. Fixes: debbugs:13160 --- lisp/ChangeLog | 8 +++ lisp/man.el | 79 ++++++++++++++++++++---- test/ChangeLog | 4 ++ test/automated/man-tests.el | 118 ++++++++++++++++++++++++++++++++++++ 4 files changed, 196 insertions(+), 13 deletions(-) create mode 100644 test/automated/man-tests.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 507550dbec0..f26c009bf2b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2013-01-10 Wolfgang Jenkner + + * 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 * autorevert.el: Add file watch support. diff --git a/lisp/man.el b/lisp/man.el index b6a6c179374..93a67128de4 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -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 @@ Used in `bookmark-set' to get the default bookmark name." :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 @@ 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)) + ;; 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 @@ 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)) - (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 @@ names or descriptions. The pattern argument is usually an ;; ("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 @@ The following key bindings are currently in effect in the buffer: ;; 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)) diff --git a/test/ChangeLog b/test/ChangeLog index c409e891d97..7b058c1d2bd 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2013-01-10 Wolfgang Jenkner + + * automated/man-tests.el: New file. + 2013-01-09 Aaron S. Hawley * automated/undo-tests.el (undo-test0): Adjust error to code change. diff --git a/test/automated/man-tests.el b/test/automated/man-tests.el new file mode 100644 index 00000000000..8a2ec953002 --- /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 +;; 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 . + +;;; 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 -- 2.39.5