]> code.delx.au - gnu-emacs/blobdiff - lisp/man.el
(rlogin): Call rlogin-mode after adding rlogin-carriage-filter to output
[gnu-emacs] / lisp / man.el
index 52645b61515bf4fac689b2488770b73f9d00f41b..ccc03a9b6da62aad9a2ebfb6d450bb8c5e7dc4cf 100644 (file)
@@ -1,10 +1,8 @@
 ;;; man.el --- browse UNIX manual pages
 
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
 
 ;; Author:             Barry A. Warsaw <bwarsaw@cen.com>
-;; Last-Modified:      $Date: 1994/10/24 15:34:50 $
-;; Version:            $Revision: 1.55 $
 ;; Keywords:           help
 ;; Adapted-By:         ESR, pot
 
@@ -21,8 +19,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
@@ -37,7 +36,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
-;; these, but wanted everthing in one single package, so I decided
+;; 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,
 ;; these folks deserve lots of credit for providing the initial
@@ -58,7 +57,7 @@
 
 ;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
 ;; making it faster, more robust and more tolerant of different
-;; systems' man idiosynchrasies.
+;; systems' man idiosyncrasies.
 
 ;; ========== Features ==========
 ;; + Runs "man" in the background and pipes the results through a
@@ -83,9 +82,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-notify)
 (defvar Man-current-page)
 (defvar Man-page-list)
