lisp/man.el

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