]> code.delx.au - gnu-emacs/blobdiff - lisp/man.el
Fix buggy calls to `error'.
[gnu-emacs] / lisp / man.el
index 30ab44efad0a40b1227c5c78fbef3cd47c7e959a..c3621be1c97358240d903b077ec5f174d2aaa699 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 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Barry A. Warsaw <bwarsaw@cen.com>
 ;; Maintainer: FSF
@@ -12,7 +12,7 @@
 
 ;; 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 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -37,7 +37,7 @@
 
 ;; ========== Credits and History ==========
 ;; In mid 1991, several people posted some interesting improvements to
-;; man.el from the standard emacs 18.57 distribution.  I liked many of
+;; man.el from the standard Emacs 18.57 distribution.  I liked many of
 ;; these, but wanted everything in one single package, so I decided
 ;; to incorporate them into a single manual browsing mode.  While
 ;; much of the code here has been rewritten, and some features added,
@@ -64,7 +64,7 @@
 ;; ========== Features ==========
 ;; + Runs "man" in the background and pipes the results through a
 ;;   series of sed and awk scripts so that all retrieving and cleaning
-;;   is done in the background. The cleaning commands are configurable.
+;;   is done in the background.  The cleaning commands are configurable.
 ;; + Syntax is the same as Un*x man
 ;; + Functionality is the same as Un*x man, including "man -k" and
 ;;   "man <section>", etc.
 
 
 (defvar Man-notify)
-(defvar Man-current-page)
-(defvar Man-page-list)
 (defcustom Man-filter-list nil
   "*Manpage cleaning filter command phrases.
 This variable contains a list of the following form:
@@ -127,13 +125,8 @@ the manpage buffer."
                               (string :tag "Phrase String"))))
   :group 'man)
 
-(defvar Man-original-frame)
-(defvar Man-arguments)
-(defvar Man-sections-alist)
-(defvar Man-refpages-alist)
 (defvar Man-uses-untabify-flag t
   "Non-nil means use `untabify' instead of `Man-untabify-command'.")
-(defvar Man-page-mode-string)
 (defvar Man-sed-script nil
   "Script for sed to nuke backspaces and ANSI codes from manpages.")
 
