(describe-function): Fix previous change.
[bpt/emacs.git] / lisp / man.el
index 397cd42..719b12e 100644 (file)
@@ -3,8 +3,8 @@
 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
 
 ;; Author:             Barry A. Warsaw <bwarsaw@cen.com>
-;; Last-Modified:      $Date: 1994/10/20 10:04:17 $
-;; Version:            $Revision: 1.53 $
+;; Last-Modified:      $Date: 1994/11/09 12:38:31 $
+;; Version:            $Revision: 1.59 $
 ;; Keywords:           help
 ;; Adapted-By:         ESR, pot
 
@@ -83,9 +83,8 @@
 ;;   headers, and after the page footer.  But it is possible to compute
 ;;   the number of blank lines before the page footer by euristhics
 ;;   only.  Is it worth doing?
-;; - Allow the Man-reuse-okay-flag to be set to 'always, meaning that all
-;;   the manpages should go in the same buffer, where they can be browsed
-;;   with M-n and M-p.
+;; - 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
 (defvar Man-filter-list)
 (defvar Man-original-frame)
 (defvar Man-arguments)
-(defvar Man-fontify-manpage-flag)
 (defvar Man-sections-alist)
 (defvar Man-refpages-alist)
 (defvar Man-uses-untabify-flag)
 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
 ;; user variables
 