-(defvar Man-filter-list)
+(defvar Man-filter-list nil
+  "*Manpage cleaning filter command phrases.
+This variable contains a list of the following form:
+
+'((command-string phrase-string*)*)
+
+Each phrase-string is concatenated onto the command-string to form a
+command filter.  The (standard) output (and standard error) of the Un*x
+man command is piped through each command filter in the order the
+commands appear in the association list.  The final output is placed in
+the manpage buffer.")
+
 (defvar Man-original-frame)
 (defvar Man-arguments)
 (defvar Man-sections-alist)
 (defvar Man-refpages-alist)
-(defvar Man-uses-untabify-flag)
+(defvar Man-uses-untabify-flag t
+  "When non-nil use `untabify' instead of Man-untabify-command.")
 (defvar Man-page-mode-string)
-(defvar Man-sed-script)
+(defvar Man-sed-script nil
+  "Script for sed to nuke backspaces and ANSI codes from manpages.")
 
 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
 ;; user variables
   "*Face to use when fontifying overstrike.")
 
 (defvar Man-underline-face 'underline
-  "*Face to use when fontifying underlinining.")
+  "*Face to use when fontifying underlining.")
 
 ;; Use the value of the obsolete user option Man-notify, if set.
 (defvar Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
@@ -145,13 +156,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
@@ -266,6 +270,7 @@ This regular expression should start with a `^' character.")
 /\b/ { s/_\b//g
        s/\b_//g
         s/o\b+/o/g
+        s/+\bo/o/g
        :ovstrk
        s/\\(.\\)\b\\1/\\1/g
        t ovstrk
@@ -277,6 +282,7 @@ This regular expression should start with a `^' character.")
 /\b/ { s/_\b//g\\
        s/\b_//g\\
         s/o\b+/o/g\\
+        s/+\bo/o/g\\
        :ovstrk\\
        s/\\(.\\)\b\\1/\\1/g\\
        t ovstrk\\
@@ -298,7 +304,6 @@ This regular expression should start with a `^' character.")
   (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 "t"    'toggle-truncate-lines)
   (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)
@@ -311,7 +316,7 @@ This regular expression should start with a `^' character.")
 ;; ======================================================================
 ;; utilities
 
-(defsubst Man-init-defvars ()
+(defun Man-init-defvars ()
   "Used for initialising variables based on the value of window-system.
 This is necessary if one wants to dump man.el with emacs."
 
@@ -320,76 +325,56 @@ This is necessary if one wants to dump man.el with emacs."
   (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
                                      window-system))
 
-  (defconst Man-uses-untabify-flag t
-    ;; don't use pr: it is buggy
-    ;; (or (not (file-readable-p "/etc/passwd"))
-    ;;   (/= 0 (apply 'call-process
-    ;;                Man-untabify-command nil nil nil
-    ;;                (append Man-untabify-command-args
-    ;;                        (list "/etc/passwd")))))
-    "When non-nil use `untabify' instead of Man-untabify-command.")
-
-  (defconst Man-sed-script
-    (cond
-     (Man-fontify-manpage-flag
-      nil)
-     ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
-      Man-sysv-sed-script)
-     ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
-      Man-berkeley-sed-script)
-     (t
-      nil))
-    "Script for sed to nuke backspaces and ANSI codes from manpages.")
-
-  (defvar Man-filter-list
-    (list
-     (cons
-      Man-sed-command
-      (list
-       (if Man-sed-script
-          (concat "-e '" Man-sed-script "'")
-        "")
-       "-e '/^[\001-\032][\001-\032]*$/d'"
-       "-e '/\e[789]/s///g'"
-       "-e '/[Nn]o such file or directory/d'"
-       "-e '/Reformatting page.  Wait/d'"
-       "-e '/Reformatting entry.  Wait/d'"
-       "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
-       "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
-       "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
-       "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
-       "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
-       "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
-       "-e '/^[A-za-z].*Last[ \t]change:/d'"
-       "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
-       "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
-       ))
-     (cons
-      Man-awk-command
-      (list
-       "'\n"
-       "BEGIN { blankline=0; anonblank=0; }\n"
-       "/^$/ { if (anonblank==0) next; }\n"
-       "{ anonblank=1; }\n"
-       "/^$/ { blankline++; next; }\n"
-       "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
-       "'"
-       ))
-     (if (not Man-uses-untabify-flag)
+  (setq Man-sed-script
+       (cond
+        (Man-fontify-manpage-flag
+         nil)
+        ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
+         Man-sysv-sed-script)
+        ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
+         Man-berkeley-sed-script)
+        (t
+         nil)))
+
+  (setq Man-filter-list
+       (list
         (cons
-         Man-untabify-command
-         Man-untabify-command-args)
-       ))
-    "*Manpage cleaning filter command phrases.
-This variable contains a list of the following form:
-
-'((command-string phrase-string*)*)
-
-Each phrase-string is concatenated onto the command-string to form a
-command filter.  The (standard) output (and standard error) of the Un*x
-man command is piped through each command filter in the order the
-commands appear in the association list.  The final output is placed in
-the manpage buffer.")
+         Man-sed-command
+         (list
+          (if Man-sed-script
+              (concat "-e '" Man-sed-script "'")
+            "")
+          "-e '/^[\001-\032][\001-\032]*$/d'"
+          "-e '/\e[789]/s///g'"
+          "-e '/Reformatting page.  Wait/d'"
+          "-e '/Reformatting entry.  Wait/d'"
+          "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
+          "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
+          "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
+          "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
+          "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
+          "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
+          "-e '/^[A-za-z].*Last[ \t]change:/d'"
+          "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
+          "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
+          "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
+          ))
+        (cons
+         Man-awk-command
+         (list
+          "'\n"
+          "BEGIN { blankline=0; anonblank=0; }\n"
+          "/^$/ { if (anonblank==0) next; }\n"
+          "{ anonblank=1; }\n"
+          "/^$/ { blankline++; next; }\n"
+          "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
+          "'"
+          ))
+        (if (not Man-uses-untabify-flag)
+            (cons
+             Man-untabify-command
+             Man-untabify-command-args)
+          )))
 )
 
 (defsubst Man-match-substring (&optional n string)
@@ -431,17 +416,17 @@ that string instead of from the current buffer."
   "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
 Leave it as is if already in that style.  Possibly downcase and
 translate the section (see the Man-downcase-section-letters-flag
-and the Man-section-translations-alist variables)." 
+and the Man-section-translations-alist variables)."
   (let ((name "")
        (section "")
        (slist Man-section-translations-alist))
     (cond
      ;; "chmod(2V)" case ?
-     ((string-match (concat Man-reference-regexp "$") ref)
+     ((string-match (concat "^" Man-reference-regexp "$") ref)
       (setq name (Man-match-substring 1 ref)
            section (Man-match-substring 2 ref)))
      ;; "2v chmod" case ?
-     ((string-match (concat "\\(" Man-section-regexp
+     ((string-match (concat "^\\(" Man-section-regexp
                            "\\) +\\(" Man-name-regexp "\\)$") ref)
       (setq name (Man-match-substring 2 ref)
            section (Man-match-substring 1 ref))))
@@ -486,13 +471,15 @@ default section number is selected from `Man-auto-section-alist'."
             (progn (skip-chars-forward "-a-zA-Z0-9_.") (point))))
       
       ;; If looking at something like ioctl(2) or brc(1M), include the
-      ;; section number in the returned value.
-      (concat
-       default-title
-       (if (looking-at
-           (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
-          (format "(%s)" (Man-match-substring 1)))
-       ))))
+      ;; section number in the returned value.  Remove text properties.
+      (let ((result (concat
+                    default-title
+                    (if (looking-at
+                         (concat "[ \t]*([ \t]*\\("
+                                 Man-section-regexp "\\)[ \t]*)"))
+                        (format "(%s)" (Man-match-substring 1))))))
+       (set-text-properties 0 (length result) nil result)
+       result))))
 
 \f
 ;; ======================================================================
@@ -503,53 +490,39 @@ 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))
-
-  ;; Init the man package variables, if not already done.
-  (Man-init-defvars)
+   (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))))
 
   ;; Possibly translate the "subject(section)" syntax into the
   ;; "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)
@@ -564,8 +537,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.
@@ -636,13 +608,16 @@ Same for the ANSI bold and normal escape sequences."
     (replace-match "\\1")
     (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)
     (replace-match "+")
     (put-text-property (1- (point)) (point) 'face 'bold))
+  ;; \255 is some kind of dash in Latin-1.
+  (goto-char (point-min))
+  (while (search-forward "\255" nil t) (replace-match "-"))
   (message "%s man page made up" Man-arguments))
 
 (defun Man-cleanup-manpage ()
@@ -662,10 +637,13 @@ 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 "+"))
+  ;; \255 is some kind of dash in Latin-1.
+  (goto-char (point-min))
+  (while (search-forward "\255" nil t) (replace-match "-"))
   (message "%s man page cleaned up" Man-arguments))
 
 (defun Man-bgproc-sentinel (process msg)
@@ -679,44 +657,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
 ;; ======================================================================
@@ -744,7 +721,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.
@@ -969,15 +945,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()")
@@ -1001,8 +975,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."
@@ -1081,6 +1054,9 @@ Prefix argument ARG is passed to `Man-getpage-in-background'."
        (Man-goto-page (length Man-page-list))
       (error "You're looking at the first manpage in the buffer"))))
 \f
+;; Init the man package variables, if not already done.
+(Man-init-defvars)
+
 (provide 'man)
 
 ;;; man.el ends here