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 everthing 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 idiosynchrasies.
  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 "t"    'toggle-truncate-lines)
 294   (define-key Man-mode-map "g"    'Man-goto-section)
 295   (define-key Man-mode-map "s"    'Man-goto-see-also-section)
 296   (define-key Man-mode-map "k"    'Man-kill)
 297   (define-key Man-mode-map "q"    'Man-quit)
 298   (define-key Man-mode-map "m"    'man)
 299   (define-key Man-mode-map "?"    'describe-mode)
 300   )
 301
 302 \f
 303 ;; ======================================================================
 304 ;; utilities
 305
 306 (defsubst Man-init-defvars ()
 307   "Used for initialising variables based on the value of window-system.
 308 This is necessary if one wants to dump man.el with emacs."
 309
 310   ;; The following is necessary until fonts are implemented on
 311   ;; terminals.
 312   (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
 313                                       window-system))
 314
 315   (defconst Man-uses-untabify-flag t
 316     ;; don't use pr: it is buggy
 317     ;; (or (not (file-readable-p "/etc/passwd"))
 318     ;;   (/= 0 (apply 'call-process
 319     ;;                Man-untabify-command nil nil nil
 320     ;;                (append Man-untabify-command-args
 321     ;;                        (list "/etc/passwd")))))
 322     "When non-nil use `untabify' instead of Man-untabify-command.")
 323
 324   (defconst Man-sed-script
 325     (cond
 326      (Man-fontify-manpage-flag
 327       nil)
 328      ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
 329       Man-sysv-sed-script)
 330      ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
 331       Man-berkeley-sed-script)
 332      (t
 333       nil))
 334     "Script for sed to nuke backspaces and ANSI codes from manpages.")
 335
 336   (defvar Man-filter-list
 337     (list
 338      (cons
 339       Man-sed-command
 340       (list
 341        (if Man-sed-script
 342            (concat "-e '" Man-sed-script "'")
 343          "")
 344        "-e '/^[\001-\032][\001-\032]*$/d'"
 345        "-e '/\e[789]/s///g'"
 346        "-e '/Reformatting page.  Wait/d'"
 347        "-e '/Reformatting entry.  Wait/d'"
 348        "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
 349        "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
 350        "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
 351        "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
 352        "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
 353        "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
 354        "-e '/^[A-za-z].*Last[ \t]change:/d'"
 355        "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
 356        "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
 357        ))
 358      (cons
 359       Man-awk-command
 360       (list
 361        "'\n"
 362        "BEGIN { blankline=0; anonblank=0; }\n"
 363        "/^$/ { if (anonblank==0) next; }\n"
 364        "{ anonblank=1; }\n"
 365        "/^$/ { blankline++; next; }\n"
 366        "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
 367        "'"
 368        ))
 369      (if (not Man-uses-untabify-flag)
 370          (cons
 371           Man-untabify-command
 372           Man-untabify-command-args)
 373        ))
 374     "*Manpage cleaning filter command phrases.
 375 This variable contains a list of the following form:
 376
 377 '((command-string phrase-string*)*)
 378
 379 Each phrase-string is concatenated onto the command-string to form a
 380 command filter.  The (standard) output (and standard error) of the Un*x
 381 man command is piped through each command filter in the order the
 382 commands appear in the association list.  The final output is placed in
 383 the manpage buffer.")
 384 )
 385
 386 (defsubst Man-match-substring (&optional n string)
 387   "Return the substring matched by the last search.
 388 Optional arg N means return the substring matched by the Nth paren
 389 grouping.  Optional second arg STRING means return a substring from
 390 that string instead of from the current buffer."
 391   (if (null n) (setq n 0))
 392   (if string
 393       (substring string (match-beginning n) (match-end n))
 394     (buffer-substring (match-beginning n) (match-end n))))
 395
 396 (defsubst Man-make-page-mode-string ()
 397   "Formats part of the mode line for Man mode."
 398   (format "%s page %d of %d"
 399           (or (nth 2 (nth (1- Man-current-page) Man-page-list))
 400               "")
 401           Man-current-page
 402           (length Man-page-list)))
 403
 404 (defsubst Man-build-man-command ()
 405   "Builds the entire background manpage and cleaning command."
 406   (let ((command (concat manual-program " " Man-switches " %s 2>/dev/null"))
 407         (flist Man-filter-list))
 408     (while (and flist (car flist))
 409       (let ((pcom (car (car flist)))
 410             (pargs (cdr (car flist))))
 411         (setq command
 412               (concat command " | " pcom " "
 413                       (mapconcat '(lambda (phrase)
 414                                     (if (not (stringp phrase))
 415                                         (error "Malformed Man-filter-list"))
 416                                     phrase)
 417                                  pargs " ")))
 418         (setq flist (cdr flist))))
 419     command))
 420
 421 (defun Man-translate-references (ref)
 422   "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
 423 Leave it as is if already in that style.  Possibly downcase and
 424 translate the section (see the Man-downcase-section-letters-flag
 425 and the Man-section-translations-alist variables)."
 426   (let ((name "")
 427         (section "")
 428         (slist Man-section-translations-alist))
 429     (cond
 430      ;; "chmod(2V)" case ?
 431      ((string-match (concat "^" Man-reference-regexp "$") ref)
 432       (setq name (Man-match-substring 1 ref)
 433             section (Man-match-substring 2 ref)))
 434      ;; "2v chmod" case ?
 435      ((string-match (concat "^\\(" Man-section-regexp
 436                             "\\) +\\(" Man-name-regexp "\\)$") ref)
 437       (setq name (Man-match-substring 2 ref)
 438             section (Man-match-substring 1 ref))))
 439     (if (string= name "")
 440         ref                             ; Return the reference as is
 441       (if Man-downcase-section-letters-flag
 442           (setq section (downcase section)))
 443       (while slist
 444         (let ((s1 (car (car slist)))
 445               (s2 (cdr (car slist))))
 446           (setq slist (cdr slist))
 447           (if Man-downcase-section-letters-flag
 448               (setq s1 (downcase s1)))
 449           (if (not (string= s1 section)) nil
 450             (setq section (if Man-downcase-section-letters-flag
 451                               (downcase s2)
 452                             s2)
 453                   slist nil))))
 454       (concat Man-specified-section-option section " " name))))
 455
 456 \f
 457 ;; ======================================================================
 458 ;; default man entry: get word under point
 459
 460 (defsubst Man-default-man-entry ()
 461   "Make a guess at a default manual entry.
 462 This guess is based on the text surrounding the cursor, and the
 463 default section number is selected from `Man-auto-section-alist'."
 464   (let (default-title)
 465     (save-excursion
 466
 467       ;; Default man entry title is any word the cursor is on, or if
 468       ;; cursor not on a word, then nearest preceding word.  Cannot
 469       ;; use the current-word function because it skips the dots.
 470       (if (not (looking-at "[-a-zA-Z_.]"))
 471           (skip-chars-backward "^a-zA-Z"))
 472       (skip-chars-backward "-(a-zA-Z_0-9_.")
 473       (if (looking-at "(") (forward-char 1))
 474       (setq default-title
 475             (buffer-substring
 476              (point)
 477              (progn (skip-chars-forward "-a-zA-Z0-9_.") (point))))
 478
 479       ;; If looking at something like ioctl(2) or brc(1M), include the
 480       ;; section number in the returned value.  Remove text properties.
 481       (let ((result (concat
 482                      default-title
 483                      (if (looking-at
 484                           (concat "[ \t]*([ \t]*\\("
 485                                   Man-section-regexp "\\)[ \t]*)"))
 486                          (format "(%s)" (Man-match-substring 1))))))
 487         (set-text-properties 0 (length result) nil result)
 488         result))))
 489
 490 \f
 491 ;; ======================================================================
 492 ;; Top level command and background process sentinel
 493
 494 ;; For compatibility with older versions.
 495 ;;;###autoload
 496 (defalias 'manual-entry 'man)
 497
 498 ;;;###autoload
 499 (defun man (man-args)
 500   "Get a Un*x manual page and put it in a buffer.
 501 This command is the top-level command in the man package.  It runs a Un*x
 502 command to retrieve and clean a manpage in the background and places the
 503 results in a Man mode (manpage browsing) buffer.  See variable
 504 `Man-notify-method' for what happens when the buffer is ready.
 505 If a buffer already exists for this man page, it will display immediately."
 506   (interactive
 507    (list (let* ((default-entry (Man-default-man-entry))
 508                 (input (read-string
 509                         (format "Manual entry%s: "
 510                                 (if (string= default-entry "")
 511                                     ""
 512                                   (format " (default %s)" default-entry))))))
 513            (if (string= input "")
 514                (if (string= default-entry "")
 515                    (error "No man args given")
 516                  default-entry)
 517              input))))
 518
 519   ;; Init the man package variables, if not already done.
 520   (Man-init-defvars)
 521
 522   ;; Possibly translate the "subject(section)" syntax into the
 523   ;; "section subject" syntax and possibly downcase the section.
 524   (setq man-args (Man-translate-references man-args))
 525
 526   (Man-getpage-in-background man-args))
 527
 528
 529 (defun Man-getpage-in-background (topic)
 530   "Uses TOPIC to build and fire off the manpage and cleaning command."
 531   (let* ((man-args topic)
 532          (bufname (concat "*Man " man-args "*"))
 533          (buffer  (get-buffer bufname)))
 534     (if buffer
 535         (Man-notify-when-ready buffer)
 536       (require 'env)
 537       (message "Invoking %s %s in the background" manual-program man-args)
 538       (setq buffer (generate-new-buffer bufname))
 539       (save-excursion
 540         (set-buffer buffer)
 541         (setq Man-original-frame (selected-frame))
 542         (setq Man-arguments man-args))
 543       (let ((process-environment (copy-sequence process-environment)))
 544         ;; Prevent any attempt to use display terminal fanciness.
 545         (setenv "TERM" "dumb")
 546         (set-process-sentinel
 547          (start-process manual-program buffer "sh" "-c"
 548                         (format (Man-build-man-command) man-args))
 549          'Man-bgproc-sentinel)))))
 550
 551 (defun Man-notify-when-ready (man-buffer)
 552   "Notify the user when MAN-BUFFER is ready.
 553 See the variable `Man-notify-method' for the different notification behaviors."
 554   (let ((saved-frame (save-excursion
 555                        (set-buffer man-buffer)
 556                        Man-original-frame)))
 557     (cond
 558      ((eq Man-notify-method 'newframe)
 559       ;; Since we run asynchronously, perhaps while Emacs is waiting
 560       ;; for input, we must not leave a different buffer current.  We
 561       ;; can't rely on the editor command loop to reselect the
 562       ;; selected window's buffer.
 563       (save-excursion
 564         (set-buffer man-buffer)
 565         (make-frame Man-frame-parameters)))
 566      ((eq Man-notify-method 'pushy)
 567       (switch-to-buffer man-buffer))
 568      ((eq Man-notify-method 'bully)
 569       (and window-system
 570            (frame-live-p saved-frame)
 571            (select-frame saved-frame))
 572       (pop-to-buffer man-buffer)
 573       (delete-other-windows))
 574      ((eq Man-notify-method 'aggressive)
 575       (and window-system
 576            (frame-live-p saved-frame)
 577            (select-frame saved-frame))
 578       (pop-to-buffer man-buffer))
 579      ((eq Man-notify-method 'friendly)
 580       (and window-system
 581            (frame-live-p saved-frame)
 582            (select-frame saved-frame))
 583       (display-buffer man-buffer 'not-this-window))
 584      ((eq Man-notify-method 'polite)
 585       (beep)
 586       (message "Manual buffer %s is ready" (buffer-name man-buffer)))
 587      ((eq Man-notify-method 'quiet)
 588       (message "Manual buffer %s is ready" (buffer-name man-buffer)))
 589      ((or (eq Man-notify-method 'meek)
 590           t)
 591       (message ""))
 592      )))
 593
 594 (defun Man-fontify-manpage ()
 595   "Convert overstriking and underlining to the correct fonts.
 596 Same for the ANSI bold and normal escape sequences."
 597   (interactive)
 598   (message "Please wait: making up the %s man page..." Man-arguments)
 599   (goto-char (point-min))
 600   (while (search-forward "\e[1m" nil t)
 601     (delete-backward-char 4)
 602     (put-text-property (point)
 603                        (progn (if (search-forward "\e[0m" nil 'move)
 604                                   (delete-backward-char 4))
 605                               (point))
 606                        'face Man-overstrike-face))
 607   (goto-char (point-min))
 608   (while (search-forward "_\b" nil t)
 609     (backward-delete-char 2)
 610     (put-text-property (point) (1+ (point)) 'face Man-underline-face))
 611   (goto-char (point-min))
 612   (while (search-forward "\b_" nil t)
 613     (backward-delete-char 2)
 614     (put-text-property (1- (point)) (point) 'face Man-underline-face))
 615   (goto-char (point-min))
 616   (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
 617     (replace-match "\\1")
 618     (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
 619   (goto-char (point-min))
 620   (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
 621     (replace-match "o")
 622     (put-text-property (1- (point)) (point) 'face 'bold))
 623   (goto-char (point-min))
 624   (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
 625     (replace-match "+")
 626     (put-text-property (1- (point)) (point) 'face 'bold))
 627   (message "%s man page made up" Man-arguments))
 628
 629 (defun Man-cleanup-manpage ()
 630   "Remove overstriking and underlining from the current buffer."
 631   (interactive)
 632   (message "Please wait: cleaning up the %s man page..."
 633            Man-arguments)
 634   (if (or (interactive-p) (not Man-sed-script))
 635       (progn
 636         (goto-char (point-min))
 637         (while (search-forward "_\b" nil t) (backward-delete-char 2))
 638         (goto-char (point-min))
 639         (while (search-forward "\b_" nil t) (backward-delete-char 2))
 640         (goto-char (point-min))
 641         (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
 642           (replace-match "\\1"))
 643         (goto-char (point-min))
 644         (while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
 645         (goto-char (point-min))
 646         (while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
 647         ))
 648   (goto-char (point-min))
 649   (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
 650   (message "%s man page cleaned up" Man-arguments))
 651
 652 (defun Man-bgproc-sentinel (process msg)
 653   "Manpage background process sentinel."
 654   (let ((Man-buffer (process-buffer process))
 655         (delete-buff nil)
 656         (err-mess nil))
 657
 658     (if (null (buffer-name Man-buffer)) ;; deleted buffer
 659         (set-process-buffer process nil)
 660
 661       (save-excursion
 662         (set-buffer Man-buffer)
 663         (let ((case-fold-search nil))
 664           (goto-char (point-min))
 665           (cond ((or (looking-at "No \\(manual \\)*entry for")
 666                      (looking-at "[^\n]*: nothing appropriate$"))
 667                  (setq err-mess (buffer-substring (point)
 668                                                   (progn
 669                                                     (end-of-line) (point)))
 670                        delete-buff t))
 671                 ((not (and (eq (process-status process) 'exit)
 672                            (= (process-exit-status process) 0)))
 673                  (setq err-mess
 674                        (concat (buffer-name Man-buffer)
 675                                ": process "
 676                                (let ((eos (1- (length msg))))
 677                                  (if (= (aref msg eos) ?\n)
 678                                      (substring msg 0 eos) msg))))
 679                  (goto-char (point-max))
 680                  (insert (format "\nprocess %s" msg))
 681                  ))
 682           (if delete-buff
 683               (kill-buffer Man-buffer)
 684             (if Man-fontify-manpage-flag
 685                 (Man-fontify-manpage)
 686               (Man-cleanup-manpage))
 687             (run-hooks 'Man-cooked-hook)
 688             (Man-mode)
 689             (set-buffer-modified-p nil)
 690             ))
 691         ;; Restore case-fold-search before calling
 692         ;; Man-notify-when-ready because it may switch buffers.
 693
 694         (if (not delete-buff)
 695             (Man-notify-when-ready Man-buffer))
 696
 697         (if err-mess
 698             (error err-mess))
 699         ))))
 700
 701 \f
 702 ;; ======================================================================
 703 ;; set up manual mode in buffer and build alists
 704
 705 (defun Man-mode ()
 706   "A mode for browsing Un*x manual pages.
 707
 708 The following man commands are available in the buffer. Try
 709 \"\\[describe-key] <key> RET\" for more information:
 710
 711 \\[man]       Prompt to retrieve a new manpage.
 712 \\[Man-follow-manual-reference]       Retrieve reference in SEE ALSO section.
 713 \\[Man-next-manpage]   Jump to next manpage in circular list.
 714 \\[Man-previous-manpage]   Jump to previous manpage in circular list.
 715 \\[Man-next-section]       Jump to next manpage section.
 716 \\[Man-previous-section]       Jump to previous manpage section.
 717 \\[Man-goto-section]       Go to a manpage section.
 718 \\[Man-goto-see-also-section]       Jumps to the SEE ALSO manpage section.
 719 \\[Man-quit]       Deletes the manpage window, bury its buffer.
 720 \\[Man-kill]       Deletes the manpage window, kill its buffer.
 721 \\[describe-mode]       Prints this help text.
 722
 723 The following variables may be of some use. Try
 724 \"\\[describe-variable] <variable-name> RET\" for more information:
 725
 726 Man-notify-method               What happens when manpage formatting is done.
 727 Man-downcase-section-letters-flag  Force section letters to lower case.
 728 Man-circular-pages-flag         Treat multiple manpage list as circular.
 729 Man-auto-section-alist          List of major modes and their section numbers.
 730 Man-section-translations-alist  List of section numbers and their Un*x equiv.
 731 Man-filter-list                 Background manpage filter command.
 732 Man-mode-line-format            Mode line format for Man mode buffers.
 733 Man-mode-map                    Keymap bindings for Man mode buffers.
 734 Man-mode-hook                   Normal hook run on entry to Man mode.
 735 Man-section-regexp              Regexp describing manpage section letters.
 736 Man-heading-regexp              Regexp describing section headers.
 737 Man-see-also-regexp             Regexp for SEE ALSO section (or your equiv).
 738 Man-first-heading-regexp        Regexp for first heading on a manpage.
 739 Man-reference-regexp            Regexp matching a references in SEE ALSO.
 740 Man-switches                    Background `man' command switches.
 741
 742 The following key bindings are currently in effect in the buffer:
 743 \\{Man-mode-map}"
 744   (interactive)
 745   (setq major-mode 'Man-mode
 746         mode-name "Man"
 747         buffer-auto-save-file-name nil
 748         mode-line-format Man-mode-line-format
 749         truncate-lines t
 750         buffer-read-only t)
 751   (buffer-disable-undo (current-buffer))
 752   (auto-fill-mode -1)
 753   (use-local-map Man-mode-map)
 754   (Man-build-page-list)
 755   (Man-strip-page-headers)
 756   (Man-unindent)
 757   (Man-goto-page 1)
 758   (run-hooks 'Man-mode-hook))
 759
 760 (defsubst Man-build-section-alist ()
 761   "Build the association list of manpage sections."
 762   (setq Man-sections-alist nil)
 763   (goto-char (point-min))
 764   (let ((case-fold-search nil))
 765     (while (re-search-forward Man-heading-regexp (point-max) t)
 766       (aput 'Man-sections-alist (Man-match-substring 1))
 767       (forward-line 1))))
 768
 769 (defsubst Man-build-references-alist ()
 770   "Build the association list of references (in the SEE ALSO section)."
 771   (setq Man-refpages-alist nil)
 772   (save-excursion
 773     (if (Man-find-section Man-see-also-regexp)
 774         (let ((start (progn (forward-line 1) (point)))
 775               (end (progn
 776                      (Man-next-section 1)
 777                      (point)))
 778               hyphenated
 779               (runningpoint -1))
 780           (save-restriction
 781             (narrow-to-region start end)
 782             (goto-char (point-min))
 783             (back-to-indentation)
 784             (while (and (not (eobp)) (/= (point) runningpoint))
 785               (setq runningpoint (point))
 786               (if (re-search-forward Man-reference-regexp end t)
 787                   (let* ((word (Man-match-substring 0))
 788                          (len (1- (length word))))
 789                     (if hyphenated
 790                         (setq word (concat hyphenated word)
 791                               hyphenated nil))
 792                     (if (= (aref word len) ?-)
 793                         (setq hyphenated (substring word 0 len))
 794                       (aput 'Man-refpages-alist word))))
 795               (skip-chars-forward " \t\n,")))))))
 796
 797 (defun Man-build-page-list ()
 798   "Build the list of separate manpages in the buffer."
 799   (setq Man-page-list nil)
 800   (let ((page-start (point-min))
 801         (page-end (point-max))
 802         (header ""))
 803     (goto-char page-start)
 804     ;; (switch-to-buffer (current-buffer))(debug)
 805     (while (not (eobp))
 806       (setq header
 807             (if (looking-at Man-page-header-regexp)
 808                 (Man-match-substring 1)
 809               nil))
 810       ;; Go past both the current and the next Man-first-heading-regexp
 811       (if (re-search-forward Man-first-heading-regexp nil 'move 2)
 812           (let ((p (progn (beginning-of-line) (point))))
 813             ;; We assume that the page header is delimited by blank
 814             ;; lines and that it contains at most one blank line.  So
 815             ;; if we back by three blank lines we will be sure to be
 816             ;; before the page header but not before the possible
 817             ;; previous page header.
 818             (search-backward "\n\n" nil t 3)
 819             (if (re-search-forward Man-page-header-regexp p 'move)
 820                 (beginning-of-line))))
 821       (setq page-end (point))
 822       (setq Man-page-list (append Man-page-list
 823                                   (list (list (copy-marker page-start)
 824                                               (copy-marker page-end)
 825                                               header))))
 826       (setq page-start page-end)
 827       )))
 828
 829 (defun Man-strip-page-headers ()
 830   "Strip all the page headers but the first from the manpage."
 831   (let ((buffer-read-only nil)
 832         (case-fold-search nil)
 833         (page-list Man-page-list)
 834         (page ())
 835         (header ""))
 836     (while page-list
 837       (setq page (car page-list))
 838       (and (nth 2 page)
 839            (goto-char (car page))
 840            (re-search-forward Man-first-heading-regexp nil t)
 841            (setq header (buffer-substring (car page) (match-beginning 0)))
 842            ;; Since the awk script collapses all successive blank
 843            ;; lines into one, and since we don't want to get rid of
 844            ;; the fast awk script, one must choose between adding
 845            ;; spare blank lines between pages when there were none and
 846            ;; deleting blank lines at page boundaries when there were
 847            ;; some.  We choose the first, so we comment the following
 848            ;; line.
 849            ;; (setq header (concat "\n" header)))
 850            (while (search-forward header (nth 1 page) t)
 851              (replace-match "")))
 852       (setq page-list (cdr page-list)))))
 853
 854 (defun Man-unindent ()
 855   "Delete the leading spaces that indent the manpage."
 856   (let ((buffer-read-only nil)
 857         (case-fold-search nil)
 858         (page-list Man-page-list))
 859     (while page-list
 860       (let ((page (car page-list))
 861             (indent "")
 862             (nindent 0))
 863         (narrow-to-region (car page) (car (cdr page)))
 864         (if Man-uses-untabify-flag
 865             (untabify (point-min) (point-max)))
 866         (if (catch 'unindent
 867               (goto-char (point-min))
 868               (if (not (re-search-forward Man-first-heading-regexp nil t))
 869                   (throw 'unindent nil))
 870               (beginning-of-line)
 871               (setq indent (buffer-substring (point)
 872                                              (progn
 873                                                (skip-chars-forward " ")
 874                                                (point))))
 875               (setq nindent (length indent))
 876               (if (zerop nindent)
 877                   (throw 'unindent nil))
 878               (setq indent (concat indent "\\|$"))
 879               (goto-char (point-min))
 880               (while (not (eobp))
 881                 (if (looking-at indent)
 882                     (forward-line 1)
 883                   (throw 'unindent nil)))
 884               (goto-char (point-min)))
 885             (while (not (eobp))
 886               (or (eolp)
 887                   (delete-char nindent))
 888               (forward-line 1)))
 889         (setq page-list (cdr page-list))
 890         ))))
 891
 892 \f
 893 ;; ======================================================================
 894 ;; Man mode commands
 895
 896 (defun Man-next-section (n)
 897   "Move point to Nth next section (default 1)."
 898   (interactive "p")
 899   (let ((case-fold-search nil))
 900     (if (looking-at Man-heading-regexp)
 901         (forward-line 1))
 902     (if (re-search-forward Man-heading-regexp (point-max) t n)
 903         (beginning-of-line)
 904       (goto-char (point-max)))))
 905
 906 (defun Man-previous-section (n)
 907   "Move point to Nth previous section (default 1)."
 908   (interactive "p")
 909   (let ((case-fold-search nil))
 910     (if (looking-at Man-heading-regexp)
 911         (forward-line -1))
 912     (if (re-search-backward Man-heading-regexp (point-min) t n)
 913         (beginning-of-line)
 914       (goto-char (point-min)))))
 915
 916 (defun Man-find-section (section)
 917   "Move point to SECTION if it exists, otherwise don't move point.
 918 Returns t if section is found, nil otherwise."
 919   (let ((curpos (point))
 920         (case-fold-search nil))
 921     (goto-char (point-min))
 922     (if (re-search-forward (concat "^" section) (point-max) t)
 923         (progn (beginning-of-line) t)
 924       (goto-char curpos)
 925       nil)
 926     ))
 927
 928 (defun Man-goto-section ()
 929   "Query for section to move point to."
 930   (interactive)
 931   (aput 'Man-sections-alist
 932         (let* ((default (aheadsym Man-sections-alist))
 933                (completion-ignore-case t)
 934                chosen
 935                (prompt (concat "Go to section: (default " default ") ")))
 936           (setq chosen (completing-read prompt Man-sections-alist))
 937           (if (or (not chosen)
 938                   (string= chosen ""))
 939               default
 940             chosen)))
 941   (Man-find-section (aheadsym Man-sections-alist)))
 942
 943 (defun Man-goto-see-also-section ()
 944   "Move point the the \"SEE ALSO\" section.
 945 Actually the section moved to is described by `Man-see-also-regexp'."
 946   (interactive)
 947   (if (not (Man-find-section Man-see-also-regexp))
 948       (error (concat "No " Man-see-also-regexp
 949                      " section found in the current manpage"))))
 950
 951 (defun Man-follow-manual-reference (reference)
 952   "Get one of the manpages referred to in the \"SEE ALSO\" section.
 953 Specify which reference to use; default is based on word at point."
 954   (interactive
 955    (if (not Man-refpages-alist)
 956        (error "There are no references in the current man page")
 957      (list (let* ((default (or
 958                              (car (all-completions
 959                                    (save-excursion
 960                                      (skip-syntax-backward "w()")
 961                                      (skip-chars-forward " \t")
 962                                      (let ((word (current-word)))
 963                                        ;; strip a trailing '-':
 964                                        (if (string-match "-$" word)
 965                                            (substring word 0
 966                                                       (match-beginning 0))
 967                                          word)))
 968                                    Man-refpages-alist))
 969                              (aheadsym Man-refpages-alist)))
 970                    chosen
 971                    (prompt (concat "Refer to: (default " default ") ")))
 972               (setq chosen (completing-read prompt Man-refpages-alist nil t))
 973               (if (or (not chosen)
 974                       (string= chosen ""))
 975                   default
 976                 chosen)))))
 977   (if (not Man-refpages-alist)
 978       (error "Can't find any references in the current manpage")
 979     (aput 'Man-refpages-alist reference)
 980     (Man-getpage-in-background
 981      (Man-translate-references (aheadsym Man-refpages-alist)))))
 982
 983 (defun Man-kill ()
 984   "Kill the buffer containing the manpage."
 985   (interactive)
 986   (let ((buff (current-buffer)))
 987     (delete-windows-on buff)
 988     (kill-buffer buff))
 989   (if (and window-system
 990            (or (eq Man-notify-method 'newframe)
 991                (and pop-up-frames
 992                     (eq Man-notify-method 'bully))))
 993       (delete-frame)))
 994
 995 (defun Man-quit ()
 996   "Bury the buffer containing the manpage."
 997   (interactive)
 998   (let ((buff (current-buffer)))
 999     (delete-windows-on buff)
1000     (bury-buffer buff))
1001   (if (and window-system
1002            (or (eq Man-notify-method 'newframe)
1003                (and pop-up-frames
1004                     (eq Man-notify-method 'bully))))
1005       (delete-frame)))
1006
1007 (defun Man-goto-page (page)
1008   "Go to the manual page on page PAGE."
1009   (interactive
1010    (if (not Man-page-list)
1011        (let ((args Man-arguments))
1012          (kill-buffer (current-buffer))
1013          (error "Can't find the %s manpage" args))
1014      (if (= (length Man-page-list) 1)
1015          (error "You're looking at the only manpage in the buffer")
1016        (list (read-minibuffer (format "Go to manpage [1-%d]: "
1017                                       (length Man-page-list)))))))
1018   (if (not Man-page-list)
1019       (let ((args Man-arguments))
1020         (kill-buffer (current-buffer))
1021         (error "Can't find the %s manpage" args)))
1022   (if (or (< page 1)
1023           (> page (length Man-page-list)))
1024       (error "No manpage %d found" page))
1025   (let* ((page-range (nth (1- page) Man-page-list))
1026          (page-start (car page-range))
1027          (page-end (car (cdr page-range))))
1028     (setq Man-current-page page
1029           Man-page-mode-string (Man-make-page-mode-string))
1030     (widen)
1031     (goto-char page-start)
1032     (narrow-to-region page-start page-end)
1033     (Man-build-section-alist)
1034     (Man-build-references-alist)
1035     (goto-char (point-min))))
1036
1037
1038 (defun Man-next-manpage ()
1039   "Find the next manpage entry in the buffer."
1040   (interactive)
1041   (if (= (length Man-page-list) 1)
1042       (error "This is the only manpage in the buffer"))
1043   (if (< Man-current-page (length Man-page-list))
1044       (Man-goto-page (1+ Man-current-page))
1045     (if Man-circular-pages-flag
1046         (Man-goto-page 1)
1047       (error "You're looking at the last manpage in the buffer"))))
1048
1049 (defun Man-previous-manpage ()
1050   "Find the previous manpage entry in the buffer."
1051   (interactive)
1052   (if (= (length Man-page-list) 1)
1053       (error "This is the only manpage in the buffer"))
1054   (if (> Man-current-page 1)
1055       (Man-goto-page (1- Man-current-page))
1056     (if Man-circular-pages-flag
1057         (Man-goto-page (length Man-page-list))
1058       (error "You're looking at the first manpage in the buffer"))))
1059 \f
1060 (provide 'man)
1061
1062 ;;; man.el ends here