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