lisp/man.el

   1 ;;; man.el --- browse UNIX manual pages
   2
   3 ;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
   4
   5 ;; Author:              Barry A. Warsaw <bwarsaw@cen.com>
   6 ;; Keywords:            help
   7 ;; Adapted-By:          ESR, pot
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This code provides a function, `man', with which you can browse
  28 ;; UNIX manual pages.  Formatting is done in background so that you
  29 ;; can continue to use your Emacs while processing is going on.
  30 ;;
  31 ;; The mode also supports hypertext-like following of manual page SEE
  32 ;; ALSO references, and other features.  See below or do `?' in a
  33 ;; manual page buffer for details.
  34
  35 ;; ========== Credits and History ==========
  36 ;; In mid 1991, several people posted some interesting improvements to
  37 ;; man.el from the standard emacs 18.57 distribution.  I liked many of
  38 ;; these, but wanted everything in one single package, so I decided
  39 ;; to incorporate them into a single manual browsing mode.  While
  40 ;; much of the code here has been rewritten, and some features added,
  41 ;; these folks deserve lots of credit for providing the initial
  42 ;; excellent packages on which this one is based.
  43
  44 ;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, posted a very nice
  45 ;; improvement which retrieved and cleaned the manpages in a
  46 ;; background process, and which correctly deciphered such options as
  47 ;; man -k.
  48
  49 ;; Eric Rose <erose@jessica.stanford.edu>, submitted manual.el which
  50 ;; provided a very nice manual browsing mode.
  51
  52 ;; This package was available as `superman.el' from the LCD package
  53 ;; for some time before it was accepted into Emacs 19.  The entry
  54 ;; point and some other names have been changed to make it a drop-in
  55 ;; replacement for the old man.el package.
  56
  57 ;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
  58 ;; making it faster, more robust and more tolerant of different
  59 ;; systems' man idiosyncrasies.
  60
  61 ;; ========== Features ==========
  62 ;; + Runs "man" in the background and pipes the results through a
  63 ;;   series of sed and awk scripts so that all retrieving and cleaning
  64 ;;   is done in the background. The cleaning commands are configurable.
  65 ;; + Syntax is the same as Un*x man
  66 ;; + Functionality is the same as Un*x man, including "man -k" and
  67 ;;   "man <section>", etc.
  68 ;; + Provides a manual browsing mode with keybindings for traversing
  69 ;;   the sections of a manpage, following references in the SEE ALSO
  70 ;;   section, and more.
  71 ;; + Multiple manpages created with the same man command are put into
  72 ;;   a narrowed buffer circular list.
  73
  74 ;; ============= TODO ===========
  75 ;; - Add a command for printing.
  76 ;; - The awk script deletes multiple blank lines.  This behaviour does
  77 ;;   not allow to understand if there was indeed a blank line at the
  78 ;;   end or beginning of a page (after the header, or before the
  79 ;;   footer).  A different algorithm should be used.  It is easy to
  80 ;;   compute how many blank lines there are before and after the page
  81 ;;   headers, and after the page footer.  But it is possible to compute
  82 ;;   the number of blank lines before the page footer by euristhics
  83 ;;   only.  Is it worth doing?
  84 ;; - Allow a user option to mean that all the manpages should go in
  85 ;;   the same buffer, where they can be browsed with M-n and M-p.
  86 ;; - Allow completion on the manpage name when calling man.  This
  87 ;;   requires a reliable list of places where manpages can be found.  The
  88 ;;   drawback would be that if the list is not complete, the user might
  89 ;;   be led to believe that the manpages in the missing directories do
  90 ;;   not exist.
  91
  92 \f
  93 ;;; Code:
  94
  95 (require 'assoc)
  96
  97 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  98 ;; empty defvars (keep the compiler quiet)
  99
 100 (defvar Man-notify)
 101 (defvar Man-current-page)
 102 (defvar Man-page-list)
 103 (defvar Man-filter-list)
 104 (defvar Man-original-frame)
 105 (defvar Man-arguments)
 106 (defvar Man-sections-alist)
 107 (defvar Man-refpages-alist)
 108 (defvar Man-uses-untabify-flag)
 109 (defvar Man-page-mode-string)
 110 (defvar Man-sed-script)
 111
 112 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
 113 ;; user variables
 114
 115 (defvar Man-fontify-manpage-flag t
 116   "*Make up the manpage with fonts.")
 117
 118 (defvar Man-overstrike-face 'bold
 119   "*Face to use when fontifying overstrike.")
 120
 121 (defvar Man-underline-face 'underline
 122   "*Face to use when fontifying underlining.")
 123
 124 ;; Use the value of the obsolete user option Man-notify, if set.
 125 (defvar Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
 126   "*Selects the behavior when manpage is ready.
 127 This variable may have one of the following values, where (sf) means
 128 that the frames are switched, so the manpage is displayed in the frame
 129 where the man command was called from:
 130
 131 newframe   -- put the manpage in its own frame (see `Man-frame-parameters')
 132 pushy      -- make the manpage the current buffer in the current window
 133 bully      -- make the manpage the current buffer and only window (sf)
 134 aggressive -- make the manpage the current buffer in the other window (sf)
 135 friendly   -- display manpage in the other window but don't make current (sf)
 136 polite     -- don't display manpage, but prints message and beep when ready
 137 quiet      -- like `polite', but don't beep
 138 meek       -- make no indication that the manpage is ready
 139
 140 Any other value of `Man-notify-method' is equivalent to `meek'.")
 141
 142 (defvar Man-frame-parameters nil
 143   "*Frame parameter list for creating a new frame for a manual page.")
 144
 145 (defvar Man-downcase-section-letters-flag t
 146   "*Letters in sections are converted to lower case.
 147 Some Un*x man commands can't handle uppercase letters in sections, for
 148 example \"man 2V chmod\", but they are often displayed in the manpage
 149 with the upper case letter.  When this variable is t, the section
 150 letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before
 151 being sent to the man background process.")
 152
 153 (defvar Man-circular-pages-flag t
 154   "*If t, the manpage list is treated as circular for traversal.")
 155
 156 (defvar Man-section-translations-alist
 157   (list
 158    '("3C++" . "3")
 159    ;; Some systems have a real 3x man section, so let's comment this.
 160    ;; '("3X" . "3")                        ; Xlib man pages
 161    '("3X11" . "3")
 162    '("1-UCB" . ""))
 163   "*Association list of bogus sections to real section numbers.
 164 Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
 165 their references which Un*x `man' does not recognize.  This
 166 association list is used to translate those sections, when found, to
 167 the associated section number.")
 168
 169 (defvar manual-program "man"
 170   "The name of the program that produces man pages.")
 171
 172 (defvar Man-untabify-command "pr"
 173   "Command used for untabifying.")
 174
 175 (defvar Man-untabify-command-args (list "-t" "-e")
 176   "List of arguments to be passed to Man-untabify-command (which see).")
 177
 178 (defvar Man-sed-command "sed"
 179   "Command used for processing sed scripts.")
 180
 181 (defvar Man-awk-command "awk"
 182   "Command used for processing awk scripts.")
 183
 184 (defvar Man-mode-line-format
 185   '("" mode-line-modified
 186        mode-line-buffer-identification "  "
 187        global-mode-string
 188        " " Man-page-mode-string
 189        "  %[(" mode-name mode-line-process minor-mode-alist ")%]----"
 190        (-3 . "%p") "-%-")
 191   "Mode line format for manual mode buffer.")
 192
 193 (defvar Man-mode-map nil
 194   "Keymap for Man mode.")
 195
 196 (defvar Man-mode-hook nil
 197   "Hook run when Man mode is enabled.")
 198
 199 (defvar Man-cooked-hook nil
 200   "Hook run after removing backspaces but before Man-mode processing.")
 201
 202 (defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
 203   "Regular expression describing the name of a manpage (without section).")
 204
 205 (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
 206   "Regular expression describing a manpage section within parentheses.")
 207
 208 (defvar Man-page-header-regexp
 209   (concat "^[ \t]*\\(" Man-name-regexp
 210           "(\\(" Man-section-regexp "\\))\\).*\\1")
 211   "Regular expression describing the heading of a page.")
 212
 213 (defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
 214   "Regular expression describing a manpage heading entry.")
 215
 216 (defvar Man-see-also-regexp "SEE ALSO"
 217   "Regular expression for SEE ALSO heading (or your equivalent).
 218 This regexp should not start with a `^' character.")
 219
 220 (defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
 221   "Regular expression describing first heading on a manpage.
 222 This regular expression should start with a `^' character.")
 223
 224 (defvar Man-reference-regexp
 225   (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
 226   "Regular expression describing a reference in the SEE ALSO section.")
 227
 228 (defvar Man-switches ""
 229   "Switches passed to the man command, as a single string.")
 230
 231 (defvar Man-specified-section-option
 232   (if (string-match "-solaris[0-9.]*$" system-configuration)
 233       "-s"
 234     "")
 235   "Option that indicates a specified a manual section name.")
 236
 237 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 238 ;; end user variables
 239 \f
 240 ;; other variables and keymap initializations
 241 (make-variable-buffer-local 'Man-sections-alist)
 242 (make-variable-buffer-local 'Man-refpages-alist)
 243 (make-variable-buffer-local 'Man-page-list)
 244 (make-variable-buffer-local 'Man-current-page)
 245 (make-variable-buffer-local 'Man-page-mode-string)
 246 (make-variable-buffer-local 'Man-original-frame)
 247 (make-variable-buffer-local 'Man-arguments)
 248
 249 (setq-default Man-sections-alist nil)
 250 (setq-default Man-refpages-alist nil)
 251 (setq-default Man-page-list nil)
 252 (setq-default Man-current-page 0)
 253 (setq-default Man-page-mode-string "1 of 1")
 254
 255 (defconst Man-sysv-sed-script "\
 256 /\b/ {  s/_\b//g
 257         s/\b_//g
 258         s/o\b+/o/g
 259         s/+\bo/o/g
 260         :ovstrk
 261         s/\\(.\\)\b\\1/\\1/g
 262         t ovstrk
 263         }
 264 /\e\\[[0-9][0-9]*m/ s///g"
 265   "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
 266
 267 (defconst Man-berkeley-sed-script "\
 268 /\b/ {  s/_\b//g\\
 269         s/\b_//g\\
 270         s/o\b+/o/g\\
 271         s/+\bo/o/g\\
 272         :ovstrk\\
 273         s/\\(.\\)\b\\1/\\1/g\\
 274         t ovstrk\\
 275         }\\
 276 /\e\\[[0-9][0-9]*m/ s///g"
 277   "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
 278
 279 (if Man-mode-map
 280     nil
 281   (setq Man-mode-map (make-keymap))
 282   (suppress-keymap Man-mode-map)
 283   (define-key Man-mode-map " "    'scroll-up)
 284   (define-key Man-mode-map "\177" 'scroll-down)
 285   (define-key Man-mode-map "n"    'Man-next-section)
 286   (define-key Man-mode-map "p"    'Man-previous-section)
 287   (define-key Man-mode-map "\en"  'Man-next-manpage)
 288   (define-key Man-mode-map "\ep"  'Man-previous-manpage)
 289   (define-key Man-mode-map ">"    'end-of-buffer)
 290   (define-key Man-mode-map "<"    'beginning-of-buffer)
 291   (define-key Man-mode-map "."    'beginning-of-buffer)
 292   (define-key Man-mode-map "r"    'Man-follow-manual-reference)
 293   (define-key Man-mode-map "g"    'Man-goto-section)
 294   (define-key Man-mode-map "s"    'Man-goto-see-also-section)
 295   (define-key Man-mode-map "k"    'Man-kill)
 296   (define-key Man-mode-map "q"    'Man-quit)
 297   (define-key Man-mode-map "m"    'man)
 298   (define-key Man-mode-map "?"    'describe-mode)
 299   )
 300
 301 \f
 302 ;; ======================================================================
 303 ;; utilities
 304
 305 (defsubst Man-init-defvars ()
 306   "Used for initialising variables based on the value of window-system.
 307 This is necessary if one wants to dump man.el with emacs."
 308
 309   ;; The following is necessary until fonts are implemented on
 310   ;; terminals.
 311   (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
 312                                       window-system))
 313
 314   (defconst Man-uses-untabify-flag t
 315     ;; don't use pr: it is buggy
 316     ;; (or (not (file-readable-p "/etc/passwd"))
 317     ;;   (/= 0 (apply 'call-process
 318     ;;                Man-untabify-command nil nil nil
 319     ;;                (append Man-untabify-command-args
 320     ;;                        (list "/etc/passwd")))))
 321     "When non-nil use `untabify' instead of Man-untabify-command.")
 322
 323   (defconst Man-sed-script
 324     (cond
 325      (Man-fontify-manpage-flag
 326       nil)
 327      ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
 328       Man-sysv-sed-script)
 329      ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
 330       Man-berkeley-sed-script)
 331      (t
 332       nil))
 333     "Script for sed to nuke backspaces and ANSI codes from manpages.")
 334
 335   (defvar Man-filter-list
 336     (list
 337      (cons
 338       Man-sed-command
 339       (list
 340        (if Man-sed-script
 341            (concat "-e '" Man-sed-script "'")
 342          "")
 343        "-e '/^[\001-\032][\001-\032]*$/d'"
 344        "-e '/\e[789]/s///g'"
 345        "-e '/Reformatting page.  Wait/d'"
 346        "-e '/Reformatting entry.  Wait/d'"
 347        "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
 348        "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
 349        "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
 350        "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
 351        "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
 352        "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
 353        "-e '/^[A-za-z].*Last[ \t]change:/d'"
 354        "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
 355        "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
 356        ))
 357      (cons
 358       Man-awk-command
 359       (list
 360        "'\n"
 361        "BEGIN { blankline=0; anonblank=0; }\n"
 362        "/^$/ { if (anonblank==0) next; }\n"
 363        "{ anonblank=1; }\n"
 364        "/^$/ { blankline++; next; }\n"
 365        "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
 366        "'"
 367        ))
 368      (if (not Man-uses-untabify-flag)
 369          (cons
 370           Man-untabify-command
 371           Man-untabify-command-args)
 372        ))
 373     "*Manpage cleaning filter command phrases.
 374 This variable contains a list of the following form:
 375
 376 '((command-string phrase-string*)*)
 377
 378 Each phrase-string is concatenated onto the command-string to form a
 379 command filter.  The (standard) output (and standard error) of the Un*x
 380 man command is piped through each command filter in the order the
 381 commands appear in the association list.  The final output is placed in
 382 the manpage buffer.")
 383 )
 384
 385 (defsubst Man-match-substring (&optional n string)
 386   "Return the substring matched by the last search.
 387 Optional arg N means return the substring matched by the Nth paren
 388 grouping.  Optional second arg STRING means return a substring from
 389 that string instead of from the current buffer."
 390   (if (null n) (setq n 0))
 391   (if string
 392       (substring string (match-beginning n) (match-end n))
 393     (buffer-substring (match-beginning n) (match-end n))))
 394
 395 (defsubst Man-make-page-mode-string ()
 396   "Formats part of the mode line for Man mode."
 397   (format "%s page %d of %d"
 398           (or (nth 2 (nth (1- Man-current-page) Man-page-list))
 399               "")
 400           Man-current-page
 401           (length Man-page-list)))
 402
 403 (defsubst Man-build-man-command ()
 404   "Builds the entire background manpage and cleaning command."
 405   (let ((command (concat manual-program " " Man-switches " %s 2>/dev/null"))
 406         (flist Man-filter-list))
 407     (while (and flist (car flist))
 408       (let ((pcom (car (car flist)))
 409             (pargs (cdr (car flist))))
 410         (setq command
 411               (concat command " | " pcom " "
 412                       (mapconcat '(lambda (phrase)
 413                                     (if (not (stringp phrase))
 414                                         (error "Malformed Man-filter-list"))
 415                                     phrase)
 416                                  pargs " ")))
 417         (setq flist (cdr flist))))
 418     command))
 419
 420 (defun Man-translate-references (ref)
 421   "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
 422 Leave it as is if already in that style.  Possibly downcase and
 423 translate the section (see the Man-downcase-section-letters-flag
 424 and the Man-section-translations-alist variables)."
 425   (let ((name "")
 426         (section "")
 427         (slist Man-section-translations-alist))
 428     (cond
 429      ;; "chmod(2V)" case ?
 430      ((string-match (concat "^" Man-reference-regexp "$") ref)
 431       (setq name (Man-match-substring 1 ref)
 432             section (Man-match-substring 2 ref)))
 433      ;; "2v chmod" case ?
 434      ((string-match (concat "^\\(" Man-section-regexp
 435                             "\\) +\\(" Man-name-regexp "\\)$") ref)
 436       (setq name (Man-match-substring 2 ref)
 437             section (Man-match-substring 1 ref))))
 438     (if (string= name "")
 439         ref                             ; Return the reference as is
 440       (if Man-downcase-section-letters-flag
 441           (setq section (downcase section)))
 442       (while slist
 443         (let ((s1 (car (car slist)))
 444               (s2 (cdr (car slist))))
 445           (setq slist (cdr slist))
 446           (if Man-downcase-section-letters-flag
 447               (setq s1 (downcase s1)))
 448           (if (not (string= s1 section)) nil
 449             (setq section (if Man-downcase-section-letters-flag
 450                               (downcase s2)
 451                             s2)
 452                   slist nil))))
 453       (concat Man-specified-section-option section " " name))))
 454
 455 \f
 456 ;; ======================================================================
 457 ;; default man entry: get word under point
 458
 459 (defsubst Man-default-man-entry ()
 460   "Make a guess at a default manual entry.
 461 This guess is based on the text surrounding the cursor, and the
 462 default section number is selected from `Man-auto-section-alist'."
 463   (let (default-title)
 464     (save-excursion
 465
 466       ;; Default man entry title is any word the cursor is on, or if
 467       ;; cursor not on a word, then nearest preceding word.  Cannot
 468       ;; use the current-word function because it skips the dots.
 469       (if (not (looking-at "[-a-zA-Z_.]"))
 470           (skip-chars-backward "^a-zA-Z"))
 471       (skip-chars-backward "-(a-zA-Z_0-9_.")
 472       (if (looking-at "(") (forward-char 1))
 473       (setq default-title
 474             (buffer-substring
 475              (point)
 476              (progn (skip-chars-forward "-a-zA-Z0-9_.") (point))))
 477
 478       ;; If looking at something like ioctl(2) or brc(1M), include the
 479       ;; section number in the returned value.  Remove text properties.
 480       (let ((result (concat
 481                      default-title
 482                      (if (looking-at
 483                           (concat "[ \t]*([ \t]*\\("
 484                                   Man-section-regexp "\\)[ \t]*)"))
 485                          (format "(%s)" (Man-match-substring 1))))))
 486         (set-text-properties 0 (length result) nil result)
 487         result))))
 488
 489 \f
 490 ;; ======================================================================
 491 ;; Top level command and background process sentinel
 492
 493 ;; For compatibility with older versions.
 494 ;;;###autoload
 495 (defalias 'manual-entry 'man)
 496
 497 ;;;###autoload
 498 (defun man (man-args)
 499   "Get a Un*x manual page and put it in a buffer.
 500 This command is the top-level command in the man package.  It runs a Un*x
 501 command to retrieve and clean a manpage in the background and places the
 502 results in a Man mode (manpage browsing) buffer.  See variable
 503 `Man-notify-method' for what happens when the buffer is ready.
 504 If a buffer already exists for this man page, it will display immediately."
 505   (interactive
 506    (list (let* ((default-entry (Man-default-man-entry))
 507                 (input (read-string
 508                         (format "Manual entry%s: "
 509                                 (if (string= default-entry "")
 510                                     ""
 511                                   (format " (default %s)" default-entry))))))
 512            (if (string= input "")
 513                (if (string= default-entry "")
 514                    (error "No man args given")
 515                  default-entry)
 516              input))))
 517
 518   ;; Init the man package variables, if not already done.
 519   (Man-init-defvars)
 520
 521   ;; Possibly translate the "subject(section)" syntax into the
 522   ;; "section subject" syntax and possibly downcase the section.
 523   (setq man-args (Man-translate-references man-args))
 524
 525   (Man-getpage-in-background man-args))
 526
 527
 528 (defun Man-getpage-in-background (topic)
 529   "Uses TOPIC to build and fire off the manpage and cleaning command."
 530   (let* ((man-args topic)
 531          (bufname (concat "*Man " man-args "*"))
 532          (buffer  (get-buffer bufname)))
 533     (if buffer
 534         (Man-notify-when-ready buffer)
 535       (require 'env)
 536       (message "Invoking %s %s in the background" manual-program man-args)
 537       (setq buffer (generate-new-buffer bufname))
 538       (save-excursion
 539         (set-buffer buffer)
 540         (setq Man-original-frame (selected-frame))
 541         (setq Man-arguments man-args))
 542       (let ((process-environment (copy-sequence process-environment)))
 543         ;; Prevent any attempt to use display terminal fanciness.
 544         (setenv "TERM" "dumb")
 545         (set-process-sentinel
 546          (start-process manual-program buffer "sh" "-c"
 547                         (format (Man-build-man-command) man-args))
 548          'Man-bgproc-sentinel)))))
 549
 550 (defun Man-notify-when-ready (man-buffer)
 551   "Notify the user when MAN-BUFFER is ready.
 552 See the variable `Man-notify-method' for the different notification behaviors."
 553   (let ((saved-frame (save-excursion
 554                        (set-buffer man-buffer)
 555                        Man-original-frame)))
 556     (cond
 557      ((eq Man-notify-method 'newframe)
 558       ;; Since we run asynchronously, perhaps while Emacs is waiting
 559       ;; for input, we must not leave a different buffer current.  We
 560       ;; can't rely on the editor command loop to reselect the
 561       ;; selected window's buffer.
 562       (save-excursion
 563         (set-buffer man-buffer)
 564         (make-frame Man-frame-parameters)))
 565      ((eq Man-notify-method 'pushy)
 566       (switch-to-buffer man-buffer))
 567      ((eq Man-notify-method 'bully)
 568       (and window-system
 569            (frame-live-p saved-frame)
 570            (select-frame saved-frame))
 571       (pop-to-buffer man-buffer)
 572       (delete-other-windows))
 573      ((eq Man-notify-method 'aggressive)
 574       (and window-system
 575            (frame-live-p saved-frame)
 576            (select-frame saved-frame))
 577       (pop-to-buffer man-buffer))
 578      ((eq Man-notify-method 'friendly)
 579       (and window-system
 580            (frame-live-p saved-frame)
 581            (select-frame saved-frame))
 582       (display-buffer man-buffer 'not-this-window))
 583      ((eq Man-notify-method 'polite)
 584       (beep)
 585       (message "Manual buffer %s is ready" (buffer-name man-buffer)))
 586      ((eq Man-notify-method 'quiet)
 587       (message "Manual buffer %s is ready" (buffer-name man-buffer)))
 588      ((or (eq Man-notify-method 'meek)
 589           t)
 590       (message ""))
 591      )))
 592
 593 (defun Man-fontify-manpage ()
 594   "Convert overstriking and underlining to the correct fonts.
 595 Same for the ANSI bold and normal escape sequences."
 596   (interactive)
 597   (message "Please wait: making up the %s man page..." Man-arguments)
 598   (goto-char (point-min))
 599   (while (search-forward "\e[1m" nil t)
 600     (delete-backward-char 4)
 601     (put-text-property (point)
 602                        (progn (if (search-forward "\e[0m" nil 'move)
 603                                   (delete-backward-char 4))
 604                               (point))
 605                        'face Man-overstrike-face))
 606   (goto-char (point-min))
 607   (while (search-forward "_\b" nil t)
 608     (backward-delete-char 2)
 609     (put-text-property (point) (1+ (point)) 'face Man-underline-face))
 610   (goto-char (point-min))
 611   (while (search-forward "\b_" nil t)
 612     (backward-delete-char 2)
 613     (put-text-property (1- (point)) (point) 'face Man-underline-face))
 614   (goto-char (point-min))
 615   (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
 616     (replace-match "\\1")
 617     (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
 618   (goto-char (point-min))
 619   (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
 620     (replace-match "o")
 621     (put-text-property (1- (point)) (point) 'face 'bold))
 622   (goto-char (point-min))
 623   (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
 624     (replace-match "+")
 625     (put-text-property (1- (point)) (point) 'face 'bold))
 626   ;; \255 is some kind of dash in Latin-1.
 627   (goto-char (point-min))
 628   (while (search-forward "\255" nil t) (replace-match "-"))
 629   (message "%s man page made up" Man-arguments))
 630
 631 (defun Man-cleanup-manpage ()
 632   "Remove overstriking and underlining from the current buffer."
 633   (interactive)
 634   (message "Please wait: cleaning up the %s man page..."
 635            Man-arguments)
 636   (if (or (interactive-p) (not Man-sed-script))
 637       (progn
 638         (goto-char (point-min))
 639         (while (search-forward "_\b" nil t) (backward-delete-char 2))
 640         (goto-char (point-min))
 641         (while (search-forward "\b_" nil t) (backward-delete-char 2))
 642         (goto-char (point-min))
 643         (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
 644           (replace-match "\\1"))
 645         (goto-char (point-min))
 646         (while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
 647         (goto-char (point-min))
 648         (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
 649         ))
 650   (goto-char (point-min))
 651   (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
 652   ;; \255 is some kind of dash in Latin-1.
 653   (goto-char (point-min))
 654   (while (search-forward "\255" nil t) (replace-match "-"))
 655   (message "%s man page cleaned up" Man-arguments))
 656
 657 (defun Man-bgproc-sentinel (process msg)
 658   "Manpage background process sentinel."
 659   (let ((Man-buffer (process-buffer process))
 660         (delete-buff nil)
 661         (err-mess nil))
 662
 663     (if (null (buffer-name Man-buffer)) ;; deleted buffer
 664         (set-process-buffer process nil)
 665
 666       (save-excursion
 667         (set-buffer Man-buffer)
 668         (let ((case-fold-search nil))
 669           (goto-char (point-min))
 670           (cond ((or (looking-at "No \\(manual \\)*entry for")
 671                      (looking-at "[^\n]*: nothing appropriate$"))
 672                  (setq err-mess (buffer-substring (point)
 673                                                   (progn
 674                                                     (end-of-line) (point)))
 675                        delete-buff t))
 676                 ((not (and (eq (process-status process) 'exit)
 677                            (= (process-exit-status process) 0)))
 678                  (setq err-mess
 679                        (concat (buffer-name Man-buffer)
 680                                ": process "
 681                                (let ((eos (1- (length msg))))
 682                                  (if (= (aref msg eos) ?\n)
 683                                      (substring msg 0 eos) msg))))
 684                  (goto-char (point-max))
 685                  (insert (format "\nprocess %s" msg))
 686                  ))
 687           (if delete-buff
 688               (kill-buffer Man-buffer)
 689             (if Man-fontify-manpage-flag
 690                 (Man-fontify-manpage)
 691               (Man-cleanup-manpage))
 692             (run-hooks 'Man-cooked-hook)
 693             (Man-mode)
 694             (set-buffer-modified-p nil)
 695             ))
 696         ;; Restore case-fold-search before calling
 697         ;; Man-notify-when-ready because it may switch buffers.
 698
 699         (if (not delete-buff)
 700             (Man-notify-when-ready Man-buffer))
 701
 702         (if err-mess
 703             (error err-mess))
 704         ))))
 705
 706 \f
 707 ;; ======================================================================
 708 ;; set up manual mode in buffer and build alists
 709
 710 (defun Man-mode ()
 711   "A mode for browsing Un*x manual pages.
 712
 713 The following man commands are available in the buffer. Try
 714 \"\\[describe-key] <key> RET\" for more information:
 715
 716 \\[man]       Prompt to retrieve a new manpage.
 717 \\[Man-follow-manual-reference]       Retrieve reference in SEE ALSO section.
 718 \\[Man-next-manpage]   Jump to next manpage in circular list.
 719 \\[Man-previous-manpage]   Jump to previous manpage in circular list.
 720 \\[Man-next-section]       Jump to next manpage section.
 721 \\[Man-previous-section]       Jump to previous manpage section.
 722 \\[Man-goto-section]       Go to a manpage section.
 723 \\[Man-goto-see-also-section]       Jumps to the SEE ALSO manpage section.
 724 \\[Man-quit]       Deletes the manpage window, bury its buffer.
 725 \\[Man-kill]       Deletes the manpage window, kill its buffer.
 726 \\[describe-mode]       Prints this help text.
 727
 728 The following variables may be of some use. Try
 729 \"\\[describe-variable] <variable-name> RET\" for more information:
 730
 731 Man-notify-method               What happens when manpage formatting is done.
 732 Man-downcase-section-letters-flag  Force section letters to lower case.
 733 Man-circular-pages-flag         Treat multiple manpage list as circular.
 734 Man-auto-section-alist          List of major modes and their section numbers.
 735 Man-section-translations-alist  List of section numbers and their Un*x equiv.
 736 Man-filter-list                 Background manpage filter command.
 737 Man-mode-line-format            Mode line format for Man mode buffers.
 738 Man-mode-map                    Keymap bindings for Man mode buffers.
 739 Man-mode-hook                   Normal hook run on entry to Man mode.
 740 Man-section-regexp              Regexp describing manpage section letters.
 741 Man-heading-regexp              Regexp describing section headers.
 742 Man-see-also-regexp             Regexp for SEE ALSO section (or your equiv).
 743 Man-first-heading-regexp        Regexp for first heading on a manpage.
 744 Man-reference-regexp            Regexp matching a references in SEE ALSO.
 745 Man-switches                    Background `man' command switches.
 746
 747 The following key bindings are currently in effect in the buffer:
 748 \\{Man-mode-map}"
 749   (interactive)
 750   (setq major-mode 'Man-mode
 751         mode-name "Man"
 752         buffer-auto-save-file-name nil
 753         mode-line-format Man-mode-line-format
 754         truncate-lines t
 755         buffer-read-only t)
 756   (buffer-disable-undo (current-buffer))
 757   (auto-fill-mode -1)
 758   (use-local-map Man-mode-map)
 759   (Man-build-page-list)
 760   (Man-strip-page-headers)
 761   (Man-unindent)
 762   (Man-goto-page 1)
 763   (run-hooks 'Man-mode-hook))
 764
 765 (defsubst Man-build-section-alist ()
 766   "Build the association list of manpage sections."
 767   (setq Man-sections-alist nil)
 768   (goto-char (point-min))
 769   (let ((case-fold-search nil))
 770     (while (re-search-forward Man-heading-regexp (point-max) t)
 771       (aput 'Man-sections-alist (Man-match-substring 1))
 772       (forward-line 1))))
 773
 774 (defsubst Man-build-references-alist ()
 775   "Build the association list of references (in the SEE ALSO section)."
 776   (setq Man-refpages-alist nil)
 777   (save-excursion
 778     (if (Man-find-section Man-see-also-regexp)
 779         (let ((start (progn (forward-line 1) (point)))
 780               (end (progn
 781                      (Man-next-section 1)
 782                      (point)))
 783               hyphenated
 784               (runningpoint -1))
 785           (save-restriction
 786             (narrow-to-region start end)
 787             (goto-char (point-min))
 788             (back-to-indentation)
 789             (while (and (not (eobp)) (/= (point) runningpoint))
 790               (setq runningpoint (point))
 791               (if (re-search-forward Man-reference-regexp end t)
 792                   (let* ((word (Man-match-substring 0))
 793                          (len (1- (length word))))
 794                     (if hyphenated
 795                         (setq word (concat hyphenated word)
 796                               hyphenated nil))
 797                     (if (= (aref word len) ?-)
 798                         (setq hyphenated (substring word 0 len))
 799                       (aput 'Man-refpages-alist word))))
 800               (skip-chars-forward " \t\n,")))))))
 801
 802 (defun Man-build-page-list ()
 803   "Build the list of separate manpages in the buffer."
 804   (setq Man-page-list nil)
 805   (let ((page-start (point-min))
 806         (page-end (point-max))
 807         (header ""))
 808     (goto-char page-start)
 809     ;; (switch-to-buffer (current-buffer))(debug)
 810     (while (not (eobp))
 811       (setq header
 812             (if (looking-at Man-page-header-regexp)
 813                 (Man-match-substring 1)
 814               nil))
 815       ;; Go past both the current and the next Man-first-heading-regexp
 816       (if (re-search-forward Man-first-heading-regexp nil 'move 2)
 817           (let ((p (progn (beginning-of-line) (point))))
 818             ;; We assume that the page header is delimited by blank
 819             ;; lines and that it contains at most one blank line.  So
 820             ;; if we back by three blank lines we will be sure to be
 821             ;; before the page header but not before the possible
 822             ;; previous page header.
 823             (search-backward "\n\n" nil t 3)
 824             (if (re-search-forward Man-page-header-regexp p 'move)
 825                 (beginning-of-line))))
 826       (setq page-end (point))
 827       (setq Man-page-list (append Man-page-list
 828                                   (list (list (copy-marker page-start)
 829                                               (copy-marker page-end)
 830                                               header))))
 831       (setq page-start page-end)
 832       )))
 833
 834 (defun Man-strip-page-headers ()
 835   "Strip all the page headers but the first from the manpage."
 836   (let ((buffer-read-only nil)
 837         (case-fold-search nil)
 838         (page-list Man-page-list)
 839         (page ())
 840         (header ""))
 841     (while page-list
 842       (setq page (car page-list))
 843       (and (nth 2 page)
 844            (goto-char (car page))
 845            (re-search-forward Man-first-heading-regexp nil t)
 846            (setq header (buffer-substring (car page) (match-beginning 0)))
 847            ;; Since the awk script collapses all successive blank
 848            ;; lines into one, and since we don't want to get rid of
 849            ;; the fast awk script, one must choose between adding
 850            ;; spare blank lines between pages when there were none and
 851            ;; deleting blank lines at page boundaries when there were
 852            ;; some.  We choose the first, so we comment the following
 853            ;; line.
 854            ;; (setq header (concat "\n" header)))
 855            (while (search-forward header (nth 1 page) t)
 856              (replace-match "")))
 857       (setq page-list (cdr page-list)))))
 858
 859 (defun Man-unindent ()
 860   "Delete the leading spaces that indent the manpage."
 861   (let ((buffer-read-only nil)
 862         (case-fold-search nil)
 863         (page-list Man-page-list))
 864     (while page-list
 865       (let ((page (car page-list))
 866             (indent "")
 867             (nindent 0))
 868         (narrow-to-region (car page) (car (cdr page)))
 869         (if Man-uses-untabify-flag
 870             (untabify (point-min) (point-max)))
 871         (if (catch 'unindent
 872               (goto-char (point-min))
 873               (if (not (re-search-forward Man-first-heading-regexp nil t))
 874                   (throw 'unindent nil))
 875               (beginning-of-line)
 876               (setq indent (buffer-substring (point)
 877                                              (progn
 878                                                (skip-chars-forward " ")
 879                                                (point))))
 880               (setq nindent (length indent))
 881               (if (zerop nindent)
 882                   (throw 'unindent nil))
 883               (setq indent (concat indent "\\|$"))
 884               (goto-char (point-min))
 885               (while (not (eobp))
 886                 (if (looking-at indent)
 887                     (forward-line 1)
 888                   (throw 'unindent nil)))
 889               (goto-char (point-min)))
 890             (while (not (eobp))
 891               (or (eolp)
 892                   (delete-char nindent))
 893               (forward-line 1)))
 894         (setq page-list (cdr page-list))
 895         ))))
 896
 897 \f
 898 ;; ======================================================================
 899 ;; Man mode commands
 900
 901 (defun Man-next-section (n)
 902   "Move point to Nth next section (default 1)."
 903   (interactive "p")
 904   (let ((case-fold-search nil))
 905     (if (looking-at Man-heading-regexp)
 906         (forward-line 1))
 907     (if (re-search-forward Man-heading-regexp (point-max) t n)
 908         (beginning-of-line)
 909       (goto-char (point-max)))))
 910
 911 (defun Man-previous-section (n)
 912   "Move point to Nth previous section (default 1)."
 913   (interactive "p")
 914   (let ((case-fold-search nil))
 915     (if (looking-at Man-heading-regexp)
 916         (forward-line -1))
 917     (if (re-search-backward Man-heading-regexp (point-min) t n)
 918         (beginning-of-line)
 919       (goto-char (point-min)))))
 920
 921 (defun Man-find-section (section)
 922   "Move point to SECTION if it exists, otherwise don't move point.
 923 Returns t if section is found, nil otherwise."
 924   (let ((curpos (point))
 925         (case-fold-search nil))
 926     (goto-char (point-min))
 927     (if (re-search-forward (concat "^" section) (point-max) t)
 928         (progn (beginning-of-line) t)
 929       (goto-char curpos)
 930       nil)
 931     ))
 932
 933 (defun Man-goto-section ()
 934   "Query for section to move point to."
 935   (interactive)
 936   (aput 'Man-sections-alist
 937         (let* ((default (aheadsym Man-sections-alist))
 938                (completion-ignore-case t)
 939                chosen
 940                (prompt (concat "Go to section: (default " default ") ")))
 941           (setq chosen (completing-read prompt Man-sections-alist))
 942           (if (or (not chosen)
 943                   (string= chosen ""))
 944               default
 945             chosen)))
 946   (Man-find-section (aheadsym Man-sections-alist)))
 947
 948 (defun Man-goto-see-also-section ()
 949   "Move point the the \"SEE ALSO\" section.
 950 Actually the section moved to is described by `Man-see-also-regexp'."
 951   (interactive)
 952   (if (not (Man-find-section Man-see-also-regexp))
 953       (error (concat "No " Man-see-also-regexp
 954                      " section found in the current manpage"))))
 955
 956 (defun Man-follow-manual-reference (reference)
 957   "Get one of the manpages referred to in the \"SEE ALSO\" section.
 958 Specify which reference to use; default is based on word at point."
 959   (interactive
 960    (if (not Man-refpages-alist)
 961        (error "There are no references in the current man page")
 962      (list (let* ((default (or
 963                              (car (all-completions
 964                                    (save-excursion
 965                                      (skip-syntax-backward "w()")
 966                                      (skip-chars-forward " \t")
 967                                      (let ((word (current-word)))
 968                                        ;; strip a trailing '-':
 969                                        (if (string-match "-$" word)
 970                                            (substring word 0
 971                                                       (match-beginning 0))
 972                                          word)))
 973                                    Man-refpages-alist))
 974                              (aheadsym Man-refpages-alist)))
 975                    chosen
 976                    (prompt (concat "Refer to: (default " default ") ")))
 977               (setq chosen (completing-read prompt Man-refpages-alist nil t))
 978               (if (or (not chosen)
 979                       (string= chosen ""))
 980                   default
 981                 chosen)))))
 982   (if (not Man-refpages-alist)
 983       (error "Can't find any references in the current manpage")
 984     (aput 'Man-refpages-alist reference)
 985     (Man-getpage-in-background
 986      (Man-translate-references (aheadsym Man-refpages-alist)))))
 987
 988 (defun Man-kill ()
 989   "Kill the buffer containing the manpage."
 990   (interactive)
 991   (let ((buff (current-buffer)))
 992     (delete-windows-on buff)
 993     (kill-buffer buff))
 994   (if (and window-system
 995            (or (eq Man-notify-method 'newframe)
 996                (and pop-up-frames
 997                     (eq Man-notify-method 'bully))))
 998       (delete-frame)))
 999
1000 (defun Man-quit ()
1001   "Bury the buffer containing the manpage."
1002   (interactive)
1003   (let ((buff (current-buffer)))
1004     (delete-windows-on buff)
1005     (bury-buffer buff))
1006   (if (and window-system
1007            (or (eq Man-notify-method 'newframe)
1008                (and pop-up-frames
1009                     (eq Man-notify-method 'bully))))
1010       (delete-frame)))
1011
1012 (defun Man-goto-page (page)
1013   "Go to the manual page on page PAGE."
1014   (interactive
1015    (if (not Man-page-list)
1016        (let ((args Man-arguments))
1017          (kill-buffer (current-buffer))
1018          (error "Can't find the %s manpage" args))
1019      (if (= (length Man-page-list) 1)
1020          (error "You're looking at the only manpage in the buffer")
1021        (list (read-minibuffer (format "Go to manpage [1-%d]: "
1022                                       (length Man-page-list)))))))
1023   (if (not Man-page-list)
1024       (let ((args Man-arguments))
1025         (kill-buffer (current-buffer))
1026         (error "Can't find the %s manpage" args)))
1027   (if (or (< page 1)
1028           (> page (length Man-page-list)))
1029       (error "No manpage %d found" page))
1030   (let* ((page-range (nth (1- page) Man-page-list))
1031          (page-start (car page-range))
1032          (page-end (car (cdr page-range))))
1033     (setq Man-current-page page
1034           Man-page-mode-string (Man-make-page-mode-string))
1035     (widen)
1036     (goto-char page-start)
1037     (narrow-to-region page-start page-end)
1038     (Man-build-section-alist)
1039     (Man-build-references-alist)
1040     (goto-char (point-min))))
1041
1042
1043 (defun Man-next-manpage ()
1044   "Find the next manpage entry in the buffer."
1045   (interactive)
1046   (if (= (length Man-page-list) 1)
1047       (error "This is the only manpage in the buffer"))
1048   (if (< Man-current-page (length Man-page-list))
1049       (Man-goto-page (1+ Man-current-page))
1050     (if Man-circular-pages-flag
1051         (Man-goto-page 1)
1052       (error "You're looking at the last manpage in the buffer"))))
1053
1054 (defun Man-previous-manpage ()
1055   "Find the previous manpage entry in the buffer."
1056   (interactive)
1057   (if (= (length Man-page-list) 1)
1058       (error "This is the only manpage in the buffer"))
1059   (if (> Man-current-page 1)
1060       (Man-goto-page (1- Man-current-page))
1061     (if Man-circular-pages-flag
1062         (Man-goto-page (length Man-page-list))
1063       (error "You're looking at the first manpage in the buffer"))))
1064 \f
1065 (provide 'man)
1066
1067 ;;; man.el ends here