man.el 41.1 KB
Newer Older
Richard M. Stallman's avatar
Richard M. Stallman committed
1
;;; man.el --- browse UNIX manual pages
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4

Richard M. Stallman's avatar
Richard M. Stallman committed
5
;; Author:		Barry A. Warsaw <bwarsaw@cen.com>
Dave Love's avatar
Dave Love committed
6
;; Maintainer: FSF
Richard M. Stallman's avatar
Richard M. Stallman committed
7
;; Keywords:		help
8
;; Adapted-By:		ESR, pot
Eric S. Raymond's avatar
Eric S. Raymond committed
9

Joseph Arceneaux's avatar
Joseph Arceneaux committed
10 11 12 13
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Eric S. Raymond's avatar
Eric S. Raymond committed
14
;; the Free Software Foundation; either version 2, or (at your option)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
15 16 17 18 19 20 21 22
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
23 24 25
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
26

27 28
;;; Commentary:

29 30 31
;; This code provides a function, `man', with which you can browse
;; UNIX manual pages.  Formatting is done in background so that you
;; can continue to use your Emacs while processing is going on.
Richard M. Stallman's avatar
Richard M. Stallman committed
32 33 34 35 36
;;
;; The mode also supports hypertext-like following of manual page SEE
;; ALSO references, and other features.  See below or do `?' in a
;; manual page buffer for details.

Dave Love's avatar
Dave Love committed
37
;; ========== Credits and History ==========
Richard M. Stallman's avatar
Richard M. Stallman committed
38 39
;; In mid 1991, several people posted some interesting improvements to
;; man.el from the standard emacs 18.57 distribution.  I liked many of
Karl Heuer's avatar
Karl Heuer committed
40
;; these, but wanted everything in one single package, so I decided
41
;; to incorporate them into a single manual browsing mode.  While
Richard M. Stallman's avatar
Richard M. Stallman committed
42 43 44 45 46 47 48 49 50 51 52 53
;; much of the code here has been rewritten, and some features added,
;; these folks deserve lots of credit for providing the initial
;; excellent packages on which this one is based.

;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, posted a very nice
;; improvement which retrieved and cleaned the manpages in a
;; background process, and which correctly deciphered such options as
;; man -k.

;; Eric Rose <erose@jessica.stanford.edu>, submitted manual.el which
;; provided a very nice manual browsing mode.

54
;; This package was available as `superman.el' from the LCD package
Richard M. Stallman's avatar
Richard M. Stallman committed
55 56 57 58
;; for some time before it was accepted into Emacs 19.  The entry
;; point and some other names have been changed to make it a drop-in
;; replacement for the old man.el package.

59 60
;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
;; making it faster, more robust and more tolerant of different
Karl Heuer's avatar
Karl Heuer committed
61
;; systems' man idiosyncrasies.
62

Richard M. Stallman's avatar
Richard M. Stallman committed
63 64 65 66 67 68
;; ========== Features ==========
;; + Runs "man" in the background and pipes the results through a
;;   series of sed and awk scripts so that all retrieving and cleaning
;;   is done in the background. The cleaning commands are configurable.
;; + Syntax is the same as Un*x man
;; + Functionality is the same as Un*x man, including "man -k" and
69
;;   "man <section>", etc.
Richard M. Stallman's avatar
Richard M. Stallman committed
70 71 72 73 74
;; + Provides a manual browsing mode with keybindings for traversing
;;   the sections of a manpage, following references in the SEE ALSO
;;   section, and more.
;; + Multiple manpages created with the same man command are put into
;;   a narrowed buffer circular list.
75

76 77 78 79 80 81 82 83 84 85
;; ============= TODO ===========
;; - Add a command for printing.
;; - The awk script deletes multiple blank lines.  This behaviour does
;;   not allow to understand if there was indeed a blank line at the
;;   end or beginning of a page (after the header, or before the
;;   footer).  A different algorithm should be used.  It is easy to
;;   compute how many blank lines there are before and after the page
;;   headers, and after the page footer.  But it is possible to compute
;;   the number of blank lines before the page footer by euristhics
;;   only.  Is it worth doing?
86 87
;; - Allow a user option to mean that all the manpages should go in
;;   the same buffer, where they can be browsed with M-n and M-p.
88 89 90 91 92 93
;; - Allow completion on the manpage name when calling man.  This
;;   requires a reliable list of places where manpages can be found.  The
;;   drawback would be that if the list is not complete, the user might
;;   be led to believe that the manpages in the missing directories do
;;   not exist.

94

Eric S. Raymond's avatar
Eric S. Raymond committed
95 96
;;; Code:

Richard M. Stallman's avatar
Richard M. Stallman committed
97 98
(require 'assoc)

99 100 101
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;; empty defvars (keep the compiler quiet)

102 103 104 105 106 107
(defgroup man nil
  "Browse UNIX manual pages."
  :prefix "Man-"
  :group 'help)


108 109 110
(defvar Man-notify)
(defvar Man-current-page)
(defvar Man-page-list)
111
(defcustom Man-filter-list nil
112 113 114 115 116 117 118 119 120
  "*Manpage cleaning filter command phrases.
This variable contains a list of the following form:

'((command-string phrase-string*)*)

Each phrase-string is concatenated onto the command-string to form a
command filter.  The (standard) output (and standard error) of the Un*x
man command is piped through each command filter in the order the
commands appear in the association list.  The final output is placed in
121 122 123 124 125
the manpage buffer."
  :type '(repeat (list (string :tag "Command String")
		       (repeat :inline t
			       (string :tag "Phrase String"))))
  :group 'man)
126

127 128 129 130
(defvar Man-original-frame)
(defvar Man-arguments)
(defvar Man-sections-alist)
(defvar Man-refpages-alist)
131
(defvar Man-uses-untabify-flag t
Dave Love's avatar
Dave Love committed
132
  "Non-nil means use `untabify' instead of `Man-untabify-command'.")
