X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b35f288d478ef137a4d9e8e5a6a5f368a86b01f5..2333c84afd9263abd5c71b4503435c5db1292f94:/lisp/man.el diff --git a/lisp/man.el b/lisp/man.el index 229365033a..88d1aa7c60 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,7 +1,7 @@ ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw ;; Maintainer: FSF @@ -74,7 +74,7 @@ ;; ============= TODO =========== ;; - Add a command for printing. -;; - The awk script deletes multiple blank lines. This behaviour does +;; - The awk script deletes multiple blank lines. This behavior does ;; not allow to understand if there was indeed a blank line at the ;; end or beginning of a page (after the header, or before the ;; footer). A different algorithm should be used. It is easy to @@ -84,11 +84,6 @@ ;; only. Is it worth doing? ;; - Allow a user option to mean that all the manpages should go in ;; the same buffer, where they can be browsed with M-n and M-p. -;; - Allow completion on the manpage name when calling man. This -;; requires a reliable list of places where manpages can be found. The -;; drawback would be that if the list is not complete, the user might -;; be led to believe that the manpages in the missing directories do -;; not exist. ;;; Code: @@ -103,12 +98,12 @@ (defgroup man nil "Browse UNIX manual pages." :prefix "Man-" + :group 'external :group 'help) - (defvar Man-notify) (defcustom Man-filter-list nil - "*Manpage cleaning filter command phrases. + "Manpage cleaning filter command phrases. This variable contains a list of the following form: '((command-string phrase-string*)*) @@ -226,6 +221,11 @@ the associated section number." :type '(repeat string) :group 'man) +(defcustom Man-name-local-regexp (concat "^" (regexp-opt '("NOM" "NAME")) "$") + "Regexp that matches the text that precedes the command's name. +Used in `bookmark-set' to get the default bookmark name." + :type 'string :group 'bookmark) + (defvar manual-program "man" "The name of the program that produces man pages.") @@ -288,7 +288,8 @@ This regular expression should start with a `^' character.") "Regular expression for SYNOPSIS heading (or your equivalent). This regexp should not start with a `^' character.") -(defvar Man-files-regexp "FILES" +(defvar Man-files-regexp "FILES\\>" + ;; Add \> so as not to match mount(8)'s FILESYSTEM INDEPENDENT MOUNT OPTIONS. "Regular expression for FILES heading (or your equivalent). This regexp should not start with a `^' character.") @@ -425,9 +426,9 @@ Otherwise, the value is whatever the function 'func nil 'action #'Man-xref-button-action) -(defun Man-xref-button-action (button) +(defun Man-xref-button-action (button) (let ((target (button-get button 'Man-target-string))) - (funcall + (funcall (button-get button 'func) (cond ((null target) (button-label button)) @@ -435,7 +436,7 @@ Otherwise, the value is whatever the function (funcall target (button-start button))) (t target))))) -(define-button-type 'Man-xref-man-page +(define-button-type 'Man-xref-man-page :supertype 'Man-abstract-xref-man-page 'func 'man-follow) @@ -486,36 +487,51 @@ This is necessary if one wants to dump man.el with Emacs." (apply 'list (cons Man-sed-command - (list - (if Man-sed-script - (concat "-e '" Man-sed-script "'") - "") - "-e '/^[\001-\032][\001-\032]*$/d'" - "-e '/\e[789]/s///g'" - "-e '/Reformatting page. Wait/d'" - "-e '/Reformatting entry. Wait/d'" - "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'" - "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'" - "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'" - "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'" - "-e '/^Printed[ \t][0-9].*[0-9]$/d'" - "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'" - "-e '/^[A-Za-z].*Last[ \t]change:/d'" - "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'" - "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'" - "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'" - )) - (cons - Man-awk-command - (list - "'\n" - "BEGIN { blankline=0; anonblank=0; }\n" - "/^$/ { if (anonblank==0) next; }\n" - "{ anonblank=1; }\n" - "/^$/ { blankline++; next; }\n" - "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" - "'" - )) + (if (eq system-type 'windows-nt) + ;; Windows needs ".." quoting, not '..'. + (list + "-e \"/Reformatting page. Wait/d\"" + "-e \"/Reformatting entry. Wait/d\"" + "-e \"/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d\"" + "-e \"/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d\"" + "-e \"/^Printed[ \t][0-9].*[0-9]$/d\"" + "-e \"/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d\"" + "-e \"/^[A-Za-z].*Last[ \t]change:/d\"" + "-e \"/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d\"" + "-e \"/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d\"") + (list + (if Man-sed-script + (concat "-e '" Man-sed-script "'") + "") + "-e '/^[\001-\032][\001-\032]*$/d'" + "-e '/\e[789]/s///g'" + "-e '/Reformatting page. Wait/d'" + "-e '/Reformatting entry. Wait/d'" + "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'" + "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'" + "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'" + "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'" + "-e '/^Printed[ \t][0-9].*[0-9]$/d'" + "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'" + "-e '/^[A-Za-z].*Last[ \t]change:/d'" + "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'" + "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'" + "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'" + ))) + ;; Windows doesn't support multi-line commands, so don't + ;; invoke Awk there. + (unless (eq system-type 'windows-nt) + (cons + Man-awk-command + (list + "'\n" + "BEGIN { blankline=0; anonblank=0; }\n" + "/^$/ { if (anonblank==0) next; }\n" + "{ anonblank=1; }\n" + "/^$/ { blankline++; next; }\n" + "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" + "'" + ))) (if (not Man-uses-untabify-flag) ;; The outer list will be stripped off by apply. (list (cons @@ -645,7 +661,7 @@ a new value." (defun Man-default-man-entry (&optional pos) "Guess default manual entry based on the text near position POS. POS defaults to `point'." - (let (word start pos column distance) + (let (word start column distance) (save-excursion (when pos (goto-char pos)) (setq pos (point)) @@ -734,28 +750,127 @@ POS defaults to `point'." ;;;###autoload (defalias 'manual-entry 'man) +(defvar Man-completion-cache nil + ;; On my machine, "man -k" is so fast that a cache makes no sense, + ;; 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-completion-table (string pred action) + (cond + ((eq action 'lambda) + (not (string-match "([^)]*\\'" string))) + ((equal string "-k") + ;; Let SPC (minibuffer-complete-word) insert the space. + (complete-with-action action '("-k ") string pred)) + (t + (let ((table (cdr Man-completion-cache)) + (section nil) + (prefix string)) + (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)) + (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. + (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 + ;; 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))) + ;; The table may contain false positives since the match is made + ;; by "man -k" not just on the manpage's name. + (if section + (let ((re (concat "(" (regexp-quote section) ")\\'"))) + (dolist (comp (prog1 table (setq table nil))) + (if (string-match re comp) + (push (substring comp 0 (match-beginning 0)) table))) + (completion-table-with-context (concat section " ") table + prefix pred action)) + ;; If the current text looks like a possible section name, + ;; then add a completion entry that just adds a space so SPC + ;; can be used to insert a space. + (if (string-match "\\`[[:digit:]]" string) + (push (concat string " ") table)) + (let ((res (complete-with-action action table string pred))) + ;; In case we're completing to a single name that exists in + ;; several sections, the longest prefix will look like "foo(". + (if (and (stringp res) + (string-match "([^(]*\\'" res) + ;; In case the paren was already in `prefix', don't + ;; remove it. + (> (match-beginning 0) (length prefix))) + (substring res 0 (match-beginning 0)) + res))))))) ;;;###autoload (defun man (man-args) "Get a Un*x manual page and put it in a buffer. -This command is the top-level command in the man package. It runs a Un*x -command to retrieve and clean a manpage in the background and places the -results in a Man mode (manpage browsing) buffer. See variable -`Man-notify-method' for what happens when the buffer is ready. -If a buffer already exists for this man page, it will display immediately. - -To specify a man page from a certain section, type SUBJECT(SECTION) or -SECTION SUBJECT when prompted for a manual entry. To see manpages from -all sections related to a subject, put something appropriate into the -`Man-switches' variable, which see." +This command is the top-level command in the man package. It +runs a Un*x command to retrieve and clean a manpage in the +background and places the results in a `Man-mode' browsing +buffer. See variable `Man-notify-method' for what happens when +the buffer is ready. If a buffer already exists for this man +page, it will display immediately. + +For a manpage from a particular section, use either of the +following. \"cat(1)\" is how cross-references appear and is +passed to man as \"1 cat\". + + cat(1) + 1 cat + +To see manpages from all sections related to a subject, use an +\"all pages\" option (which might be \"-a\" if it's not the +default), then step through with `Man-next-manpage' (\\\\[Man-next-manpage]) etc. +Add to `Man-switches' to make this option permanent. + + -a chmod + +An explicit filename can be given too. Use -l if it might +otherwise look like a page name. + + /my/file/name.1.gz + -l somefile.1 + +An \"apropos\" query with -k gives a buffer of matching page +names or descriptions. The pattern argument is usually an +\"egrep\" style regexp. + + -k pattern" + (interactive (list (let* ((default-entry (Man-default-man-entry)) - (input (read-string + ;; ignore case because that's friendly for bizarre + ;; caps things like the X11 function names and because + ;; "man" itself is case-sensitive on the command line + ;; so you're accustomed not to bother about the case + ;; ("man -k" is case-insensitive similarly, so the + ;; table has everything available to complete) + (completion-ignore-case t) + (input (completing-read (format "Manual entry%s" (if (string= default-entry "") ": " (format " (default %s): " default-entry))) - nil 'Man-topic-history default-entry))) + 'Man-completion-table + nil nil nil 'Man-topic-history default-entry))) (if (string= input "") (error "No man args given") input)))) @@ -776,7 +891,8 @@ all sections related to a subject, put something appropriate into the (man man-args))) (defun Man-getpage-in-background (topic) - "Use TOPIC to build and fire off the manpage and cleaning command." + "Use TOPIC to build and fire off the manpage and cleaning command. +Return the buffer in which the manpage will appear." (let* ((man-args topic) (bufname (concat "*Man " man-args "*")) (buffer (get-buffer bufname))) @@ -796,7 +912,7 @@ all sections related to a subject, put something appropriate into the ;; We must decode the output by a coding system that the ;; system's locale suggests in multibyte mode. (coding-system-for-read - (if default-enable-multibyte-characters + (if (default-value 'enable-multibyte-characters) locale-coding-system 'raw-text-unix)) ;; Avoid possible error by using a directory that always exists. (default-directory @@ -829,6 +945,10 @@ all sections related to a subject, put something appropriate into the (Man-width (frame-width)) ((window-width)))))) (setenv "GROFF_NO_SGR" "1") + ;; Since man-db 2.4.3-1, man writes plain text with no escape + ;; sequences when stdout is not a tty. In 2.5.0, the following + ;; env-var was added to allow control of this (see Debian Bug#340673). + (setenv "MAN_KEEP_FORMATTING" "1") (if (fboundp 'start-process) (set-process-sentinel (start-process manual-program buffer @@ -850,15 +970,16 @@ all sections related to a subject, put something appropriate into the (format "exited abnormally with code %d" exit-status))) (setq msg exit-status)) - (Man-bgproc-sentinel bufname msg))))))) + (Man-bgproc-sentinel bufname msg))))) + buffer)) (defun Man-notify-when-ready (man-buffer) "Notify the user when MAN-BUFFER is ready. See the variable `Man-notify-method' for the different notification behaviors." (let ((saved-frame (with-current-buffer man-buffer Man-original-frame))) - (cond - ((eq Man-notify-method 'newframe) + (case Man-notify-method + (newframe ;; Since we run asynchronously, perhaps while Emacs is waiting ;; for input, we must not leave a different buffer current. We ;; can't rely on the editor command loop to reselect the @@ -869,28 +990,27 @@ See the variable `Man-notify-method' for the different notification behaviors." (set-window-dedicated-p (frame-selected-window frame) t) (or (display-multi-frame-p frame) (select-frame frame))))) - ((eq Man-notify-method 'pushy) + (pushy (switch-to-buffer man-buffer)) - ((eq Man-notify-method 'bully) + (bully (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer) (delete-other-windows)) - ((eq Man-notify-method 'aggressive) + (aggressive (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer)) - ((eq Man-notify-method 'friendly) + (friendly (and (frame-live-p saved-frame) (select-frame saved-frame)) (display-buffer man-buffer 'not-this-window)) - ((eq Man-notify-method 'polite) + (polite (beep) (message "Manual buffer %s is ready" (buffer-name man-buffer))) - ((eq Man-notify-method 'quiet) + (quiet (message "Manual buffer %s is ready" (buffer-name man-buffer))) - ((or (eq Man-notify-method 'meek) - t) + (t ;; meek (message "")) ))) @@ -977,6 +1097,11 @@ Same for the ANSI bold and normal escape sequences." (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+") (put-text-property (1- (point)) (point) 'face 'bold)) + ;; When the header is longer than the manpage name, groff tries to + ;; condense it to a shorter line interspered with ^H. Remove ^H with + ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566) + (goto-char (point-min)) + (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (goto-char (point-min)) ;; Try to recognize common forms of cross references. (Man-highlight-references) @@ -1007,7 +1132,7 @@ default type, `Man-xref-man-page' is used for the buttons." (Man-highlight-references0 nil Man-apropos-regexp 1 'Man-default-man-entry (or xref-man-type 'Man-xref-man-page))) - (Man-highlight-references0 Man-see-also-regexp Man-reference-regexp 1 + (Man-highlight-references0 Man-see-also-regexp Man-reference-regexp 1 'Man-default-man-entry (or xref-man-type 'Man-xref-man-page)) (Man-highlight-references0 Man-synopsis-regexp Man-header-regexp 0 2 @@ -1034,7 +1159,7 @@ default type, `Man-xref-man-page' is used for the buttons." (match-end button-pos) 'type type 'Man-target-string (cond - ((numberp target) + ((numberp target) (match-string target)) ((functionp target) target) @@ -1064,6 +1189,11 @@ script would have done them." )) (goto-char (point-min)) (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+")) + ;; When the header is longer than the manpage name, groff tries to + ;; condense it to a shorter line interspered with ^H. Remove ^H with + ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566) + (goto-char (point-min)) + (while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (Man-softhyphen-to-minus) (message "%s man page cleaned up" Man-arguments)) @@ -1092,6 +1222,18 @@ manpage command." (progn (end-of-line) (point))) delete-buff t)) + + ;; "-k foo", successful exit, but no output (from man-db) + ;; ENHANCE-ME: share the check for -k with + ;; `Man-highlight-references'. The \\s- bits here are + ;; meant to allow for multiple options with -k among them. + ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments) + (eq (process-status process) 'exit) + (= (process-exit-status process) 0) + (= (point-min) (point-max))) + (setq err-mess (format "%s: no matches" Man-arguments) + delete-buff t)) + ((or (stringp process) (not (and (eq (process-status process) 'exit) (= (process-exit-status process) 0)))) @@ -1136,6 +1278,8 @@ manpage command." ;; ====================================================================== ;; set up manual mode in buffer and build alists +(defvar bookmark-make-record-function) + (put 'Man-mode 'mode-class 'special) (defun Man-mode () @@ -1192,6 +1336,8 @@ The following key bindings are currently in effect in the buffer: (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) (set (make-local-variable 'outline-regexp) Man-heading-regexp) (set (make-local-variable 'outline-level) (lambda () 1)) + (set (make-local-variable 'bookmark-make-record-function) + 'Man-bookmark-make-record) (Man-build-page-list) (Man-strip-page-headers) (Man-unindent) @@ -1383,7 +1529,9 @@ Returns t if section is found, nil otherwise." (string= chosen "")) default chosen))) - (Man-find-section (aheadsym Man-sections-alist))) + (unless (Man-find-section (aheadsym Man-sections-alist)) + (error "Section not found"))) + (defun Man-goto-see-also-section () "Move point to the \"SEE ALSO\" section. @@ -1524,6 +1672,46 @@ Specify which REFERENCE to use; default is based on word at point." (setq path nil)) (setq complete-path nil))) complete-path)) + +;;; Bookmark Man Support +(declare-function bookmark-make-record-default + "bookmark" (&optional no-file no-context posn)) +(declare-function bookmark-prop-get "bookmark" (bookmark prop)) +(declare-function bookmark-default-handler "bookmark" (bmk)) +(declare-function bookmark-get-bookmark-record "bookmark" (bmk)) + +(defun Man-default-bookmark-title () + "Default bookmark name for Man or WoMan pages. +Uses `Man-name-local-regexp'." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward Man-name-local-regexp nil t) + (skip-chars-forward "\n\t ") + (buffer-substring-no-properties (point) (line-end-position))))) + +(defun Man-bookmark-make-record () + "Make a bookmark entry for a Man buffer." + `(,(Man-default-bookmark-title) + ,@(bookmark-make-record-default 'no-file) + (location . ,(concat "man " Man-arguments)) + (man-args . ,Man-arguments) + (handler . Man-bookmark-jump))) + +;;;###autoload +(defun Man-bookmark-jump (bookmark) + "Default bookmark handler for Man buffers." + (let* ((man-args (bookmark-prop-get bookmark 'man-args)) + ;; Let bookmark.el do the window handling. + ;; This let-binding needs to be active during the call to both + ;; Man-getpage-in-background and accept-process-output. + (Man-notify-method 'meek) + (buf (Man-getpage-in-background man-args)) + (proc (get-buffer-process buf))) + (while (and proc (eq (process-status proc) 'run)) + (accept-process-output proc)) + (bookmark-default-handler + `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark))))) + ;; Init the man package variables, if not already done. (Man-init-defvars)