-(defvar manual-program "man"
-  "The name of the program that produces man pages.")
+(defvar Man-fontify-manpage-flag t
+  "*Make up the manpage with fonts.")
+
+(defvar Man-overstrike-face 'bold
+  "*Face to use when fontifying overstrike.")
+
+(defvar Man-underline-face 'underline
+  "*Face to use when fontifying underlinining.")
 
 ;; Use the value of the obsolete user option Man-notify, if set.
 (defvar Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
@@ -140,13 +144,6 @@ Any other value of `Man-notify-method' is equivalent to `meek'.")
 (defvar Man-frame-parameters nil
   "*Frame parameter list for creating a new frame for a manual page.")
 
-(defvar Man-reuse-okay-flag t
-  "*Reuse a manpage buffer if possible.
-If non-nil, and a manpage buffer already exists with the same
-invocation, man just indicates the manpage is ready according to the
-value of `Man-notify-method'.  When nil, it always fires off a
-background process,putting the results in a uniquely named buffer.")
-
 (defvar Man-downcase-section-letters-flag t
   "*Letters in sections are converted to lower case.
 Some Un*x man commands can't handle uppercase letters in sections, for
@@ -171,39 +168,20 @@ their references which Un*x `man' does not recognize.  This
 association list is used to translate those sections, when found, to
 the associated section number.")
 
+(defvar manual-program "man"
+  "The name of the program that produces man pages.")
+
 (defvar Man-untabify-command "pr"
-  "*Command used for untabifying.")
+  "Command used for untabifying.")
 
 (defvar Man-untabify-command-args (list "-t" "-e")
-  "*List of arguments to be passed to Man-untabify-command (which see).")
+  "List of arguments to be passed to Man-untabify-command (which see).")
 
 (defvar Man-sed-command "sed"
-  "*Command used for processing sed scripts.")
+  "Command used for processing sed scripts.")
 
 (defvar Man-awk-command "awk"
-  "*Command used for processing awk scripts.")
-
-(defconst Man-sysv-sed-script "\
-/\b/ { s/_\b//g
-       s/\b_//g
-        s/o\b+/o/g
-       :ovstrk
-       s/\\(.\\)\b\\1/\\1/g
-       t ovstrk
-       }
-/\e\\[[0-9][0-9]*m/ s///g"
-  "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
-
-(defconst Man-berkeley-sed-script "\
-/\b/ { s/_\b//g\\
-       s/\b_//g\\
-        s/o\b+/o/g\\
-       :ovstrk\\
-       s/\\(.\\)\b\\1/\\1/g\\
-       t ovstrk\\
-       }\\
-/\e\\[[0-9][0-9]*m/ s///g"
-  "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
+  "Command used for processing awk scripts.")
 
 (defvar Man-mode-line-format
   '("" mode-line-modified
@@ -212,54 +190,51 @@ the associated section number.")
        " " Man-page-mode-string
        "  %[(" mode-name mode-line-process minor-mode-alist ")%]----"
        (-3 . "%p") "-%-")
-  "*Mode line format for manual mode buffer.")
+  "Mode line format for manual mode buffer.")
 
 (defvar Man-mode-map nil
-  "*Keymap for Man mode.")
+  "Keymap for Man mode.")
 
 (defvar Man-mode-hook nil
-  "*Hook run when Man mode is enabled.")
+  "Hook run when Man mode is enabled.")
 
 (defvar Man-cooked-hook nil
-  "*Hook run after removing backspaces but before Man-mode processing.")
+  "Hook run after removing backspaces but before Man-mode processing.")
 
 (defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
-  "*Regular expression describing the name of a manpage (without section).")
+  "Regular expression describing the name of a manpage (without section).")
 
 (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
-  "*Regular expression describing a manpage section within parentheses.")
+  "Regular expression describing a manpage section within parentheses.")
 
 (defvar Man-page-header-regexp
   (concat "^[ \t]*\\(" Man-name-regexp
          "(\\(" Man-section-regexp "\\))\\).*\\1")
-  "*Regular expression describing the heading of a page.")
+  "Regular expression describing the heading of a page.")
 
 (defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
-  "*Regular expression describing a manpage heading entry.")
+  "Regular expression describing a manpage heading entry.")
 
 (defvar Man-see-also-regexp "SEE ALSO"
-  "*Regular expression for SEE ALSO heading (or your equivalent).
+  "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.*$"
-  "*Regular expression describing first heading on a manpage.
+  "Regular expression describing first heading on a manpage.
 This regular expression should start with a `^' character.")
 
 (defvar Man-reference-regexp
   (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
-  "*Regular expression describing a reference in the SEE ALSO section.")
+  "Regular expression describing a reference in the SEE ALSO section.")
 
 (defvar Man-switches ""
-  "*Switches passed to the man command, as a single string.")
+  "Switches passed to the man command, as a single string.")
 
-;; Would someone like to provide a good test for being on Solaris?
-;; We could give it its own value of system-type, but that has drawbacks;
-;; it would require changes in lots of places that test system-type.
 (defvar Man-specified-section-option
   (if (string-match "-solaris[0-9.]*$" system-configuration)
       "-s"
     "")
-  "*Option that indicates a specified a manual section name.")
+  "Option that indicates a specified a manual section name.")
 
 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 ;; end user variables
@@ -279,6 +254,30 @@ This regular expression should start with a `^' character.")
 (setq-default Man-current-page 0)
 (setq-default Man-page-mode-string "1 of 1")
 
+(defconst Man-sysv-sed-script "\
+/\b/ { s/_\b//g
+       s/\b_//g
+        s/o\b+/o/g
+        s/+\bo/o/g
+       :ovstrk
+       s/\\(.\\)\b\\1/\\1/g
+       t ovstrk
+       }
+/\e\\[[0-9][0-9]*m/ s///g"
+  "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
+
+(defconst Man-berkeley-sed-script "\
+/\b/ { s/_\b//g\\
+       s/\b_//g\\
+        s/o\b+/o/g\\
+        s/+\bo/o/g\\
+       :ovstrk\\
+       s/\\(.\\)\b\\1/\\1/g\\
+       t ovstrk\\
+       }\\
+/\e\\[[0-9][0-9]*m/ s///g"
+  "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
+
 (if Man-mode-map
     nil
   (setq Man-mode-map (make-keymap))
@@ -310,8 +309,6 @@ This regular expression should start with a `^' character.")
   "Used for initialising variables based on the value of window-system.
 This is necessary if one wants to dump man.el with emacs."
 
-  (defvar Man-fontify-manpage-flag t
-    "*Make up the manpage with fonts.")
   ;; The following is necessary until fonts are implemented on
   ;; terminals.
   (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
@@ -346,7 +343,7 @@ This is necessary if one wants to dump man.el with emacs."
        (if Man-sed-script
           (concat "-e '" Man-sed-script "'")
         "")
-       "-e '/^[\001-\032]*$/d'"
+       "-e '/^[\001-\032][\001-\032]*$/d'"
        "-e '/\e[789]/s///g'"
        "-e '/[Nn]o such file or directory/d'"
        "-e '/Reformatting page.  Wait/d'"
@@ -500,31 +497,25 @@ default section number is selected from `Man-auto-section-alist'."
 (defalias 'manual-entry 'man)
 
 ;;;###autoload
-(defun man (man-args prefix-arg)
+(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.
-Normally, if a buffer already exists for this man page, it will display
-immediately; either a prefix argument or a nil value to `Man-reuse-okay-flag'
-overrides this and forces the man page to be regenerated."
+If a buffer already exists for this man page, it will display immediately."
   (interactive
-   (list
-    ;; first argument
-    (let* ((default-entry (Man-default-man-entry))
-          (input (read-string
-                  (format "Manual entry%s: "
-                          (if (string= default-entry "")
-                              ""
-                            (format " (default %s)" default-entry))))))
-      (if (string= input "")
-         (if (string= default-entry "")
-             (error "No man args given")
-           default-entry)
-       input))
-    ;; second argument
-    current-prefix-arg))
+   (list (let* ((default-entry (Man-default-man-entry))
+               (input (read-string
+                       (format "Manual entry%s: "
+                               (if (string= default-entry "")
+                                   ""
+                                 (format " (default %s)" default-entry))))))
+          (if (string= input "")
+              (if (string= default-entry "")
+                  (error "No man args given")
+                default-entry)
+            input))))
 
   ;; Init the man package variables, if not already done.
   (Man-init-defvars)
@@ -533,20 +524,15 @@ overrides this and forces the man page to be regenerated."
   ;; "section subject" syntax and possibly downcase the section.
   (setq man-args (Man-translate-references man-args))
 
-  (Man-getpage-in-background man-args (consp prefix-arg)))
+  (Man-getpage-in-background man-args))
 
 
-(defun Man-getpage-in-background (topic &optional override-reuse-p)
-  "Uses TOPIC to build and fire off the manpage and cleaning command.
-Optional OVERRIDE-REUSE-P, when non-nil, means to
-start a background process even if a buffer already exists and
-`Man-reuse-okay-flag' is non-nil."
+(defun Man-getpage-in-background (topic)
+  "Uses TOPIC to build and fire off the manpage and cleaning command."
   (let* ((man-args topic)
         (bufname (concat "*Man " man-args "*"))
         (buffer  (get-buffer bufname)))
-    (if (and Man-reuse-okay-flag
-            (not override-reuse-p)
-            buffer)
+    (if buffer
        (Man-notify-when-ready buffer)
       (require 'env)
       (message "Invoking %s %s in the background" manual-program man-args)
@@ -561,8 +547,7 @@ start a background process even if a buffer already exists and
        (set-process-sentinel
         (start-process manual-program buffer "sh" "-c"
                        (format (Man-build-man-command) man-args))
-        'Man-bgproc-sentinel))
-      )))
+        'Man-bgproc-sentinel)))))
 
 (defun Man-notify-when-ready (man-buffer)
   "Notify the user when MAN-BUFFER is ready.
@@ -619,22 +604,22 @@ Same for the ANSI bold and normal escape sequences."
                       (progn (if (search-forward "\e[0m" nil 'move)
                                  (delete-backward-char 4))
                              (point))
-                      'face 'bold))
+                      'face Man-overstrike-face))
   (goto-char (point-min))
   (while (search-forward "_\b" nil t)
     (backward-delete-char 2)
-    (put-text-property (point) (1+ (point)) 'face 'underline))
+    (put-text-property (point) (1+ (point)) 'face Man-underline-face))
   (goto-char (point-min))
   (while (search-forward "\b_" nil t)
     (backward-delete-char 2)
-    (put-text-property (1- (point)) (point) 'face 'underline))
+    (put-text-property (1- (point)) (point) 'face Man-underline-face))
   (goto-char (point-min))
   (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
     (replace-match "\\1")
-    (put-text-property (1- (point)) (point) 'face 'bold))
+    (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
   (goto-char (point-min))
-  (while (search-forward "o\b+" nil t)
-    (backward-delete-char 2)
+  (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
+    (replace-match "o")
     (put-text-property (1- (point)) (point) 'face 'bold))
   (goto-char (point-min))
   (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
@@ -659,7 +644,7 @@ Same for the ANSI bold and normal escape sequences."
        (goto-char (point-min))
        (while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
        (goto-char (point-min))
-       (while (search-forward "o\b+" nil t) (backward-delete-char 2))
+       (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
        ))
   (goto-char (point-min))
   (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
@@ -676,44 +661,43 @@ Same for the ANSI bold and normal escape sequences."
 
       (save-excursion
        (set-buffer Man-buffer)
-       (save-match-data
-         (let ((case-fold-search nil))
-           (goto-char (point-min))
-           (cond ((or (looking-at "No \\(manual \\)*entry for")
-                      (looking-at "[^\n]*: nothing appropriate$"))
-                  (setq err-mess (buffer-substring (point)
-                                                   (progn
-                                                     (end-of-line) (point)))
-                        delete-buff t))
-                 ((not (and (eq (process-status process) 'exit)
-                            (= (process-exit-status process) 0)))
-                  (setq err-mess
-                        (concat (buffer-name Man-buffer)
-                                ": process "
-                                (let ((eos (1- (length msg))))
-                                  (if (= (aref msg eos) ?\n)
-                                      (substring msg 0 eos) msg))))
-                  (goto-char (point-max))
-                  (insert (format "\nprocess %s" msg))
-                  ))
-           (if delete-buff
-               (kill-buffer Man-buffer)
-             (if Man-fontify-manpage-flag
-                 (Man-fontify-manpage)
-               (Man-cleanup-manpage))
-             (run-hooks 'Man-cooked-hook)
-             (Man-mode)
-             (set-buffer-modified-p nil)
-             ))
-         ;; Restore case-fold-search before calling
-         ;; Man-notify-when-ready because it may switch buffers.
-
-         (if (not delete-buff)
-             (Man-notify-when-ready Man-buffer))
-
-         (if err-mess
-             (error err-mess))
-         )))))
+       (let ((case-fold-search nil))
+         (goto-char (point-min))
+         (cond ((or (looking-at "No \\(manual \\)*entry for")
+                    (looking-at "[^\n]*: nothing appropriate$"))
+                (setq err-mess (buffer-substring (point)
+                                                 (progn
+                                                   (end-of-line) (point)))
+                      delete-buff t))
+               ((not (and (eq (process-status process) 'exit)
+                          (= (process-exit-status process) 0)))
+                (setq err-mess
+                      (concat (buffer-name Man-buffer)
+                              ": process "
+                              (let ((eos (1- (length msg))))
+                                (if (= (aref msg eos) ?\n)
+                                    (substring msg 0 eos) msg))))
+                (goto-char (point-max))
+                (insert (format "\nprocess %s" msg))
+                ))
+         (if delete-buff
+             (kill-buffer Man-buffer)
+           (if Man-fontify-manpage-flag
+               (Man-fontify-manpage)
+             (Man-cleanup-manpage))
+           (run-hooks 'Man-cooked-hook)
+           (Man-mode)
+           (set-buffer-modified-p nil)
+           ))
+       ;; Restore case-fold-search before calling
+       ;; Man-notify-when-ready because it may switch buffers.
+
+       (if (not delete-buff)
+           (Man-notify-when-ready Man-buffer))
+
+       (if err-mess
+           (error err-mess))
+       ))))
 
 \f
 ;; ======================================================================
@@ -741,7 +725,6 @@ The following variables may be of some use. Try
 \"\\[describe-variable] <variable-name> RET\" for more information:
 
 Man-notify-method               What happens when manpage formatting is done.
-Man-reuse-okay-flag             Reuse already formatted buffer.
 Man-downcase-section-letters-flag  Force section letters to lower case.
 Man-circular-pages-flag         Treat multiple manpage list as circular.
 Man-auto-section-alist          List of major modes and their section numbers.
@@ -966,15 +949,13 @@ Actually the section moved to is described by `Man-see-also-regexp'."
       (error (concat "No " Man-see-also-regexp
                     " section found in the current manpage"))))
 
-(defun Man-follow-manual-reference (arg reference)
+(defun Man-follow-manual-reference (reference)
   "Get one of the manpages referred to in the \"SEE ALSO\" section.
-Specify which reference to use; default is based on word at point.
-Prefix argument ARG is passed to `Man-getpage-in-background'."
+Specify which reference to use; default is based on word at point."
   (interactive
    (if (not Man-refpages-alist)
        (error "There are no references in the current man page")
-     (list current-prefix-arg
-          (let* ((default (or
+     (list (let* ((default (or
                             (car (all-completions
                                   (save-excursion
                                     (skip-syntax-backward "w()")
@@ -998,8 +979,7 @@ Prefix argument ARG is passed to `Man-getpage-in-background'."
       (error "Can't find any references in the current manpage")
     (aput 'Man-refpages-alist reference)
     (Man-getpage-in-background
-     (Man-translate-references (aheadsym Man-refpages-alist))
-     arg)))
+     (Man-translate-references (aheadsym Man-refpages-alist)))))
 
 (defun Man-kill ()
   "Kill the buffer containing the manpage."