merge trunk
[bpt/emacs.git] / lisp / man.el
index 364a5d2..0b3ac53 100644 (file)
@@ -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, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2011
+;;   Free Software Foundation, Inc.
 
 ;; Author: Barry A. Warsaw <bwarsaw@cen.com>
 ;; Maintainer: FSF
 ;;   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.
 
 \f
 ;;; Code:
 (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.
@@ -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.")
 
@@ -313,7 +314,7 @@ This regexp should not start with a `^' character.")
   "Regular expression describing references to normal files.")
 
 ;; This includes the section as an optional part to catch hyphenated
-;; refernces to manpages.
+;; references to manpages.
 (defvar Man-hyphenated-reference-regexp
   (concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?")
   "Regular expression describing a reference in the SEE ALSO section.")
@@ -660,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))
@@ -756,45 +757,113 @@ POS defaults to `point'."
 
 (defun Man-completion-table (string pred action)
   (cond
-   ((memq action '(t nil))
-    (let ((table (cdr Man-completion-cache)))
+   ((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) string))
-      (with-temp-buffer
-        ;; Actually for my `man' the arg is a regexp.  Don't know how
-        ;; standard that is.  Also, it's not clear what kind of
-        ;; regexp are accepted: under GNU/Linux it seems it's ERE-style,
-        ;; whereas under MacOSX it seems to be BRE-style and
-        ;; doesn't accept backslashes at all.  Let's not bother to
-        ;; quote anything.
-          (call-process manual-program nil '(t nil) nil
-                        "-k" (concat "^" string))
-        (goto-char (point-min))
-        (while (re-search-forward "^[^ \t\n]+" nil t)
-          (push (match-string 0) table)))
+                   (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 string table)))
+        (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.
-      (complete-with-action action table string pred)))
-   ((eq action 'lambda) t)
-   ((eq (car-safe action) 'boundaries) nil)))
+      (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-mode-map>\\[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))
+               ;; 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 "")
@@ -822,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)))
@@ -900,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
@@ -919,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 ""))
      )))
 
@@ -1027,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)
@@ -1079,7 +1154,9 @@ default type, `Man-xref-man-page' is used for the buttons."
                 (goto-char (point-min))
                 nil)))
       (while (re-search-forward regexp end t)
-       (make-text-button
+       ;; An overlay button is preferable because the underlying text
+       ;; may have text property highlights (Bug#7881).
+       (make-button
         (match-beginning button-pos)
         (match-end button-pos)
         'type type
@@ -1114,6 +1191,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))
 
@@ -1142,6 +1224,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))))
@@ -1186,6 +1280,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 ()
@@ -1242,6 +1338,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)
@@ -1433,7 +1531,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.
@@ -1574,6 +1674,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)))))
+
 \f
 ;; Init the man package variables, if not already done.
 (Man-init-defvars)
@@ -1583,5 +1723,4 @@ Specify which REFERENCE to use; default is based on word at point."
 
 (provide 'man)
 
-;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47
 ;;; man.el ends here