-;;; 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, 2006 Free Software Foundation, Inc.
-;; Author: Barry A. Warsaw <bwarsaw@cen.com>
-;; Keywords: help
-;; Adapted-By: ESR, pot
+;; Author: Barry A. Warsaw <bwarsaw@cen.com>
+;; Maintainer: FSF
+;; Keywords: help
+;; Adapted-By: ESR, pot
;; This file is part of GNU Emacs.
;; 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:
;; ALSO references, and other features. See below or do `?' in a
;; manual page buffer for details.
-;; ========== Credits and History ==========
+;; ========== Credits and History ==========
;; In mid 1991, several people posted some interesting improvements to
;; man.el from the standard emacs 18.57 distribution. I liked many of
;; these, but wanted everything in one single package, so I decided
;; 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.
\f
;;; Code:
+(eval-when-compile (require 'cl))
(require 'assoc)
+(require 'button)
;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
;; empty defvars (keep the compiler quiet)
(defvar Man-sections-alist)
(defvar Man-refpages-alist)
(defvar Man-uses-untabify-flag t
- "When non-nil use `untabify' instead of Man-untabify-command.")
+ "Non-nil means use `untabify' instead of `Man-untabify-command'.")
(defvar Man-page-mode-string)
(defvar Man-sed-script nil
"Script for sed to nuke backspaces and ANSI codes from manpages.")
;; user variables
(defcustom Man-fontify-manpage-flag t
- "*Make up the manpage with fonts."
+ "*Non-nil means make up the manpage with fonts."
:type 'boolean
:group 'man)
: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.
(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
:group 'man)
(defcustom Man-downcase-section-letters-flag t
- "*Letters in sections are converted to lower case.
+ "*Non-nil means letters in sections are converted to lower case.
Some Un*x man commands can't handle uppercase letters in sections, for
example \"man 2V chmod\", but they are often displayed in the manpage
with the upper case letter. When this variable is t, the section
:group 'man)
(defcustom Man-circular-pages-flag t
- "*If t, the manpage list is treated as circular for traversal."
+ "*Non-nil means the manpage list is treated as circular for traversal."
:type 'boolean
:group 'man)
(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.")
"Command used for untabifying.")
(defvar Man-untabify-command-args (list "-t" "-e")
- "List of arguments to be passed to Man-untabify-command (which see).")
+ "List of arguments to be passed to `Man-untabify-command' (which see).")
(defvar Man-sed-command "sed"
"Command used for processing sed scripts.")
(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.")
"Hook run when Man mode is enabled.")
(defvar Man-cooked-hook nil
- "Hook run after removing backspaces but before Man-mode processing.")
+ "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]"
+(defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]"
"Regular expression describing a manpage section within parentheses.")
(defvar Man-page-header-regexp
- (concat "^[ \t]*\\(" Man-name-regexp
- "(\\(" Man-section-regexp "\\))\\).*\\1")
+ (if (and (string-match "-solaris2\\." system-configuration)
+ (not (string-match "-solaris2\\.[123435]$" system-configuration)))
+ (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
+ "(\\(" Man-section-regexp "\\))\\)$")
+ (concat "^[ \t]*\\(" Man-name-regexp
+ "(\\(" 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"
This regular expression should start with a `^' character.")
(defvar Man-reference-regexp
- (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
+ (concat "\\(" Man-name-regexp "\\)[ \t]*(\\(" Man-section-regexp "\\))")
+ "Regular expression describing a reference to another manpage.")
+
+(defvar Man-apropos-regexp
+ (concat "\\\[\\(" Man-name-regexp "\\)\\\][ \t]*(\\(" Man-section-regexp "\\))")
+ "Regular expression describing a reference to manpages in \"man -k output\".")
+
+(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)
"")
"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
\f
(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)
(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)
(define-key Man-mode-map "k" 'Man-kill)
(define-key Man-mode-map "q" 'Man-quit)
(define-key Man-mode-map "m" 'man)
+ ;; Not all the man references get buttons currently. The text in the
+ ;; manual page can contain references to other man pages
(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-abstract-xref-man-page
+ 'follow-link t
+ 'help-echo "mouse-2, RET: display this man page"
+ 'func nil
+ 'action (lambda (button)
+ (funcall
+ (button-get button 'func)
+ (let ((func (button-get button 'Man-target-string)))
+ (if func
+ (if (functionp func) (funcall func) func)
+ (button-label button))))))
+
+(define-button-type 'Man-xref-man-page
+ :supertype 'Man-abstract-xref-man-page
+ 'func 'man-follow)
+
+
+(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")
\f
;; ======================================================================
;; utilities
(defun Man-init-defvars ()
- "Used for initialising variables based on the value of window-system.
-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
- window-system))
+ "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.
(let ((default-directory "/"))
(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))))
(setq Man-filter-list
- (list
+ ;; Avoid trailing nil which confuses customize.
+ (apply 'list
(cons
Man-sed-command
(list
"'"
))
(if (not Man-uses-untabify-flag)
- (cons
- Man-untabify-command
- Man-untabify-command-args)
+ ;; The outer list will be stripped off by apply.
+ (list (cons
+ Man-untabify-command
+ Man-untabify-command-args))
)))
)
-(defsubst Man-match-substring (&optional n string)
- "Return the substring matched by the last search.
-Optional arg N means return the substring matched by the Nth paren
-grouping. Optional second arg STRING means return a substring from
-that string instead of from the current buffer."
- (if (null n) (setq n 0))
- (if string
- (substring string (match-beginning n) (match-end n))
- (buffer-substring (match-beginning n) (match-end n))))
-
(defsubst Man-make-page-mode-string ()
"Formats part of the mode line for Man mode."
(format "%s page %d of %d"
(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"
- " %s 2>/dev/null")))
+ (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)))
(pargs (cdr (car flist))))
(setq command
(concat command " | " pcom " "
- (mapconcat '(lambda (phrase)
- (if (not (stringp phrase))
- (error "Malformed Man-filter-list"))
- phrase)
+ (mapconcat (lambda (phrase)
+ (if (not (stringp phrase))
+ (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)."
+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
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)))))
+
\f
;; ======================================================================
;; 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)))))))
\f
;; ======================================================================
;;;###autoload
(defalias 'manual-entry 'man)
+
;;;###autoload
(defun man (man-args)
"Get a Un*x manual page and put it in a buffer.
command to retrieve and clean a manpage in the background and places the
results in a Man mode (manpage browsing) buffer. See variable
`Man-notify-method' for what happens when the buffer is ready.
-If a buffer already exists for this man page, it will display immediately."
+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. 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: "
+ (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
(man man-args)))
(defun Man-getpage-in-background (topic)
- "Uses TOPIC to build and fire off the manpage and cleaning command."
+ "Use TOPIC to build and fire off the manpage and cleaning command."
(let* ((man-args topic)
(bufname (concat "*Man " man-args "*"))
(buffer (get-buffer bufname)))
(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))
- (inhibit-eol-conversion t) ; so Awk script gets \n intact
+ ;; 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.
(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)
)))
(defun Man-softhyphen-to-minus ()
- ;; \255 is some kind of dash in Latin-1.
- (goto-char (point-min))
- (if enable-multibyte-characters
- (while (search-forward "\255" nil t)
- (if (= (preceding-char) ?\255)
- (replace-match "-")))
- (while (search-forward "\255" nil t) (replace-match "-"))))
+ ;; \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))
+ (goto-char (point-min))
+ (let ((str "\255"))
+ (if enable-multibyte-characters
+ (setq str (string-as-multibyte str)))
+ (while (search-forward str nil t) (replace-match "-")))))
(defun Man-fontify-manpage ()
"Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences."
(interactive)
- (message "Please wait: making up the %s man page..." Man-arguments)
+ (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))
- (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 (&optional xref-man-type)
+ "Highlight the references on mouse-over.
+References include items in the SEE ALSO section,
+header file (#include <foo.h>), and files in FILES.
+If optional argument XREF-MAN-TYPE is non-nil, it used as the
+button type for items in SEE ALSO section. If it is nil, the
+default type, `Man-xref-man-page' is used for the buttons."
+ ;; `Man-highlight-references' is used from woman.el, too.
+ ;; woman.el doesn't set `Man-arguments'.
+ (unless Man-arguments
+ (setq Man-arguments ""))
+ (if (string-match "-k " Man-arguments)
+ (progn
+ (Man-highlight-references0 nil Man-reference-regexp 1
+ 'Man-default-man-entry
+ (or xref-man-type 'Man-xref-man-page))
+ (Man-highlight-references0 nil Man-apropos-regexp 1
+ 'Man-default-man-entry
+ (or xref-man-type 'Man-xref-man-page)))
+ (Man-highlight-references0 Man-see-also-regexp Man-reference-regexp 1
+ 'Man-default-man-entry
+ (or xref-man-type '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 type)
+ ;; Based on `Man-build-references-alist'
+ (when (or (null start-section)
+ (Man-find-section start-section))
+ (let ((end (if start-section
+ (progn
+ (forward-line 1)
+ (back-to-indentation)
+ (save-excursion
+ (Man-next-section 1)
+ (point)))
+ (goto-char (point-min))
+ (point-max))))
+ (while (re-search-forward regexp end t)
+ (make-text-button
+ (match-beginning button-pos)
+ (match-end button-pos)
+ 'type type
+ 'Man-target-string (cond
+ ((numberp target)
+ (match-string target))
+ ((functionp target)
+ target)
+ (t nil)))))))
+
+(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))
(defun Man-bgproc-sentinel (process msg)
"Manpage background process sentinel.
-When manpage command is run asynchronously, PROCESS is the process
+When manpage command is run asynchronously, PROCESS is the process
object for the manpage command; when manpage command is run
synchronously, PROCESS is the name of the buffer where the manpage
command is run. Second argument MSG is the exit message of the
(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
;; ======================================================================
;; 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.
-The following man commands are available in the buffer. Try
+The following man commands are available in the buffer. Try
\"\\[describe-key] <key> RET\" for more information:
\\[man] Prompt to retrieve a new manpage.
\\[Man-kill] Deletes the manpage window, kill its buffer.
\\[describe-mode] Prints this help text.
-The following variables may be of some use. Try
+The following variables may be of some use. Try
\"\\[describe-variable] <variable-name> RET\" for more information:
-Man-notify-method What happens when manpage formatting is done.
-Man-downcase-section-letters-flag Force section letters to lower case.
-Man-circular-pages-flag Treat multiple manpage list as circular.
-Man-auto-section-alist List of major modes and their section numbers.
-Man-section-translations-alist List of section numbers and their Un*x equiv.
-Man-filter-list Background manpage filter command.
-Man-mode-line-format Mode line format for Man mode buffers.
-Man-mode-map Keymap bindings for Man mode buffers.
-Man-mode-hook Normal hook run on entry to Man mode.
-Man-section-regexp Regexp describing manpage section letters.
-Man-heading-regexp Regexp describing section headers.
-Man-see-also-regexp Regexp for SEE ALSO section (or your equiv).
-Man-first-heading-regexp Regexp for first heading on a manpage.
-Man-reference-regexp Regexp matching a references in SEE ALSO.
-Man-switches Background `man' command switches.
+`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-section-translations-alist' List of section numbers and their Un*x equiv.
+`Man-filter-list' Background manpage filter command.
+`Man-mode-map' Keymap bindings for Man mode buffers.
+`Man-mode-hook' Normal hook run on entry to Man mode.
+`Man-section-regexp' Regexp describing manpage section letters.
+`Man-heading-regexp' Regexp describing section headers.
+`Man-see-also-regexp' Regexp for SEE ALSO section (or your equiv).
+`Man-first-heading-regexp' Regexp for first heading on a manpage.
+`Man-reference-regexp' Regexp matching a references in SEE ALSO.
+`Man-switches' Background `man' command switches.
The following key bindings are currently in effect in the buffer:
\\{Man-mode-map}"
(interactive)
+ (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."
(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 ()
(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."
(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)
(let* ((default (aheadsym Man-sections-alist))
(completion-ignore-case t)
chosen
- (prompt (concat "Go to section: (default " default ") ")))
+ (prompt (concat "Go to section (default " default "): ")))
(setq chosen (completing-read prompt Man-sections-alist))
(if (or (not chosen)
(string= chosen ""))
(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."
+Specify which REFERENCE to use; default is based on word at point."
(interactive
(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))
+ (prompt (concat "Refer to (default " default "): ")))
+ (setq chosen (completing-read prompt Man-refpages-alist))
(if (or (not chosen)
(string= chosen ""))
default
(defun Man-kill ()
"Kill the buffer containing the manpage."
(interactive)
- (let ((buff (current-buffer)))
- (delete-windows-on buff)
- (kill-buffer buff))
- (if (and window-system
- (or (eq Man-notify-method 'newframe)
- (and pop-up-frames
- (eq Man-notify-method 'bully))))
- (delete-frame)))
+ (quit-window t))
(defun Man-quit ()
"Bury the buffer containing the manpage."
(interactive)
- (let ((buff (current-buffer)))
- (delete-windows-on buff)
- (bury-buffer buff))
- (if (and window-system
- (or (eq Man-notify-method 'newframe)
- (and pop-up-frames
- (eq Man-notify-method 'bully))))
- (delete-frame)))
-
-(defun Man-goto-page (page)
+ (quit-window))
+
+(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 ()
(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))
\f
;; Init the man package variables, if not already done.
(Man-init-defvars)
+(add-to-list 'debug-ignored-errors "^No manpage [0-9]* found$")
+(add-to-list 'debug-ignored-errors "^Can't find the .* manpage$")
+
(provide 'man)
+;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47
;;; man.el ends here