]> code.delx.au - gnu-emacs/blobdiff - lisp/man.el
Merge changes from emacs-23 branch
[gnu-emacs] / lisp / man.el
index d64846a2d4da9a73fe3f3cb7902784e12bfe9469..c8c2f8653e214c262dcaf36df63a45cdb15e1a3a 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, 2010  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
@@ -221,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.")
 
@@ -283,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.")
 
@@ -308,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.")
@@ -617,36 +623,32 @@ and the `Man-section-translations-alist' variables)."
       (concat Man-specified-section-option section " " name))))
 
 (defun Man-support-local-filenames ()
-  "Check the availability of `-l' option of the man command.
-This option allows `man' to interpret command line arguments
-as local filenames.
-Return the value of the variable `Man-support-local-filenames'
-if it was set to nil or t before the call of this function.
-If t, the man command supports `-l' option.  If nil, it doesn't.
-Otherwise, if the value of `Man-support-local-filenames'
-is neither t nor nil, then determine a new value, set it
-to the variable `Man-support-local-filenames' and return
-a new value."
-  (if (or (not Man-support-local-filenames)
-          (eq Man-support-local-filenames t))
-      Man-support-local-filenames
-    (setq Man-support-local-filenames
-          (with-temp-buffer
-            (and (equal (condition-case nil
-                           (let ((default-directory
-                                   ;; Assure that `default-directory' exists
-                                   ;; and is readable.
-                                   (if (and (file-directory-p default-directory)
-                                            (file-readable-p default-directory))
-                                       default-directory
-                                     (expand-file-name "~/"))))
-                             (call-process manual-program nil t nil "--help"))
-                          (error nil))
-                        0)
-                 (progn
-                   (goto-char (point-min))
-                   (search-forward "--local-file" nil t))
-                 t)))))
+  "Return non-nil if the man command supports local filenames.
+Different man programs support this feature in different ways.
+The default Debian man program (\"man-db\") has a `--local-file'
+\(or `-l') option for this purpose.  The default Red Hat man
+program has no such option, but interprets any name containing
+a \"/\" as a local filename.  The function returns either `man-db'
+`man', or nil."
+  (if (eq Man-support-local-filenames 'auto-detect)
+      (setq Man-support-local-filenames
+            (with-temp-buffer
+              (let ((default-directory
+                      ;; Ensure that `default-directory' exists and is readable.
+                      (if (and (file-directory-p default-directory)
+                               (file-readable-p default-directory))
+                        default-directory
+                        (expand-file-name "~/"))))
+                (ignore-errors
+                  (call-process manual-program nil t nil "--help")))
+              (cond ((search-backward "--local-file" nil 'move)
+                     'man-db)
+                    ;; This feature seems to be present in at least ver 1.4f,
+                    ;; which is about 20 years old.
+                    ;; I don't know if this version has an official name?
+                    ((looking-at "^man, versione? [1-9]")
+                     'man))))
+    Man-support-local-filenames))
 
 \f
 ;; ======================================================================
@@ -753,6 +755,9 @@ POS defaults to `point'."
   (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)
@@ -882,7 +887,8 @@ names or descriptions.  The pattern argument is usually an
     (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)))
@@ -960,15 +966,16 @@ names or descriptions.  The pattern argument is usually an
                           (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
@@ -979,28 +986,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 ""))
      )))
 
@@ -1144,7 +1150,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
@@ -1268,6 +1276,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 ()
@@ -1324,6 +1334,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)
@@ -1658,6 +1670,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)
@@ -1667,5 +1719,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