@@ -141,28 +134,28 @@ the manpage buffer."
 ;; user variables
 
 (defcustom Man-fontify-manpage-flag t
-  "*Non-nil means make up the manpage with fonts."
+  "Non-nil means make up the manpage with fonts."
   :type 'boolean
   :group 'man)
 
 (defcustom Man-overstrike-face 'bold
-  "*Face to use when fontifying overstrike."
+  "Face to use when fontifying overstrike."
   :type 'face
   :group 'man)
 
 (defcustom Man-underline-face 'underline
-  "*Face to use when fontifying underlining."
+  "Face to use when fontifying underlining."
   :type 'face
   :group 'man)
 
 (defcustom Man-reverse-face 'highlight
-  "*Face to use when fontifying reverse video."
+  "Face to use when fontifying reverse video."
   :type 'face
   :group 'man)
 
 ;; Use the value of the obsolete user option Man-notify, if set.
 (defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
-  "*Selects the behavior when manpage is ready.
+  "Selects the behavior when manpage is ready.
 This variable may have one of the following values, where (sf) means
 that the frames are switched, so the manpage is displayed in the frame
 where the man command was called from:
@@ -183,7 +176,7 @@ Any other value of `Man-notify-method' is equivalent to `meek'."
   :group 'man)
 
 (defcustom Man-width nil
-  "*Number of columns for which manual pages should be formatted.
+  "Number of columns for which manual pages should be formatted.
 If nil, the width of the window selected at the moment of man
 invocation is used.  If non-nil, the width of the frame selected
 at the moment of man invocation is used.  The value also can be a
@@ -194,12 +187,12 @@ positive integer."
   :group 'man)
 
 (defcustom Man-frame-parameters nil
-  "*Frame parameter list for creating a new frame for a manual page."
+  "Frame parameter list for creating a new frame for a manual page."
   :type 'sexp
   :group 'man)
 
 (defcustom Man-downcase-section-letters-flag t
-  "*Non-nil means letters in sections are converted to lower case.
+  "Non-nil means letters in sections are converted to lower case.
 Some Un*x man commands can't handle uppercase letters in sections, for
 example \"man 2V chmod\", but they are often displayed in the manpage
 with the upper case letter.  When this variable is t, the section
@@ -209,7 +202,7 @@ being sent to the man background process."
   :group 'man)
 
 (defcustom Man-circular-pages-flag t
-  "*Non-nil means the manpage list is treated as circular for traversal."
+  "Non-nil means the manpage list is treated as circular for traversal."
   :type 'boolean
   :group 'man)
 
@@ -220,7 +213,7 @@ being sent to the man background process."
    ;; '("3X" . "3")                        ; Xlib man pages
    '("3X11" . "3")
    '("1-UCB" . ""))
-  "*Association list of bogus sections to real section numbers.
+  "Association list of bogus sections to real section numbers.
 Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
 their references which Un*x `man' does not recognize.  This
 association list is used to translate those sections, when found, to
@@ -250,9 +243,6 @@ the associated section number."
 (defvar Man-awk-command "awk"
   "Command used for processing awk scripts.")
 
-(defvar Man-mode-map nil
-  "Keymap for Man mode.")
-
 (defvar Man-mode-hook nil
   "Hook run when Man mode is enabled.")
 
@@ -262,7 +252,7 @@ the associated section number."
 (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-Z+]*\\|[LNln]"
+(defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]"
   "Regular expression describing a manpage section within parentheses.")
 
 (defvar Man-page-header-regexp
@@ -274,14 +264,17 @@ the associated section number."
            "(\\(" Man-section-regexp "\\))\\).*\\1"))
   "Regular expression describing the heading of a page.")
 
-(defvar Man-heading-regexp "^\\([A-Z][A-Z -]+\\)$"
+(defvar Man-heading-regexp "^\\([A-Z][A-Z0-9 /-]+\\)$"
   "Regular expression describing a manpage heading entry.")
 
 (defvar Man-see-also-regexp "SEE ALSO"
   "Regular expression for SEE ALSO heading (or your equivalent).
 This regexp should not start with a `^' character.")
 
-(defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
+;; This used to have leading space [ \t]*, but was removed because it
+;; causes false page splits on an occasional NAME with leading space
+;; inside a manpage.  And `Man-heading-regexp' doesn't have [ \t]* anyway.
+(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry fo.*$"
   "Regular expression describing first heading on a manpage.
 This regular expression should start with a `^' character.")
 
@@ -304,7 +297,7 @@ This regexp should not start with a `^' character.")
 (defvar Man-include-regexp "#[ \t]*include[ \t]*"
   "Regular expression describing the #include (directive of cpp).")
 
-(defvar Man-file-name-regexp "[^<>\" \t\n]+"
+(defvar Man-file-name-regexp "[^<>\", \t\n]+"
   "Regular expression describing <> in #include line (directive of cpp).")
 
 (defvar Man-normal-file-prefix-regexp "[/~$]"
@@ -349,20 +342,22 @@ Otherwise, the value is whatever the function
 ;; end user variables
 \f
 ;; other variables and keymap initializations
+(defvar Man-original-frame)
+(make-variable-buffer-local 'Man-original-frame)
+(defvar Man-arguments)
+(make-variable-buffer-local 'Man-arguments)
+(put 'Man-arguments 'permanent-local t)
+
+(defvar Man-sections-alist nil)
 (make-variable-buffer-local 'Man-sections-alist)
+(defvar Man-refpages-alist nil)
 (make-variable-buffer-local 'Man-refpages-alist)
+(defvar Man-page-list nil)
 (make-variable-buffer-local 'Man-page-list)
+(defvar Man-current-page 0)
 (make-variable-buffer-local 'Man-current-page)
+(defvar Man-page-mode-string "1 of 1")
 (make-variable-buffer-local 'Man-page-mode-string)
-(make-variable-buffer-local 'Man-original-frame)
-(make-variable-buffer-local 'Man-arguments)
-(put 'Man-arguments 'permanent-local t)
-
-(setq-default Man-sections-alist nil)
-(setq-default Man-refpages-alist nil)
-(setq-default Man-page-list nil)
-(setq-default Man-current-page 0)
-(setq-default Man-page-mode-string "1 of 1")
 
 (defconst Man-sysv-sed-script "\
 /\b/ { s/_\b//g
@@ -388,6 +383,8 @@ Otherwise, the value is whatever the function
 /\e\\[[0-9][0-9]*m/ s///g"
   "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
 
+(defvar Man-topic-history nil "Topic read history.")
+
 (defvar man-mode-syntax-table
   (let ((table (copy-syntax-table (standard-syntax-table))))
     (modify-syntax-entry ?. "w" table)
@@ -396,37 +393,49 @@ Otherwise, the value is whatever the function
     table)
   "Syntax table used in Man mode buffers.")
 
-(unless Man-mode-map
-  (setq Man-mode-map (make-sparse-keymap))
-  (suppress-keymap Man-mode-map)
-  (set-keymap-parent Man-mode-map button-buffer-map)
-
-  (define-key Man-mode-map " "    'scroll-up)
-  (define-key Man-mode-map "\177" 'scroll-down)
-  (define-key Man-mode-map "n"    'Man-next-section)
-  (define-key Man-mode-map "p"    'Man-previous-section)
-  (define-key Man-mode-map "\en"  'Man-next-manpage)
-  (define-key Man-mode-map "\ep"  'Man-previous-manpage)
-  (define-key Man-mode-map ">"    'end-of-buffer)
-  (define-key Man-mode-map "<"    'beginning-of-buffer)
-  (define-key Man-mode-map "."    'beginning-of-buffer)
-  (define-key Man-mode-map "r"    'Man-follow-manual-reference)
-  (define-key Man-mode-map "g"    'Man-goto-section)
-  (define-key Man-mode-map "s"    'Man-goto-see-also-section)
-  (define-key Man-mode-map "k"    'Man-kill)
-  (define-key Man-mode-map "q"    'Man-quit)
-  (define-key Man-mode-map "m"    'man)
-  (define-key Man-mode-map "?"    'describe-mode))
+(defvar Man-mode-map
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
+    (set-keymap-parent map button-buffer-map)
+
+    (define-key map " "    'scroll-up)
+    (define-key map "\177" 'scroll-down)
+    (define-key map "n"    'Man-next-section)
+    (define-key map "p"    'Man-previous-section)
+    (define-key map "\en"  'Man-next-manpage)
+    (define-key map "\ep"  'Man-previous-manpage)
+    (define-key map ">"    'end-of-buffer)
+    (define-key map "<"    'beginning-of-buffer)
+    (define-key map "."    'beginning-of-buffer)
+    (define-key map "r"    'Man-follow-manual-reference)
+    (define-key map "g"    'Man-goto-section)
+    (define-key map "s"    'Man-goto-see-also-section)
+    (define-key map "k"    'Man-kill)
+    (define-key map "q"    'Man-quit)
+    (define-key map "m"    'man)
+    ;; Not all the man references get buttons currently.  The text in the
+    ;; manual page can contain references to other man pages
+    (define-key map "\r"   'man-follow)
+    (define-key map "?"    'describe-mode)
+    map)
+  "Keymap for Man mode.")
 
 ;; buttons
 (define-button-type 'Man-abstract-xref-man-page
   'follow-link t
   'help-echo "mouse-2, RET: display this man page"
   'func nil
-  'action (lambda (button) (funcall 
-                           (button-get button 'func)
-                           (or (button-get button 'Man-target-string)
-                               (button-label button)))))
+  'action #'Man-xref-button-action)
+
+(defun Man-xref-button-action (button) 
+  (let ((target (button-get button 'Man-target-string)))
+    (funcall 
+     (button-get button 'func)
+     (cond ((null target)
+           (button-label button))
+          ((functionp target)
+           (funcall target (button-start button)))
+          (t target)))))
 
 (define-button-type 'Man-xref-man-page 
   :supertype 'Man-abstract-xref-man-page
@@ -616,7 +625,14 @@ a new value."
     (setq Man-support-local-filenames
           (with-temp-buffer
             (and (equal (condition-case nil
-                            (call-process manual-program nil t nil "--help")
+                           (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
@@ -628,17 +644,24 @@ a new value."
 ;; ======================================================================
 ;; default man entry: get word under point
 
-(defsubst Man-default-man-entry ()
-  "Make a guess at a default manual entry.
-This guess is based on the text surrounding the cursor."
+(defsubst Man-default-man-entry (&optional pos)
+  "Make a guess at a default manual entry based on the text at POS.
+If POS is nil, the current point is used."
   (let (word)
     (save-excursion
+      (if pos (goto-char pos))
       ;; Default man entry title is any word the cursor is on, or if
       ;; cursor not on a word, then nearest preceding word.
       (skip-chars-backward "-a-zA-Z0-9._+:")
       (let ((start (point)))
        (skip-chars-forward "-a-zA-Z0-9._+:")
-       (setq word (buffer-substring-no-properties start (point))))
+       ;; If there is a continuation at the end of line, check the
+       ;; following line too, eg:
+       ;;     see this-
+       ;;     command-here(1)
+       (setq word (buffer-substring-no-properties start (point)))
+       (if (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])")
+           (setq word (concat word (match-string 1)))))
       (if (string-match "[._]+$" word)
          (setq word (substring word 0 (match-beginning 0))))
       ;; If looking at something like *strcat(... , remove the '*'
@@ -680,7 +703,7 @@ all sections related to a subject, put something appropriate into the
                                (if (string= default-entry "")
                                    ": "
                                  (format " (default %s): " default-entry)))
-                       nil nil default-entry)))
+                       nil 'Man-topic-history default-entry)))
           (if (string= input "")
               (error "No man args given")
             input))))
@@ -710,8 +733,7 @@ all sections related to a subject, put something appropriate into the
       (require 'env)
       (message "Invoking %s %s in the background" manual-program man-args)
       (setq buffer (generate-new-buffer bufname))
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (setq buffer-undo-list t)
        (setq Man-original-frame (selected-frame))
        (setq Man-arguments man-args))
@@ -744,17 +766,16 @@ all sections related to a subject, put something appropriate into the
        ;;               minal (using an ioctl(2) if available, the value of
        ;;               $COLUMNS,  or falling back to 80 characters if nei-
        ;;               ther is available).
-       (if window-system
-           (unless (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.
-             (setenv "COLUMNS" (number-to-string
-                                (cond
-                                 ((and (integerp Man-width) (> Man-width 0))
-                                  Man-width)
-                                 (Man-width (frame-width))
-                                 ((window-width)))))))
+       (unless (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.
+         (setenv "COLUMNS" (number-to-string
+                            (cond
+                             ((and (integerp Man-width) (> Man-width 0))
+                              Man-width)
+                             (Man-width (frame-width))
+                             ((window-width))))))
        (setenv "GROFF_NO_SGR" "1")
        (if (fboundp 'start-process)
            (set-process-sentinel
@@ -782,8 +803,7 @@ all sections related to a subject, put something appropriate into the
 (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 (save-excursion
-                      (set-buffer man-buffer)
+  (let ((saved-frame (with-current-buffer man-buffer
                       Man-original-frame)))
     (cond
      ((eq Man-notify-method 'newframe)
@@ -919,31 +939,29 @@ Same for the ANSI bold and normal escape sequences."
 (defun Man-highlight-references (&optional xref-man-type)
   "Highlight the references on mouse-over.
 References include items in the SEE ALSO section,
-header file (#include <foo.h>) and files in FILES.
-If XREF-MAN-TYPE is used as the button type for items
-in SEE ALSO section. If it is nil, default type, 
-`Man-xref-man-page' is used."
+header file (#include <foo.h>), and files in FILES.
+If optional argument XREF-MAN-TYPE is non-nil, it used as the
+button type for items in SEE ALSO section.  If it is nil, the
+default type, `Man-xref-man-page' is used for the buttons."
+  ;; `Man-highlight-references' is used from woman.el, too.
+  ;; woman.el doesn't set `Man-arguments'.
+  (unless Man-arguments
+    (setq Man-arguments ""))
   (if (string-match "-k " Man-arguments)
       (progn
-       (Man-highlight-references0
-        nil Man-reference-regexp 1 nil
-        (or xref-man-type 'Man-xref-man-page))
-       (Man-highlight-references0
-        nil Man-apropos-regexp 1 (lambda () 
-                                   (format "%s(%s)"
-                                           (match-string 1)
-                                           (match-string 2)))
-        (or xref-man-type 'Man-xref-man-page))
-       )
-    (Man-highlight-references0
-     Man-see-also-regexp Man-reference-regexp 1 nil
-     (or xref-man-type 'Man-xref-man-page))
-    (Man-highlight-references0
-     Man-synopsis-regexp Man-header-regexp 0 2
-     'Man-xref-header-file)
-    (Man-highlight-references0
-     Man-files-regexp Man-normal-file-regexp 0 0
-     'Man-xref-normal-file)))
+       (Man-highlight-references0 nil Man-reference-regexp 1
+                                  'Man-default-man-entry
+                                  (or xref-man-type 'Man-xref-man-page))
+       (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-default-man-entry
+                              (or xref-man-type 'Man-xref-man-page))
+    (Man-highlight-references0 Man-synopsis-regexp Man-header-regexp 0 2
+                              'Man-xref-header-file)
+    (Man-highlight-references0 Man-files-regexp Man-normal-file-regexp 0 0
+                              'Man-xref-normal-file)))
 
 (defun Man-highlight-references0 (start-section regexp button-pos target type)
   ;; Based on `Man-build-references-alist'
@@ -957,7 +975,7 @@ in SEE ALSO section. If it is nil, default type,
                       (Man-next-section 1)
                       (point)))
                 (goto-char (point-min))
-                (point-max))))
+                nil)))
       (while (re-search-forward regexp end t)
        (make-text-button
         (match-beginning button-pos)
@@ -967,7 +985,7 @@ in SEE ALSO section. If it is nil, default type,
                             ((numberp target) 
                              (match-string target))
                             ((functionp target)
-                             (funcall target))
+                             target)
                             (t nil)))))))
 
 (defun Man-cleanup-manpage (&optional interactive)
@@ -1013,8 +1031,7 @@ manpage command."
        (or (stringp process)
            (set-process-buffer process nil))
 
-      (save-excursion
-       (set-buffer Man-buffer)
+      (with-current-buffer Man-buffer
        (let ((case-fold-search nil))
          (goto-char (point-min))
          (cond ((or (looking-at "No \\(manual \\)*entry for")
@@ -1060,7 +1077,7 @@ manpage command."
            (Man-notify-when-ready Man-buffer))
 
        (if err-mess
-           (error err-mess))
+           (error "%s" err-mess))
        ))))
 
 \f
@@ -1205,13 +1222,10 @@ The following key bindings are currently in effect in the buffer:
 
 (defun Man-strip-page-headers ()
   "Strip all the page headers but the first from the manpage."
-  (let ((buffer-read-only nil)
+  (let ((inhibit-read-only t)
        (case-fold-search nil)
-       (page-list Man-page-list)
-       (page ())
        (header ""))
-    (while page-list
-      (setq page (car page-list))
+    (dolist (page Man-page-list)
       (and (nth 2 page)
           (goto-char (car page))
           (re-search-forward Man-first-heading-regexp nil t)
@@ -1225,17 +1239,14 @@ The following key bindings are currently in effect in the buffer:
           ;; line.
           ;; (setq header (concat "\n" header)))
           (while (search-forward header (nth 1 page) t)
-            (replace-match "")))
-      (setq page-list (cdr page-list)))))
+            (replace-match ""))))))
 
 (defun Man-unindent ()
   "Delete the leading spaces that indent the manpage."
-  (let ((buffer-read-only nil)
-       (case-fold-search nil)
-       (page-list Man-page-list))
-    (while page-list
-      (let ((page (car page-list))
-           (indent "")
+  (let ((inhibit-read-only t)
+       (case-fold-search nil))
+    (dolist (page Man-page-list)
+      (let ((indent "")
            (nindent 0))
        (narrow-to-region (car page) (car (cdr page)))
        (if Man-uses-untabify-flag
@@ -1263,7 +1274,6 @@ The following key bindings are currently in effect in the buffer:
              (or (eolp)
                  (delete-char nindent))
              (forward-line 1)))
-       (setq page-list (cdr page-list))
        ))))
 
 \f
@@ -1273,12 +1283,18 @@ The following key bindings are currently in effect in the buffer:
 (defun Man-next-section (n)
   "Move point to Nth next section (default 1)."
   (interactive "p")
-  (let ((case-fold-search nil))
+  (let ((case-fold-search nil)
+        (start (point)))
     (if (looking-at Man-heading-regexp)
        (forward-line 1))
     (if (re-search-forward Man-heading-regexp (point-max) t n)
        (beginning-of-line)
-      (goto-char (point-max)))))
+      (goto-char (point-max))
+      ;; The last line doesn't belong to any section.
+      (forward-line -1))
+    ;; But don't move back from the starting point (can happen if `start'
+    ;; is somewhere on the last line).
+    (if (< (point) start) (goto-char start))))
 
 (defun Man-previous-section (n)
   "Move point to Nth previous section (default 1)."
@@ -1322,7 +1338,7 @@ Returns t if section is found, nil otherwise."
 Actually the section moved to is described by `Man-see-also-regexp'."
   (interactive)
   (if (not (Man-find-section Man-see-also-regexp))
-      (error (concat "No " Man-see-also-regexp
+      (error "%s" (concat "No " Man-see-also-regexp
                     " section found in the current manpage"))))
 
 (defun Man-possibly-hyphenated-word ()
@@ -1442,7 +1458,7 @@ Specify which REFERENCE to use; default is based on word at point."
   (let ((path Man-header-file-path)
         complete-path)
     (while path
-      (setq complete-path (concat (car path) "/" file)
+      (setq complete-path (expand-file-name file (car path))
             path (cdr path))
       (if (file-readable-p complete-path)
           (progn (view-file complete-path)