lisp/man.el

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