Mercurial > hg > xemacs-beta
diff lisp/packages/man.el @ 24:4103f0995bd7 r19-15b95
Import from CVS: tag r19-15b95
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:51:03 +0200 |
| parents | 0293115a14e9 |
| children | 441bb1e64a06 |
line wrap: on
line diff
--- a/lisp/packages/man.el Mon Aug 13 08:50:31 2007 +0200 +++ b/lisp/packages/man.el Mon Aug 13 08:51:03 2007 +0200 @@ -1,7 +1,7 @@ ;;; man.el --- browse UNIX manual pages ;; Keywords: help -;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1993, 1994, 1996 Free Software Foundation, Inc. ;; ;; This file is part of XEmacs. @@ -16,161 +16,38 @@ ;; 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, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;; Mostly rewritten by Alan K. Stebbens <aks@hub.ucsb.edu> 11-apr-90. -;; -;; o Match multiple man pages using TOPIC as a simple pattern -;; o Search unformatted pages, even when formatted matches are found -;; o Query the user as to which pages are desired -;; o Use of the prefix arg to toggle/bypass the above features -;; o Buffers named by the first topic in the buffer -;; o Automatic uncompress for compressed man pages (.Z, .z, and .gz) -;; o View the resulting buffer using M-x view mode -;; -;; Modified 16-mar-91 by Jamie Zawinski <jwz@lucid.com> to default the -;; manual topic to the symbol at point, just like find-tag does. -;; -;; Modified 22-mar-93 by jwz to use multiple fonts and follow xrefs with mouse. -;; -;; Modified 16-apr-93 by Dave Gillespie <daveg@synaptics.com> to make -;; apropos work nicely; work correctly when bold or italic is unavailable; -;; reuse old buffer if topic is re-selected (in Manual-topic-buffer mode). -;; -;; Modified 4-apr-94 by jwz: merged in Tibor Polgar's code for manpath.conf. -;; -;; Modified 19-apr-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for -;; $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 -;; backwards. -;; -;; Modified 23-aug-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for -;; 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. -;; -;; Modified 29-nov-94 by Ben Wing <wing@spg.amdahl.com>: small fixes -;; that should hopefully make things work under HPUX and IRIX.; -;; -;; Modified 15-jul-95 by Dale Atems <atems@physics.wayne.edu>: -;; some extensive rewriting to make things work right (more or less) -;; under IRIX. -;; ;; This file defines "manual-entry", and the remaining definitions all ;; begin with "Manual-". This makes the autocompletion on "M-x man" work. -;; -;; Variables of interest: +;; +;; Eviscerated 26-Jun-96 by Jamie Zawinski <jwz@netscape.com>. +;; All that stuff about looking at $MANPATH and building up lists of +;; directories was bullshit. Now we just invoke "man" and format the +;; output, end of story. ;; -;; Manual-program -;; Manual-topic-buffer -;; Manual-buffer-view-mode -;; Manual-directory-list -;; Manual-formatted-directory-list -;; Manual-match-topic-exactly -;; Manual-query-multiple-pages -;; Manual-page-history -;; Manual-subdirectory-list -;; Manual-man-page-section-ids -;; Manual-formatted-page-prefix -;; Manual-unformatted-page-prefix -;; Manual-use-full-section-ids +;; [ older changelog entries removed, since they're all about code that +;; I've deleted. ] (defvar Manual-program "man" "\ *Name of the program to invoke in order to format the source man pages.") -(defvar Manual-section-switch (if (eq system-type 'usg-unix-v) "-s" nil) - "SysV needs this to work right.") - -(defvar Manual-topic-buffer t "\ -*Non-nil means \\[Manual-entry] should output the manual entry for TOPIC into -a buffer named *man TOPIC*, otherwise, it should name the buffer -*Manual Entry*.") - (defvar Manual-buffer-view-mode t "\ *Whether manual buffers should be placed in view-mode. nil means leave the buffer in fundamental-mode in another window. t means use `view-buffer' to display the man page in the current window. Any other value means use `view-buffer-other-window'.") -(defvar Manual-match-topic-exactly t "\ -*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\" -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), -since the \"man\" command always does exact topic matches.") - -(defvar Manual-query-multiple-pages nil "\ -*Non-nil means that \\[manual-entry] will query the user about multiple man -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 -topic given to \\[manual-entry] will be inserted into the temporary buffer. -See the variable \"Manual-match-topic-exactly\" to control the matching.") - -(defvar Manual-unique-man-sections-only nil - "*Only present one man page per section. This variable is useful if the same or -up/down level man pages for the same entry are present in mulitple man paths. -When set to t, only the first entry found in a section is displayed, the others -are ignored without any messages or warnings. Note that duplicates can occur if -the system has both formatted and unformatted version of the same page.") - (defvar Manual-mode-hook nil "Function or functions run on entry to Manual-mode.") -(defvar Manual-directory-list nil "\ -*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, -it is initialized by \\[Manual-directory-list-init].") - -(defvar Manual-formatted-directory-list nil "\ -A list of directories containing formatted man pages. Initialized by -\\[Manual-directory-list-init].") - -(defvar Manual-unformatted-directory-list nil "\ -A list of directories containing the unformatted (source) man pages. -Initialized by \\[Manual-directory-list-init].") - (defvar Manual-page-history nil "\ A list of names of previously visited man page buffers.") -(defvar Manual-manpath-config-file "/usr/lib/manpath.config" - "*Location of the manpath.config file, if any.") - -(defvar Manual-apropos-switch "-k" - "*Man apropos switch") ;; New variables. -(defvar Manual-subdirectory-list nil "\ -A list of all the subdirectories in which man pages may be found. -Iniialized by Manual-directory-list-init.") - -;; This is for SGI systems; don't know what it should be otherwise. -(defvar Manual-man-page-section-ids "1nl6823457poD" "\ -String containing all suffix characters for \"cat\" and \"man\" -that identify valid sections of the Un*x manual.") - -(defvar Manual-formatted-page-prefix "cat" "\ -Prefix for directories where formatted man pages are to be found. -Defaults to \"cat\".") - -(defvar Manual-unformatted-page-prefix "man" "\ -Prefix for directories where unformatted man pages are to be found. -Defaults to \"man\".") - -(defvar Manual-leaf-signature "" "\ -Regexp for identifying \"leaf\" subdirectories in the search path. -If empty, initialized by Manual-directory-list-init.") - -(defvar Manual-use-full-section-ids t "\ -If non-nil, pass full section ids to Manual-program, otherwise pass -only the first character. Defaults to 't'.") - -(defvar Manual-use-subdirectory-list (eq system-type 'irix) "\ -This makes manual-entry work correctly on SGI machines but it -imposes a large startup cost which is why it is not simply on by -default on all systems.") - (defvar Manual-use-rosetta-man (not (null (locate-file "rman" exec-path))) "\ If non-nil, use RosettaMan (rman) to filter man pages. This makes man-page cleanup virtually instantaneous, instead of @@ -259,108 +136,17 @@ (or (face-differs-from-default-p 'man-xref) (set-face-underline-p 'man-xref t)) -;; Manual-directory-list-init -;; Initialize the directory lists. - -(defun Manual-directory-list-init (&optional arg) - "Initialize the Manual-directory-list variable from $MANPATH -if it is not already set, or if a prefix argument is provided." - (interactive "P") - (if arg (setq Manual-directory-list nil)) - (if (null Manual-directory-list) - (let ((manpath (getenv "MANPATH")) - (global (Manual-manpath-config-contents)) - (dirlist nil) - dir) - (cond ((and manpath global) - (setq manpath (concat manpath ":" global))) - (global - (setq manpath global)) - ((not manpath) - ;; XEmacs - (bpw/stig) Unix-specifix hack for lusers w/ no manpath - (setq manpath "/usr/local/man:/usr/share/man:/usr/contrib/man:/usr/X11/man:/usr/man:/usr/catman"))) - ;; Make sure that any changes we've made internally are seen by man. - (setenv "MANPATH" manpath) - (while (string-match "\\`:*\\([^:]+\\)" manpath) - (setq dir (substring manpath (match-beginning 1) (match-end 1))) - (and (not (member dir dirlist)) - (setq dirlist (cons dir dirlist))) - (setq manpath (substring manpath (match-end 0)))) - (setq dirlist (nreverse dirlist)) - (setq Manual-directory-list dirlist) - (setq Manual-subdirectory-list nil) - (setq Manual-formatted-directory-list nil) - (setq Manual-unformatted-directory-list nil))) - (if (string-equal Manual-leaf-signature "") - (setq Manual-leaf-signature - (concat "/\\(" - Manual-formatted-page-prefix - "\\|" Manual-unformatted-page-prefix - "\\)" - "[" Manual-man-page-section-ids - "].?/."))) - (if Manual-use-subdirectory-list - (progn - (if (null Manual-subdirectory-list) - (setq Manual-subdirectory-list - (Manual-all-subdirectories Manual-directory-list - Manual-leaf-signature nil))) - (if (null Manual-formatted-directory-list) - (setq Manual-formatted-directory-list - (Manual-filter-subdirectories Manual-subdirectory-list - Manual-formatted-page-prefix))) - (if (null Manual-unformatted-directory-list) - (setq Manual-unformatted-directory-list - (Manual-filter-subdirectories Manual-subdirectory-list - Manual-unformatted-page-prefix)))) - (if (null Manual-formatted-directory-list) - (setq Manual-formatted-directory-list - (Manual-select-subdirectories Manual-directory-list - Manual-formatted-page-prefix))) - (if (null Manual-unformatted-directory-list) - (setq Manual-unformatted-directory-list - (Manual-select-subdirectories Manual-directory-list - Manual-unformatted-page-prefix))))) - - -(defun Manual-manpath-config-contents () - "Parse the `Manual-manpath-config-file' file, if any. -Returns a string like in $MANPATH." - (if (and Manual-manpath-config-file - (file-readable-p Manual-manpath-config-file)) - (let ((buf (get-buffer-create " *Manual-config*")) - path) - (set-buffer buf) - (buffer-disable-undo buf) - (erase-buffer) - (insert-file-contents Manual-manpath-config-file) - (while (re-search-forward "^\\(MANDATORY_MANPATH\\|MANPATH_MAP\\)" - nil t) - (and (re-search-forward "\\(/[^ \t\n]+\\)[ \t]*$") - (setq path (concat path (buffer-substring (match-beginning 1) - (match-end 1)) - ":")))) - (kill-buffer buf) - path))) -;; -;; manual-entry -- The "main" user function -;; +(defvar Manual-mode-map + (let ((m (make-sparse-keymap))) + (set-keymap-name m 'Manual-mode-map) + (define-key m "l" 'Manual-last-page) + (define-key m 'button2 'Manual-follow-xref) + (define-key m 'button3 'Manual-popup-menu) + m)) ;;;###autoload (defun manual-entry (topic &optional arg silent) - "Display the Unix manual entry (or entries) for TOPIC. -If prefix arg is given, modify the search according to the value: - 2 = complement default exact matching of the TOPIC name; - exact matching default is specified by `Manual-match-topic-exactly' - 3 = force a search of the unformatted man directories - 4 = both 2 and 3 -The manual entries are searched according to the variable -Manual-directory-list, which should be a list of directories. If -Manual-directory-list is nil, \\[Manual-directory-list-init] is -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." + "Display the Unix manual entry (or entries) for TOPIC." (interactive (list (let* ((fmh "-A-Za-z0-9_.") (default (save-excursion @@ -376,18 +162,11 @@ (prefix-numeric-value current-prefix-arg))) ;;(interactive "sManual entry (topic): \np") (or arg (setq arg 1)) - (Manual-directory-list-init nil) - (let ((exact (if (or (= arg 2) (= arg 4)) - (not Manual-match-topic-exactly) - Manual-match-topic-exactly)) - (force (if (>= arg 3) - t - nil)) - section fmtlist manlist apropos-mode) + (let (section apropos-mode) (let ((case-fold-search nil)) (if (and (null section) - (string-match - "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic)) + (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" + topic)) (setq section (substring topic (match-beginning 2) (match-end 2)) topic (substring topic (match-beginning 1) @@ -395,206 +174,79 @@ (if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic) (setq section "-k" topic (substring topic (match-beginning 1)))))) + + ;; jwz: turn section "3x11" and "3n" into "3". + (if (and section (string-match "\\`\\([0-9]+\\)[^0-9]" section)) + (setq section (substring section 0 (match-end 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))))) + (setq apropos-mode t)) - (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)))) + (let ((bufname (cond (apropos-mode + (concat "*man apropos " topic "*")) + (t + (concat "*man " topic + (if section (concat "." section) "") + "*")))) + (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)))) + (cond ((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) -(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)) + (let ((args (list topic)) + args-string) + (if section + (setq args + (if (eq system-type 'usg-unix-v) + (cons "-s" (cons section args)) + (cons section args)))) + (setq args-string + (mapconcat 'identity (cons Manual-program args) " ")) + (if (string-match "\\`\\([^ \t/]*/\\)+" args-string) + (setq args-string + (substring args-string (match-end 0)))) -(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 - (message "Cleaning manual entry for %s..." - (file-name-nondirectory name)) - (narrow-to-region start end) - (Manual-nuke-nroff-bs) - (goto-char (point-min)) - (insert "File: " name "\n") - (goto-char (point-max)) - )) - (if (or (cdr fmtlist) manlist) - (insert "\n\n" sep "\n")) - (setq fmtlist (cdr fmtlist))) + (message "%s (running...)" args-string) + (apply 'call-process Manual-program nil t nil args) - (while manlist ; process any unformatted files - (setq name (car manlist)) - (or (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\(\\.gz\\'\\)" name) - (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\'" name)) - (setq topic (substring name (match-beginning 1) (match-end 1))) - (setq section (substring name (match-beginning 2) (match-end 2))) - ;; This won't work under IRIX, because SGI man accepts only the - ;; "main" (one-character) section id, not full section ids - ;; like 1M, 3X, etc. Put (setq Manual-use-full-section-ids nil) - ;; in your .emacs to work around this problem. - (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 - (message "Cleaning manual entry for %s(%s)..." topic section) - (narrow-to-region start end) - (Manual-nuke-nroff-bs apropos-mode) - (goto-char (point-min)) - (insert "File: " name "\n") - (goto-char (point-max)) - )) - (if (cdr manlist) - (insert "\n\n" sep "\n")) - (setq manlist (cdr manlist)))) - (if (< (buffer-size) 200) - (progn - (goto-char (point-min)) - (if (looking-at "^File: ") - (forward-line 1)) - (error (buffer-substring (point) (progn (end-of-line) (point)))))) - nil) + (if (< (buffer-size) 200) + (progn + (goto-char (point-min)) + (error (buffer-substring (point) + (progn (end-of-line) + (point)))))) + (message "%s (cleaning...)" args-string) + (Manual-nuke-nroff-bs apropos-mode) + (message "%s (done.)" args-string) + ) -(defun Manual-run-formatter (name topic section) - (cond ((string-match "roff\\'" Manual-program) - ;; kludge kludge - (call-process Manual-program nil t nil "-Tman" "-man" name)) - (Manual-section-switch - (call-process Manual-program nil t nil Manual-section-switch - section topic)) - (t - (call-process Manual-program nil t nil section topic)))) - - -(defvar Manual-mode-map - (let ((m (make-sparse-keymap))) - (set-keymap-name m 'Manual-mode-map) - (define-key m "l" 'Manual-last-page) - (define-key m 'button2 'Manual-follow-xref) - (define-key m 'button3 'Manual-popup-menu) - m)) + (set-buffer-modified-p nil) + (Manual-mode) + )))) + (setq Manual-page-history + (cons (buffer-name) + (delete (buffer-name) Manual-page-history))))) + (message nil) + t) (defun Manual-mode () (kill-all-local-variables) @@ -607,8 +259,7 @@ ;; overran by a couple of chars. (setq truncate-lines t) ;; turn off horizontal scrollbars in this buffer - (when (featurep 'scrollbar) - (set-specifier scrollbar-height (cons (current-buffer) 0))) + (set-specifier scrollbar-height (cons (current-buffer) 0)) (run-hooks 'Manual-mode-hook)) (defun Manual-last-page () @@ -620,225 +271,6 @@ (switch-to-buffer (car Manual-page-history))) -;; Manual-select-subdirectories -;; Given a DIRLIST and a SUBDIR name, return all subdirectories of the former which -;; match the latter. - -(defun Manual-select-subdirectories (dirlist subdir) - (let ((dirs '()) - (case-fold-search nil) - (match (concat "\\`" (regexp-quote subdir))) - d) - (while dirlist - (setq d (car dirlist) dirlist (cdr dirlist)) - (if (file-directory-p d) - (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 - (let ((l '()) - ;;(match (concat (substring section 0 1) "/?\\'")) - ;; ^^^ - ;; We'll lose any pages inside subdirectories of the "standard" - ;; ones if we insist on this! The following regexp should - ;; match any directory ending with the full section id or - ;; its first character, or any direct subdirectory thereof: - (match (concat "\\(" - (regexp-quote section) - "\\|" - (substring section 0 1) - "\\)/?")) - d) - (while dirlist - (setq d (car dirlist) dirlist (cdr dirlist)) - (if (string-match match d) - (setq l (cons d l)))) - (setq dirlist l))) - (if shadow - (setq shadow (concat "/\\(" - (mapconcat #'(lambda (n) - (regexp-quote - (file-name-nondirectory n))) - shadow - "\\|") - "\\)\\'"))) - (let ((manlist '()) - (match (concat "\\`" - (regexp-quote topic) - ;; **Note: on IRIX the preformatted pages - ;; are packed, so they end with ".z". This - ;; way you miss them if you specify a - ;; section. I don't see any point to it here - ;; even on BSD systems since we're looking - ;; one level down already, but I can't test - ;; this. More thought needed (???) - - (cond ((and section - (not Manual-use-subdirectory-list)) - (concat "\\." (regexp-quote section))) - (exact - ;; If Manual-match-topic-exactly is - ;; set, then we must make sure the - ;; completions are exact, except for - ;; trailing weird characters after - ;; the section. - "\\.") - (t - "")))) - dir) - (while dirlist - (setq dir (car dirlist) dirlist (cdr dirlist)) - (if (not (file-directory-p dir)) - (progn - (message "warning: %s is not a directory" dir) - ;;(sit-for 1) - ) - (let ((files (directory-files dir t match nil t)) - f) - (while files - (setq f (car files) files (cdr files)) - (cond ((string-match Manual-bogus-file-pattern f) - ;(message "Bogus fule %s" f) (sit-for 2) - ) - ((and shadow (string-match shadow f)) - ;(message "Shadowed %s" f) (sit-for 2) - ) - ((not (file-readable-p f)) - ;(message "Losing with %s" f) (sit-for 2) - ) - (t - (setq manlist (cons f manlist)))))))) - (setq manlist (nreverse manlist)) - (and Manual-unique-man-sections-only - (setq manlist (Manual-clean-to-unique-pages-only manlist))) - (if (and manlist Manual-query-multiple-pages) - (apply #'append - (mapcar #'(lambda (page) - (and page - (y-or-n-p (format "Read %s? " page)) - (list page))) - manlist)) - manlist)))) - -(defun Manual-clean-to-unique-pages-only (manlist) - "Prune the current list of pages down to a unique set." - (let (page-name unique-pages) - (apply 'append - (mapcar '(lambda (page) - (cond (page - (and (string-match ".*/\\(.*\\)" page) - (setq page-name (substring page (match-beginning 1) - (match-end 1))) - ;; try to clip off .Z, .gz suffixes - (and (string-match "\\(.*\\)\\.\\(.+\\)\\.\\(.+\\)" - page-name) - (setq page-name - (substring page-name (match-beginning 1) - (match-end 2))))) - ;; add Manual-unique-pages if it isn't there - ;; and return file - (if (and unique-pages - page-name - (string-match (concat "\\b" page-name "\\b") - unique-pages)) - nil - (setq unique-pages (concat unique-pages - page-name - " ")) - (list page))))) - manlist)))) - - - -(defun Manual-insert-man-file (name) - ;; Insert manual file (unpacked as necessary) into buffer - (cond ((equal (substring name -3) ".gz") - (call-process "gunzip" nil t nil "--stdout" name)) - ((or (equal (substring name -2) ".Z") - ;; HPUX uses directory names that end in .Z and compressed - ;; files that don't. How gratuitously random. - (let ((case-fold-search nil)) - (string-match "\\.Z/" name))) - (call-process "zcat" name t nil)) ;; XEmacs change for HPUX - ((equal (substring name -2) ".z") - (call-process "pcat" nil t nil name)) - (t - (insert-file-contents name)))) - (defmacro Manual-delete-char (n) ;; in v19, delete-char is compiled as a function call, but delete-region ;; is byte-coded, so it's much faster. (We were spending 40% of our time @@ -855,9 +287,10 @@ ;; (goto-char (point-min)) (while (search-forward "_\b" nil t) - ;; searching for underscore-backspace and then comparing the following - ;; chars until the sequence ends turns out to be much faster than searching - ;; for a regexp which matches the whole sequence. + ;; searching for underscore-backspace and then comparing the + ;; following chars until the sequence ends turns out to be much + ;; faster than searching for a regexp which matches the whole + ;; sequence. (let ((s (match-beginning 0))) (goto-char s) (while (and (= (following-char) ?_) @@ -928,7 +361,7 @@ (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") @@ -1036,53 +469,6 @@ (delete-region (point) p)) )) -;(defun Manual-nuke-nroff-bs-footers () -; ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)" -; (goto-char (point-min)) -; (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Za-z]+)\\).*\\1$" nil t) -; (replace-match "")) -; -; ;; -; ;; it would appear that we have a choice between sometimes introducing -; ;; an extra blank line when a paragraph was broken by a footer, and -; ;; sometimes not putting in a blank line between two paragraphs when -; ;; a footer appeared right between them. FMH; I choose the latter. -; ;; -; -; ;; Nuke footers: "Printed 12/3/85 27 April 1981 1" -; ;; Sun appear to be on drugz: -; ;; "Sun Release 3.0B Last change: 1 February 1985 1" -; ;; HP are even worse! -; ;; " Hewlett-Packard -1- (printed 12/31/99)" FMHWA12ID!! -; ;; System V (well WICATs anyway): -; ;; "Page 1 (printed 7/24/85)" -; ;; Who is administering PCP to these corporate bozos? -; (goto-char (point-min)) -; (while (re-search-forward -; (cond -; ((eq system-type 'hpux) -; "\n\n?[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*\n") -; ((eq system-type 'dgux-unix) -; "\n\n?[ \t]*Licensed material--.*Page [0-9]*\n") -; ((eq system-type 'usg-unix-v) -; "\n\n? *Page [0-9]*.*(printed [0-9/]*)\n") -; (t -; "\n\n?\\(Printed\\|Sun Release\\) [0-9].*[0-9]\n")) -; nil t) -; (replace-match "")) -; -; ;; Also, hack X footers: -; ;; "X Version 11 Last change: Release 5 1" -; (goto-char (point-min)) -; (while (re-search-forward "\n\n?X Version [^\n]+\n" nil t) -; (replace-match "")) -; -; ;; Crunch blank lines -; (goto-char (point-min)) -; (while (re-search-forward "\n\n\n\n*" nil t) -; (replace-match "\n\n")) -; ) - (defun Manual-mouseify-xrefs () (goto-char (point-min)) (forward-line 1) @@ -1131,20 +517,18 @@ (if (eq (car-safe data) 'Manual-follow-xref) (eval data) (error "no manual cross-reference there."))) - (let ((Manual-match-topic-exactly t) - (Manual-query-multiple-pages nil)) - (or (manual-entry name-or-event) - ;; If that didn't work, maybe it's in a different section than the - ;; man page writer expected. For example, man pages tend assume - ;; that all user programs are in section 1, but X tends to generate - ;; makefiles that put things in section "n" instead... - (and (string-match "[ \t]*([^)]+)\\'" name-or-event) - (progn - (message "No entries found for %s; checking other sections..." - name-or-event) - (manual-entry - (substring name-or-event 0 (match-beginning 0)) - nil t))))))) + (or (manual-entry name-or-event) + ;; If that didn't work, maybe it's in a different section than the + ;; man page writer expected. For example, man pages tend assume + ;; that all user programs are in section 1, but X tends to generate + ;; makefiles that put things in section "n" instead... + (and (string-match "[ \t]*([^)]+)\\'" name-or-event) + (progn + (message "No entries found for %s; checking other sections..." + name-or-event) + (manual-entry + (substring name-or-event 0 (match-beginning 0)) + nil t)))))) (defun Manual-popup-menu (&optional event) "Pops up a menu of cross-references in this manual page. @@ -1185,9 +569,8 @@ (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))) + (if (or (string-match "^/tmp/man[0-9]+" buf-name) + (string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name)) (let (buffer manpage) (require 'man) (goto-char (point-min)) @@ -1197,7 +580,8 @@ (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 (buffer-substring (match-beginning 1) + (match-end 1))) (setq manpage "???")) (setq buffer (rename-buffer