X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/40b1a3a937512ff35884df2e8e19c3feed9f2688..b2db44d9c6b6895222e9de5ab58b3897fdb3c889:/lisp/man.el diff --git a/lisp/man.el b/lisp/man.el index b1c5f37bc7..ed24e35f0e 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1,7 +1,7 @@ ;;; 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 ;; Maintainer: FSF @@ -254,8 +254,7 @@ Used in `bookmark-set' to get the default bookmark name." "Regular expression describing a manpage section within parentheses.") (defvar Man-page-header-regexp - (if (and (string-match "-solaris2\\." system-configuration) - (not (string-match "-solaris2\\.[123435]$" system-configuration))) + (if (string-match "-solaris2\\." system-configuration) (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp "(\\(" Man-section-regexp "\\))\\)$") (concat "^[ \t]*\\(" Man-name-regexp @@ -277,7 +276,9 @@ This regexp should not start with a `^' character.") This regular expression should start with a `^' character.") (defvar Man-reference-regexp - (concat "\\(" Man-name-regexp "\\)[ \t]*(\\(" Man-section-regexp "\\))") + (concat "\\(" Man-name-regexp + "\\(\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\(" + Man-section-regexp "\\))") "Regular expression describing a reference to another manpage.") (defvar Man-apropos-regexp @@ -598,8 +599,8 @@ and the `Man-section-translations-alist' variables)." (cond ;; "chmod(2V)" case ? ((string-match (concat "^" Man-reference-regexp "$") ref) - (setq name (match-string 1 ref) - section (match-string 2 ref))) + (setq name (replace-regexp-in-string "[\n\t ]" "" (match-string 1 ref)) + section (match-string 3 ref))) ;; "2v chmod" case ? ((string-match (concat "^\\(" Man-section-regexp "\\) +\\(" Man-name-regexp "\\)$") ref) @@ -623,36 +624,32 @@ and the `Man-section-translations-alist' variables)." (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)) ;; ====================================================================== @@ -1111,7 +1108,7 @@ Same for the ANSI bold and normal escape sequences." (put-text-property (match-beginning 0) (match-end 0) 'face Man-overstrike-face))) - (message "%s man page formatted" Man-arguments)) + (message "%s man page formatted" (Man-page-from-arguments Man-arguments))) (defun Man-highlight-references (&optional xref-man-type) "Highlight the references on mouse-over. @@ -1154,7 +1151,9 @@ default type, `Man-xref-man-page' is used for the buttons." (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 @@ -1258,12 +1257,11 @@ manpage command." (Man-mode) (if (not Man-page-list) - (let ((args Man-arguments)) + (let ((args Man-arguments)) (kill-buffer (current-buffer)) - (error "Can't find the %s manpage" args))) - - (set-buffer-modified-p nil) - )) + (error "Can't find the %s manpage" + (Man-page-from-arguments args))) + (set-buffer-modified-p nil)))) ;; Restore case-fold-search before calling ;; Man-notify-when-ready because it may switch buffers. @@ -1274,6 +1272,18 @@ manpage command." (error "%s" err-mess)) )))) +(defun Man-page-from-arguments (args) + ;; Skip arguments and only print the page name. + (mapconcat + 'identity + (delete nil + (mapcar + (lambda (elem) + (and (not (string-match "^-" elem)) + elem)) + (split-string args " "))) + " ")) + ;; ====================================================================== ;; set up manual mode in buffer and build alists @@ -1721,5 +1731,4 @@ Uses `Man-name-local-regexp'." (provide 'man) -;; arch-tag: 587cda76-8e23-4594-b1f3-89b6b09a0d47 ;;; man.el ends here