X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6c5acd7fbb603fd242162ad2326ebafb7c37d2ab..3db571c0d71c8d568ff54786606cccad2b138ddc:/lisp/man.el diff --git a/lisp/man.el b/lisp/man.el index a3085e4150..60fc7c009e 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,6 +1,7 @@ ;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, +;; 2004, 2005 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw ;; Maintainer: FSF @@ -21,8 +22,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -94,6 +95,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'assoc) (require 'button) @@ -153,6 +155,11 @@ the manpage buffer." :type 'face :group 'man) +(defcustom Man-reverse-face 'highlight + "*Face to use when fontifying reverse video." + :type 'face + :group 'man) + ;; Use the value of the obsolete user option Man-notify, if set. (defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly) "*Selects the behavior when manpage is ready. @@ -175,6 +182,17 @@ Any other value of `Man-notify-method' is equivalent to `meek'." (const polite) (const quiet) (const meek)) :group 'man) +(defcustom Man-width nil + "*Number of columns for which manual pages should be formatted. +If nil, the width of the window selected at the moment of man +invocation is used. If non-nil, the width of the frame selected +at the moment of man invocation is used. The value also can be a +positive integer." + :type '(choice (const :tag "Window width" nil) + (const :tag "Frame width" t) + (integer :tag "Specific width" :value 65)) + :group 'man) + (defcustom Man-frame-parameters nil "*Frame parameter list for creating a new frame for a manual page." :type 'sexp @@ -241,7 +259,7 @@ the associated section number." (defvar Man-cooked-hook nil "Hook run after removing backspaces but before `Man-mode' processing.") -(defvar Man-name-regexp "[-a-zA-Z0-9_­+][-a-zA-Z0-9_.­+]*" +(defvar Man-name-regexp "[-a-zA-Z0-9_­+][-a-zA-Z0-9_.:­+]*" "Regular expression describing the name of a manpage (without section).") (defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]" @@ -317,6 +335,12 @@ make -a one of the switches, if your `man' program supports it.") "") "Option that indicates a specified a manual section name.") +(defvar Man-support-local-filenames 'auto-detect + "Internal cache for the value of the function `Man-support-local-filenames'. +`auto-detect' means the value is not yet determined. +Otherwise, the value is whatever the function +`Man-support-local-filenames' should return.") + ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ;; end user variables @@ -328,6 +352,7 @@ make -a one of the switches, if your `man' program supports it.") (make-variable-buffer-local 'Man-page-mode-string) (make-variable-buffer-local 'Man-original-frame) (make-variable-buffer-local 'Man-arguments) +(put 'Man-arguments 'permanent-local t) (setq-default Man-sections-alist nil) (setq-default Man-refpages-alist nil) @@ -363,13 +388,15 @@ make -a one of the switches, if your `man' program supports it.") (let ((table (copy-syntax-table (standard-syntax-table)))) (modify-syntax-entry ?. "w" table) (modify-syntax-entry ?_ "w" table) + (modify-syntax-entry ?: "w" table) ; for PDL::Primitive in Perl man pages table) "Syntax table used in Man mode buffers.") -(if Man-mode-map - nil - (setq Man-mode-map (copy-keymap button-buffer-map)) +(unless Man-mode-map + (setq Man-mode-map (make-sparse-keymap)) (suppress-keymap Man-mode-map) + (set-keymap-parent Man-mode-map button-buffer-map) + (define-key Man-mode-map " " 'scroll-up) (define-key Man-mode-map "\177" 'scroll-down) (define-key Man-mode-map "n" 'Man-next-section) @@ -385,19 +412,20 @@ make -a one of the switches, if your `man' program supports it.") (define-key Man-mode-map "k" 'Man-kill) (define-key Man-mode-map "q" 'Man-quit) (define-key Man-mode-map "m" 'man) - (define-key Man-mode-map "?" 'describe-mode) - ) + (define-key Man-mode-map "?" 'describe-mode)) ;; buttons (define-button-type 'Man-xref-man-page 'action (lambda (button) (man-follow (button-label button))) - 'help-echo "RET, mouse-2: display this man page") + 'follow-link t + 'help-echo "mouse-2, RET: display this man page") (define-button-type 'Man-xref-header-file 'action (lambda (button) (let ((w (button-get button 'Man-target-string))) (unless (Man-view-header-file w) (error "Cannot find header file: %s" w)))) + 'follow-link t 'help-echo "mouse-2: display this header file") (define-button-type 'Man-xref-normal-file @@ -409,14 +437,15 @@ make -a one of the switches, if your `man' program supports it.") (view-file f) (error "Cannot read a file: %s" f)) (error "Cannot find a file: %s" f)))) - 'help-echo "mouse-2: mouse-2: display this file") + 'follow-link t + 'help-echo "mouse-2: display this file") ;; ====================================================================== ;; utilities (defun Man-init-defvars () - "Used for initialising variables based on display's color support. + "Used for initializing variables based on display's color support. This is necessary if one wants to dump man.el with Emacs." ;; Avoid possible error in call-process by using a directory that must exist. @@ -425,9 +454,9 @@ This is necessary if one wants to dump man.el with Emacs." (cond (Man-fontify-manpage-flag nil) - ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script)) + ((eq 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script)) Man-sysv-sed-script) - ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script)) + ((eq 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script)) Man-berkeley-sed-script) (t nil)))) @@ -486,13 +515,15 @@ This is necessary if one wants to dump man.el with Emacs." (defsubst Man-build-man-command () "Builds the entire background manpage and cleaning command." (let ((command (concat manual-program " " Man-switches - ; Stock MS-DOS shells cannot redirect stderr; - ; `call-process' below sends it to /dev/null, - ; so we don't need `2>' even with DOS shells - ; which do support stderr redirection. - (if (not (fboundp 'start-process)) - " %s" - (concat " %s 2>" null-device)))) + (cond + ;; Already has %s + ((string-match "%s" manual-program) "") + ;; Stock MS-DOS shells cannot redirect stderr; + ;; `call-process' below sends it to /dev/null, + ;; so we don't need `2>' even with DOS shells + ;; which do support stderr redirection. + ((not (fboundp 'start-process)) " %s") + ((concat " %s 2>" null-device))))) (flist Man-filter-list)) (while (and flist (car flist)) (let ((pcom (car (car flist))) @@ -522,8 +553,8 @@ This is necessary if one wants to dump man.el with Emacs." (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)." +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)) @@ -555,6 +586,31 @@ and the Man-section-translations-alist variables)." slist nil)))) (concat Man-specified-section-option section " " name)))) +(defun Man-support-local-filenames () + "Check the availability of `-l' option of the man command. +This option allows `man' to interpret command line arguments +as local filenames. +Return the value of the variable `Man-support-local-filenames' +if it was set to nil or t before the call of this function. +If t, the man command supports `-l' option. If nil, it doesn't. +Otherwise, if the value of `Man-support-local-filenames' +is neither t nor nil, then determine a new value, set it +to the variable `Man-support-local-filenames' and return +a new value." + (if (or (not Man-support-local-filenames) + (eq Man-support-local-filenames t)) + Man-support-local-filenames + (setq Man-support-local-filenames + (with-temp-buffer + (and (equal (condition-case nil + (call-process manual-program nil t nil "--help") + (error nil)) + 0) + (progn + (goto-char (point-min)) + (search-forward "--local-file" nil t)) + t))))) + ;; ====================================================================== ;; default man entry: get word under point @@ -572,9 +628,11 @@ This guess is based on the text surrounding the cursor." (setq word (buffer-substring-no-properties start (point)))) (if (string-match "[._]+$" word) (setq word (substring word 0 (match-beginning 0)))) + ;; If looking at something like *strcat(... , remove the '*' + (if (string-match "^*" word) + (setq word (substring word 1))) ;; If looking at something like ioctl(2) or brc(1M), include the ;; section number in the returned value. Remove text properties. - (forward-word 1) (concat word (if (looking-at (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) @@ -641,6 +699,7 @@ all sections related to a subject, put something appropriate into the (setq buffer (generate-new-buffer bufname)) (save-excursion (set-buffer buffer) + (setq buffer-undo-list t) (setq Man-original-frame (selected-frame)) (setq Man-arguments man-args)) (let ((process-environment (copy-sequence process-environment)) @@ -677,15 +736,25 @@ all sections related to a subject, put something appropriate into the ;; This isn't strictly correct, since we don't know how ;; the page will actually be displayed, but it seems ;; reasonable. - (setenv "COLUMNS" (number-to-string (frame-width))))) + (setenv "COLUMNS" (number-to-string + (cond + ((and (integerp Man-width) (> Man-width 0)) + Man-width) + (Man-width (frame-width)) + ((window-width))))))) (setenv "GROFF_NO_SGR" "1") (if (fboundp 'start-process) (set-process-sentinel - (start-process manual-program buffer "sh" "-c" + (start-process manual-program buffer + (if (memq system-type '(cygwin windows-nt)) + shell-file-name + "sh") + shell-command-switch (format (Man-build-man-command) man-args)) 'Man-bgproc-sentinel) (let ((exit-status - (call-process shell-file-name nil (list buffer nil) nil "-c" + (call-process shell-file-name nil (list buffer nil) nil + shell-command-switch (format (Man-build-man-command) man-args))) (msg "")) (or (and (numberp exit-status) @@ -755,56 +824,89 @@ See the variable `Man-notify-method' for the different notification behaviors." "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)) - (if (< (buffer-size) (position-bytes (point-max))) - ;; Multibyte characters exist. - (progn - (goto-char (point-min)) - (while (search-forward "__\b\b" nil t) - (backward-delete-char 4) - (put-text-property (point) (1+ (point)) 'face Man-underline-face)) - (goto-char (point-min)) - (while (search-forward "\b\b__" nil t) - (backward-delete-char 4) - (put-text-property (1- (point)) (point) 'face Man-underline-face)))) - (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)) + (message "Please wait: formatting the %s man page..." Man-arguments) (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)) - (goto-char (point-min)) - ;; Try to recognize common forms of cross references. - (Man-highlight-references) - (Man-softhyphen-to-minus) - (message "%s man page made up" Man-arguments)) + ;; Fontify ANSI escapes. + (let ((faces nil) + (buffer-undo-list t) + (start (point))) + ;; http://www.isthe.com/chongo/tech/comp/ansi_escapes.html + ;; suggests many codes, but we only handle: + ;; ESC [ 00 m reset to normal display + ;; ESC [ 01 m bold + ;; ESC [ 04 m underline + ;; ESC [ 07 m reverse-video + ;; ESC [ 22 m no-bold + ;; ESC [ 24 m no-underline + ;; ESC [ 27 m no-reverse-video + (while (re-search-forward "\e\\[0?\\([1470]\\|2\\([247]\\)\\)m" nil t) + (if faces (put-text-property start (match-beginning 0) 'face + (if (cdr faces) faces (car faces)))) + (setq faces + (cond + ((match-beginning 2) + (delq (case (char-after (match-beginning 2)) + (?2 Man-overstrike-face) + (?4 Man-underline-face) + (?7 Man-reverse-face)) + faces)) + ((eq (char-after (match-beginning 1)) ?0) nil) + (t + (cons (case (char-after (match-beginning 1)) + (?1 Man-overstrike-face) + (?4 Man-underline-face) + (?7 Man-reverse-face)) + faces)))) + (delete-region (match-beginning 0) (match-end 0)) + (setq start (point)))) + ;; Other highlighting. + (let ((buffer-undo-list t)) + (if (< (buffer-size) (position-bytes (point-max))) + ;; Multibyte characters exist. + (progn + (goto-char (point-min)) + (while (search-forward "__\b\b" nil t) + (backward-delete-char 4) + (put-text-property (point) (1+ (point)) 'face Man-underline-face)) + (goto-char (point-min)) + (while (search-forward "\b\b__" nil t) + (backward-delete-char 4) + (put-text-property (1- (point)) (point) 'face Man-underline-face)))) + (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)) + (goto-char (point-min)) + ;; Try to recognize common forms of cross references. + (Man-highlight-references) + (Man-softhyphen-to-minus) + (goto-char (point-min)) + (while (re-search-forward Man-heading-regexp nil t) + (put-text-property (match-beginning 0) + (match-end 0) + 'face Man-overstrike-face))) + (message "%s man page formatted" Man-arguments)) (defun Man-highlight-references () "Highlight the references on mouse-over. -references include items in the SEE ALSO section, -header file(#include ) and files in FILES" +References include items in the SEE ALSO section, +header file (#include ) and files in FILES." (let ((dummy 0)) (Man-highlight-references0 Man-see-also-regexp Man-reference-regexp 1 dummy @@ -832,12 +934,15 @@ header file(#include ) and files in FILES" 'Man-target-string (match-string target-pos) ))))) -(defun Man-cleanup-manpage () - "Remove overstriking and underlining from the current buffer." - (interactive) +(defun Man-cleanup-manpage (&optional interactive) + "Remove overstriking and underlining from the current buffer. +Normally skip any jobs that should have been done by the sed script, +but when called interactively, do those jobs even if the sed +script would have done them." + (interactive "p") (message "Please wait: cleaning up the %s man page..." Man-arguments) - (if (or (interactive-p) (not Man-sed-script)) + (if (or interactive (not Man-sed-script)) (progn (goto-char (point-min)) (while (search-forward "_\b" nil t) (backward-delete-char 2)) @@ -901,8 +1006,15 @@ manpage command." (if Man-fontify-manpage-flag (Man-fontify-manpage) (Man-cleanup-manpage)) + (run-hooks 'Man-cooked-hook) - (Man-mode) + (Man-mode) + + (if (not Man-page-list) + (let ((args Man-arguments)) + (kill-buffer (current-buffer)) + (error "Can't find the %s manpage" args))) + (set-buffer-modified-p nil) )) ;; Restore case-fold-search before calling @@ -919,6 +1031,8 @@ manpage command." ;; ====================================================================== ;; set up manual mode in buffer and build alists +(put 'Man-mode 'mode-class 'special) + (defun Man-mode () "A mode for browsing Un*x manual pages. @@ -957,6 +1071,7 @@ The following variables may be of some use. Try The following key bindings are currently in effect in the buffer: \\{Man-mode-map}" (interactive) + (kill-all-local-variables) (setq major-mode 'Man-mode mode-name "Man" buffer-auto-save-file-name nil @@ -965,15 +1080,18 @@ The following key bindings are currently in effect in the buffer: " {" 'Man-page-mode-string "}") truncate-lines t buffer-read-only t) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (auto-fill-mode -1) (use-local-map Man-mode-map) (set-syntax-table man-mode-syntax-table) + (setq imenu-generic-expression (list (list nil Man-heading-regexp 0))) + (set (make-local-variable 'outline-regexp) Man-heading-regexp) + (set (make-local-variable 'outline-level) (lambda () 1)) (Man-build-page-list) (Man-strip-page-headers) (Man-unindent) - (Man-goto-page 1) - (run-hooks 'Man-mode-hook)) + (Man-goto-page 1 t) + (run-mode-hooks 'Man-mode-hook)) (defsubst Man-build-section-alist () "Build the association list of manpage sections." @@ -1199,7 +1317,9 @@ Specify which REFERENCE to use; default is based on word at point." (error "There are no references in the current man page") (list (let* ((default (or (car (all-completions - (let ((word (Man-possibly-hyphenated-word))) + (let ((word + (or (Man-possibly-hyphenated-word) + ""))) ;; strip a trailing '-': (if (string-match "-$" word) (substring word 0 @@ -1230,35 +1350,32 @@ Specify which REFERENCE to use; default is based on word at point." (interactive) (quit-window)) -(defun Man-goto-page (page) +(defun Man-goto-page (page &optional noerror) "Go to the manual page on page PAGE." (interactive (if (not Man-page-list) - (let ((args Man-arguments)) - (kill-buffer (current-buffer)) - (error "Can't find the %s manpage" args)) + (error "Not a man page buffer") (if (= (length Man-page-list) 1) (error "You're looking at the only manpage in the buffer") (list (read-minibuffer (format "Go to manpage [1-%d]: " (length Man-page-list))))))) - (if (not Man-page-list) - (let ((args Man-arguments)) - (kill-buffer (current-buffer)) - (error "Can't find the %s manpage" args))) - (if (or (< page 1) - (> page (length Man-page-list))) - (error "No manpage %d found" page)) - (let* ((page-range (nth (1- page) Man-page-list)) - (page-start (car page-range)) - (page-end (car (cdr page-range)))) - (setq Man-current-page page - Man-page-mode-string (Man-make-page-mode-string)) - (widen) - (goto-char page-start) - (narrow-to-region page-start page-end) - (Man-build-section-alist) - (Man-build-references-alist) - (goto-char (point-min)))) + (if (and (not Man-page-list) (not noerror)) + (error "Not a man page buffer")) + (when Man-page-list + (if (or (< page 1) + (> page (length Man-page-list))) + (error "No manpage %d found" page)) + (let* ((page-range (nth (1- page) Man-page-list)) + (page-start (car page-range)) + (page-end (car (cdr page-range)))) + (setq Man-current-page page + Man-page-mode-string (Man-make-page-mode-string)) + (widen) + (goto-char page-start) + (narrow-to-region page-start page-end) + (Man-build-section-alist) + (Man-build-references-alist) + (goto-char (point-min))))) (defun Man-next-manpage () @@ -1305,4 +1422,5 @@ Specify which REFERENCE to use; default is based on word at point." (provide 'man) +;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47 ;;; man.el ends here