;;; man.el --- browse UNIX manual pages -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1993, 1994, 1996, 1997, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008, 2009, 2010 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
:type '(repeat string)
:group 'man)
-(defcustom Man-name-local-regexp "^NOM$"
- "*The translation of the uppercase word NAME in your language.
+(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)
"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.")
(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
- (let ((default-directory
- ;; Assure that `default-directory' exists
- ;; and is readable.
- (if (and (file-directory-p default-directory)
- (file-readable-p default-directory))
- default-directory
- (expand-file-name "~/"))))
- (call-process manual-program nil t nil "--help"))
- (error nil))
- 0)
- (progn
- (goto-char (point-min))
- (search-forward "--local-file" nil t))
- t)))))
+ "Return non-nil if the man command supports local filenames.
+Different man programs support this feature in different ways.
+The default Debian man program (\"man-db\") has a `--local-file'
+\(or `-l') option for this purpose. The default Red Hat man
+program has no such option, but interprets any name containing
+a \"/\" as a local filename. The function returns either `man-db'
+`man', or nil."
+ (if (eq Man-support-local-filenames 'auto-detect)
+ (setq Man-support-local-filenames
+ (with-temp-buffer
+ (let ((default-directory
+ ;; Ensure that `default-directory' exists and is readable.
+ (if (and (file-directory-p default-directory)
+ (file-readable-p default-directory))
+ default-directory
+ (expand-file-name "~/"))))
+ (ignore-errors
+ (call-process manual-program nil t nil "--help")))
+ (cond ((search-backward "--local-file" nil 'move)
+ 'man-db)
+ ;; This feature seems to be present in at least ver 1.4f,
+ ;; which is about 20 years old.
+ ;; I don't know if this version has an official name?
+ ((looking-at "^man, versione? [1-9]")
+ 'man))))
+ Man-support-local-filenames))
\f
;; ======================================================================
(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)
(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)))
(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 ""))
)))
(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
;; ======================================================================
;; 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))
- ;; Bookmark support.
(set (make-local-variable 'bookmark-make-record-function)
- 'man-bookmark-make-record)
+ 'Man-bookmark-make-record)
(Man-build-page-list)
(Man-strip-page-headers)
(Man-unindent)
complete-path))
;;; Bookmark Man Support
-
-(defun man-set-default-bookmark-title ()
- "Set default bookmark title for Man or woman page based \
-on NAME or `Man-name-local-regexp' entry."
+(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 (or (re-search-forward Man-name-local-regexp nil t)
- (re-search-forward "^NAME$" nil t))
- (forward-line 1)
- (unless (> (skip-chars-forward " ") 0)
- (skip-chars-forward "\t"))
+ (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 ()
+(defun Man-bookmark-make-record ()
"Make a bookmark entry for a Man buffer."
- `(,(man-set-default-bookmark-title)
- ,@(bookmark-make-record-default 'point-only)
- (buffer-name . ,(buffer-name (current-buffer)))
- (handler . man-bookmark-jump)))
+ `(,(Man-default-bookmark-title)
+ ,@(bookmark-make-record-default 'no-file)
+ (location . ,(concat "man " Man-arguments))
+ (man-args . ,Man-arguments)
+ (handler . Man-bookmark-jump)))
-(defun man-bookmark-jump (bookmark)
+;;;###autoload
+(defun Man-bookmark-jump (bookmark)
"Default bookmark handler for Man buffers."
- (let* ((buf (bookmark-prop-get bookmark 'buffer-name))
- (buf-lst (split-string buf))
- (node (replace-regexp-in-string "\*" "" (car (last buf-lst))))
- (ind (when (> (length buf-lst) 2) (second buf-lst)))
- (Man-notify-method (case bookmark-jump-display-function
- ('switch-to-buffer 'pushy)
- ('switch-to-buffer-other-window 'friendly)
- ('display-buffer 'quiet)
- (t 'friendly))))
- (man (if ind (format "%s(%s)" node ind) node))
- (while (get-process "man") (sit-for 1))
+ (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)))))
(provide 'man)
-;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47
;;; man.el ends here