X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4fbee715cb2c990faa34c8144f309b2ff5fe3626..b0c9a334c2f0eb881eff47f590997e746cc3bdb3:/lisp/man.el diff --git a/lisp/man.el b/lisp/man.el index 7fdfdb99e2..d1b607600a 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,11 +1,12 @@ -;;; man.el --- browse UNIX manual pages +;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*- -;; Copyright (C) 1993, 1994, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, +;; 2004, 2005 Free Software Foundation, Inc. -;; Author: Barry A. Warsaw +;; Author: Barry A. Warsaw ;; Maintainer: FSF -;; Keywords: help -;; Adapted-By: ESR, pot +;; Keywords: help +;; Adapted-By: ESR, pot ;; This file is part of GNU Emacs. @@ -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: @@ -81,7 +82,7 @@ ;; footer). A different algorithm should be used. It is easy to ;; compute how many blank lines there are before and after the page ;; headers, and after the page footer. But it is possible to compute -;; the number of blank lines before the page footer by euristhics +;; the number of blank lines before the page footer by heuristics ;; only. Is it worth doing? ;; - Allow a user option to mean that all the manpages should go in ;; the same buffer, where they can be browsed with M-n and M-p. @@ -94,7 +95,9 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'assoc) +(require 'button) ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ;; empty defvars (keep the compiler quiet) @@ -152,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. @@ -174,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 @@ -210,6 +229,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.") @@ -225,20 +250,6 @@ the associated section number." (defvar Man-awk-command "awk" "Command used for processing awk scripts.") -(defvar Man-mode-line-format - '("-" - mode-line-mule-info - mode-line-modified - mode-line-frame-identification - mode-line-buffer-identification " " - global-mode-string - " " Man-page-mode-string - " %[(" mode-name mode-line-process minor-mode-alist "%n)%]--" - (line-number-mode "L%l--") - (column-number-mode "C%c--") - (-3 . "%p") "-%-") - "Mode line format for manual mode buffer.") - (defvar Man-mode-map nil "Keymap for Man mode.") @@ -248,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]" @@ -263,7 +274,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" @@ -276,10 +287,47 @@ This regular expression should start with a `^' character.") (defvar Man-reference-regexp (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 + (concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?") "Regular expression describing a reference in the SEE ALSO section.") (defvar Man-switches "" - "Switches passed to the man command, as a single string.") + "Switches passed to the man command, as a single string. + +If you want to be able to see all the manpages for a subject you type, +make -a one of the switches, if your `man' program supports it.") (defvar Man-specified-section-option (if (string-match "-solaris[0-9.]*$" system-configuration) @@ -287,6 +335,12 @@ This regular expression should start with a `^' character.") "") "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 @@ -298,6 +352,7 @@ This regular expression should start with a `^' character.") (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) @@ -333,13 +388,15 @@ This regular expression should start with a `^' character.") (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 (make-keymap)) +(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) @@ -355,32 +412,51 @@ This regular expression should start with a `^' character.") (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 "?" '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))) + '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 + '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)))) + 'follow-link t + 'help-echo "mouse-2: display this file") ;; ====================================================================== ;; utilities (defun Man-init-defvars () - "Used for initialising variables based on the value of `window-system'. + "Used for initialising variables based on display's color support. This is necessary if one wants to dump man.el with Emacs." - ;; The following is necessary until fonts are implemented on - ;; terminals. - (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag - (display-color-p))) - ;; Avoid possible error in call-process by using a directory that must exist. (let ((default-directory "/")) (setq Man-sed-script (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)))) @@ -428,16 +504,6 @@ This is necessary if one wants to dump man.el with Emacs." ))) ) -(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" @@ -449,13 +515,15 @@ that string instead of from the current buffer." (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))) @@ -467,27 +535,40 @@ that string instead of from the current buffer." (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) - (setq name (Man-match-substring 1 ref) - section (Man-match-substring 2 ref))) + (setq name (match-string 1 ref) + section (match-string 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)))) + (setq name (match-string 2 ref) + section (match-string 1 ref)))) (if (string= name "") ref ; Return the reference as is (if Man-downcase-section-letters-flag @@ -505,31 +586,57 @@ 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 (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'." +This guess is based on the text surrounding the cursor." (let (word) (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)" (Man-match-substring 1)) - ""))))) + (format "(%s)" (match-string-no-properties 1))))))) ;; ====================================================================== @@ -539,6 +646,7 @@ default section number is selected from `Man-auto-section-alist'." ;;;###autoload (defalias 'manual-entry 'man) + ;;;###autoload (defun man (man-args) "Get a Un*x manual page and put it in a buffer. @@ -549,18 +657,19 @@ results in a Man mode (manpage browsing) buffer. See variable If a buffer already exists for this man page, it will display immediately. To specify a man page from a certain section, type SUBJECT(SECTION) or -SECTION SUBJECT when prompted for a manual entry." +SECTION SUBJECT when prompted for a manual entry. To see manpages from +all sections related to a subject, put something appropriate into the +`Man-switches' variable, which see." (interactive (list (let* ((default-entry (Man-default-man-entry)) (input (read-string (format "Manual entry%s: " (if (string= default-entry "") "" - (format " (default %s)" default-entry)))))) + (format " (default %s)" default-entry))) + nil nil default-entry))) (if (string= input "") - (if (string= default-entry "") - (error "No man args given") - default-entry) + (error "No man args given") input)))) ;; Possibly translate the "subject(section)" syntax into the @@ -590,34 +699,72 @@ SECTION SUBJECT when prompted for a manual entry." (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)) ;; The following is so Awk script gets \n intact ;; But don't prevent decoding of the outside. (coding-system-for-write 'raw-text-unix) + ;; We must decode the output by a coding system that the + ;; system's locale suggests in multibyte mode. + (coding-system-for-read + (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" + (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) - (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 + shell-command-switch + (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. @@ -634,23 +781,22 @@ See the variable `Man-notify-method' for the different notification behaviors." (save-excursion (let ((frame (make-frame Man-frame-parameters))) (set-window-buffer (frame-selected-window frame) man-buffer) - (set-window-dedicated-p (frame-selected-window frame) t)))) + (set-window-dedicated-p (frame-selected-window frame) t) + (or (display-multi-frame-p frame) + (select-frame frame))))) ((eq Man-notify-method 'pushy) (switch-to-buffer man-buffer)) ((eq Man-notify-method 'bully) - (and window-system - (frame-live-p saved-frame) + (and (frame-live-p saved-frame) (select-frame saved-frame)) (pop-to-buffer man-buffer) (delete-other-windows)) ((eq Man-notify-method 'aggressive) - (and window-system - (frame-live-p saved-frame) + (and (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) + (and (frame-live-p saved-frame) (select-frame saved-frame)) (display-buffer man-buffer 'not-this-window)) ((eq Man-notify-method 'polite) @@ -664,7 +810,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)) @@ -678,55 +824,125 @@ 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) - (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)) - (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)) - (Man-softhyphen-to-minus) - (message "%s man page made up" Man-arguments)) - -(defun Man-cleanup-manpage () - "Remove overstriking and underlining from the current buffer." - (interactive) + ;; 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" + (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 (&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)) @@ -790,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 @@ -808,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. @@ -832,10 +1057,8 @@ The following variables may be of some use. Try `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. @@ -848,21 +1071,27 @@ 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 - mode-line-format Man-mode-line-format + mode-line-buffer-identification + (list (default-value 'mode-line-buffer-identification) + " {" '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." @@ -870,7 +1099,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 () @@ -890,16 +1119,21 @@ The following key bindings are currently in effect in the buffer: (back-to-indentation) (while (and (not (eobp)) (/= (point) runningpoint)) (setq runningpoint (point)) - (if (re-search-forward Man-reference-regexp end t) - (let* ((word (Man-match-substring 0)) + (if (re-search-forward Man-hyphenated-reference-regexp end t) + (let* ((word (match-string 0)) (len (1- (length word)))) (if hyphenated (setq word (concat hyphenated word) - hyphenated nil)) - (if (= (aref word len) ?-) - (setq hyphenated (substring word 0 len)) - (aput 'Man-refpages-alist word)))) - (skip-chars-forward " \t\n,"))))))) + hyphenated nil + ;; Update len, in case a reference spans + ;; more than two lines (paranoia). + len (1- (length word)))) + (if (memq (aref word len) '(?- ?­)) + (setq hyphenated (substring word 0 len))) + (if (string-match Man-reference-regexp word) + (aput 'Man-refpages-alist word)))) + (skip-chars-forward " \t\n,")))))) + (setq Man-refpages-alist (nreverse Man-refpages-alist))) (defun Man-build-page-list () "Build the list of separate manpages in the buffer." @@ -912,7 +1146,7 @@ The following key bindings are currently in effect in the buffer: (while (not (eobp)) (setq header (if (looking-at Man-page-header-regexp) - (Man-match-substring 1) + (match-string 1) nil)) ;; Go past both the current and the next Man-first-heading-regexp (if (re-search-forward Man-first-heading-regexp nil 'move 2) @@ -1048,13 +1282,33 @@ 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)) (error (concat "No " Man-see-also-regexp " section found in the current manpage")))) +(defun Man-possibly-hyphenated-word () + "Return a possibly hyphenated word at point. +If the word starts at the first non-whitespace column, and the +previous line ends with a hyphen, return the last word on the previous +line instead. Thus, if a reference to \"tcgetpgrp(3V)\" is hyphenated +as \"tcgetp-grp(3V)\", and point is at \"grp(3V)\", we return +\"tcgetp-\" instead of \"grp\"." + (save-excursion + (skip-syntax-backward "w()") + (skip-chars-forward " \t") + (let ((beg (point)) + (word (current-word))) + (when (eq beg (save-excursion + (back-to-indentation) + (point))) + (end-of-line 0) + (if (eq (char-before) ?-) + (setq word (current-word)))) + word))) + (defun Man-follow-manual-reference (reference) "Get one of the manpages referred to in the \"SEE ALSO\" section. Specify which REFERENCE to use; default is based on word at point." @@ -1062,21 +1316,20 @@ Specify which REFERENCE to use; default is based on word at point." (if (not Man-refpages-alist) (error "There are no references in the current man page") (list (let* ((default (or - (car (all-completions - (save-excursion - (skip-syntax-backward "w()") - (skip-chars-forward " \t") - (let ((word (current-word))) - ;; strip a trailing '-': - (if (string-match "-$" word) - (substring word 0 - (match-beginning 0)) - word))) - Man-refpages-alist)) - (aheadsym Man-refpages-alist))) + (car (all-completions + (let ((word + (or (Man-possibly-hyphenated-word) + ""))) + ;; strip a trailing '-': + (if (string-match "-$" word) + (substring word 0 + (match-beginning 0)) + word)) + Man-refpages-alist)) + (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 @@ -1097,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 () @@ -1149,6 +1399,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) @@ -1158,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