X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/72397ff1a9b0d94ccf77c9bda86bd37657d21ffc..9edfb3d2a1d7480ed6566c5e7b25036d9c47eb19:/lisp/man.el diff --git a/lisp/man.el b/lisp/man.el index c9d175466f..7222c1bad1 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,6 +1,6 @@ -;;; man.el --- browse UNIX manual pages +;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Barry A. Warsaw ;; Maintainer: FSF @@ -95,6 +95,7 @@ ;;; Code: (require 'assoc) +(require 'button) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; empty defvars (keep the compiler quiet) @@ -174,6 +175,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 @@ -210,6 +222,12 @@ the associated section number." (string :tag "Real Section"))) :group 'man) +(defcustom Man-header-file-path + '("/usr/include" "/usr/local/include") + "C Header file search path used in Man." + :type '(repeat string) + :group 'man) + (defvar manual-program "man" "The name of the program that produces man pages.") @@ -234,7 +252,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]" @@ -249,7 +267,7 @@ the associated section number." "(\\(" Man-section-regexp "\\))\\).*\\1")) "Regular expression describing the heading of a page.") -(defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$" +(defvar Man-heading-regexp "^\\([A-Z][A-Z -]+\\)$" "Regular expression describing a manpage heading entry.") (defvar Man-see-also-regexp "SEE ALSO" @@ -264,6 +282,34 @@ This regular expression should start with a `^' character.") (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))") "Regular expression describing a reference to another manpage.") +(defvar Man-synopsis-regexp "SYNOPSIS" + "Regular expression for SYNOPSIS heading (or your equivalent). +This regexp should not start with a `^' character.") + +(defvar Man-files-regexp "FILES" + "Regular expression for FILES heading (or your equivalent). +This regexp should not start with a `^' character.") + +(defvar Man-include-regexp "#[ \t]*include[ \t]*" + "Regular expression describing the #include (directive of cpp).") + +(defvar Man-file-name-regexp "[^<>\" \t\n]+" + "Regular expression describing <> in #include line (directive of cpp).") + +(defvar Man-normal-file-prefix-regexp "[/~$]" + "Regular expression describing a file path appeared in FILES section.") + +(defvar Man-header-regexp + (concat "\\(" Man-include-regexp "\\)" + "[<\"]" + "\\(" Man-file-name-regexp "\\)" + "[>\"]") + "Regular expression describing references to header files.") + +(defvar Man-normal-file-regexp + (concat Man-normal-file-prefix-regexp Man-file-name-regexp) + "Regular expression describing references to normal files.") + ;; This includes the section as an optional part to catch hyphenated ;; refernces to manpages. (defvar Man-hyphenated-reference-regexp @@ -282,6 +328,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 @@ -333,7 +385,7 @@ make -a one of the switches, if your `man' program supports it.") (if Man-mode-map nil - (setq Man-mode-map (make-keymap)) + (setq Man-mode-map (copy-keymap button-buffer-map)) (suppress-keymap Man-mode-map) (define-key Man-mode-map " " 'scroll-up) (define-key Man-mode-map "\177" 'scroll-down) @@ -350,11 +402,32 @@ 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 "\r" 'man-follow) - (define-key Man-mode-map [mouse-2] 'man-follow-mouse) (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") + +(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)))) + 'help-echo "mouse-2: display this header file") + +(define-button-type 'Man-xref-normal-file + 'action (lambda (button) + (let ((f (substitute-in-file-name + (button-get button 'Man-target-string)))) + (if (file-exists-p f) + (if (file-readable-p f) + (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") + ;; ====================================================================== ;; utilities @@ -369,9 +442,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)))) @@ -430,13 +503,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))) @@ -448,17 +523,30 @@ This is necessary if one wants to dump man.el with Emacs." (error "Malformed Man-filter-list")) phrase) pargs " "))) - (setq flist (cdr flist)))) + (setq flist (cdr flist)))) command)) + +(defun Man-translate-cleanup (string) + "Strip leading, trailing and middle spaces." + (when (stringp string) + ;; Strip leading and trailing + (if (string-match "^[ \t\f\r\n]*\\(.+[^ \t\f\r\n]\\)" string) + (setq string (match-string 1 string))) + ;; middle spaces + (setq string (replace-regexp-in-string "[\t\r\n]" " " string)) + (setq string (replace-regexp-in-string " +" " " string)) + string)) + (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)) + (section "") + (slist Man-section-translations-alist)) + (setq ref (Man-translate-cleanup ref)) (cond ;; "chmod(2V)" case ? ((string-match (concat "^" Man-reference-regexp "$") ref) @@ -486,6 +574,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 don'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 @@ -497,19 +610,21 @@ This guess is based on the text surrounding the cursor." (save-excursion ;; Default man entry title is any word the cursor is on, or if ;; cursor not on a word, then nearest preceding word. - (setq word (current-word)) + (skip-chars-backward "-a-zA-Z0-9._+:") + (let ((start (point))) + (skip-chars-forward "-a-zA-Z0-9._+:") + (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) - ;; Use `format' here to clear any text props from `word'. - (format "%s%s" - word + (concat word (if (looking-at (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) - (format "(%s)" (match-string 1)) - ""))))) + (format "(%s)" (match-string-no-properties 1))))))) ;; ====================================================================== @@ -519,6 +634,7 @@ This guess is based on the text surrounding the cursor." ;;;###autoload (defalias 'manual-entry 'man) + ;;;###autoload (defun man (man-args) "Get a Un*x manual page and put it in a buffer. @@ -559,13 +675,6 @@ all sections related to a subject, put something appropriate into the (error "No item under point") (man man-args))) -(defun man-follow-mouse (e) - "Get a Un*x manual page of the item under the mouse and put it in a buffer." - (interactive "e") - (save-excursion - (mouse-set-point e) - (call-interactively 'man-follow))) - (defun Man-getpage-in-background (topic) "Use TOPIC to build and fire off the manpage and cleaning command." (let* ((man-args topic) @@ -590,27 +699,54 @@ all sections related to a subject, put something appropriate into the (if default-enable-multibyte-characters locale-coding-system 'raw-text-unix)) ;; Avoid possible error by using a directory that always exists. - (default-directory "/")) + (default-directory + (if (and (file-directory-p default-directory) + (not (find-file-name-handler default-directory + 'file-directory-p))) + default-directory + "/"))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") + ;; In Debian Woody, at least, we get overlong lines under X + ;; unless COLUMNS or MANWIDTH is set. This isn't a problem on + ;; a tty. man(1) says: + ;; MANWIDTH + ;; If $MANWIDTH is set, its value is used as the line + ;; length for which manual pages should be formatted. + ;; If it is not set, manual pages will be formatted + ;; with a line length appropriate to the current ter- + ;; minal (using an ioctl(2) if available, the value of + ;; $COLUMNS, or falling back to 80 characters if nei- + ;; ther is available). + (if window-system + (unless (or (getenv "MANWIDTH") (getenv "COLUMNS")) + ;; 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 + (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" (format (Man-build-man-command) man-args)) 'Man-bgproc-sentinel) - (progn - (let ((exit-status - (call-process shell-file-name nil (list buffer nil) nil "-c" - (format (Man-build-man-command) man-args))) - (msg "")) - (or (and (numberp exit-status) - (= exit-status 0)) - (and (numberp exit-status) - (setq msg - (format "exited abnormally with code %d" - exit-status))) - (setq msg exit-status)) - (Man-bgproc-sentinel bufname msg)))))))) + (let ((exit-status + (call-process shell-file-name nil (list buffer nil) nil "-c" + (format (Man-build-man-command) man-args))) + (msg "")) + (or (and (numberp exit-status) + (= exit-status 0)) + (and (numberp exit-status) + (setq msg + (format "exited abnormally with code %d" + exit-status))) + (setq msg exit-status)) + (Man-bgproc-sentinel bufname msg))))))) (defun Man-notify-when-ready (man-buffer) "Notify the user when MAN-BUFFER is ready. @@ -656,7 +792,7 @@ See the variable `Man-notify-method' for the different notification behaviors." ))) (defun Man-softhyphen-to-minus () - ;; \255 is some kind of dash in Latin-N. Versions of Debian man, at + ;; \255 is SOFT HYPHEN in Latin-N. Versions of Debian man, at ;; least, emit it even when not in a Latin-N locale. (unless (eq t (compare-strings "latin-" 0 nil current-language-environment 0 6 t)) @@ -670,7 +806,7 @@ 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) + (message "Please wait: formatting the %s man page..." Man-arguments) (goto-char (point-min)) (while (search-forward "\e[1m" nil t) (delete-backward-char 4) @@ -712,11 +848,45 @@ Same for the ANSI bold and normal escape sequences." (put-text-property (1- (point)) (point) 'face 'bold)) (goto-char (point-min)) ;; Try to recognize common forms of cross references. - (while (re-search-forward "\\w+([0-9].?)" nil t) - (put-text-property (match-beginning 0) (match-end 0) - 'mouse-face 'highlight)) + (Man-highlight-references) (Man-softhyphen-to-minus) - (message "%s man page made up" Man-arguments)) + (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" + (let ((dummy 0)) + (Man-highlight-references0 + Man-see-also-regexp Man-reference-regexp 1 dummy + 'Man-xref-man-page) + (Man-highlight-references0 + Man-synopsis-regexp Man-header-regexp 0 2 + 'Man-xref-header-file) + (Man-highlight-references0 + Man-files-regexp Man-normal-file-regexp 0 0 + 'Man-xref-normal-file))) + +(defun Man-highlight-references0 (start-section regexp button-pos target-pos type) + ;; Based on `Man-build-references-alist' + (when (Man-find-section start-section) + (forward-line 1) + (let ((end (save-excursion + (Man-next-section 1) + (point)))) + (back-to-indentation) + (while (re-search-forward regexp end t) + (make-text-button + (match-beginning button-pos) + (match-end button-pos) + 'type type + 'Man-target-string (match-string target-pos) + ))))) (defun Man-cleanup-manpage () "Remove overstriking and underlining from the current buffer." @@ -855,6 +1025,9 @@ The following key bindings are currently in effect in the buffer: (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) @@ -867,7 +1040,7 @@ The following key bindings are currently in effect in the buffer: (goto-char (point-min)) (let ((case-fold-search nil)) (while (re-search-forward Man-heading-regexp (point-max) t) - (aput 'Man-sections-alist (Man-match-substring 1)) + (aput 'Man-sections-alist (match-string 1)) (forward-line 1)))) (defsubst Man-build-references-alist () @@ -896,7 +1069,7 @@ The following key bindings are currently in effect in the buffer: ;; Update len, in case a reference spans ;; more than two lines (paranoia). len (1- (length word)))) - (if (= (aref word len) ?-) + (if (memq (aref word len) '(?- ?­)) (setq hyphenated (substring word 0 len))) (if (string-match Man-reference-regexp word) (aput 'Man-refpages-alist word)))) @@ -1050,7 +1223,7 @@ Returns t if section is found, nil otherwise." (Man-find-section (aheadsym Man-sections-alist))) (defun Man-goto-see-also-section () - "Move point the the \"SEE ALSO\" section. + "Move point to the \"SEE ALSO\" section. Actually the section moved to is described by `Man-see-also-regexp'." (interactive) (if (not (Man-find-section Man-see-also-regexp)) @@ -1095,7 +1268,7 @@ Specify which REFERENCE to use; default is based on word at point." (aheadsym Man-refpages-alist))) chosen (prompt (concat "Refer to: (default " default ") "))) - (setq chosen (completing-read prompt Man-refpages-alist nil t)) + (setq chosen (completing-read prompt Man-refpages-alist)) (if (or (not chosen) (string= chosen "")) default @@ -1168,6 +1341,20 @@ Specify which REFERENCE to use; default is based on word at point." (if Man-circular-pages-flag (Man-goto-page (length Man-page-list)) (error "You're looking at the first manpage in the buffer")))) + +;; Header file support +(defun Man-view-header-file (file) + "View a header file specified by FILE from `Man-header-file-path'." + (let ((path Man-header-file-path) + complete-path) + (while path + (setq complete-path (concat (car path) "/" file) + path (cdr path)) + (if (file-readable-p complete-path) + (progn (view-file complete-path) + (setq path nil)) + (setq complete-path nil))) + complete-path)) ;; Init the man package variables, if not already done. (Man-init-defvars) @@ -1177,4 +1364,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