]> code.delx.au - gnu-emacs/blobdiff - lisp/man.el
* doc/emacs/dired.texi (Shell Commands in Dired): Fix typo.
[gnu-emacs] / lisp / man.el
index eb21cb2e834f2bec5881782c8cbb90737062f20f..0a7b831ca8ef73610c313aa3fc6646a4c7861598 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, 2011  Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2012
+;;   Free Software Foundation, Inc.
 
 ;; Author: Barry A. Warsaw <bwarsaw@cen.com>
 ;; Maintainer: FSF
@@ -215,15 +215,27 @@ the associated section number."
                       (string :tag "Real Section")))
   :group 'man)
 
+;; FIXME see comments at ffap-c-path.
 (defcustom Man-header-file-path
-  '("/usr/include" "/usr/local/include")
+  (let ((arch (with-temp-buffer
+                (when (eq 0 (ignore-errors
+                              (call-process "gcc" nil '(t nil) nil
+                                            "-print-multiarch")))
+                  (goto-char (point-min))
+                  (buffer-substring (point) (line-end-position)))))
+        (base '("/usr/include" "/usr/local/include")))
+    (if (zerop (length arch))
+        base
+      (append base (list (expand-file-name arch "/usr/include")))))
   "C Header file search path used in Man."
+  :version "24.1"                       ; add multiarch
   :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."
+  :version "24.1"
   :type 'string :group 'bookmark)
 
 (defvar manual-program "man"
@@ -254,8 +266,7 @@ Used in `bookmark-set' to get the default bookmark name."
   "Regular expression describing a manpage section within parentheses.")
 
 (defvar Man-page-header-regexp
-  (if (and (string-match "-solaris2\\." system-configuration)
-          (not (string-match "-solaris2\\.[123435]$" system-configuration)))
+  (if (string-match "-solaris2\\." system-configuration)
       (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
              "(\\(" Man-section-regexp "\\))\\)$")
     (concat "^[ \t]*\\(" Man-name-regexp
@@ -277,7 +288,9 @@ This regexp should not start with a `^' character.")
 This regular expression should start with a `^' character.")
 
 (defvar Man-reference-regexp
-  (concat "\\(" Man-name-regexp "\\)[ \t]*(\\(" Man-section-regexp "\\))")
+  (concat "\\(" Man-name-regexp
+         "\\(\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\("
+         Man-section-regexp "\\))")
   "Regular expression describing a reference to another manpage.")
 
 (defvar Man-apropos-regexp
@@ -397,8 +410,8 @@ Otherwise, the value is whatever the function
     (suppress-keymap map)
     (set-keymap-parent map button-buffer-map)
 
-    (define-key map " "    'scroll-up)
-    (define-key map "\177" 'scroll-down)
+    (define-key map " "    'scroll-up-command)
+    (define-key map "\177" 'scroll-down-command)
     (define-key map "n"    'Man-next-section)
     (define-key map "p"    'Man-previous-section)
     (define-key map "\en"  'Man-next-manpage)
@@ -598,8 +611,8 @@ and the `Man-section-translations-alist' variables)."
     (cond
      ;; "chmod(2V)" case ?
      ((string-match (concat "^" Man-reference-regexp "$") ref)
-      (setq name (match-string 1 ref)
-           section (match-string 2 ref)))
+      (setq name (replace-regexp-in-string "[\n\t ]" "" (match-string 1 ref))
+           section (match-string 3 ref)))
      ;; "2v chmod" case ?
      ((string-match (concat "^\\(" Man-section-regexp
                            "\\) +\\(" Man-name-regexp "\\)$") ref)
@@ -623,36 +636,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
 ;; ======================================================================
@@ -690,7 +699,7 @@ POS defaults to `point'."
          ;; Otherwise record the current column and look backwards.
          (setq column (current-column))
          (skip-chars-backward ",; \t")
-         ;; Record the distance travelled.
+         ;; Record the distance traveled.
          (setq distance (- column (current-column)))
          (when (looking-back
                 (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)"))
@@ -757,8 +766,10 @@ POS defaults to `point'."
 
 (defun Man-completion-table (string pred action)
   (cond
-   ((eq action 'lambda)
-    (not (string-match "([^)]*\\'" string)))
+   ;; This ends up returning t for pretty much any string, and hence leads to
+   ;; spurious "complete but not unique" messages.  And since `man' doesn't
+   ;; require-match anyway, there's not point being clever.
+   ;;((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))
@@ -934,7 +945,8 @@ Return the buffer in which the manpage will appear."
        ;;               minal (using an ioctl(2) if available, the value of
        ;;               $COLUMNS,  or falling back to 80 characters if nei-
        ;;               ther is available).
-       (unless (or (getenv "MANWIDTH") (getenv "COLUMNS"))
+       (when (or window-system
+                  (not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
          ;; This isn't strictly correct, since we don't know how
          ;; the page will actually be displayed, but it seems
          ;; reasonable.
@@ -1098,7 +1110,7 @@ Same for the ANSI bold and normal escape sequences."
       (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
+    ;; condense it to a shorter line interspersed 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))
@@ -1111,7 +1123,7 @@ Same for the ANSI bold and normal escape sequences."
       (put-text-property (match-beginning 0)
                         (match-end 0)
                         'face Man-overstrike-face)))
-  (message "%s man page formatted" Man-arguments))
+  (message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
 
 (defun Man-highlight-references (&optional xref-man-type)
   "Highlight the references on mouse-over.
@@ -1154,7 +1166,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
@@ -1190,7 +1204,7 @@ 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
+  ;; condense it to a shorter line interspersed 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))
@@ -1258,12 +1272,11 @@ manpage command."
          (Man-mode)
 
          (if (not Man-page-list)
-             (let ((args Man-arguments))
+             (let ((args Man-arguments))
                (kill-buffer (current-buffer))
-               (error "Can't find the %s manpage" args)))
-
-          (set-buffer-modified-p nil)
-          ))
+               (error "Can't find the %s manpage"
+                      (Man-page-from-arguments args)))
+           (set-buffer-modified-p nil))))
        ;; Restore case-fold-search before calling
        ;; Man-notify-when-ready because it may switch buffers.
 
@@ -1274,6 +1287,18 @@ manpage command."
            (error "%s" err-mess))
        ))))
 
+(defun Man-page-from-arguments (args)
+  ;; Skip arguments and only print the page name.
+  (mapconcat
+   'identity
+   (delete nil
+          (mapcar
+           (lambda (elem)
+             (and (not (string-match "^-" elem))
+                  elem))
+           (split-string args " ")))
+   " "))
+
 \f
 ;; ======================================================================
 ;; set up manual mode in buffer and build alists
@@ -1721,5 +1746,4 @@ Uses `Man-name-local-regexp'."
 
 (provide 'man)
 
-;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47
 ;;; man.el ends here