133
(defvar Man-page-mode-string)
134 135
(defvar Man-sed-script nil
  "Script for sed to nuke backspaces and ANSI codes from manpages.")
136

Richard M. Stallman's avatar
Richard M. Stallman committed
137 138 139
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;; user variables

140
(defcustom Man-fontify-manpage-flag t
Dave Love's avatar
Dave Love committed
141
  "*Non-nil means make up the manpage with fonts."
142 143
  :type 'boolean
  :group 'man)
144

145 146 147 148
(defcustom Man-overstrike-face 'bold
  "*Face to use when fontifying overstrike."
  :type 'face
  :group 'man)
149

150 151 152 153
(defcustom Man-underline-face 'underline
  "*Face to use when fontifying underlining."
  :type 'face
  :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)
Richard M. Stallman's avatar
Richard M. Stallman committed
157
  "*Selects the behavior when manpage is ready.
158 159 160
This variable may have one of the following values, where (sf) means
that the frames are switched, so the manpage is displayed in the frame
where the man command was called from:
Richard M. Stallman's avatar
Richard M. Stallman committed
161

162
newframe   -- put the manpage in its own frame (see `Man-frame-parameters')
163 164 165 166 167
pushy      -- make the manpage the current buffer in the current window
bully      -- make the manpage the current buffer and only window (sf)
aggressive -- make the manpage the current buffer in the other window (sf)
friendly   -- display manpage in the other window but don't make current (sf)
polite     -- don't display manpage, but prints message and beep when ready
Richard M. Stallman's avatar
Richard M. Stallman committed
168
quiet      -- like `polite', but don't beep
169
meek       -- make no indication that the manpage is ready
Richard M. Stallman's avatar
Richard M. Stallman committed
170

171 172 173 174 175
Any other value of `Man-notify-method' is equivalent to `meek'."
  :type '(radio (const newframe) (const pushy) (const bully)
		(const aggressive) (const friendly)
		(const polite) (const quiet) (const meek))
  :group 'man)
Richard M. Stallman's avatar
Richard M. Stallman committed
176

177 178 179 180
(defcustom Man-frame-parameters nil
  "*Frame parameter list for creating a new frame for a manual page."
  :type 'sexp
  :group 'man)
181

182
(defcustom Man-downcase-section-letters-flag t
Dave Love's avatar
Dave Love committed
183
  "*Non-nil means letters in sections are converted to lower case.
Richard M. Stallman's avatar
Richard M. Stallman committed
184 185
Some Un*x man commands can't handle uppercase letters in sections, for
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
Richard M. Stallman's avatar
Richard M. Stallman committed
187
letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before
188 189 190
being sent to the man background process."
  :type 'boolean
  :group 'man)
Richard M. Stallman's avatar
Richard M. Stallman committed
191

192
(defcustom Man-circular-pages-flag t
Dave Love's avatar
Dave Love committed
193
  "*Non-nil means the manpage list is treated as circular for traversal."
194 195
  :type 'boolean
  :group 'man)
Richard M. Stallman's avatar
Richard M. Stallman committed
196

197
(defcustom Man-section-translations-alist
198 199 200 201 202 203
  (list
   '("3C++" . "3")
   ;; Some systems have a real 3x man section, so let's comment this.
   ;; '("3X" . "3")                        ; Xlib man pages
   '("3X11" . "3")
   '("1-UCB" . ""))
Richard M. Stallman's avatar
Richard M. Stallman committed
204 205
  "*Association list of bogus sections to real section numbers.
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 209 210 211
the associated section number."
  :type '(repeat (cons (string :tag "Bogus Section")
		       (string :tag "Real Section")))
  :group 'man)
Richard M. Stallman's avatar
Richard M. Stallman committed
212

213 214 215
(defvar manual-program "man"
  "The name of the program that produces man pages.")

216
(defvar Man-untabify-command "pr"
217
  "Command used for untabifying.")
218 219

(defvar Man-untabify-command-args (list "-t" "-e")
Dave Love's avatar
Dave Love committed
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.")
Richard M. Stallman's avatar
Richard M. Stallman committed
227 228

(defvar Man-mode-line-format
229 230 231 232 233 234 235 236 237 238 239
  '("-"
    mode-line-mule-info
    mode-line-modified
    mode-line-frame-identification
    mode-line-buffer-identification "  "
    global-mode-string
    " " Man-page-mode-string
    "  %[(" mode-name mode-line-process minor-mode-alist "%n)%]--"
    (line-number-mode "L%l--")
    (column-number-mode "C%c--")
    (-3 . "%p") "-%-")
240
  "Mode line format for manual mode buffer.")
Richard M. Stallman's avatar
Richard M. Stallman committed
241 242

(defvar Man-mode-map nil
243
  "Keymap for Man mode.")
Richard M. Stallman's avatar
Richard M. Stallman committed
244

245
(defvar Man-mode-hook nil
246
  "Hook run when Man mode is enabled.")
Richard M. Stallman's avatar
Richard M. Stallman committed
247

248
(defvar Man-cooked-hook nil
Dave Love's avatar
Dave Love committed
249
  "Hook run after removing backspaces but before `Man-mode' processing.")
250 251

(defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
252
  "Regular expression describing the name of a manpage (without section).")
253

254
(defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
255
  "Regular expression describing a manpage section within parentheses.")
Richard M. Stallman's avatar
Richard M. Stallman committed
256

257
(defvar Man-page-header-regexp
258 259 260 261 262 263
  (if (and (string-match "-solaris2\\." system-configuration)
	   (not (string-match "-solaris2\\.[123435]$" system-configuration)))
      (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
	      "(\\(" Man-section-regexp "\\))\\)$")
    (concat "^[ \t]*\\(" Man-name-regexp
	    "(\\(" Man-section-regexp "\\))\\).*\\1"))
264
  "Regular expression describing the heading of a page.")
265 266

(defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
267
  "Regular expression describing a manpage heading entry.")
Richard M. Stallman's avatar
Richard M. Stallman committed
268 269

(defvar Man-see-also-regexp "SEE ALSO"
270
  "Regular expression for SEE ALSO heading (or your equivalent).
Richard M. Stallman's avatar
Richard M. Stallman committed
271 272
This regexp should not start with a `^' character.")

Karl Heuer's avatar
Karl Heuer committed
273
(defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
274
  "Regular expression describing first heading on a manpage.
Richard M. Stallman's avatar
Richard M. Stallman committed
275 276
This regular expression should start with a `^' character.")

277
(defvar Man-reference-regexp
278
  (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
279
  "Regular expression describing a reference in the SEE ALSO section.")
Richard M. Stallman's avatar
Richard M. Stallman committed
280

281
(defvar Man-switches ""
282
  "Switches passed to the man command, as a single string.")
Richard M. Stallman's avatar
Richard M. Stallman committed
283

284 285 286 287
(defvar Man-specified-section-option
  (if (string-match "-solaris[0-9.]*$" system-configuration)
      "-s"
    "")
288
  "Option that indicates a specified a manual section name.")
289

Richard M. Stallman's avatar
Richard M. Stallman committed
290 291 292 293 294 295 296 297 298
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; end user variables

;; other variables and keymap initializations
(make-variable-buffer-local 'Man-sections-alist)
(make-variable-buffer-local 'Man-refpages-alist)
(make-variable-buffer-local 'Man-page-list)
(make-variable-buffer-local 'Man-current-page)
(make-variable-buffer-local 'Man-page-mode-string)
299
(make-variable-buffer-local 'Man-original-frame)
300
(make-variable-buffer-local 'Man-arguments)
Richard M. Stallman's avatar
Richard M. Stallman committed
301 302 303 304 305

(setq-default Man-sections-alist nil)
(setq-default Man-refpages-alist nil)
(setq-default Man-page-list nil)
(setq-default Man-current-page 0)
306
(setq-default Man-page-mode-string "1 of 1")
Richard M. Stallman's avatar
Richard M. Stallman committed
307

308 309 310 311
(defconst Man-sysv-sed-script "\
/\b/ {	s/_\b//g
	s/\b_//g
        s/o\b+/o/g
312
        s/+\bo/o/g
313 314 315 316 317 318 319 320 321 322 323
	:ovstrk
	s/\\(.\\)\b\\1/\\1/g
	t ovstrk
	}
/\e\\[[0-9][0-9]*m/ s///g"
  "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")

(defconst Man-berkeley-sed-script "\
/\b/ {	s/_\b//g\\
	s/\b_//g\\
        s/o\b+/o/g\\
324
        s/+\bo/o/g\\
325 326 327 328 329 330 331
	:ovstrk\\
	s/\\(.\\)\b\\1/\\1/g\\
	t ovstrk\\
	}\\
/\e\\[[0-9][0-9]*m/ s///g"
  "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")

332 333 334 335 336 337 338
(defvar man-mode-syntax-table
  (let ((table (copy-syntax-table (standard-syntax-table))))
    (modify-syntax-entry ?. "w" table)
    (modify-syntax-entry ?_ "w" table)
    table)
  "Syntax table used in Man mode buffers.")

Richard M. Stallman's avatar
Richard M. Stallman committed
339 340 341 342 343 344 345 346 347 348
(if Man-mode-map
    nil
  (setq Man-mode-map (make-keymap))
  (suppress-keymap Man-mode-map)
  (define-key Man-mode-map " "    'scroll-up)
  (define-key Man-mode-map "\177" 'scroll-down)
  (define-key Man-mode-map "n"    'Man-next-section)
  (define-key Man-mode-map "p"    'Man-previous-section)
  (define-key Man-mode-map "\en"  'Man-next-manpage)
  (define-key Man-mode-map "\ep"  'Man-previous-manpage)
349 350 351
  (define-key Man-mode-map ">"    'end-of-buffer)
  (define-key Man-mode-map "<"    'beginning-of-buffer)
  (define-key Man-mode-map "."    'beginning-of-buffer)
Richard M. Stallman's avatar
Richard M. Stallman committed
352 353 354
  (define-key Man-mode-map "r"    'Man-follow-manual-reference)
  (define-key Man-mode-map "g"    'Man-goto-section)
  (define-key Man-mode-map "s"    'Man-goto-see-also-section)
355
  (define-key Man-mode-map "k"    'Man-kill)
Richard M. Stallman's avatar
Richard M. Stallman committed
356
  (define-key Man-mode-map "q"    'Man-quit)
357
  (define-key Man-mode-map "m"    'man)
Karl Heuer's avatar
Karl Heuer committed
358
  (define-key Man-mode-map "\r"   'man-follow)
Richard M. Stallman's avatar
Richard M. Stallman committed
359 360 361 362 363 364 365
  (define-key Man-mode-map "?"    'describe-mode)
  )


;; ======================================================================
;; utilities

366
(defun Man-init-defvars ()
367
  "Used for initialising variables based on display's color support.
Dave Love's avatar
Dave Love committed
368
This is necessary if one wants to dump man.el with Emacs."
369 370 371 372

  ;; The following is necessary until fonts are implemented on
  ;; terminals.
  (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
Dave Love's avatar
Dave Love committed
373
				      (display-color-p)))
374

375 376 377 378 379 380 381 382 383 384 385 386
  ;; Avoid possible error in call-process by using a directory that must exist.
  (let ((default-directory "/"))
    (setq Man-sed-script
	  (cond
	   (Man-fontify-manpage-flag
	    nil)
	   ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
	    Man-sysv-sed-script)
	   ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
	    Man-berkeley-sed-script)
	   (t
	    nil))))
387 388

  (setq Man-filter-list
389 390
	;; Avoid trailing nil which confuses customize.
	(apply 'list
391
	 (cons
392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
	  Man-sed-command
	  (list
	   (if Man-sed-script
	       (concat "-e '" Man-sed-script "'")
	     "")
	   "-e '/^[\001-\032][\001-\032]*$/d'"
	   "-e '/\e[789]/s///g'"
	   "-e '/Reformatting page.  Wait/d'"
	   "-e '/Reformatting entry.  Wait/d'"
	   "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
	   "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
	   "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
	   "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
	   "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
	   "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
407
	   "-e '/^[A-Za-z].*Last[ \t]change:/d'"
408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423
	   "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
	   "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
	   "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
	   ))
	 (cons
	  Man-awk-command
	  (list
	   "'\n"
	   "BEGIN { blankline=0; anonblank=0; }\n"
	   "/^$/ { if (anonblank==0) next; }\n"
	   "{ anonblank=1; }\n"
	   "/^$/ { blankline++; next; }\n"
	   "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
	   "'"
	   ))
	 (if (not Man-uses-untabify-flag)
424 425 426 427
	     ;; The outer list will be stripped off by apply.
	     (list (cons
		    Man-untabify-command
		    Man-untabify-command-args))
428
	   )))
429
)
Richard M. Stallman's avatar
Richard M. Stallman committed
430

431 432 433 434 435 436 437 438 439 440
(defsubst Man-match-substring (&optional n string)
  "Return the substring matched by the last search.
Optional arg N means return the substring matched by the Nth paren
grouping.  Optional second arg STRING means return a substring from
that string instead of from the current buffer."
  (if (null n) (setq n 0))
  (if string
      (substring string (match-beginning n) (match-end n))
    (buffer-substring (match-beginning n) (match-end n))))

441 442 443 444 445 446 447 448 449
(defsubst Man-make-page-mode-string ()
  "Formats part of the mode line for Man mode."
  (format "%s page %d of %d"
	  (or (nth 2 (nth (1- Man-current-page) Man-page-list))
	      "")
	  Man-current-page
	  (length Man-page-list)))

(defsubst Man-build-man-command ()
Richard M. Stallman's avatar
Richard M. Stallman committed
450
  "Builds the entire background manpage and cleaning command."
451 452 453 454 455 456 457
  (let ((command (concat manual-program " " Man-switches
			 ; Stock MS-DOS shells cannot redirect stderr;
			 ; `call-process' below sends it to /dev/null,
			 ; so we don't need `2>' even with DOS shells
			 ; which do support stderr redirection.
			 (if (not (fboundp 'start-process))
			     " %s"
458
			   (concat " %s 2>" null-device))))
Richard M. Stallman's avatar
Richard M. Stallman committed
459
	(flist Man-filter-list))
460
    (while (and flist (car flist))
Richard M. Stallman's avatar
Richard M. Stallman committed
461
      (let ((pcom (car (car flist)))
462 463 464
	    (pargs (cdr (car flist))))
	(setq command
	      (concat command " | " pcom " "
465 466 467 468
		      (mapconcat (lambda (phrase)
				   (if (not (stringp phrase))
				       (error "Malformed Man-filter-list"))
				   phrase)
469 470
				 pargs " ")))
	(setq flist (cdr flist))))
Richard M. Stallman's avatar
Richard M. Stallman committed
471 472 473
    command))

(defun Man-translate-references (ref)
474 475 476
  "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
Leave it as is if already in that style.  Possibly downcase and
translate the section (see the Man-downcase-section-letters-flag
477
and the Man-section-translations-alist variables)."
478 479 480
  (let ((name "")
	(section "")
	(slist Man-section-translations-alist))
Richard M. Stallman's avatar
Richard M. Stallman committed
481
    (cond
482
     ;; "chmod(2V)" case ?
483
     ((string-match (concat "^" Man-reference-regexp "$") ref)
484 485 486
      (setq name (Man-match-substring 1 ref)
	    section (Man-match-substring 2 ref)))
     ;; "2v chmod" case ?
487
     ((string-match (concat "^\\(" Man-section-regexp
488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507
			    "\\) +\\(" Man-name-regexp "\\)$") ref)
      (setq name (Man-match-substring 2 ref)
	    section (Man-match-substring 1 ref))))
    (if (string= name "")
	ref				; Return the reference as is
      (if Man-downcase-section-letters-flag
	  (setq section (downcase section)))
      (while slist
	(let ((s1 (car (car slist)))
	      (s2 (cdr (car slist))))
	  (setq slist (cdr slist))
	  (if Man-downcase-section-letters-flag
	      (setq s1 (downcase s1)))
	  (if (not (string= s1 section)) nil
	    (setq section (if Man-downcase-section-letters-flag
			      (downcase s2)
			    s2)
		  slist nil))))
      (concat Man-specified-section-option section " " name))))

Richard M. Stallman's avatar
Richard M. Stallman committed
508 509

;; ======================================================================
510
;; default man entry: get word under point
Richard M. Stallman's avatar
Richard M. Stallman committed
511

512
(defsubst Man-default-man-entry ()
Richard M. Stallman's avatar
Richard M. Stallman committed
513 514
  "Make a guess at a default manual entry.
This guess is based on the text surrounding the cursor, and the
515
default section number is selected from `Man-auto-section-alist'."
516
  (let (word)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
517
    (save-excursion
518
      ;; Default man entry title is any word the cursor is on, or if
519 520 521 522
      ;; cursor not on a word, then nearest preceding word.
      (setq word (current-word))
      (if (string-match "[._]+$" word)
	  (setq word (substring word 0 (match-beginning 0))))
523
      ;; If looking at something like ioctl(2) or brc(1M), include the
524
      ;; section number in the returned value.  Remove text properties.
525 526 527 528 529 530 531 532
      (forward-word 1)
      ;; Use `format' here to clear any text props from `word'.
      (format "%s%s"
	      word
	      (if (looking-at
		   (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
		  (format "(%s)" (Man-match-substring 1))
		"")))))
533

Richard M. Stallman's avatar
Richard M. Stallman committed
534 535

;; ======================================================================
536
;; Top level command and background process sentinel
Joseph Arceneaux's avatar
Joseph Arceneaux committed
537

538
;; For compatibility with older versions.
Richard M. Stallman's avatar
Richard M. Stallman committed
539
;;;###autoload
540
(defalias 'manual-entry 'man)
Richard M. Stallman's avatar
Richard M. Stallman committed
541

Richard M. Stallman's avatar
Richard M. Stallman committed
542
;;;###autoload
543
(defun man (man-args)
Richard M. Stallman's avatar
Richard M. Stallman committed
544
  "Get a Un*x manual page and put it in a buffer.
545
This command is the top-level command in the man package.  It runs a Un*x
Richard M. Stallman's avatar
Richard M. Stallman committed
546
command to retrieve and clean a manpage in the background and places the
547
results in a Man mode (manpage browsing) buffer.  See variable
548
`Man-notify-method' for what happens when the buffer is ready.
Eli Zaretskii's avatar
Eli Zaretskii committed
549 550 551 552
If a buffer already exists for this man page, it will display immediately.

To specify a man page from a certain section, type SUBJECT(SECTION) or
SECTION SUBJECT when prompted for a manual entry."
553
  (interactive
554 555 556 557 558 559 560 561 562 563 564
   (list (let* ((default-entry (Man-default-man-entry))
		(input (read-string
			(format "Manual entry%s: "
				(if (string= default-entry "")
				    ""
				  (format " (default %s)" default-entry))))))
	   (if (string= input "")
	       (if (string= default-entry "")
		   (error "No man args given")
		 default-entry)
	     input))))
565 566 567 568 569

  ;; Possibly translate the "subject(section)" syntax into the
  ;; "section subject" syntax and possibly downcase the section.
  (setq man-args (Man-translate-references man-args))

570
  (Man-getpage-in-background man-args))
571

Karl Heuer's avatar
Karl Heuer committed
572 573 574 575 576 577 578 579
;;;###autoload
(defun man-follow (man-args)
  "Get a Un*x manual page of the item under point and put it in a buffer."
  (interactive (list (Man-default-man-entry)))
  (if (or (not man-args)
	  (string= man-args ""))
      (error "No item under point")
    (man man-args)))
Jim Blandy's avatar
Jim Blandy committed
580

581
(defun Man-getpage-in-background (topic)
Dave Love's avatar
Dave Love committed
582
  "Use TOPIC to build and fire off the manpage and cleaning command."
583
  (let* ((man-args topic)
584
	 (bufname (concat "*Man " man-args "*"))
Richard M. Stallman's avatar
Richard M. Stallman committed
585
	 (buffer  (get-buffer bufname)))
586
    (if buffer
Richard M. Stallman's avatar
Richard M. Stallman committed
587
	(Man-notify-when-ready buffer)
588
      (require 'env)
589
      (message "Invoking %s %s in the background" manual-program man-args)
Richard M. Stallman's avatar
Richard M. Stallman committed
590
      (setq buffer (generate-new-buffer bufname))
591 592
      (save-excursion
	(set-buffer buffer)
593 594
	(setq Man-original-frame (selected-frame))
	(setq Man-arguments man-args))
595
      (let ((process-environment (copy-sequence process-environment))
596 597 598
	    ;; The following is so Awk script gets \n intact
	    ;; But don't prevent decoding of the outside.
	    (coding-system-for-write 'raw-text-unix)
599 600 601
	    ;; We must decode the output by a coding system that the
	    ;; systen locale suggests.
	    (coding-system-for-read locale-coding-system)
602 603
	    ;; Avoid possible error by using a directory that always exists.
	    (default-directory "/"))
604 605
	;; Prevent any attempt to use display terminal fanciness.
	(setenv "TERM" "dumb")
606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623
	(if (fboundp 'start-process)
	    (set-process-sentinel
	     (start-process manual-program buffer "sh" "-c"
			    (format (Man-build-man-command) man-args))
	     'Man-bgproc-sentinel)
	  (progn
	    (let ((exit-status
		   (call-process shell-file-name nil (list buffer nil) nil "-c"
				 (format (Man-build-man-command) man-args)))
		  (msg ""))
	      (or (and (numberp exit-status)
		       (= exit-status 0))
		  (and (numberp exit-status)
		       (setq msg
			     (format "exited abnormally with code %d"
				     exit-status)))
		  (setq msg exit-status))
	      (Man-bgproc-sentinel bufname msg))))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
624 625 626

(defun Man-notify-when-ready (man-buffer)
  "Notify the user when MAN-BUFFER is ready.
627
See the variable `Man-notify-method' for the different notification behaviors."
628 629 630 631
  (let ((saved-frame (save-excursion
		       (set-buffer man-buffer)
		       Man-original-frame)))
    (cond
632
     ((eq Man-notify-method 'newframe)
633 634 635 636
      ;; Since we run asynchronously, perhaps while Emacs is waiting
      ;; for input, we must not leave a different buffer current.  We
      ;; can't rely on the editor command loop to reselect the
      ;; selected window's buffer.
637
      (save-excursion
638 639
	(let ((frame (make-frame Man-frame-parameters)))
	  (set-window-buffer (frame-selected-window frame) man-buffer)
640 641 642
          (set-window-dedicated-p (frame-selected-window frame) t)
	  (or (display-multi-frame-p frame)
	      (select-frame frame)))))
643
     ((eq Man-notify-method 'pushy)
644
      (switch-to-buffer man-buffer))
645
     ((eq Man-notify-method 'bully)
646
      (and (frame-live-p saved-frame)
647 648 649
	   (select-frame saved-frame))
      (pop-to-buffer man-buffer)
      (delete-other-windows))
650
     ((eq Man-notify-method 'aggressive)
651
      (and (frame-live-p saved-frame)
652 653
	   (select-frame saved-frame))
      (pop-to-buffer man-buffer))
654
     ((eq Man-notify-method 'friendly)
655
      (and (frame-live-p saved-frame)
656 657
	   (select-frame saved-frame))
      (display-buffer man-buffer 'not-this-window))
658
     ((eq Man-notify-method 'polite)
659
      (beep)
660
      (message "Manual buffer %s is ready" (buffer-name man-buffer)))
661
     ((eq Man-notify-method 'quiet)
662
      (message "Manual buffer %s is ready" (buffer-name man-buffer)))
663
     ((or (eq Man-notify-method 'meek)
664 665 666
	  t)
      (message ""))
     )))
Richard M. Stallman's avatar
Richard M. Stallman committed
667

668
(defun Man-softhyphen-to-minus ()
669 670 671 672 673 674 675 676 677
  ;; \255 is some kind of dash in Latin-N.  Versions of Debian man, at
  ;; least, emit it even when not in a Latin-N locale.
  (unless (eq t (compare-strings "latin-" 0 nil
				 current-language-environment 0 6 t))
    (goto-char (point-min))
    (let ((str "\255"))
      (if enable-multibyte-characters
	  (setq str (string-as-multibyte str)))
      (while (search-forward str nil t) (replace-match "-")))))
678

679 680 681 682 683
(defun Man-fontify-manpage ()
  "Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
  (interactive)
  (message "Please wait: making up the %s man page..." Man-arguments)
684
  (goto-char (point-min))
685 686 687 688 689 690
  (while (search-forward "\e[1m" nil t)
    (delete-backward-char 4)
    (put-text-property (point)
		       (progn (if (search-forward "\e[0m" nil 'move)
				  (delete-backward-char 4))
			      (point))
691
		       'face Man-overstrike-face))
692 693 694 695 696 697 698 699 700 701 702
  (if (< (buffer-size) (position-bytes (point-max)))
      ;; Multibyte characters exist.
      (progn
	(goto-char (point-min))
	(while (search-forward "__\b\b" nil t)
	  (backward-delete-char 4)
	  (put-text-property (point) (1+ (point)) 'face Man-underline-face))
	(goto-char (point-min))
	(while (search-forward "\b\b__" nil t)
	  (backward-delete-char 4)
	  (put-text-property (1- (point)) (point) 'face Man-underline-face))))
703 704 705
  (goto-char (point-min))
  (while (search-forward "_\b" nil t)
    (backward-delete-char 2)
706
    (put-text-property (point) (1+ (point)) 'face Man-underline-face))
707 708 709
  (goto-char (point-min))
  (while (search-forward "\b_" nil t)
    (backward-delete-char 2)
710
    (put-text-property (1- (point)) (point) 'face Man-underline-face))
711
  (goto-char (point-min))
712
  (while (re-search-forward "\\(.\\)\\(\b+\\1\\)+" nil t)
713
    (replace-match "\\1")
714
    (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
715
  (goto-char (point-min))
716 717
  (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
    (replace-match "o")
718 719
    (put-text-property (1- (point)) (point) 'face 'bold))
  (goto-char (point-min))
720
  (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
721
    (replace-match "+")
722
    (put-text-property (1- (point)) (point) 'face 'bold))
723
  (Man-softhyphen-to-minus)
724 725 726 727 728
  (message "%s man page made up" Man-arguments))

(defun Man-cleanup-manpage ()
  "Remove overstriking and underlining from the current buffer."
  (interactive)
729 730
  (message "Please wait: cleaning up the %s man page..."
	   Man-arguments)
Francesco Potortì's avatar
Francesco Potortì committed
731
  (if (or (interactive-p) (not Man-sed-script))
732 733 734 735 736 737 738 739 740 741 742
      (progn
	(goto-char (point-min))
	(while (search-forward "_\b" nil t) (backward-delete-char 2))
	(goto-char (point-min))
	(while (search-forward "\b_" nil t) (backward-delete-char 2))
	(goto-char (point-min))
	(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
	  (replace-match "\\1"))
	(goto-char (point-min))
	(while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
	(goto-char (point-min))
743
	(while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
744
	))
745
  (goto-char (point-min))
746
  (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
747
  (Man-softhyphen-to-minus)
748
  (message "%s man page cleaned up" Man-arguments))
749

Richard M. Stallman's avatar
Richard M. Stallman committed
750
(defun Man-bgproc-sentinel (process msg)
751
  "Manpage background process sentinel.
Dave Love's avatar
Dave Love committed
752
When manpage command is run asynchronously, PROCESS is the process
753 754 755 756 757 758
object for the manpage command; when manpage command is run
synchronously, PROCESS is the name of the buffer where the manpage
command is run.  Second argument MSG is the exit message of the
manpage command."
  (let ((Man-buffer (if (stringp process) (get-buffer process)
		      (process-buffer process)))
Richard M. Stallman's avatar
Richard M. Stallman committed
759
	(delete-buff nil)
760
	(err-mess nil))
761

Richard M. Stallman's avatar
Richard M. Stallman committed
762
    (if (null (buffer-name Man-buffer)) ;; deleted buffer
763 764
	(or (stringp process)
	    (set-process-buffer process nil))
765 766 767

      (save-excursion
	(set-buffer Man-buffer)
768 769 770 771 772 773 774 775
	(let ((case-fold-search nil))
	  (goto-char (point-min))
	  (cond ((or (looking-at "No \\(manual \\)*entry for")
		     (looking-at "[^\n]*: nothing appropriate$"))
		 (setq err-mess (buffer-substring (point)
						  (progn
						    (end-of-line) (point)))
		       delete-buff t))
776 777 778 779 780 781 782 783 784 785 786 787 788 789
		((or (stringp process)
		     (not (and (eq (process-status process) 'exit)
			       (= (process-exit-status process) 0))))
		 (or (zerop (length msg))
		     (progn
		       (setq err-mess
			     (concat (buffer-name Man-buffer)
				     ": process "
				     (let ((eos (1- (length msg))))
				       (if (= (aref msg eos) ?\n)
					   (substring msg 0 eos) msg))))
		       (goto-char (point-max))
		       (insert (format "\nprocess %s" msg))))
		 ))
790 791 792 793 794 795 796 797
        (if delete-buff
            (kill-buffer Man-buffer)
          (if Man-fontify-manpage-flag
              (Man-fontify-manpage)
            (Man-cleanup-manpage))
          (run-hooks 'Man-cooked-hook)
          (Man-mode)
          (set-buffer-modified-p nil)
798
          ))
799 800 801 802 803 804 805 806 807
	;; Restore case-fold-search before calling
	;; Man-notify-when-ready because it may switch buffers.

	(if (not delete-buff)
	    (Man-notify-when-ready Man-buffer))

	(if err-mess
	    (error err-mess))
	))))
Richard M. Stallman's avatar
Richard M. Stallman committed
808 809 810 811 812 813


;; ======================================================================
;; set up manual mode in buffer and build alists

(defun Man-mode ()
814
  "A mode for browsing Un*x manual pages.
Richard M. Stallman's avatar
Richard M. Stallman committed
815

Dave Love's avatar
Dave Love committed
816
The following man commands are available in the buffer.  Try
Richard M. Stallman's avatar
Richard M. Stallman committed
817
\"\\[describe-key] <key> RET\" for more information:
Jim Blandy's avatar
Jim Blandy committed
818

819
\\[man]       Prompt to retrieve a new manpage.
Richard M. Stallman's avatar
Richard M. Stallman committed
820 821 822 823 824 825 826
\\[Man-follow-manual-reference]       Retrieve reference in SEE ALSO section.
\\[Man-next-manpage]   Jump to next manpage in circular list.
\\[Man-previous-manpage]   Jump to previous manpage in circular list.
\\[Man-next-section]       Jump to next manpage section.
\\[Man-previous-section]       Jump to previous manpage section.
\\[Man-goto-section]       Go to a manpage section.
\\[Man-goto-see-also-section]       Jumps to the SEE ALSO manpage section.
827 828
\\[Man-quit]       Deletes the manpage window, bury its buffer.
\\[Man-kill]       Deletes the manpage window, kill its buffer.
Richard M. Stallman's avatar
Richard M. Stallman committed
829 830
\\[describe-mode]       Prints this help text.

Dave Love's avatar
Dave Love committed
831
The following variables may be of some use.  Try
Richard M. Stallman's avatar
Richard M. Stallman committed
832 833
\"\\[describe-variable] <variable-name> RET\" for more information:

Dave Love's avatar
Dave Love committed
834 835 836 837 838 839 840 841 842 843 844 845 846 847 848
`Man-notify-method'		What happens when manpage formatting is done.
`Man-downcase-section-letters-flag' Force section letters to lower case.
`Man-circular-pages-flag'	Treat multiple manpage list as circular.
`Man-auto-section-alist'	List of major modes and their section numbers.
`Man-section-translations-alist' List of section numbers and their Un*x equiv.
`Man-filter-list'		Background manpage filter command.
`Man-mode-line-format'		Mode line format for Man mode buffers.
`Man-mode-map'			Keymap bindings for Man mode buffers.
`Man-mode-hook'			Normal hook run on entry to Man mode.
`Man-section-regexp'		Regexp describing manpage section letters.
`Man-heading-regexp'		Regexp describing section headers.
`Man-see-also-regexp'		Regexp for SEE ALSO section (or your equiv).
`Man-first-heading-regexp'	Regexp for first heading on a manpage.
`Man-reference-regexp'		Regexp matching a references in SEE ALSO.
`Man-switches'			Background `man' command switches.
Richard M. Stallman's avatar
Richard M. Stallman committed
849 850 851 852 853

The following key bindings are currently in effect in the buffer:
\\{Man-mode-map}"
  (interactive)
  (setq major-mode 'Man-mode
854
	mode-name "Man"
Richard M. Stallman's avatar
Richard M. Stallman committed
855 856 857 858 859 860 861
	buffer-auto-save-file-name nil
	mode-line-format Man-mode-line-format
	truncate-lines t
	buffer-read-only t)
  (buffer-disable-undo (current-buffer))
  (auto-fill-mode -1)
  (use-local-map Man-mode-map)
862
  (set-syntax-table man-mode-syntax-table)
Richard M. Stallman's avatar
Richard M. Stallman committed
863
  (Man-build-page-list)
864 865
  (Man-strip-page-headers)
  (Man-unindent)
866 867
  (Man-goto-page 1)
  (run-hooks 'Man-mode-hook))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
868

869
(defsubst Man-build-section-alist ()
Richard M. Stallman's avatar
Richard M. Stallman committed
870 871
  "Build the association list of manpage sections."
  (setq Man-sections-alist nil)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
872
  (goto-char (point-min))
Karl Heuer's avatar
Karl Heuer committed
873 874
  (let ((case-fold-search nil))
    (while (re-search-forward Man-heading-regexp (point-max) t)
875
      (aput 'Man-sections-alist (Man-match-substring 1))
Karl Heuer's avatar
Karl Heuer committed
876
      (forward-line 1))))
Richard M. Stallman's avatar
Richard M. Stallman committed
877

878
(defsubst Man-build-references-alist ()
Richard M. Stallman's avatar
Richard M. Stallman committed
879 880 881 882 883 884 885 886 887 888
  "Build the association list of references (in the SEE ALSO section)."
  (setq Man-refpages-alist nil)
  (save-excursion
    (if (Man-find-section Man-see-also-regexp)
	(let ((start (progn (forward-line 1) (point)))
	      (end (progn
		     (Man-next-section 1)
		     (point)))
	      hyphenated
	      (runningpoint -1))
Karl Heuer's avatar
Karl Heuer committed
889 890 891 892 893 894
	  (save-restriction
	    (narrow-to-region start end)
	    (goto-char (point-min))
	    (back-to-indentation)
	    (while (and (not (eobp)) (/= (point) runningpoint))
	      (setq runningpoint (point))
895 896 897 898 899 900 901 902 903
	      (if (re-search-forward Man-reference-regexp end t)
		  (let* ((word (Man-match-substring 0))
			 (len (1- (length word))))
		    (if hyphenated
			(setq word (concat hyphenated word)
			      hyphenated nil))
		    (if (= (aref word len) ?-)
			(setq hyphenated (substring word 0 len))
		      (aput 'Man-refpages-alist word))))
Karl Heuer's avatar
Karl Heuer committed
904
	      (skip-chars-forward " \t\n,")))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
905

906
(defun Man-build-page-list ()
Richard M. Stallman's avatar
Richard M. Stallman committed
907 908
  "Build the list of separate manpages in the buffer."
  (setq Man-page-list nil)
909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937
  (let ((page-start (point-min))
	(page-end (point-max))
	(header ""))
    (goto-char page-start)
    ;; (switch-to-buffer (current-buffer))(debug)
    (while (not (eobp))
      (setq header
	    (if (looking-at Man-page-header-regexp)
		(Man-match-substring 1)
	      nil))
      ;; Go past both the current and the next Man-first-heading-regexp
      (if (re-search-forward Man-first-heading-regexp nil 'move 2)
	  (let ((p (progn (beginning-of-line) (point))))
	    ;; We assume that the page header is delimited by blank
	    ;; lines and that it contains at most one blank line.  So
	    ;; if we back by three blank lines we will be sure to be
	    ;; before the page header but not before the possible
	    ;; previous page header.
	    (search-backward "\n\n" nil t 3)
	    (if (re-search-forward Man-page-header-regexp p 'move)
		(beginning-of-line))))
      (setq page-end (point))
      (setq Man-page-list (append Man-page-list
				  (list (list (copy-marker page-start)
					      (copy-marker page-end)
					      header))))
      (setq page-start page-end)
      )))

938
(defun Man-strip-page-headers ()
939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962
  "Strip all the page headers but the first from the manpage."
  (let ((buffer-read-only nil)
	(case-fold-search nil)
	(page-list Man-page-list)
	(page ())
	(header ""))
    (while page-list
      (setq page (car page-list))
      (and (nth 2 page)
	   (goto-char (car page))
	   (re-search-forward Man-first-heading-regexp nil t)
	   (setq header (buffer-substring (car page) (match-beginning 0)))
	   ;; Since the awk script collapses all successive blank
	   ;; lines into one, and since we don't want to get rid of
	   ;; the fast awk script, one must choose between adding
	   ;; spare blank lines between pages when there were none and
	   ;; deleting blank lines at page boundaries when there were
	   ;; some.  We choose the first, so we comment the following
	   ;; line.
	   ;; (setq header (concat "\n" header)))
	   (while (search-forward header (nth 1 page) t)
	     (replace-match "")))
      (setq page-list (cdr page-list)))))

963
(defun Man-unindent ()
964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986