;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Barry A. Warsaw <bwarsaw@cen.com>
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; ============= TODO ===========
;; - Add a command for printing.
-;; - The awk script deletes multiple blank lines. This behaviour does
+;; - The awk script deletes multiple blank lines. This behavior does
;; not allow to understand if there was indeed a blank line at the
;; end or beginning of a page (after the header, or before the
;; footer). A different algorithm should be used. It is easy to
;; 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.")
'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
\f
;; ======================================================================
-;; default man entry: get word under point
+;; default man entry: get word near point
-(defsubst Man-default-man-entry (&optional pos)
- "Make a guess at a default manual entry based on the text at POS.
-If POS is nil, the current point is used."
- (let (word start original-pos distance)
+(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 column distance)
(save-excursion
- (if pos (goto-char pos))
- ;; Default man entry title is any word the cursor is on, or if
- ;; cursor not on a word, nearest preceding or next word-like
- ;; object on this line.
- (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
+ (when pos (goto-char pos))
+ (setq pos (point))
+ ;; The default title is the nearest entry-like object before or
+ ;; after POS.
+ (if (and (skip-chars-backward " \ta-zA-Z0-9+")
+ (not (zerop (skip-chars-backward "(")))
+ ;; Try to handle the special case where POS is on a
+ ;; section number.
+ (looking-at
+ (concat "([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
+ ;; We skipped a valid section number backwards, look at
+ ;; preceding text.
+ (or (and (skip-chars-backward ",; \t")
+ (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))))
+ ;; Not a valid entry, move POS after closing paren.
+ (not (setq pos (match-end 0)))))
+ ;; We have a candidate, make `start' record its starting
+ ;; position.
(setq start (point))
- (setq original-pos (point))
- (setq distance (abs (skip-chars-backward ",; \t")))
+ ;; Otherwise look at char before POS.
+ (goto-char pos)
(if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
- (progn
- (setq start (point))
- (goto-char original-pos)
- (if (and (< (skip-chars-forward ",; \t") distance)
- (looking-at "[-a-zA-Z0-9._+:]"))
- (setq start (point))
- (goto-char start)))
- (skip-chars-forward ",; \t")
- (setq start (point))))
+ ;; Our candidate is just before or around POS.
+ (setq start (point))
+ ;; Otherwise record the current column and look backwards.
+ (setq column (current-column))
+ (skip-chars-backward ",; \t")
+ ;; Record the distance travelled.
+ (setq distance (- column (current-column)))
+ (when (looking-back
+ (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)"))
+ ;; Skip section number backwards.
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t"))
+ (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))
+ (progn
+ ;; We have a candidate before POS ...
+ (setq start (point))
+ (goto-char pos)
+ (if (and (skip-chars-forward ",; \t")
+ (< (- (current-column) column) distance)
+ (looking-at "[-a-zA-Z0-9._+:]"))
+ ;; ... but the one after POS is better.
+ (setq start (point))
+ ;; ... and anything after POS is worse.
+ (goto-char start)))
+ ;; No candidate before POS.
+ (goto-char pos)
+ (skip-chars-forward ",; \t")
+ (setq start (point)))))
+ ;; We have found a suitable starting point, try to skip at least
+ ;; one character.
(skip-chars-forward "-a-zA-Z0-9._+:")
(setq word (buffer-substring-no-properties start (point)))
;; If there is a continuation at the end of line, check the
;; following line too, eg:
;; see this-
;; command-here(1)
+ ;; Note: This code gets executed iff our entry is after POS.
(when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])")
- (setq word (concat word (match-string-no-properties 1))))
+ (setq word (concat word (match-string-no-properties 1)))
+ ;; Make sure the section number gets included by the code below.
+ (goto-char (match-end 1)))
(when (string-match "[._]+$" word)
(setq word (substring word 0 (match-beginning 0))))
- ;; If looking at something like *strcat(... , remove the '*'
- (when (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.
- (concat word
- (if (looking-at
- (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
- (format "(%s)" (match-string-no-properties 1)))))))
+ ;; The following was commented out since the preceding code
+ ;; should not produce a leading "*" in the first place.
+;;; ;; If looking at something like *strcat(... , remove the '*'
+;;; (when (string-match "^*" word)
+;;; (setq word (substring word 1)))
+ (concat
+ word
+ (and (not (string-equal word ""))
+ ;; If looking at something like ioctl(2) or brc(1M),
+ ;; include the section number in the returned value.
+ (looking-at
+ (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)"))
+ (format "(%s)" (match-string-no-properties 1)))))))
\f
;; ======================================================================
;;;###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)))
+ (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
(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.
(interactive
(if (not Man-refpages-alist)
(error "There are no references in the current man page")
- (list (let* ((default (or
- (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))
- (if (or (not chosen)
- (string= chosen ""))
- default
- chosen)))))
+ (list
+ (let* ((default (or
+ (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)))
+ (defaults
+ (mapcar 'substring-no-properties
+ (delete-dups
+ (delq nil (cons default
+ (mapcar 'car Man-refpages-alist))))))
+ chosen
+ (prompt (concat "Refer to (default " default "): ")))
+ (setq chosen (completing-read prompt Man-refpages-alist
+ nil nil nil nil defaults))
+ (if (or (not chosen)
+ (string= chosen ""))
+ default
+ chosen)))))
(if (not Man-refpages-alist)
(error "Can't find any references in the current manpage")
(aput 'Man-refpages-alist reference)
(setq path nil))
(setq complete-path nil)))
complete-path))
+
+;;; Bookmark Man Support
+(declare-function bookmark-make-record-default "bookmark" (&optional pos-only))
+(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 'point-only)
+ (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)
HCoop / bpt / emacs.git / blobdiff