xemacs-beta: lisp/packages/man.el comparison

comparison lisp/packages/man.el @ 4:b82b59fe008d r19-15b3

Import from CVS: tag r19-15b3

author	cvs
date	Mon, 13 Aug 2007 08:46:56 +0200
parents	ac2d302a0011
children	4b173ad71786

comparison

equal deleted inserted replaced

-:30df88044ec6
+:b82b59fe008d
 ;;; man.el --- browse UNIX manual pages
-;; Keywords: help
+;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
-;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
-;;
+;; Author:		Barry A. Warsaw <bwarsaw@cen.com>
+;; Keywords:		help
+;; Adapted-By:		ESR, pot
 ;; This file is part of XEmacs.
 ;; XEmacs is free software; you can redistribute it and/or modify it
 ;; under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 2, or (at your option)
 ;; 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
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
-;;; Synched up with: Not synched with FSF.
-;;; ICK!  This file is almost completely different from FSF.
+;;; Synched up with: FSF 19.34.
-;;; Someone clarify please.
+;;; Commentary:
-;; Mostly rewritten by Alan K. Stebbens <aks@hub.ucsb.edu> 11-apr-90.
+;; 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.
 ;;
-;;  o  Match multiple man pages using TOPIC as a simple pattern
+;; The mode also supports hypertext-like following of manual page SEE
-;;  o  Search unformatted pages, even when formatted matches are found
+;; ALSO references, and other features.  See below or do `?' in a
-;;  o  Query the user as to which pages are desired
+;; manual page buffer for details.
-;;  o  Use of the prefix arg to toggle/bypass the above features
-;;  o  Buffers named by the first topic in the buffer
+;; ========== Credits and History ==========
-;;  o  Automatic uncompress for compressed man pages (.Z, .z, and .gz)
+;; In mid 1991, several people posted some interesting improvements to
-;;  o  View the resulting buffer using M-x view mode
+;; man.el from the standard emacs 18.57 distribution.  I liked many of
-;;
+;; these, but wanted everything in one single package, so I decided
-;; Modified 16-mar-91 by Jamie Zawinski <jwz@lucid.com> to default the
+;; to incorporate them into a single manual browsing mode.  While
-;; manual topic to the symbol at point, just like find-tag does.
+;; much of the code here has been rewritten, and some features added,
-;;
+;; these folks deserve lots of credit for providing the initial
-;; Modified 22-mar-93 by jwz to use multiple fonts and follow xrefs with mouse.
+;; excellent packages on which this one is based.
-;;
-;; Modified 16-apr-93 by Dave Gillespie <daveg@synaptics.com> to make
+;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, posted a very nice
-;; apropos work nicely; work correctly when bold or italic is unavailable;
+;; improvement which retrieved and cleaned the manpages in a
-;; reuse old buffer if topic is re-selected (in Manual-topic-buffer mode).
+;; background process, and which correctly deciphered such options as
-;;
+;; man -k.
-;; Modified 4-apr-94 by jwz: merged in Tibor Polgar's code for manpath.conf.
-;;
+;; Eric Rose <erose@jessica.stanford.edu>, submitted manual.el which
-;; Modified 19-apr-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for
+;; provided a very nice manual browsing mode.
-;; $PAGER variable to be emacsclient and properly process man pages (assuming
-;; the man pages were built by man in /tmp.  also fixed bug with man list being
+;; This package was available as `superman.el' from the LCD package
-;; backwards.
+;; 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
-;; Modified 23-aug-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for
+;; replacement for the old man.el package.
-;; displaying only one instance of a man page (Manual-unique-man-sections-only)
-;; Fixed some more man page ordering bugs, bug with Manual-query-multiple-pages.
+;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
-;;
+;; making it faster, more robust and more tolerant of different
-;; Modified 29-nov-94 by Ben Wing <wing@spg.amdahl.com>: small fixes
+;; systems' man idiosyncrasies.
-;; that should hopefully make things work under HPUX and IRIX.;
-;;
+;; ========== Features ==========
-;; Modified 15-jul-95 by Dale Atems <atems@physics.wayne.edu>:
+;; + Runs "man" in the background and pipes the results through a
-;; some extensive rewriting to make things work right (more or less)
+;;   series of sed and awk scripts so that all retrieving and cleaning
-;; under IRIX.
+;;   is done in the background. The cleaning commands are configurable.
-;;
+;; + Syntax is the same as Un*x man
-;; Modified 08-mar-96 by Hubert Palme <palme@wrcs3.urz.uni-wuppertal.de>:
+;; + Functionality is the same as Un*x man, including "man -k" and
-;; added /usr/share/catman to the manual directory list for IRIX (5.3)
+;;   "man <section>", etc.
-;;
+;; + Provides a manual browsing mode with keybindings for traversing
-;; This file defines "manual-entry", and the remaining definitions all
+;;   the sections of a manpage, following references in the SEE ALSO
-;; begin with "Manual-".  This makes the autocompletion on "M-x man" work.
+;;   section, and more.
-;;
+;; + Multiple manpages created with the same man command are put into
-;; Variables of interest:
+;;   a narrowed buffer circular list.
-;;
-;;	Manual-program
+;; ============= TODO ===========
-;;	Manual-topic-buffer
+;; - Add a command for printing.
-;;	Manual-buffer-view-mode
+;; - The awk script deletes multiple blank lines.  This behaviour does
-;;	Manual-directory-list
+;;   not allow to understand if there was indeed a blank line at the
-;;	Manual-formatted-directory-list
+;;   end or beginning of a page (after the header, or before the
-;;	Manual-match-topic-exactly
+;;   footer).  A different algorithm should be used.  It is easy to
-;;	Manual-query-multiple-pages
+;;   compute how many blank lines there are before and after the page
-;;	Manual-page-history
+;;   headers, and after the page footer.  But it is possible to compute
-;;	Manual-subdirectory-list
+;;   the number of blank lines before the page footer by euristhics
-;;	Manual-man-page-section-ids
+;;   only.  Is it worth doing?
-;;	Manual-formatted-page-prefix
+;; - Allow a user option to mean that all the manpages should go in
-;;	Manual-unformatted-page-prefix
+;;   the same buffer, where they can be browsed with M-n and M-p.
-;;	Manual-use-full-section-ids
+;; - Allow completion on the manpage name when calling man.  This
+;;   requires a reliable list of places where manpages can be found.  The
-(defvar Manual-program "man" "\
+;;   drawback would be that if the list is not complete, the user might
-*Name of the program to invoke in order to format the source man pages.")
+;;   be led to believe that the manpages in the missing directories do
+;;   not exist.
-(defvar Manual-section-switch (if (eq system-type 'usg-unix-v) "-s" nil)
-"SysV needs this to work right.")
+;;; Code:
-(defvar Manual-topic-buffer t "\
-*Non-nil means \\[Manual-entry] should output the manual entry for TOPIC into
+(require 'assoc)
-a buffer named *man TOPIC*, otherwise, it should name the buffer
-*Manual Entry*.")
+;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+;; empty defvars (keep the compiler quiet)
-(defvar Manual-buffer-view-mode t "\
-*Whether manual buffers should be placed in view-mode.
+(defvar Man-notify)
-nil means leave the buffer in fundamental-mode in another window.
+(defvar Man-current-page)
-t means use `view-buffer' to display the man page in the current window.
+(defvar Man-page-list)
-Any other value means use `view-buffer-other-window'.")
+(defvar Man-filter-list nil
+"*Manpage cleaning filter command phrases.
-(defvar Manual-match-topic-exactly t "\
+This variable contains a list of the following form:
-*Non-nil means that \\[manual-entry] will match the given TOPIC exactly, rather
-apply it as a pattern.  When this is nil, and \"Manual-query-multiple-pages\"
+'((command-string phrase-string*)*)
-is non-nil, then \\[manual-entry] will query you for all matching TOPICs.
-This variable only has affect on the preformatted man pages (the \"cat\" files),
+Each phrase-string is concatenated onto the command-string to form a
-since the \"man\" command always does exact topic matches.")
+command filter.  The (standard) output (and standard error) of the Un*x
+man command is piped through each command filter in the order the
-(defvar Manual-query-multiple-pages nil "\
+commands appear in the association list.  The final output is placed in
-*Non-nil means that \\[manual-entry] will query the user about multiple man
+the manpage buffer.")
-pages which match the given topic.  The query is done using the function
-\"y-or-n-p\".  If this variable is nil, all man pages with topics matching the
+(defvar Man-original-frame)
-topic given to \\[manual-entry] will be inserted into the temporary buffer.
+(defvar Man-arguments)
-See the variable \"Manual-match-topic-exactly\" to control the matching.")
+(defvar Man-sections-alist)
+(defvar Man-refpages-alist)
-(defvar Manual-unique-man-sections-only nil
+(defvar Man-uses-untabify-flag t
-"*Only present one man page per section.  This variable is useful if the same or
+"When non-nil use `untabify' instead of Man-untabify-command.")
-up/down level man pages for the same entry are present in mulitple man paths.
+(defvar Man-page-mode-string)
-When set to t, only the first entry found in a section is displayed, the others
+(defvar Man-sed-script nil
-are ignored without any messages or warnings.  Note that duplicates can occur if
+"Script for sed to nuke backspaces and ANSI codes from manpages.")
-the system has both formatted and unformatted version of the same page.")
+;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-(defvar Manual-mode-hook nil
+;; user variables
-"Function or functions run on entry to Manual-mode.")
+(defvar Man-fontify-manpage-flag t
-(defvar Manual-directory-list nil "\
+"*Make up the manpage with fonts.")
-*A list of directories used with the \"man\" command, where each directory
-contains a set of \"man?\" and \"cat?\" subdirectories.  If this variable is nil,
+(defvar Man-overstrike-face 'bold
-it is initialized by \\[Manual-directory-list-init].")
+"*Face to use when fontifying overstrike.")
-(defvar Manual-formatted-directory-list nil "\
+(defvar Man-underline-face 'underline
-A list of directories containing formatted man pages.  Initialized by
+"*Face to use when fontifying underlining.")
-\\[Manual-directory-list-init].")
+;; Use the value of the obsolete user option Man-notify, if set.
-(defvar Manual-unformatted-directory-list nil "\
+(defvar Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
-A list of directories containing the unformatted (source) man pages.
+"*Selects the behavior when manpage is ready.
-Initialized by \\[Manual-directory-list-init].")
+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
-(defvar Manual-page-history nil "\
+where the man command was called from:
-A list of names of previously visited man page buffers.")
+newframe   -- put the manpage in its own frame (see `Man-frame-parameters')
-(defvar Manual-manpath-config-file "/usr/lib/manpath.config"
+pushy      -- make the manpage the current buffer in the current window
-"*Location of the manpath.config file, if any.")
+bully      -- make the manpage the current buffer and only window (sf)
+aggressive -- make the manpage the current buffer in the other window (sf)
-(defvar Manual-apropos-switch "-k"
+friendly   -- display manpage in the other window but don't make current (sf)
-"*Man apropos switch")
+polite     -- don't display manpage, but prints message and beep when ready
+quiet      -- like `polite', but don't beep
-;; New variables.
+meek       -- make no indication that the manpage is ready
-(defvar Manual-subdirectory-list nil "\
+Any other value of `Man-notify-method' is equivalent to `meek'.")
-A list of all the subdirectories in which man pages may be found.
-Iniialized by Manual-directory-list-init.")
+(defvar Man-frame-parameters nil
+"*Frame parameter list for creating a new frame for a manual page.")
-;; This is for SGI systems; don't know what it should be otherwise.
-(defvar Manual-man-page-section-ids "1nl6823457poD" "\
+(defvar Man-downcase-section-letters-flag t
-String containing all suffix characters for \"cat\" and \"man\"
+"*Letters in sections are converted to lower case.
-that identify valid sections of the Un*x manual.")
+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
-(defvar Manual-formatted-page-prefix "cat" "\
+with the upper case letter.  When this variable is t, the section
-Prefix for directories where formatted man pages are to be found.
+letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before
-Defaults to \"cat\".")
+being sent to the man background process.")
-(defvar Manual-unformatted-page-prefix "man" "\
+(defvar Man-circular-pages-flag t
-Prefix for directories where unformatted man pages are to be found.
+"*If t, the manpage list is treated as circular for traversal.")
-Defaults to \"man\".")
+(defvar Man-section-translations-alist
-(defvar Manual-leaf-signature "" "\
+(list
-Regexp for identifying \"leaf\" subdirectories in the search path.
+'("3C++" . "3")
-If empty, initialized by Manual-directory-list-init.")
+;; Some systems have a real 3x man section, so let's comment this.
+;; '("3X" . "3")                        ; Xlib man pages
-(defvar Manual-use-full-section-ids t "\
+'("3X11" . "3")
-If non-nil, pass full section ids to Manual-program, otherwise pass
+'("1-UCB" . ""))
-only the first character. Defaults to 't'.")
+"*Association list of bogus sections to real section numbers.
+Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
-(defvar Manual-use-subdirectory-list (eq system-type 'irix) "\
+their references which Un*x `man' does not recognize.  This
-This makes manual-entry work correctly on SGI machines but it
+association list is used to translate those sections, when found, to
-imposes a large startup cost which is why it is not simply on by
+the associated section number.")
-default on all systems.")
+(defvar manual-program "man"
-(defvar Manual-use-rosetta-man (not (null (locate-file "rman" exec-path))) "\
+"The name of the program that produces man pages.")
-If non-nil, use RosettaMan (rman) to filter man pages.
-This makes man-page cleanup virtually instantaneous, instead of
+(defvar Man-untabify-command "pr"
-potentially taking a long time.
+"Command used for untabifying.")
-Here is information on RosettaMan, from Neal.Becker@comsat.com (Neal Becker):
+(defvar Man-untabify-command-args (list "-t" "-e")
+"List of arguments to be passed to Man-untabify-command (which see).")
-RosettaMan is a filter for UNIX manual pages.  It takes as input man
-pages formatted for a variety of UNIX flavors (not [tn]roff source)
+(defvar Man-sed-command "sed"
-and produces as output a variety of file formats.  Currently
+"Command used for processing sed scripts.")
-RosettaMan accepts man pages as formatted by the following flavors of
-UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1,
+(defvar Man-awk-command "awk"
-DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following
+"Command used for processing awk scripts.")
-formats: printable ASCII only (stripping page headers and footers),
-section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF,
+(defvar Man-mode-line-format
-SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod.
+'("" mode-line-modified
+mode-line-buffer-identification "  "
-RosettaMan improves on other man page filters in several ways: (1) its
+global-mode-string
-analysis recognizes the structural pieces of man pages, enabling high
+" " Man-page-mode-string
-quality output, (2) its modular structure permits easy augmentation of
+"  %[(" mode-name mode-line-process minor-mode-alist ")%]----"
-output formats, (3) it accepts man pages formatted with the varient
+(-3 . "%p") "-%-")
-macros of many different flavors of UNIX, and (4) it doesn't require
+"Mode line format for manual mode buffer.")
-modification or cooperation with any other program.
+(defvar Man-mode-map nil
-RosettaMan is a rewrite of TkMan's man page filter, called bs2tk.  (If
+"Keymap for Man mode.")
-you haven't heard about TkMan, a hypertext man page browser, you
-should grab it via anonymous ftp from ftp.cs.berkeley.edu:
+(defvar Man-mode-hook nil
-/ucb/people/phelps/tkman.tar.Z.)  Whereas bs2tk generated output only for
+"Hook run when Man mode is enabled.")
-TkMan, RosettaMan generalizes the process so that the analysis can be
-leveraged to new output formats.  A single analysis engine recognizes
+(defvar Man-cooked-hook nil
-section heads, subsection heads, body text, lists, references to other
+"Hook run after removing backspaces but before Man-mode processing.")
-man pages, boldface, italics, bold italics, special characters (like
-bullets), tables (to a degree) and strips out page headers and
+(defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
-footers.  The engine sends signals to the selected output functions so
+"Regular expression describing the name of a manpage (without section).")
-that an enhancement in the engine improves the quality of output of
-all of them.  Output format functions are easy to add, and thus far
+(defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
-average about about 75 lines of C code each.
+"Regular expression describing a manpage section within parentheses.")
+(defvar Man-page-header-regexp
+(concat "^[ \t]*\\(" Man-name-regexp
-*** NOTES ON CURRENT VERSION ***
+	  "(\\(" Man-section-regexp "\\))\\).*\\1")
+"Regular expression describing the heading of a page.")
-Help!  I'm looking for people to help with the following projects.
-\(1) Better RTF output format.  The current one works, but could be
+(defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
-made better.  (2) Roff macros that produce text that is easily
+"Regular expression describing a manpage heading entry.")
-parsable.  RosettaMan handles a great variety, but some things, like
-H-P's tables, are intractable.  If you write an output format or
+(defvar Man-see-also-regexp "SEE ALSO"
-otherwise improve RosettaMan, please send in your code so that I may
+"Regular expression for SEE ALSO heading (or your equivalent).
-share the wealth in future releases.
+This regexp should not start with a `^' character.")
-This version can try to identify tables (turn this on with the -T
+(defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
-switch) by looking for lines with a large amount of interword spacing,
+"Regular expression describing first heading on a manpage.
-reasoning that this is space between columns of a table.  This
+This regular expression should start with a `^' character.")
-heuristic doesn't always work and sometimes misidentifies ordinary
-text as tables.  In general I think it is impossible to perfectly
+(defvar Man-reference-regexp
-identify tables from nroff formatted text.  However, I do think the
+(concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
-heuristics can be tuned, so if you have a collection of manual pages
+"Regular expression describing a reference in the SEE ALSO section.")
-with unrecognized tables, send me the lot, in formatted form (i.e.,
-after formatting with nroff -man), and uuencode them to preserve the
+(defvar Man-switches ""
-control characters.  Better, if you can think of heuristics that
+"Switches passed to the man command, as a single string.")
-distinguish tables from ordinary text, I'd like to hear them.
+(defvar Man-specified-section-option
+(if (string-match "-solaris[0-9.]*$" system-configuration)
-Notes for HTML consumers: This filter does real (heuristic)
+"-s"
-parsing--no <PRE>!  Man page references are turned into hypertext links.")
+"")
+"Option that indicates a specified a manual section name.")
-(make-face 'man-italic)
-(or (face-differs-from-default-p 'man-italic)
+;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-(copy-face 'italic 'man-italic))
+;; end user variables
-;; XEmacs (from Darrell Kindred): underlining is annoying due to
-;; large blank spaces in this face.
+;; other variables and keymap initializations
-;; (or (face-differs-from-default-p 'man-italic)
+(make-variable-buffer-local 'Man-sections-alist)
-;;    (set-face-underline-p 'man-italic t))
+(make-variable-buffer-local 'Man-refpages-alist)
+(make-variable-buffer-local 'Man-page-list)
-(make-face 'man-bold)
+(make-variable-buffer-local 'Man-current-page)
-(or (face-differs-from-default-p 'man-bold)
+(make-variable-buffer-local 'Man-page-mode-string)
-(copy-face 'bold 'man-bold))
+(make-variable-buffer-local 'Man-original-frame)
-(or (face-differs-from-default-p 'man-bold)
+(make-variable-buffer-local 'Man-arguments)
-(copy-face 'man-italic 'man-bold))
+(setq-default Man-sections-alist nil)
-(make-face 'man-heading)
+(setq-default Man-refpages-alist nil)
-(or (face-differs-from-default-p 'man-heading)
+(setq-default Man-page-list nil)
-(copy-face 'man-bold 'man-heading))
+(setq-default Man-current-page 0)
+(setq-default Man-page-mode-string "1 of 1")
-(make-face 'man-xref)
-(or (face-differs-from-default-p 'man-xref)
+(defconst Man-sysv-sed-script "\
-(set-face-underline-p 'man-xref t))
+/\b/ {	s/_\b//g
+	s/\b_//g
-;; Manual-directory-list-init
+s/o\b+/o/g
-;; Initialize the directory lists.
+s/+\bo/o/g
+	:ovstrk
-(defun Manual-directory-list-init (&optional arg)
+	s/\\(.\\)\b\\1/\\1/g
-"Initialize the Manual-directory-list variable from $MANPATH
+	t ovstrk
-if it is not already set, or if a prefix argument is provided."
+	}
-(interactive "P")
+/\e\\[[0-9][0-9]*m/ s///g"
-(if arg (setq Manual-directory-list nil))
+"Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
-(if (null Manual-directory-list)
-(let ((manpath (getenv "MANPATH"))
+(defconst Man-berkeley-sed-script "\
-	    (global (Manual-manpath-config-contents))
+/\b/ {	s/_\b//g\\
-	    (dirlist nil)
+	s/\b_//g\\
-	    dir)
+s/o\b+/o/g\\
-	(cond ((and manpath global)
+s/+\bo/o/g\\
-	       (setq manpath (concat manpath ":" global)))
+	:ovstrk\\
-	      (global
+	s/\\(.\\)\b\\1/\\1/g\\
-	       (setq manpath global))
+	t ovstrk\\
-	      ((not manpath)
+	}\\
-	       ;; XEmacs - (bpw/stig) Unix-specifix hack for lusers w/ no manpath
+/\e\\[[0-9][0-9]*m/ s///g"
-	       (setq manpath "/usr/local/man:/usr/share/man:/usr/share/catman:/usr/contrib/man:/usr/X11/man:/usr/man:/usr/catman")))
+"Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
-	;; Make sure that any changes we've made internally are seen by man.
-	(setenv "MANPATH" manpath)
+(if Man-mode-map
-	(while (string-match "\\`:*\\([^:]+\\)" manpath)
+nil
-	  (setq dir (substring manpath (match-beginning 1) (match-end 1)))
+(setq Man-mode-map (make-keymap))
-	  (and (not (member dir dirlist))
+(suppress-keymap Man-mode-map)
-	       (setq dirlist (cons dir dirlist)))
+(define-key Man-mode-map " "    'scroll-up)
-	  (setq manpath (substring manpath (match-end 0))))
+(define-key Man-mode-map "\177" 'scroll-down)
-	(setq dirlist (nreverse dirlist))
+(define-key Man-mode-map "n"    'Man-next-section)
-	(setq Manual-directory-list dirlist)
+(define-key Man-mode-map "p"    'Man-previous-section)
-	(setq Manual-subdirectory-list nil)
+(define-key Man-mode-map "\en"  'Man-next-manpage)
-	(setq Manual-formatted-directory-list nil)
+(define-key Man-mode-map "\ep"  'Man-previous-manpage)
-	(setq Manual-unformatted-directory-list nil)))
+(define-key Man-mode-map ">"    'end-of-buffer)
-(if (string-equal Manual-leaf-signature "")
+(define-key Man-mode-map "<"    'beginning-of-buffer)
-(setq Manual-leaf-signature
+(define-key Man-mode-map "."    'beginning-of-buffer)
-	    (concat "/\\("
+(define-key Man-mode-map "r"    'Man-follow-manual-reference)
-		    Manual-formatted-page-prefix
+(define-key Man-mode-map "g"    'Man-goto-section)
-		    "\\|" Manual-unformatted-page-prefix
+(define-key Man-mode-map "s"    'Man-goto-see-also-section)
-		    "\\)"
+(define-key Man-mode-map "k"    'Man-kill)
-		    "[" Manual-man-page-section-ids
+(define-key Man-mode-map "q"    'Man-quit)
-		    "].?/.")))
+(define-key Man-mode-map "m"    'man)
-(if Manual-use-subdirectory-list
+(define-key Man-mode-map "?"    'describe-mode)
-(progn
+)
-	(if (null Manual-subdirectory-list)
-	    (setq Manual-subdirectory-list
-		  (Manual-all-subdirectories Manual-directory-list
+;; ======================================================================
-					     Manual-leaf-signature nil)))
+;; utilities
-	(if (null Manual-formatted-directory-list)
-	    (setq Manual-formatted-directory-list
+(defun Man-init-defvars ()
-		  (Manual-filter-subdirectories Manual-subdirectory-list
+"Used for initialising variables based on the value of window-system.
-						Manual-formatted-page-prefix)))
+This is necessary if one wants to dump man.el with emacs."
-	(if (null Manual-unformatted-directory-list)
-	    (setq Manual-unformatted-directory-list
+;; The following is necessary until fonts are implemented on
-		  (Manual-filter-subdirectories Manual-subdirectory-list
+;; terminals.
-						Manual-unformatted-page-prefix))))
+(setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
-(if (null Manual-formatted-directory-list)
+				      window-system))
-(setq Manual-formatted-directory-list
-	      (Manual-select-subdirectories Manual-directory-list
+(setq Man-sed-script
-					    Manual-formatted-page-prefix)))
+	(cond
-(if (null Manual-unformatted-directory-list)
+	 (Man-fontify-manpage-flag
-(setq Manual-unformatted-directory-list
+	  nil)
-	      (Manual-select-subdirectories Manual-directory-list
+	 ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
-					    Manual-unformatted-page-prefix)))))
+	  Man-sysv-sed-script)
+	 ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
+	  Man-berkeley-sed-script)
-(defun Manual-manpath-config-contents ()
+	 (t
-"Parse the `Manual-manpath-config-file' file, if any.
+	  nil)))
-Returns a string like in $MANPATH."
-(if (and Manual-manpath-config-file
+(setq Man-filter-list
-	   (file-readable-p Manual-manpath-config-file))
+	(list
-(let ((buf (get-buffer-create " *Manual-config*"))
+	 (cons
-	    path)
+	  Man-sed-command
-	(set-buffer buf)
+	  (list
-	(buffer-disable-undo buf)
+	   (if Man-sed-script
-	(erase-buffer)
+	       (concat "-e '" Man-sed-script "'")
-	(insert-file-contents Manual-manpath-config-file)
+	     "")
-	(while (re-search-forward "^\\(MANDATORY_MANPATH\\|MANPATH_MAP\\)"
+	   "-e '/^[\001-\032][\001-\032]*$/d'"
-				  nil t)
+	   "-e '/\e[789]/s///g'"
-	  (and (re-search-forward "\\(/[^ \t\n]+\\)[ \t]*$")
+	   "-e '/Reformatting page.  Wait/d'"
-	       (setq path (concat path (buffer-substring (match-beginning 1)
+	   "-e '/Reformatting entry.  Wait/d'"
-							 (match-end 1))
+	   "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
-				  ":"))))
+	   "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
-	(kill-buffer buf)
+	   "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
-	path)))
+	   "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
-;;
+	   "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
-;; manual-entry  -- The "main" user function
+	   "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
-;;
+	   "-e '/^[A-za-z].*Last[ \t]change:/d'"
+	   "-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)
+	     (cons
+	      Man-untabify-command
+	      Man-untabify-command-args)
+	   )))
+)
+(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))))
+(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 ()
+"Builds the entire background manpage and cleaning command."
+(let ((command (concat manual-program " " Man-switches " %s 2>/dev/null"))
+	(flist Man-filter-list))
+(while (and flist (car flist))
+(let ((pcom (car (car flist)))
+	    (pargs (cdr (car flist))))
+	(setq command
+	      (concat command " | " pcom " "
+		      (mapconcat '(lambda (phrase)
+				    (if (not (stringp phrase))
+					(error "Malformed Man-filter-list"))
+				    phrase)
+				 pargs " ")))
+	(setq flist (cdr flist))))
+command))
+(defun Man-translate-references (ref)
+"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
+and the Man-section-translations-alist variables)."
+(let ((name "")
+	(section "")
+	(slist Man-section-translations-alist))
+(cond
+;; "chmod(2V)" case ?
+((string-match (concat "^" Man-reference-regexp "$") ref)
+(setq name (Man-match-substring 1 ref)
+	    section (Man-match-substring 2 ref)))
+;; "2v chmod" case ?
+((string-match (concat "^\\(" Man-section-regexp
+			    "\\) +\\(" 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))))
+;; ======================================================================
+;; default man entry: get word under point
+(defsubst Man-default-man-entry ()
+"Make a guess at a default manual entry.
+This guess is based on the text surrounding the cursor, and the
+default section number is selected from `Man-auto-section-alist'."
+(let (default-title)
+(save-excursion
+;; Default man entry title is any word the cursor is on, or if
+;; cursor not on a word, then nearest preceding word.  Cannot
+;; use the current-word function because it skips the dots.
+(if (not (looking-at "[-a-zA-Z_.]"))
+	  (skip-chars-backward "^a-zA-Z"))
+(skip-chars-backward "-(a-zA-Z_0-9_.")
+(if (looking-at "(") (forward-char 1))
+(setq default-title
+	    (buffer-substring
+	     (point)
+	     (progn (skip-chars-forward "-a-zA-Z0-9_.") (point))))
+;; If looking at something like ioctl(2) or brc(1M), include the
+;; section number in the returned value.  Remove text properties.
+(let ((result (concat
+		     default-title
+		     (if (looking-at
+			  (concat "[ \t]*([ \t]*\\("
+				  Man-section-regexp "\\)[ \t]*)"))
+			 (format "(%s)" (Man-match-substring 1))))))
+	(set-text-properties 0 (length result) nil result)
+	result))))
+;; ======================================================================
+;; Top level command and background process sentinel
+;; For compatibility with older versions.
 ;;;###autoload
-(defun manual-entry (topic &optional arg silent)
+(defalias 'manual-entry 'man)
-"Display the Unix manual entry (or entries) for TOPIC.
-If prefix arg is given, modify the search according to the value:
+;;;###autoload
-2 = complement default exact matching of the TOPIC name;
+(defun man (man-args)
-exact matching default is specified by `Manual-match-topic-exactly'
+"Get a Un*x manual page and put it in a buffer.
-3 = force a search of the unformatted man directories
+This command is the top-level command in the man package.  It runs a Un*x
-4 = both 2 and 3
+command to retrieve and clean a manpage in the background and places the
-The manual entries are searched according to the variable
+results in a Man mode (manpage browsing) buffer.  See variable
-Manual-directory-list, which should be a list of directories.  If
+`Man-notify-method' for what happens when the buffer is ready.
-Manual-directory-list is nil, \\[Manual-directory-list-init] is
+If a buffer already exists for this man page, it will display immediately."
-invoked to create this list from the MANPATH environment variable.
-See the variable Manual-topic-buffer which controls how the buffer
-is named.  See also the variables Manual-match-topic-exactly,
-Manual-query-multiple-pages, and Manual-buffer-view-mode."
 (interactive
-(list (let* ((fmh "-A-Za-z0-9_.")
+(list (let* ((default-entry (Man-default-man-entry))
-		(default (save-excursion
+		(input (read-string
-			   (buffer-substring
+			(format "Manual entry%s: "
-			    (progn
+				(if (string= default-entry "")
-			      (re-search-backward "\\sw" nil t)
+				    ""
-			      (skip-chars-backward fmh) (point))
+				  (format " (default %s)" default-entry))))))
-			    (progn (skip-chars-forward fmh) (point)))))
+	   (if (string= input "")
-		(thing (read-string
+	       (if (string= default-entry "")
-			(if (equal default "") "Manual entry: "
+		   (error "No man args given")
-			  (concat "Manual entry: (default " default ") ")))))
+		 default-entry)
-	   (if (equal thing "") default thing))
+	     input))))
-	 (prefix-numeric-value current-prefix-arg)))
-;;(interactive "sManual entry (topic): \np")
+;; Possibly translate the "subject(section)" syntax into the
-(or arg (setq arg 1))
+;; "section subject" syntax and possibly downcase the section.
-(Manual-directory-list-init nil)
+(setq man-args (Man-translate-references man-args))
-(let ((exact (if (or (= arg 2) (= arg 4))
-		   (not Manual-match-topic-exactly)
+(Man-getpage-in-background man-args))
-		 Manual-match-topic-exactly))
-	(force (if (>= arg 3)
-t
+(defun Man-getpage-in-background (topic)
-nil))
+"Uses TOPIC to build and fire off the manpage and cleaning command."
-	section fmtlist manlist apropos-mode)
+(let* ((man-args topic)
-(let ((case-fold-search nil))
+	 (bufname (concat "*Man " man-args "*"))
-(if (and (null section)
+	 (buffer  (get-buffer bufname)))
-	       (string-match
+(if buffer
-		"\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
+	(Man-notify-when-ready buffer)
-	  (setq section (substring topic (match-beginning 2)
+(require 'env)
-				   (match-end 2))
+(message "Invoking %s %s in the background" manual-program man-args)
-		topic (substring topic (match-beginning 1)
+(setq buffer (generate-new-buffer bufname))
-				 (match-end 1)))
-	(if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic)
-	    (setq section "-k"
-		  topic (substring topic (match-beginning 1))))))
-(if (equal section "-k")
-	(setq apropos-mode t)
-(or silent
-	  (message "Looking for formatted entry for %s%s..."
-		   topic (if section (concat "(" section ")") "")))
-(setq fmtlist (Manual-select-man-pages
-Manual-formatted-directory-list
-topic section exact '()))
-(if (or force (not section) (null fmtlist))
-	  (progn
-	    (or silent
-		(message "%sooking for unformatted entry for %s%s..."
-			 (if fmtlist "L" "No formatted entry, l")
-			 topic (if section (concat "(" section ")") "")))
-	    (setq manlist (Manual-select-man-pages
-Manual-unformatted-directory-list
-topic section exact (if force '() fmtlist))))))
-;; Delete duplicate man pages (a file of the same name in multiple
-;; directories.)
-(or nil ;force
-(let ((rest (append fmtlist manlist)))
-(while rest
-(let ((rest2 (cdr rest)))
-(while rest2
-(if (equal (file-name-nondirectory (car rest))
-(file-name-nondirectory (car rest2)))
-(setq fmtlist (delq (car rest2) fmtlist)
-manlist (delq (car rest2) manlist)))
-(setq rest2 (cdr rest2))))
-(setq rest (cdr rest)))))
-(if (not (or fmtlist manlist apropos-mode))
-(progn
-(message "No entries found for %s%s" topic
-(if section (concat "(" section ")") ""))
-nil)
-(let ((bufname (cond ((not Manual-topic-buffer)
-;; What's the point of retaining this?
-(if apropos-mode
-"*Manual Apropos*"
-"*Manual Entry*"))
-(apropos-mode
-(concat "*man apropos " topic "*"))
-(t
-(concat "*man "
-(cond (exact
-(if section
-(concat topic "." section)
-topic))
-((or (cdr fmtlist) (cdr manlist)
-(and fmtlist manlist))
-;; more than one entry found
-(concat topic "..."))
-(t
-(file-name-nondirectory
-(car (or fmtlist manlist)))))
-"*"))))
-(temp-buffer-show-function
-(cond ((eq 't Manual-buffer-view-mode) 'view-buffer)
-((eq 'nil Manual-buffer-view-mode)
-temp-buffer-show-function)
-(t 'view-buffer-other-window))))
-(if apropos-mode
-(setq manlist (list (format "%s.%s" topic section))))
-(cond
-((and Manual-topic-buffer (get-buffer bufname))
-;; reselect an old man page buffer if it exists already.
-(save-excursion
-(set-buffer (get-buffer bufname))
-(Manual-mode))
-(if temp-buffer-show-function
-(funcall temp-buffer-show-function (get-buffer bufname))
-(display-buffer bufname)))
-(t
-(with-output-to-temp-buffer bufname
-(buffer-disable-undo standard-output)
-(save-excursion
-(set-buffer standard-output)
-(setq buffer-read-only nil)
-(erase-buffer)
-	       (Manual-insert-pages fmtlist manlist apropos-mode)
-(set-buffer-modified-p nil)
-(Manual-mode)
-))))
-(setq Manual-page-history
-(cons (buffer-name)
-(delete (buffer-name) Manual-page-history)))
-(message nil)
-t))))
-(defun Manpage-apropos (topic &optional arg silent)
-"Apropos on Unix manual pages for TOPIC.
-It calls the function `manual-entry'. Look at this function for
-further description. Look also at the variable `Manual-apropos-switch',
-if this function doesn't work on your system."
-(interactive
-(list (let* ((fmh "-A-Za-z0-9_.")
-		(default (save-excursion
-			   (buffer-substring
-			    (progn
-			      (re-search-backward "\\sw" nil t)
-			      (skip-chars-backward fmh) (point))
-			    (progn (skip-chars-forward fmh) (point)))))
-		(thing (read-string
-			(if (equal default "") "Manual entry: "
-			  (concat "Manual entry: (default " default ") ")))))
-	   (if (equal thing "") default thing))
-	 (prefix-numeric-value current-prefix-arg)))
-(manual-entry (concat Manual-apropos-switch " " topic) arg silent))
-(defun Manual-insert-pages (fmtlist manlist apropos-mode)
-(let ((sep (make-string 65 ?-))
-	name start end topic section)
-(while fmtlist			; insert any formatted files
-(setq name (car fmtlist))
-(goto-char (point-max))
-(setq start (point))
-;; In case the file can't be read or uncompressed or
-;; something like that.
-(condition-case ()
-	  (Manual-insert-man-file name)
-	(file-error nil))
-(goto-char (point-max))
-(setq end (point))
 (save-excursion
-	(save-restriction
+	(set-buffer buffer)
-	  (message "Cleaning manual entry for %s..."
+	(setq Man-original-frame (selected-frame))
-		   (file-name-nondirectory name))
+	(setq Man-arguments man-args))
-	  (narrow-to-region start end)
+(let ((process-environment (copy-sequence process-environment)))
-	  (Manual-nuke-nroff-bs)
+	;; Prevent any attempt to use display terminal fanciness.
-	  (goto-char (point-min))
+	(setenv "TERM" "dumb")
-	  (insert "File: " name "\n")
+	(set-process-sentinel
-	  (goto-char (point-max))
+	 (start-process manual-program buffer "sh" "-c"
-	  ))
+			(format (Man-build-man-command) man-args))
-(if (or (cdr fmtlist) manlist)
+	 'Man-bgproc-sentinel)))))
-	  (insert "\n\n" sep "\n"))
-(setq fmtlist (cdr fmtlist)))
+(defun Man-notify-when-ready (man-buffer)
+"Notify the user when MAN-BUFFER is ready.
-(while manlist			; process any unformatted files
+See the variable `Man-notify-method' for the different notification behaviors."
-(setq name (car manlist))
+(let ((saved-frame (save-excursion
-(or (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\(\\.gz\\'\\)" name)
+		       (set-buffer man-buffer)
-	  (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\'" name))
+		       Man-original-frame)))
-(setq topic (substring name (match-beginning 1) (match-end 1)))
+(cond
-(setq section (substring name (match-beginning 2) (match-end 2)))
+((eq Man-notify-method 'newframe)
-;; This won't work under IRIX, because SGI man accepts only the
+;; Since we run asynchronously, perhaps while Emacs is waiting
-;; "main" (one-character) section id, not full section ids
+;; for input, we must not leave a different buffer current.  We
-;; like 1M, 3X, etc. Put (setq Manual-use-full-section-ids nil)
+;; can't rely on the editor command loop to reselect the
-;; in your .emacs to work around this problem.
+;; selected window's buffer.
-(if (not (or Manual-use-full-section-ids (string-equal section "")))
-	  (setq section (substring section 0 1)))
-(message "Invoking man %s%s %s..."
-	       (if Manual-section-switch
-		   (concat Manual-section-switch " ")
-		 "")
-	       section topic)
-(setq start (point))
-(Manual-run-formatter name topic section)
-(setq end (point))
 (save-excursion
-	(save-restriction
+	(set-buffer man-buffer)
-	  (message "Cleaning manual entry for %s(%s)..." topic section)
+	(make-frame Man-frame-parameters)))
-	  (narrow-to-region start end)
+((eq Man-notify-method 'pushy)
-	  (Manual-nuke-nroff-bs apropos-mode)
+(switch-to-buffer man-buffer))
-	  (goto-char (point-min))
+((eq Man-notify-method 'bully)
-	  (insert "File: " name "\n")
+(and window-system
-	  (goto-char (point-max))
+	   (frame-live-p saved-frame)
-	  ))
+	   (select-frame saved-frame))
-(if (cdr manlist)
+(pop-to-buffer man-buffer)
-	  (insert "\n\n" sep "\n"))
+(delete-other-windows))
-(setq manlist (cdr manlist))))
+((eq Man-notify-method 'aggressive)
-(if (< (buffer-size) 200)
+(and window-system
+	   (frame-live-p saved-frame)
+	   (select-frame saved-frame))
+(pop-to-buffer man-buffer))
+((eq Man-notify-method 'friendly)
+(and window-system
+	   (frame-live-p saved-frame)
+	   (select-frame saved-frame))
+(display-buffer man-buffer 'not-this-window))
+((eq Man-notify-method 'polite)
+(beep)
+(message "Manual buffer %s is ready" (buffer-name man-buffer)))
+((eq Man-notify-method 'quiet)
+(message "Manual buffer %s is ready" (buffer-name man-buffer)))
+((or (eq Man-notify-method 'meek)
+	  t)
+(message ""))
+)))
+(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)
+(goto-char (point-min))
+(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))
+		       'face Man-overstrike-face))
+(goto-char (point-min))
+(while (search-forward "_\b" nil t)
+(backward-delete-char 2)
+(put-text-property (point) (1+ (point)) 'face Man-underline-face))
+(goto-char (point-min))
+(while (search-forward "\b_" nil t)
+(backward-delete-char 2)
+(put-text-property (1- (point)) (point) 'face Man-underline-face))
+(goto-char (point-min))
+(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
+(replace-match "\\1")
+(put-text-property (1- (point)) (point) 'face Man-overstrike-face))
+(goto-char (point-min))
+(while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
+(replace-match "o")
+(put-text-property (1- (point)) (point) 'face 'bold))
+(goto-char (point-min))
+(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
+(replace-match "+")
+(put-text-property (1- (point)) (point) 'face 'bold))
+;; \255 is some kind of dash in Latin-1.
+(goto-char (point-min))
+(while (search-forward "\255" nil t) (replace-match "-"))
+(message "%s man page made up" Man-arguments))
+(defun Man-cleanup-manpage ()
+"Remove overstriking and underlining from the current buffer."
+(interactive)
+(message "Please wait: cleaning up the %s man page..."
+	   Man-arguments)
+(if (or (interactive-p) (not Man-sed-script))
 (progn
 	(goto-char (point-min))
-	(if (looking-at "^File: ")
+	(while (search-forward "_\b" nil t) (backward-delete-char 2))
-	    (forward-line 1))
+	(goto-char (point-min))
-	(error (buffer-substring (point) (progn (end-of-line) (point))))))
+	(while (search-forward "\b_" nil t) (backward-delete-char 2))
-nil)
+	(goto-char (point-min))
+	(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
+	  (replace-match "\\1"))
-(defun Manual-run-formatter (name topic section)
+	(goto-char (point-min))
-(cond
+	(while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
-((string-match "roff\\'" Manual-program)
+	(goto-char (point-min))
-;; kludge kludge
+	(while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
-(call-process Manual-program nil t nil "-Tman" "-man" name))
+	))
+(goto-char (point-min))
-(t
+(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
-(call-process Manual-program nil t nil
+;; \255 is some kind of dash in Latin-1.
-(concat Manual-section-switch section) topic))))
+(goto-char (point-min))
+(while (search-forward "\255" nil t) (replace-match "-"))
-;(Manual-use-rosetta-man
+(message "%s man page cleaned up" Man-arguments))
-; (call-process "/bin/sh" nil t nil "-c"
-;               (format "man %s %s | rman" section topic)))
+(defun Man-bgproc-sentinel (process msg)
+"Manpage background process sentinel."
+(let ((Man-buffer (process-buffer process))
-(defvar Manual-mode-map
+	(delete-buff nil)
-(let ((m (make-sparse-keymap)))
+	(err-mess nil))
-(set-keymap-name m 'Manual-mode-map)
-(define-key m "l" 'Manual-last-page)
+(if (null (buffer-name Man-buffer)) ;; deleted buffer
-(define-key m 'button2 'Manual-follow-xref)
+	(set-process-buffer process nil)
-(define-key m 'button3 'Manual-popup-menu)
-m))
+(save-excursion
+	(set-buffer Man-buffer)
-(defun Manual-mode ()
+	(let ((case-fold-search nil))
-(kill-all-local-variables)
+	  (goto-char (point-min))
-(setq buffer-read-only t)
+	  (cond ((or (looking-at "No \\(manual \\)*entry for")
-(use-local-map Manual-mode-map)
+		     (looking-at "[^\n]*: nothing appropriate$"))
-(setq major-mode 'Manual-mode
+		 (setq err-mess (buffer-substring (point)
-	mode-name "Manual")
+						  (progn
-;; man pages with long lines are buggy!
+						    (end-of-line) (point)))
-;; This looks slightly better if they only
+		       delete-buff t))
-;; overran by a couple of chars.
+		((not (and (eq (process-status process) 'exit)
-(setq truncate-lines t)
+			   (= (process-exit-status process) 0)))
-(if (featurep 'scrollbar)
+		 (setq err-mess
-;; turn off horizontal scrollbars in this buffer
+		       (concat (buffer-name Man-buffer)
-(set-specifier scrollbar-height (cons (current-buffer) 0)))
+			       ": process "
-(run-hooks 'Manual-mode-hook))
+			       (let ((eos (1- (length msg))))
+				 (if (= (aref msg eos) ?\n)
-(defun Manual-last-page ()
+				     (substring msg 0 eos) msg))))
+		 (goto-char (point-max))
+		 (insert (format "\nprocess %s" msg))
+		 ))
+	  (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)
+	    ))
+	;; 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))
+	))))
+;; ======================================================================
+;; set up manual mode in buffer and build alists
+(defun Man-mode ()
+"A mode for browsing Un*x manual pages.
+The following man commands are available in the buffer. Try
+\"\\[describe-key] <key> RET\" for more information:
+\\[man]       Prompt to retrieve a new manpage.
+\\[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.
+\\[Man-quit]       Deletes the manpage window, bury its buffer.
+\\[Man-kill]       Deletes the manpage window, kill its buffer.
+\\[describe-mode]       Prints this help text.
+The following variables may be of some use. Try
+\"\\[describe-variable] <variable-name> RET\" for more information:
+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.
+The following key bindings are currently in effect in the buffer:
+\\{Man-mode-map}"
 (interactive)
-(while (or (not (get-buffer (car (or Manual-page-history
+(setq major-mode 'Man-mode
-				       (error "No more history.")))))
+	mode-name "Man"
-	     (eq (get-buffer (car Manual-page-history)) (current-buffer)))
+	buffer-auto-save-file-name nil
-(setq Manual-page-history (cdr Manual-page-history)))
+	mode-line-format Man-mode-line-format
-(switch-to-buffer (car Manual-page-history)))
+	truncate-lines t
+	buffer-read-only t)
+(buffer-disable-undo (current-buffer))
-;; Manual-select-subdirectories
+(auto-fill-mode -1)
-;; Given a DIRLIST and a SUBDIR name, return all subdirectories of the former which
+(use-local-map Man-mode-map)
-;; match the latter.
+(Man-build-page-list)
+(Man-strip-page-headers)
-(defun Manual-select-subdirectories (dirlist subdir)
+(Man-unindent)
-(let ((dirs '())
+(Man-goto-page 1)
-(case-fold-search nil)
+(run-hooks 'Man-mode-hook))
-(match (concat "\\`" (regexp-quote subdir)))
-d)
+(defsubst Man-build-section-alist ()
-(while dirlist
+"Build the association list of manpage sections."
-(setq d (car dirlist) dirlist (cdr dirlist))
+(setq Man-sections-alist nil)
-(if (file-directory-p d)
+(goto-char (point-min))
-(let ((files (directory-files d t match nil 'dirs-only))
-		(dir-temp '()))
-(while files
-(if (file-executable-p (car files))
-(setq dir-temp (cons (file-name-as-directory (car files))
-dir-temp)))
-(setq files (cdr files)))
-	    (and dir-temp
-		 (setq dirs (append dirs (nreverse dir-temp)))))))
-dirs))
-;; Manual-filter-subdirectories
-;; Given a DIRLIST and a SUBDIR name, return all members of the former
-;; which match the latter.
-(defun Manual-filter-subdirectories (dirlist subdir)
-(let ((match (concat
-		"/"
-		(regexp-quote subdir)
-		"[" Manual-man-page-section-ids "]"))
-	slist dir)
-(while dirlist
-(setq dir (car dirlist) dirlist (cdr dirlist))
-(if (and (file-executable-p dir) (string-match match dir))
-	    (setq slist (cons dir slist))))
-(nreverse slist)))
-(defun Manual-all-subdirectories (dirlist leaf-signature dirs &optional silent) "\
-Given a DIRLIST, return a backward-sorted list of all subdirectories
-thereof, prepended to DIRS if non-nil. This function calls itself
-recursively until subdirectories matching LEAF-SIGNATURE are reached,
-or the hierarchy has been thoroughly searched. This code is a modified
-version of a function written by Tim Bradshaw (tfb@ed.ac.uk)."
-(Manual-all-subdirectories-noloop dirlist leaf-signature dirs nil silent))
-(defun Manual-all-subdirectories-noloop (dirlist leaf-signature dirs been &optional silent) "\
-Does the job of manual-all-subdirectories and keeps track of where it
-has been to avoid loops."
-(let (dir)
-(while dirlist
-(setq dir (car dirlist) dirlist (cdr dirlist))
-(if (file-directory-p dir)
-	  (let ((dir-temp (cons (file-name-as-directory dir) dirs)))
-	    ;; Without feedback the user might wonder about the delay!
-	    (or silent (message
-			"Building list of search directories... %s"
-			(car dir-temp)))
-	    (if (member (file-truename dir) been)
-		()		 ; Ignore. We have been here before
-	      (setq been (cons (file-truename dir) been))
-	      (setq dirs
-		    (if (string-match leaf-signature dir)
-			dir-temp
-		      (Manual-all-subdirectories-noloop
-		       (directory-files dir t "[^.]$" nil 'dirs-only)
-		       leaf-signature dir-temp been silent))))))))
-dirs)
-(defvar Manual-bogus-file-pattern "\\.\\(lpr\\|ps\\|PS\\)\\'"
-"Some systems have files in the man/man*/ directories which aren't man pages.
-This pattern is used to prune those files.")
-;; Manual-select-man-pages
-;;
-;; Given a DIRLIST, discover all filenames which complete given the TOPIC
-;; and SECTION.
-;; ## Note: BSD man looks for .../man1/foo.1 and .../man1/$MACHINE/foo.1
-;; ## Fixed for SGI IRIX 5.x on Sat Jul 15 1995 by Dale Atems
-;; (atems@physics.wayne.edu).
-(defun Manual-select-man-pages (dirlist topic section exact shadow)
 (let ((case-fold-search nil))
-(and section
+(while (re-search-forward Man-heading-regexp (point-max) t)
-(let ((l '())
+(aput 'Man-sections-alist (Man-match-substring 1))
-	    ;;(match (concat (substring section 0 1) "/?\\'"))
+(forward-line 1))))
-	    ;;                                          ^^^
-	    ;; We'll lose any pages inside subdirectories of the "standard"
+(defsubst Man-build-references-alist ()
-	    ;; ones if we insist on this! The following regexp should
+"Build the association list of references (in the SEE ALSO section)."
-	    ;; match any directory ending with the full section id or
+(setq Man-refpages-alist nil)
-	    ;; its first character, or any direct subdirectory thereof:
+(save-excursion
-	    (match (concat "\\("
+(if (Man-find-section Man-see-also-regexp)
-			   (regexp-quote section)
+	(let ((start (progn (forward-line 1) (point)))
-			   "\\|"
+	      (end (progn
-			   (substring section 0 1)
+		     (Man-next-section 1)
-			   "\\)/?"))
+		     (point)))
-	    d)
+	      hyphenated
-	(while dirlist
+	      (runningpoint -1))
-	  (setq d (car dirlist) dirlist (cdr dirlist))
+	  (save-restriction
-	  (if (string-match match d)
+	    (narrow-to-region start end)
-	      (setq l (cons d l))))
+	    (goto-char (point-min))
-	(setq dirlist l)))
+	    (back-to-indentation)
-(if shadow
+	    (while (and (not (eobp)) (/= (point) runningpoint))
-(setq shadow (concat "/\\("
+	      (setq runningpoint (point))
-(mapconcat #'(lambda (n)
+	      (if (re-search-forward Man-reference-regexp end t)
-(regexp-quote
+		  (let* ((word (Man-match-substring 0))
-(file-name-nondirectory n)))
+			 (len (1- (length word))))
-shadow
+		    (if hyphenated
-"\\|")
+			(setq word (concat hyphenated word)
-"\\)\\'")))
+			      hyphenated nil))
-(let ((manlist '())
+		    (if (= (aref word len) ?-)
-(match (concat "\\`"
+			(setq hyphenated (substring word 0 len))
-(regexp-quote topic)
+		      (aput 'Man-refpages-alist word))))
-			    ;; **Note: on IRIX the preformatted pages
+	      (skip-chars-forward " \t\n,")))))))
-			    ;; are packed, so they end with ".z". This
-			    ;; way you miss them if you specify a
+(defun Man-build-page-list ()
-			    ;; section. I don't see any point to it here
+"Build the list of separate manpages in the buffer."
-			    ;; even on BSD systems since we're looking
+(setq Man-page-list nil)
-			    ;; one level down already, but I can't test
+(let ((page-start (point-min))
-			    ;; this. More thought needed (???)
+	(page-end (point-max))
+	(header ""))
-			   (cond ((and section
+(goto-char page-start)
-				       (not Manual-use-subdirectory-list))
+;; (switch-to-buffer (current-buffer))(debug)
-				  (concat "\\." (regexp-quote section)))
+(while (not (eobp))
-(exact
+(setq header
-;; If Manual-match-topic-exactly is
+	    (if (looking-at Man-page-header-regexp)
-;; set, then we must make sure the
+		(Man-match-substring 1)
-;; completions are exact, except for
+	      nil))
-;; trailing weird characters after
+;; Go past both the current and the next Man-first-heading-regexp
-;; the section.
+(if (re-search-forward Man-first-heading-regexp nil 'move 2)
-"\\.")
+	  (let ((p (progn (beginning-of-line) (point))))
-(t
+	    ;; We assume that the page header is delimited by blank
-""))))
+	    ;; lines and that it contains at most one blank line.  So
-dir)
+	    ;; if we back by three blank lines we will be sure to be
-(while dirlist
+	    ;; before the page header but not before the possible
-(setq dir (car dirlist) dirlist (cdr dirlist))
+	    ;; previous page header.
-(if (not (file-directory-p dir))
+	    (search-backward "\n\n" nil t 3)
-(progn
+	    (if (re-search-forward Man-page-header-regexp p 'move)
-(message "warning: %s is not a directory" dir)
+		(beginning-of-line))))
-;;(sit-for 1)
+(setq page-end (point))
-)
+(setq Man-page-list (append Man-page-list
-(let ((files (directory-files dir t match nil t))
+				  (list (list (copy-marker page-start)
-f)
+					      (copy-marker page-end)
-(while files
+					      header))))
-(setq f (car files) files (cdr files))
+(setq page-start page-end)
-(cond ((string-match Manual-bogus-file-pattern f)
+)))
-		       ;(message "Bogus fule %s" f) (sit-for 2)
-)
+(defun Man-strip-page-headers ()
-		      ((and shadow (string-match shadow f))
+"Strip all the page headers but the first from the manpage."
-;(message "Shadowed %s" f) (sit-for 2)
+(let ((buffer-read-only nil)
-)
+	(case-fold-search nil)
-((not (file-readable-p f))
+	(page-list Man-page-list)
-;(message "Losing with %s" f) (sit-for 2)
+	(page ())
-)
+	(header ""))
-(t
+(while page-list
-(setq manlist (cons f manlist))))))))
+(setq page (car page-list))
-(setq manlist (nreverse manlist))
+(and (nth 2 page)
-(and Manual-unique-man-sections-only
+	   (goto-char (car page))
-	   (setq manlist (Manual-clean-to-unique-pages-only manlist)))
+	   (re-search-forward Man-first-heading-regexp nil t)
-(if (and manlist Manual-query-multiple-pages)
+	   (setq header (buffer-substring (car page) (match-beginning 0)))
-(apply #'append
+	   ;; Since the awk script collapses all successive blank
-(mapcar #'(lambda (page)
+	   ;; lines into one, and since we don't want to get rid of
-(and page
+	   ;; the fast awk script, one must choose between adding
-(y-or-n-p (format "Read %s? " page))
+	   ;; spare blank lines between pages when there were none and
-				  (list page)))
+	   ;; deleting blank lines at page boundaries when there were
-manlist))
+	   ;; some.  We choose the first, so we comment the following
-manlist))))
+	   ;; line.
+	   ;; (setq header (concat "\n" header)))
-(defun Manual-clean-to-unique-pages-only (manlist)
+	   (while (search-forward header (nth 1 page) t)
-"Prune the current list of pages down to a unique set."
+	     (replace-match "")))
-(let (page-name unique-pages)
+(setq page-list (cdr page-list)))))
-(apply 'append
-	   (mapcar '(lambda (page)
+(defun Man-unindent ()
-		      (cond (page
+"Delete the leading spaces that indent the manpage."
-			     (and (string-match ".*/\\(.*\\)" page)
+(let ((buffer-read-only nil)
-				  (setq page-name (substring page (match-beginning 1)
+	(case-fold-search nil)
-							     (match-end 1)))
+	(page-list Man-page-list))
-				  ;; try to clip off .Z, .gz suffixes
+(while page-list
-				  (and (string-match "\\(.*\\)\\.\\(.+\\)\\.\\(.+\\)"
+(let ((page (car page-list))
-						     page-name)
+	    (indent "")
-				       (setq page-name
+	    (nindent 0))
-					     (substring page-name (match-beginning 1)
+	(narrow-to-region (car page) (car (cdr page)))
-							(match-end 2)))))
+	(if Man-uses-untabify-flag
-			     ;; add Manual-unique-pages if it isn't there
+	    (untabify (point-min) (point-max)))
-			     ;;  and return file
+	(if (catch 'unindent
-			     (if (and unique-pages
+	      (goto-char (point-min))
-				      page-name
+	      (if (not (re-search-forward Man-first-heading-regexp nil t))
-				      (string-match (concat "\\b" page-name "\\b")
+		  (throw 'unindent nil))
-						    unique-pages))
+	      (beginning-of-line)
-				 nil
+	      (setq indent (buffer-substring (point)
-			       (setq unique-pages (concat unique-pages
+					     (progn
-								 page-name
+					       (skip-chars-forward " ")
-								 " "))
+					       (point))))
-			       (list page)))))
+	      (setq nindent (length indent))
-		   manlist))))
+	      (if (zerop nindent)
+		  (throw 'unindent nil))
+	      (setq indent (concat indent "\\|$"))
+	      (goto-char (point-min))
-(defun Manual-insert-man-file (name)
+	      (while (not (eobp))
-;; Insert manual file (unpacked as necessary) into buffer
+		(if (looking-at indent)
-(cond ((equal (substring name -3) ".gz")
+		    (forward-line 1)
-	 (call-process "gunzip" nil t nil "--stdout" name))
+		  (throw 'unindent nil)))
-((or (equal (substring name -2) ".Z")
+	      (goto-char (point-min)))
-	     ;; HPUX uses directory names that end in .Z and compressed
+	    (while (not (eobp))
-	     ;; files that don't.  How gratuitously random.
+	      (or (eolp)
-(let ((case-fold-search nil))
+		  (delete-char nindent))
-(string-match "\\.Z/" name)))
+	      (forward-line 1)))
-	 (call-process "zcat" name t nil)) ;; XEmacs change for HPUX
+	(setq page-list (cdr page-list))
-	((equal (substring name -2) ".z")
+	))))
-	 (call-process "pcat" nil t nil name))
-	(t
-	 (insert-file-contents name))))
+;; ======================================================================
+;; Man mode commands
-(defmacro Manual-delete-char (n)
-;; in v19, delete-char is compiled as a function call, but delete-region
+(defun Man-next-section (n)
-;; is byte-coded, so it's much faster.
+"Move point to Nth next section (default 1)."
-;; (We were spending 40% of our time in delete-char alone.)
+(interactive "p")
-(list 'delete-region '(point) (list '+ '(point) n)))
+(let ((case-fold-search nil))
+(if (looking-at Man-heading-regexp)
-;; Hint: BS stands for more things than "back space"
+	(forward-line 1))
-(defun Manual-nuke-nroff-bs (&optional apropos-mode)
+(if (re-search-forward Man-heading-regexp (point-max) t n)
-(interactive "*")
+	(beginning-of-line)
-(if Manual-use-rosetta-man
+(goto-char (point-max)))))
-(call-process-region (point-min) (point-max) "rman" t t nil)
-;;
+(defun Man-previous-section (n)
-;; turn underlining into italics
+"Move point to Nth previous section (default 1)."
-;;
+(interactive "p")
+(let ((case-fold-search nil))
+(if (looking-at Man-heading-regexp)
+	(forward-line -1))
+(if (re-search-backward Man-heading-regexp (point-min) t n)
+	(beginning-of-line)
+(goto-char (point-min)))))
+(defun Man-find-section (section)
+"Move point to SECTION if it exists, otherwise don't move point.
+Returns t if section is found, nil otherwise."
+(let ((curpos (point))
+	(case-fold-search nil))
 (goto-char (point-min))
-(while (search-forward "_\b" nil t)
+(if (re-search-forward (concat "^" section) (point-max) t)
-;; searching for underscore-backspace and then comparing the following
+	(progn (beginning-of-line) t)
-;; chars until the sequence ends turns out to be much faster than searching
+(goto-char curpos)
-;; for a regexp which matches the whole sequence.
+nil)
-(let ((s (match-beginning 0)))
-	(goto-char s)
-	(while (and (= (following-char) ?_)
-		    (= (char-after (1+ (point))) ?\b))
-	  (Manual-delete-char 2)
-	  (forward-char 1))
-	(set-extent-face (make-extent s (point)) 'man-italic)))
-;;
-;; turn overstriking into bold
-;;
-(goto-char (point-min))
-(while (re-search-forward "\\([^\n]\\)\\(\b\\1\\)" nil t)
-;; Surprisingly, searching for the above regexp is faster than searching
-;; for a backspace and then comparing the preceding and following chars,
-;; I presume because there are many false matches, meaning more funcalls
-;; to re-search-forward.
-(let ((s (match-beginning 0)))
-	(goto-char s)
-	;; Some systems (SGI) overstrike multiple times, eg, "M\bM\bM\bM".
-	(while (looking-at "\\([^\n]\\)\\(\b\\1\\)+")
-	  (delete-region (+ (point) 1) (match-end 0))
-	  (forward-char 1))
-	(set-extent-face (make-extent s (point)) 'man-bold)))
-;;
-;; hack bullets: o^H+ --> +
-(goto-char (point-min))
-(while (search-forward "\b" nil t)
-(Manual-delete-char -2))
-(if (> (buffer-size) 100) ; minor kludge
-	(Manual-nuke-nroff-bs-footers))
-) ;; not Manual-use-rosetta-man
-;;
-;; turn subsection header lines into bold
-;;
-(goto-char (point-min))
-(if apropos-mode
-(while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t)
-	(forward-char -2)
-	(delete-backward-char 1))
-;;    (while (re-search-forward "^[^ \t\n]" nil t)
-;;      (set-extent-face (make-extent (match-beginning 0)
-;;                                   (progn (end-of-line) (point)))
-;;                      'man-heading))
-;; boldface the first line
-(if (looking-at "[^ \t\n].*$")
-	(set-extent-face (make-extent (match-beginning 0) (match-end 0))
-			 'man-bold))
-;; boldface subsequent title lines
-;; Regexp to match section headers changed to match a non-indented
-;; line preceded by a blank line and followed by an indented line.
-;; This seems to work ok for manual pages but gives better results
-;; with other nroff'd files
-(while (re-search-forward "\n\n\\([^ \t\n].*\\)\n[ \t]+[^ \t\n]" nil t)
-(goto-char (match-end 1))
-(set-extent-face (make-extent (match-beginning 1) (match-end 1))
-		       'man-heading)
-(forward-line 1))
-)
-(if Manual-use-rosetta-man
-nil
-;; Zap ESC7,  ESC8, and ESC9
-;; This is for Sun man pages like "man 1 csh"
-(goto-char (point-min))
-(while (re-search-forward "\e[789]" nil t)
-(replace-match "")))
-;; Nuke blanks lines at start.
-;;  (goto-char (point-min))
-;;  (skip-chars-forward "\n")
-;;  (delete-region (point-min) (point))
-(Manual-mouseify-xrefs)
-)
-(fset 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name
-(defun Manual-nuke-nroff-bs-footers ()
-;; Nuke headers and footers.
-;;
-;; nroff assumes pages are 66 lines high.  We assume that, and that the
-;; first and last line on each page is expendible.  There is no way to
-;; tell the difference between a page break in the middle of a paragraph
-;; and a page break between paragraphs (the amount of extra whitespace
-;; that nroff inserts is the same in both cases) so this might strip out
-;; a blank line were one should remain.  I think that's better than
-;; leaving in a blank line where there shouldn't be one.  (Need I say
-;; it: FMH.)
-;;
-;; Note that if nroff spits out error messages, pages will be more than
-;; 66 lines high, and we'll lose badly.  That's ok because standard
-;; nroff doesn't do any diagnostics, and the "gnroff" wrapper for groff
-;; turns off error messages for compatibility.  (At least, it's supposed
-;; to.)
-;;
-(goto-char (point-min))
-;; first lose the status output
-(let ((case-fold-search t))
-(if (and (not (looking-at "[^\n]*warning"))
-	     (looking-at "Reformatting.*\n"))
-	(delete-region (match-beginning 0) (match-end 0))))
-;; kludge around a groff bug where it won't keep quiet about some
-;; warnings even with -Wall or -Ww.
-(cond ((looking-at "grotty:")
-	 (while (looking-at "grotty:")
-	   (delete-region (point) (progn (forward-line 1) (point))))
-	 (if (looking-at " *done\n")
-	     (delete-region (point) (match-end 0)))))
-(let ((pages '())
-	p)
-;; collect the page boundary markers before we start deleting, to make
-;; it easier to strip things out without changing the page sizes.
-(while (not (eobp))
-(forward-line 66)
-(setq pages (cons (point-marker) pages)))
-(setq pages (nreverse pages))
-(while pages
-(goto-char (car pages))
-(set-marker (car pages) nil)
-;;
-;; The lines are: 3 blank; footer; 6 blank; header; 3 blank.
-;; We're in between the previous footer and the following header,
-;;
-;; First lose 3 blank lines, the header, and then 3 more.
-;;
-(setq p (point))
-(skip-chars-forward "\n")
-(delete-region p (point))
-(and (looking-at "[^\n]+\n\n?\n?\n?")
-	   (delete-region (match-beginning 0) (match-end 0)))
-;;
-;; Next lose the footer, and the 3 blank lines after, and before it.
-;; But don't lose the last footer of the manual entry; that contains
-;; the "last change" date, so it's not completely uninteresting.
-;; (Actually lose all blank lines before it; sh(1) needs this.)
-;;
-(skip-chars-backward "\n")
-(beginning-of-line)
-(if (null (cdr pages))
-	  nil
-	(and (looking-at "[^\n]+\n\n?\n?\n?")
-	     (delete-region (match-beginning 0) (match-end 0))))
-(setq p (point))
-(skip-chars-backward "\n")
-(if (> (- p (point)) 4)
-	  (delete-region (+ 2 (point)) p)
-	(delete-region (1+ (point)) p))
-;      (and (looking-at "\n\n?\n?")
-;	   (delete-region (match-beginning 0) (match-end 0)))
-(setq pages (cdr pages)))
-;;
-;; Now nuke the extra blank lines at the beginning and end.
-(goto-char (point-min))
-(if (looking-at "\n+")
-	(delete-region (match-beginning 0) (match-end 0)))
-(forward-line 1)
-(if (looking-at "\n\n+")
-	(delete-region (1+ (match-beginning 0)) (match-end 0)))
-(goto-char (point-max))
-(skip-chars-backward "\n")
-(delete-region (point) (point-max))
-(beginning-of-line)
-(forward-char -1)
-(setq p (point))
-(skip-chars-backward "\n")
-(if (= ?\n (following-char)) (forward-char 1))
-(if (> (point) (1+ p))
-	(delete-region (point) p))
 ))
-;(defun Manual-nuke-nroff-bs-footers ()
+(defun Man-goto-section ()
-;  ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
+"Query for section to move point to."
-;  (goto-char (point-min))
+(interactive)
-;  (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Za-z]+)\\).*\\1$" nil t)
+(aput 'Man-sections-alist
-;    (replace-match ""))
+	(let* ((default (aheadsym Man-sections-alist))
-;
+	       (completion-ignore-case t)
-;  ;;
+	       chosen
-;  ;; it would appear that we have a choice between sometimes introducing
+	       (prompt (concat "Go to section: (default " default ") ")))
-;  ;; an extra blank line when a paragraph was broken by a footer, and
+	  (setq chosen (completing-read prompt Man-sections-alist))
-;  ;; sometimes not putting in a blank line between two paragraphs when
+	  (if (or (not chosen)
-;  ;; a footer appeared right between them.  FMH; I choose the latter.
+		  (string= chosen ""))
-;  ;;
+	      default
-;
+	    chosen)))
-;  ;; Nuke footers: "Printed 12/3/85	27 April 1981	1"
+(Man-find-section (aheadsym Man-sections-alist)))
-;  ;;    Sun appear to be on drugz:
-;  ;;     "Sun Release 3.0B  Last change: 1 February 1985     1"
+(defun Man-goto-see-also-section ()
-;  ;;    HP are even worse!
+"Move point the the \"SEE ALSO\" section.
-;  ;;     "     Hewlett-Packard   -1- (printed 12/31/99)"  FMHWA12ID!!
+Actually the section moved to is described by `Man-see-also-regexp'."
-;  ;;    System V (well WICATs anyway):
+(interactive)
-;  ;;     "Page 1			  (printed 7/24/85)"
+(if (not (Man-find-section Man-see-also-regexp))
-;  ;;    Who is administering PCP to these corporate bozos?
+(error (concat "No " Man-see-also-regexp
-;  (goto-char (point-min))
+		     " section found in the current manpage"))))
-;  (while (re-search-forward
-;	   (cond
+(defun Man-follow-manual-reference (reference)
-;	    ((eq system-type 'hpux)
+"Get one of the manpages referred to in the \"SEE ALSO\" section.
-;	     "\n\n?[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*\n")
+Specify which reference to use; default is based on word at point."
-;	    ((eq system-type 'dgux-unix)
+(interactive
-;	     "\n\n?[ \t]*Licensed material--.*Page [0-9]*\n")
+(if (not Man-refpages-alist)
-;	    ((eq system-type 'usg-unix-v)
+(error "There are no references in the current man page")
-;	     "\n\n? *Page [0-9]*.*(printed [0-9/]*)\n")
+(list (let* ((default (or
-;	    (t
+			     (car (all-completions
-;	     "\n\n?\\(Printed\\|Sun Release\\) [0-9].*[0-9]\n"))
+				   (save-excursion
-;	   nil t)
+				     (skip-syntax-backward "w()")
-;    (replace-match ""))
+				     (skip-chars-forward " \t")
-;
+				     (let ((word (current-word)))
-;  ;;    Also, hack X footers:
+				       ;; strip a trailing '-':
-;  ;;     "X Version 11         Last change: Release 5         1"
+				       (if (string-match "-$" word)
-;  (goto-char (point-min))
+					   (substring word 0
-;  (while (re-search-forward "\n\n?X Version [^\n]+\n" nil t)
+						      (match-beginning 0))
-;    (replace-match ""))
+					 word)))
-;
+				   Man-refpages-alist))
-;  ;; Crunch blank lines
+			     (aheadsym Man-refpages-alist)))
-;  (goto-char (point-min))
+		   chosen
-;  (while (re-search-forward "\n\n\n\n*" nil t)
+		   (prompt (concat "Refer to: (default " default ") ")))
-;    (replace-match "\n\n"))
+	      (setq chosen (completing-read prompt Man-refpages-alist nil t))
-;  )
+	      (if (or (not chosen)
+		      (string= chosen ""))
-(defun Manual-mouseify-xrefs ()
+		  default
-(goto-char (point-min))
+		chosen)))))
-(forward-line 1)
+(if (not Man-refpages-alist)
-(let ((case-fold-search nil)
+(error "Can't find any references in the current manpage")
-	s e name extent)
+(aput 'Man-refpages-alist reference)
-;; possibly it would be faster to rewrite this expression to search for
+(Man-getpage-in-background
-;; a less common sequence first (like "([0-9]") and then back up to see
+(Man-translate-references (aheadsym Man-refpages-alist)))))
-;; if it's really a match.  This function is 15% of the total time, 13%
-;; of which is this call to re-search-forward.
+(defun Man-kill ()
-(while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.]*([0-9][a-zA-Z0-9]*)"
+"Kill the buffer containing the manpage."
-			      nil t)
+(interactive)
-(setq s (match-beginning 0)
+(let ((buff (current-buffer)))
-	    e (match-end 0)
+(delete-windows-on buff)
-	    name (buffer-substring s e))
+(kill-buffer buff))
-(goto-char s)
+(if (and window-system
-(skip-chars-backward " \t")
+	   (or (eq Man-notify-method 'newframe)
-(if (and (bolp)
+	       (and pop-up-frames
-	       (progn (backward-char 1) (= (preceding-char) ?-)))
+		    (eq Man-notify-method 'bully))))
-	  (progn
+(delete-frame)))
-	    (setq s (point))
-	    (skip-chars-backward "-a-zA-Z0-9_.")
+(defun Man-quit ()
-	    (setq name (concat (buffer-substring (point) (1- s)) name))
+"Bury the buffer containing the manpage."
-	    (setq s (point))))
+(interactive)
-;; if there are upper case letters in the section, downcase them.
+(let ((buff (current-buffer)))
-(if (string-match "(.*[A-Z]+.*)$" name)
+(delete-windows-on buff)
-	  (setq name (concat (substring name 0 (match-beginning 0))
+(bury-buffer buff))
-			     (downcase (substring name (match-beginning 0))))))
+(if (and window-system
-;; (setq already-fontified (extent-at s))
+	   (or (eq Man-notify-method 'newframe)
-(setq extent (make-extent s e))
+	       (and pop-up-frames
-(set-extent-property extent 'man (list 'Manual-follow-xref name))
+		    (eq Man-notify-method 'bully))))
-(set-extent-property extent 'highlight t)
+(delete-frame)))
-;; (if (not already-fontified)...
-(set-extent-face extent 'man-xref)
+(defun Man-goto-page (page)
-(goto-char e))))
+"Go to the manual page on page PAGE."
+(interactive
-(defun Manual-follow-xref (&optional name-or-event)
+(if (not Man-page-list)
-"Invoke `manual-entry' on the cross-reference under the mouse.
+(let ((args Man-arguments))
-When invoked noninteractively, the arg may be an xref string to parse instead."
+	 (kill-buffer (current-buffer))
-(interactive "e")
+	 (error "Can't find the %s manpage" args))
-(if (eventp name-or-event)
+(if (= (length Man-page-list) 1)
-(let* ((p (event-point name-or-event))
+	 (error "You're looking at the only manpage in the buffer")
-	     (extent (and p (extent-at p
+(list (read-minibuffer (format "Go to manpage [1-%d]: "
-			     (event-buffer name-or-event)
+				      (length Man-page-list)))))))
-			     'highlight)))
+(if (not Man-page-list)
-	     (data (and extent (extent-property extent 'man))))
+(let ((args Man-arguments))
-	(if (eq (car-safe data) 'Manual-follow-xref)
+	(kill-buffer (current-buffer))
-	    (eval data)
+	(error "Can't find the %s manpage" args)))
-	  (error "no manual cross-reference there.")))
+(if (or (< page 1)
-(let ((Manual-match-topic-exactly t)
+	  (> page (length Man-page-list)))
-	  (Manual-query-multiple-pages nil))
+(error "No manpage %d found" page))
-(or (manual-entry name-or-event)
+(let* ((page-range (nth (1- page) Man-page-list))
-	  ;; If that didn't work, maybe it's in a different section than the
+	 (page-start (car page-range))
-	  ;; man page writer expected.  For example, man pages tend assume
+	 (page-end (car (cdr page-range))))
-	  ;; that all user programs are in section 1, but X tends to generate
+(setq Man-current-page page
-	  ;; makefiles that put things in section "n" instead...
+	  Man-page-mode-string (Man-make-page-mode-string))
-	  (and (string-match "[ \t]*([^)]+)\\'" name-or-event)
+(widen)
-	       (progn
+(goto-char page-start)
-		 (message "No entries found for %s; checking other sections..."
+(narrow-to-region page-start page-end)
-			  name-or-event)
+(Man-build-section-alist)
-		 (manual-entry
+(Man-build-references-alist)
-		  (substring name-or-event 0 (match-beginning 0))
+(goto-char (point-min))))
-		  nil t)))))))
-(defun Manual-popup-menu (&optional event)
+(defun Man-next-manpage ()
-"Pops up a menu of cross-references in this manual page.
+"Find the next manpage entry in the buffer."
-If there is a cross-reference under the mouse button which invoked this
+(interactive)
-command, it will be the first item on the menu.  Otherwise, they are
+(if (= (length Man-page-list) 1)
-on the menu in the order in which they appear in the buffer."
+(error "This is the only manpage in the buffer"))
-(interactive "e")
+(if (< Man-current-page (length Man-page-list))
-(let ((buffer (current-buffer))
+(Man-goto-page (1+ Man-current-page))
-	(sep "---")
+(if Man-circular-pages-flag
-	(prefix "Show Manual Page for ")
+	(Man-goto-page 1)
-	xref items)
+(error "You're looking at the last manpage in the buffer"))))
-(cond (event
-	   (setq buffer (event-buffer event))
+(defun Man-previous-manpage ()
-	   (let* ((p (event-point event))
+"Find the previous manpage entry in the buffer."
-		  (extent (and p (extent-at p buffer 'highlight)))
+(interactive)
-		  (data (and extent (extent-property extent 'man))))
+(if (= (length Man-page-list) 1)
-	     (if (eq (car-safe data) 'Manual-follow-xref)
+(error "This is the only manpage in the buffer"))
-		 (setq xref (nth 1 data))))))
+(if (> Man-current-page 1)
-(if xref (setq items (list sep xref)))
+(Man-goto-page (1- Man-current-page))
-(map-extents #'(lambda (extent ignore)
+(if Man-circular-pages-flag
-		     (let ((data (extent-property extent 'man)))
+	(Man-goto-page (length Man-page-list))
-		       (if (and (eq (car-safe data) 'Manual-follow-xref)
+(error "You're looking at the first manpage in the buffer"))))
-				(not (member (nth 1 data) items)))
-			   (setq items (cons (nth 1 data) items)))
+;; Init the man package variables, if not already done.
-		    nil))
+(Man-init-defvars)
-		 buffer)
-(if (eq sep (car items)) (setq items (cdr items)))
-(let ((popup-menu-titles nil))
-(popup-menu
-(cons "Manual Entry"
-	     (mapcar #'(lambda (item)
-			 (if (eq item sep)
-			     item
-(vector (concat prefix item)
-(list 'Manual-follow-xref item) t)))
-		     (nreverse items)))))))
-(defun pager-cleanup-hook ()
-"cleanup man page if called via $PAGER"
-(let ((buf-name (or buffer-file-name (buffer-name))))
-	(if (and (or (string-match "^/tmp/man[0-9]+" buf-name)
-		     (string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name))
-		 (not (string-match Manual-bogus-file-pattern buf-name)))
-	    (let (buffer manpage)
-	      (require 'man)
-	      (goto-char (point-min))
-	      (setq buffer-read-only nil)
-	      (Manual-nuke-nroff-bs)
-	      (goto-char (point-min))
-	      (if (re-search-forward "[^ \t]")
-		  (goto-char (- (point) 1)))
-	      (if (looking-at "\\([a-zA-Z0-9]+\\)[ \t]*(")
-		  (setq manpage (buffer-substring (match-beginning 1) (match-end 1)))
-		(setq manpage "???"))
-	      (setq buffer
-		    (rename-buffer
-		     (generate-new-buffer-name (concat "*man " manpage "*"))))
-	      (setq buffer-file-name nil)
-	      (goto-char (point-min))
-	      (insert (format "%s\n" buf-name))
-	      (goto-char (point-min))
-	      (buffer-disable-undo buffer)
-	      (set-buffer-modified-p nil)
-	      (Manual-mode)
-	      ))))
-(add-hook 'server-visit-hook 'pager-cleanup-hook)
 (provide 'man)
+;;; man.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/packages/man.el @ 4:b82b59fe008d r19-15b3