;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2011
+;; Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Maintainer: FSF
;; 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.
-;; - Allow completion on the manpage name when calling man. This
-;; requires a reliable list of places where manpages can be found. The
-;; drawback would be that if the list is not complete, the user might
-;; be led to believe that the manpages in the missing directories do
-;; not exist.
\f
;;; Code:
(defgroup man nil
"Browse UNIX manual pages."
:prefix "Man-"
+ :group 'external
:group 'help)
-
(defvar Man-notify)
(defcustom Man-filter-list nil
- "*Manpage cleaning filter command phrases.
+ "Manpage cleaning filter command phrases.
This variable contains a list of the following form:
'((command-string phrase-string*)*)
:type '(repeat string)
:group 'man)
+(defcustom Man-name-local-regexp (concat "^" (regexp-opt '("NOM" "NAME")) "$")
+ "Regexp that matches the text that precedes the command's name.
+Used in `bookmark-set' to get the default bookmark name."
+ :type 'string :group 'bookmark)
+
(defvar manual-program "man"
"The name of the program that produces man pages.")
"Regular expression for SYNOPSIS heading (or your equivalent).
This regexp should not start with a `^' character.")
-(defvar Man-files-regexp "FILES"
+(defvar Man-files-regexp "FILES\\>"
+ ;; Add \> so as not to match mount(8)'s FILESYSTEM INDEPENDENT MOUNT OPTIONS.
"Regular expression for FILES heading (or your equivalent).
This regexp should not start with a `^' character.")
"Regular expression describing references to normal files.")
;; This includes the section as an optional part to catch hyphenated
-;; refernces to manpages.
+;; references to manpages.
(defvar Man-hyphenated-reference-regexp
(concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?")
"Regular expression describing a reference in the SEE ALSO section.")
'func nil
'action #'Man-xref-button-action)
-(defun Man-xref-button-action (button)
+(defun Man-xref-button-action (button)
(let ((target (button-get button 'Man-target-string)))
- (funcall
+ (funcall
(button-get button 'func)
(cond ((null target)
(button-label button))
(funcall target (button-start button)))
(t target)))))
-(define-button-type 'Man-xref-man-page
+(define-button-type 'Man-xref-man-page
:supertype 'Man-abstract-xref-man-page
'func 'man-follow)
(apply 'list
(cons
Man-sed-command
- (list
- (if Man-sed-script
- (concat "-e '" Man-sed-script "'")
- "")
- "-e '/^[\001-\032][\001-\032]*$/d'"
- "-e '/\e[789]/s///g'"
- "-e '/Reformatting page. Wait/d'"
- "-e '/Reformatting entry. Wait/d'"
- "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
- "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
- "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
- "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
- "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
- "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
- "-e '/^[A-Za-z].*Last[ \t]change:/d'"
- "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
- "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
- "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
- ))
- (cons
- Man-awk-command
- (list
- "'\n"
- "BEGIN { blankline=0; anonblank=0; }\n"
- "/^$/ { if (anonblank==0) next; }\n"
- "{ anonblank=1; }\n"
- "/^$/ { blankline++; next; }\n"
- "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
- "'"
- ))
+ (if (eq system-type 'windows-nt)
+ ;; Windows needs ".." quoting, not '..'.
+ (list
+ "-e \"/Reformatting page. Wait/d\""
+ "-e \"/Reformatting entry. Wait/d\""
+ "-e \"/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d\""
+ "-e \"/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d\""
+ "-e \"/^Printed[ \t][0-9].*[0-9]$/d\""
+ "-e \"/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d\""
+ "-e \"/^[A-Za-z].*Last[ \t]change:/d\""
+ "-e \"/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d\""
+ "-e \"/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d\"")
+ (list
+ (if Man-sed-script
+ (concat "-e '" Man-sed-script "'")
+ "")
+ "-e '/^[\001-\032][\001-\032]*$/d'"
+ "-e '/\e[789]/s///g'"
+ "-e '/Reformatting page. Wait/d'"
+ "-e '/Reformatting entry. Wait/d'"
+ "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
+ "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
+ "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
+ "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
+ "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
+ "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
+ "-e '/^[A-Za-z].*Last[ \t]change:/d'"
+ "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
+ "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
+ "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
+ )))
+ ;; Windows doesn't support multi-line commands, so don't
+ ;; invoke Awk there.
+ (unless (eq system-type 'windows-nt)
+ (cons
+ Man-awk-command
+ (list
+ "'\n"
+ "BEGIN { blankline=0; anonblank=0; }\n"
+ "/^$/ { if (anonblank==0) next; }\n"
+ "{ anonblank=1; }\n"
+ "/^$/ { blankline++; next; }\n"
+ "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
+ "'"
+ )))
(if (not Man-uses-untabify-flag)
;; The outer list will be stripped off by apply.
(list (cons
(defun Man-default-man-entry (&optional pos)
"Guess default manual entry based on the text near position POS.
POS defaults to `point'."
- (let (word start pos column distance)
+ (let (word start column distance)
(save-excursion
(when pos (goto-char pos))
(setq pos (point))
;;;###autoload
(defalias 'manual-entry 'man)
+(defvar Man-completion-cache nil
+ ;; On my machine, "man -k" is so fast that a cache makes no sense,
+ ;; but apparently that's not the case in all cases, so let's add a cache.
+ "Cache of completion table of the form (PREFIX . TABLE).")
+
+(defun Man-completion-table (string pred action)
+ (cond
+ ((eq action 'lambda)
+ (not (string-match "([^)]*\\'" string)))
+ ((equal string "-k")
+ ;; Let SPC (minibuffer-complete-word) insert the space.
+ (complete-with-action action '("-k ") string pred))
+ (t
+ (let ((table (cdr Man-completion-cache))
+ (section nil)
+ (prefix string))
+ (when (string-match "\\`\\([[:digit:]].*?\\) " string)
+ (setq section (match-string 1 string))
+ (setq prefix (substring string (match-end 0))))
+ (unless (and Man-completion-cache
+ (string-prefix-p (car Man-completion-cache) prefix))
+ (with-temp-buffer
+ (setq default-directory "/") ;; in case inherited doesn't exist
+ ;; Actually for my `man' the arg is a regexp.
+ ;; POSIX says it must be ERE and "man-db" seems to agree,
+ ;; whereas under MacOSX it seems to be BRE-style and doesn't
+ ;; accept backslashes at all. Let's not bother to
+ ;; quote anything.
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "COLUMNS" "999") ;; don't truncate long names
+ ;; manual-program might not even exist. And since it's
+ ;; run differently in Man-getpage-in-background, an error
+ ;; here may not necessarily mean that we'll also get an
+ ;; error later.
+ (ignore-errors
+ (call-process manual-program nil '(t nil) nil
+ "-k" (concat "^" prefix))))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^ \t\n]+\\)\\(?: ?\\((.+?)\\)\\(?:[ \t]+- \\(.*\\)\\)?\\)?" nil t)
+ (push (propertize (concat (match-string 1) (match-string 2))
+ 'help-echo (match-string 3))
+ table)))
+ ;; Cache the table for later reuse.
+ (setq Man-completion-cache (cons prefix table)))
+ ;; The table may contain false positives since the match is made
+ ;; by "man -k" not just on the manpage's name.
+ (if section
+ (let ((re (concat "(" (regexp-quote section) ")\\'")))
+ (dolist (comp (prog1 table (setq table nil)))
+ (if (string-match re comp)
+ (push (substring comp 0 (match-beginning 0)) table)))
+ (completion-table-with-context (concat section " ") table
+ prefix pred action))
+ ;; If the current text looks like a possible section name,
+ ;; then add a completion entry that just adds a space so SPC
+ ;; can be used to insert a space.
+ (if (string-match "\\`[[:digit:]]" string)
+ (push (concat string " ") table))
+ (let ((res (complete-with-action action table string pred)))
+ ;; In case we're completing to a single name that exists in
+ ;; several sections, the longest prefix will look like "foo(".
+ (if (and (stringp res)
+ (string-match "([^(]*\\'" res)
+ ;; In case the paren was already in `prefix', don't
+ ;; remove it.
+ (> (match-beginning 0) (length prefix)))
+ (substring res 0 (match-beginning 0))
+ res)))))))
;;;###autoload
(defun man (man-args)
"Get a Un*x manual page and put it in a buffer.
-This command is the top-level command in the man package. It runs a Un*x
-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.
-
-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."
+This command is the top-level command in the man package. It
+runs a Un*x command to retrieve and clean a manpage in the
+background and places the results in a `Man-mode' 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.
+
+For a manpage from a particular section, use either of the
+following. \"cat(1)\" is how cross-references appear and is
+passed to man as \"1 cat\".
+
+ cat(1)
+ 1 cat
+
+To see manpages from all sections related to a subject, use an
+\"all pages\" option (which might be \"-a\" if it's not the
+default), then step through with `Man-next-manpage' (\\<Man-mode-map>\\[Man-next-manpage]) etc.
+Add to `Man-switches' to make this option permanent.
+
+ -a chmod
+
+An explicit filename can be given too. Use -l if it might
+otherwise look like a page name.
+
+ /my/file/name.1.gz
+ -l somefile.1
+
+An \"apropos\" query with -k gives a buffer of matching page
+names or descriptions. The pattern argument is usually an
+\"egrep\" style regexp.
+
+ -k pattern"
+
(interactive
(list (let* ((default-entry (Man-default-man-entry))
- (input (read-string
+ ;; ignore case because that's friendly for bizarre
+ ;; caps things like the X11 function names and because
+ ;; "man" itself is case-sensitive on the command line
+ ;; so you're accustomed not to bother about the case
+ ;; ("man -k" is case-insensitive similarly, so the
+ ;; table has everything available to complete)
+ (completion-ignore-case t)
+ (input (completing-read
(format "Manual entry%s"
(if (string= default-entry "")
": "
(format " (default %s): " default-entry)))
- nil 'Man-topic-history default-entry)))
+ 'Man-completion-table
+ nil nil nil 'Man-topic-history default-entry)))
(if (string= input "")
(error "No man args given")
input))))
(man man-args)))
(defun Man-getpage-in-background (topic)
- "Use TOPIC to build and fire off the manpage and cleaning command."
+ "Use TOPIC to build and fire off the manpage and cleaning command.
+Return the buffer in which the manpage will appear."
(let* ((man-args topic)
(bufname (concat "*Man " man-args "*"))
(buffer (get-buffer bufname)))
;; 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
+ (if (default-value 'enable-multibyte-characters)
locale-coding-system 'raw-text-unix))
;; Avoid possible error by using a directory that always exists.
(default-directory
(Man-width (frame-width))
((window-width))))))
(setenv "GROFF_NO_SGR" "1")
+ ;; Since man-db 2.4.3-1, man writes plain text with no escape
+ ;; sequences when stdout is not a tty. In 2.5.0, the following
+ ;; env-var was added to allow control of this (see Debian Bug#340673).
+ (setenv "MAN_KEEP_FORMATTING" "1")
(if (fboundp 'start-process)
(set-process-sentinel
(start-process manual-program buffer
(format "exited abnormally with code %d"
exit-status)))
(setq msg exit-status))
- (Man-bgproc-sentinel bufname msg)))))))
+ (Man-bgproc-sentinel bufname msg)))))
+ buffer))
(defun Man-notify-when-ready (man-buffer)
"Notify the user when MAN-BUFFER is ready.
See the variable `Man-notify-method' for the different notification behaviors."
(let ((saved-frame (with-current-buffer man-buffer
Man-original-frame)))
- (cond
- ((eq Man-notify-method 'newframe)
+ (case Man-notify-method
+ (newframe
;; Since we run asynchronously, perhaps while Emacs is waiting
;; for input, we must not leave a different buffer current. We
;; can't rely on the editor command loop to reselect the
(set-window-dedicated-p (frame-selected-window frame) t)
(or (display-multi-frame-p frame)
(select-frame frame)))))
- ((eq Man-notify-method 'pushy)
+ (pushy
(switch-to-buffer man-buffer))
- ((eq Man-notify-method 'bully)
+ (bully
(and (frame-live-p saved-frame)
(select-frame saved-frame))
(pop-to-buffer man-buffer)
(delete-other-windows))
- ((eq Man-notify-method 'aggressive)
+ (aggressive
(and (frame-live-p saved-frame)
(select-frame saved-frame))
(pop-to-buffer man-buffer))
- ((eq Man-notify-method 'friendly)
+ (friendly
(and (frame-live-p saved-frame)
(select-frame saved-frame))
(display-buffer man-buffer 'not-this-window))
- ((eq Man-notify-method 'polite)
+ (polite
(beep)
(message "Manual buffer %s is ready" (buffer-name man-buffer)))
- ((eq Man-notify-method 'quiet)
+ (quiet
(message "Manual buffer %s is ready" (buffer-name man-buffer)))
- ((or (eq Man-notify-method 'meek)
- t)
+ (t ;; meek
(message ""))
)))
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
(replace-match "+")
(put-text-property (1- (point)) (point) 'face 'bold))
+ ;; When the header is longer than the manpage name, groff tries to
+ ;; condense it to a shorter line interspered with ^H. Remove ^H with
+ ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ (goto-char (point-min))
+ (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(goto-char (point-min))
;; Try to recognize common forms of cross references.
(Man-highlight-references)
(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-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
(goto-char (point-min))
nil)))
(while (re-search-forward regexp end t)
- (make-text-button
+ ;; An overlay button is preferable because the underlying text
+ ;; may have text property highlights (Bug#7881).
+ (make-button
(match-beginning button-pos)
(match-end button-pos)
'type type
'Man-target-string (cond
- ((numberp target)
+ ((numberp target)
(match-string target))
((functionp target)
target)
))
(goto-char (point-min))
(while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
+ ;; When the header is longer than the manpage name, groff tries to
+ ;; condense it to a shorter line interspered with ^H. Remove ^H with
+ ;; their preceding chars (but don't put Man-overstrike-face). (Bug#5566)
+ (goto-char (point-min))
+ (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(Man-softhyphen-to-minus)
(message "%s man page cleaned up" Man-arguments))
(progn
(end-of-line) (point)))
delete-buff t))
+
+ ;; "-k foo", successful exit, but no output (from man-db)
+ ;; ENHANCE-ME: share the check for -k with
+ ;; `Man-highlight-references'. The \\s- bits here are
+ ;; meant to allow for multiple options with -k among them.
+ ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments)
+ (eq (process-status process) 'exit)
+ (= (process-exit-status process) 0)
+ (= (point-min) (point-max)))
+ (setq err-mess (format "%s: no matches" Man-arguments)
+ delete-buff t))
+
((or (stringp process)
(not (and (eq (process-status process) 'exit)
(= (process-exit-status process) 0))))
;; ======================================================================
;; set up manual mode in buffer and build alists
+(defvar bookmark-make-record-function)
+
(put 'Man-mode 'mode-class 'special)
(defun Man-mode ()
(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))
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'Man-bookmark-make-record)
(Man-build-page-list)
(Man-strip-page-headers)
(Man-unindent)
(string= chosen ""))
default
chosen)))
- (Man-find-section (aheadsym Man-sections-alist)))
+ (unless (Man-find-section (aheadsym Man-sections-alist))
+ (error "Section not found")))
+
(defun Man-goto-see-also-section ()
"Move point to the \"SEE ALSO\" section.
(setq path nil))
(setq complete-path nil)))
complete-path))
+
+;;; Bookmark Man Support
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(defun Man-default-bookmark-title ()
+ "Default bookmark name for Man or WoMan pages.
+Uses `Man-name-local-regexp'."
+ (save-excursion
+ (goto-char (point-min))
+ (when (re-search-forward Man-name-local-regexp nil t)
+ (skip-chars-forward "\n\t ")
+ (buffer-substring-no-properties (point) (line-end-position)))))
+
+(defun Man-bookmark-make-record ()
+ "Make a bookmark entry for a Man buffer."
+ `(,(Man-default-bookmark-title)
+ ,@(bookmark-make-record-default 'no-file)
+ (location . ,(concat "man " Man-arguments))
+ (man-args . ,Man-arguments)
+ (handler . Man-bookmark-jump)))
+
+;;;###autoload
+(defun Man-bookmark-jump (bookmark)
+ "Default bookmark handler for Man buffers."
+ (let* ((man-args (bookmark-prop-get bookmark 'man-args))
+ ;; Let bookmark.el do the window handling.
+ ;; This let-binding needs to be active during the call to both
+ ;; Man-getpage-in-background and accept-process-output.
+ (Man-notify-method 'meek)
+ (buf (Man-getpage-in-background man-args))
+ (proc (get-buffer-process buf)))
+ (while (and proc (eq (process-status proc) 'run))
+ (accept-process-output proc))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))
+
\f
;; Init the man package variables, if not already done.
(Man-init-defvars)
(provide 'man)
-;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47
;;; man.el ends here
HCoop / bpt / emacs.git / blobdiff