]> code.delx.au - gnu-emacs/blobdiff - lisp/man.el
CC Mode: truncate the semi-nonlit cache when applying syntax-table to a quote
[gnu-emacs] / lisp / man.el
index 3731170e2795fe028194995315765b58f1d5fe51..d127decfebd8497411944ae66f67972d577ee225 100644 (file)
@@ -1,6 +1,6 @@
-;;; man.el --- browse UNIX manual pages  -*- coding: utf-8 -*-
+;;; man.el --- browse UNIX manual pages
 
-;; Copyright (C) 1993-1994, 1996-1997, 2001-2015 Free Software
+;; Copyright (C) 1993-1994, 1996-1997, 2001-2016 Free Software
 ;; Foundation, Inc.
 
 ;; Author: Barry A. Warsaw <bwarsaw@cen.com>
@@ -75,7 +75,7 @@
 ;; ============= TODO ===========
 ;; - Add a command for printing.
 ;; - The awk script deletes multiple blank lines.  This behavior does
-;;   not allow to understand if there was indeed a blank line at the
+;;   not allow one 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
 ;;   compute how many blank lines there are before and after the page
   "Manpage cleaning filter command phrases.
 This variable contains a list of the following form:
 
-'((command-string phrase-string*)*)
+  ((command-string phrase-string*)*)
 
 Each phrase-string is concatenated onto the command-string to form a
 command filter.  The (standard) output (and standard error) of the Un*x
@@ -174,18 +174,19 @@ Any other value of `Man-notify-method' is equivalent to `meek'."
 
 (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."
+If nil, use the width of the window where the manpage is displayed.
+If non-nil, use the width of the frame where the manpage is displayed.
+The value also can be a positive integer for a fixed width."
   :type '(choice (const :tag "Window width" nil)
                  (const :tag "Frame width" t)
-                 (integer :tag "Specific width" :value 65))
+                 (integer :tag "Fixed width" :value 65))
   :group 'man)
 
 (defcustom Man-frame-parameters nil
   "Frame parameter list for creating a new frame for a manual page."
-  :type 'sexp
+  :type '(repeat (cons :format "%v"
+                      (symbol :tag "Parameter")
+                      (sexp :tag "Value")))
   :group 'man)
 
 (defcustom Man-downcase-section-letters-flag t
@@ -307,12 +308,12 @@ This regular expression should start with a `^' character.")
 
 (defvar Man-reference-regexp
   (concat "\\(" Man-name-regexp
-         "\\(\n[ \t]+" Man-name-regexp "\\)*\\)[ \t]*(\\("
+         "\\(‐?\n[ \t]+" 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 "\\))")
+  (concat "\\[\\(" Man-name-regexp "\\)\\][ \t]*(\\(" Man-section-regexp "\\))")
   "Regular expression describing a reference to manpages in \"man -k output\".")
 
 (defvar Man-synopsis-regexp "SYNOPSIS"
@@ -618,7 +619,7 @@ This is necessary if one wants to dump man.el with Emacs."
                           ;; `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")
+                          ((not (fboundp 'make-process)) " %s")
                           ((concat " %s 2>" null-device)))))
        (flist Man-filter-list))
     (while (and flist (car flist))
@@ -695,9 +696,8 @@ a \"/\" as a local filename.  The function returns either `man-db'
             (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
+                      (if (file-accessible-directory-p default-directory)
+                          default-directory
                         (expand-file-name "~/"))))
                 (ignore-errors
                   (call-process manual-program nil t nil "--help")))
@@ -749,7 +749,8 @@ POS defaults to `point'."
          ;; Record the distance traveled.
          (setq distance (- column (current-column)))
          (when (looking-back
-                (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)"))
+                (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)")
+                 (line-beginning-position))
            ;; Skip section number backwards.
            (goto-char (match-beginning 0))
            (skip-chars-backward " \t"))
@@ -778,7 +779,7 @@ POS defaults to `point'."
       ;;     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])")
+      (when (looking-at "‐?[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])")
        (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)))
@@ -932,12 +933,14 @@ test/automated/man-tests.el in the emacs repository."
 ;;;###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
+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.
+buffer.  The variable `Man-width' defines the number of columns in
+formatted manual pages.  The buffer is displayed immediately.
+The variable `Man-notify-method' defines how the buffer is displayed.
+If a buffer already exists for this man page, it will be displayed
+without running the man command.
 
 For a manpage from a particular section, use either of the
 following.  \"cat(1)\" is how cross-references appear and is
@@ -961,7 +964,7 @@ otherwise look like a page name.
 
 An \"apropos\" query with -k gives a buffer of matching page
 names or descriptions.  The pattern argument is usually an
-\"egrep\" style regexp.
+\"grep -E\" style regexp.
 
     -k pattern"
 
@@ -1032,15 +1035,22 @@ names or descriptions.  The pattern argument is usually an
     ;;               ther is available).
     (when (or window-system
              (not (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.
+      ;; Since the page buffer is displayed beforehand,
+      ;; we can select its window and get the window/frame width.
       (setenv "COLUMNS" (number-to-string
                         (cond
                          ((and (integerp Man-width) (> Man-width 0))
                           Man-width)
-                         (Man-width (frame-width))
-                         ((window-width))))))
+                         (Man-width
+                          (if (window-live-p (get-buffer-window (current-buffer) t))
+                              (with-selected-window (get-buffer-window (current-buffer) t)
+                                (frame-width))
+                            (frame-width)))
+                         (t
+                          (if (window-live-p (get-buffer-window (current-buffer) t))
+                              (with-selected-window (get-buffer-window (current-buffer) t)
+                                (window-width))
+                            (window-width)))))))
     ;; 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).
@@ -1059,33 +1069,45 @@ Return the buffer in which the manpage will appear."
       (message "Invoking %s %s in the background" manual-program man-args)
       (setq buffer (generate-new-buffer bufname))
       (with-current-buffer buffer
+       (Man-notify-when-ready buffer)
        (setq buffer-undo-list t)
        (setq Man-original-frame (selected-frame))
-       (setq Man-arguments man-args))
-      (Man-start-calling
-       (if (fboundp 'start-process)
-           (set-process-sentinel
-            (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)
-         (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)))))
-      buffer))
+       (setq Man-arguments man-args)
+       (Man-mode)
+       (setq mode-line-process
+             (concat " " (propertize (if Man-fontify-manpage-flag
+                                         "[formatting...]"
+                                       "[cleaning...]")
+                                     'face 'mode-line-emphasis)))
+       (Man-start-calling
+        (if (fboundp 'make-process)
+            (let ((proc (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))))
+              (set-process-sentinel proc 'Man-bgproc-sentinel)
+              (set-process-filter proc 'Man-bgproc-filter))
+          (let* ((inhibit-read-only t)
+                 (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))
+            (if Man-fontify-manpage-flag
+                (Man-fontify-manpage)
+              (Man-cleanup-manpage))
+            (Man-bgproc-sentinel bufname msg))))))
+    buffer))
 
 (defun Man-update-manpage ()
   "Reformat current manpage by calling the man command again synchronously."
@@ -1170,7 +1192,6 @@ See the variable `Man-notify-method' for the different notification behaviors."
   "Convert overstriking and underlining to the correct fonts.
 Same for the ANSI bold and normal escape sequences."
   (interactive)
-  (message "Please wait: formatting the %s man page..." Man-arguments)
   (goto-char (point-min))
   ;; Fontify ANSI escapes.
   (let ((ansi-color-apply-face-function
@@ -1185,7 +1206,7 @@ Same for the ANSI bold and normal escape sequences."
        ;; Multibyte characters exist.
        (progn
          (goto-char (point-min))
-         (while (search-forward "__\b\b" nil t)
+         (while (and (search-forward "__\b\b" nil t) (not (eobp)))
            (backward-delete-char 4)
            (put-text-property (point) (1+ (point)) 'face 'Man-underline))
          (goto-char (point-min))
@@ -1193,7 +1214,7 @@ Same for the ANSI bold and normal escape sequences."
            (backward-delete-char 4)
            (put-text-property (1- (point)) (point) 'face 'Man-underline))))
     (goto-char (point-min))
-    (while (search-forward "_\b" nil t)
+    (while (and (search-forward "_\b" nil t) (not (eobp)))
       (backward-delete-char 2)
       (put-text-property (point) (1+ (point)) 'face 'Man-underline))
     (goto-char (point-min))
@@ -1225,8 +1246,7 @@ Same for the ANSI bold and normal escape sequences."
     (while (re-search-forward Man-heading-regexp nil t)
       (put-text-property (match-beginning 0)
                         (match-end 0)
-                        'face 'Man-overstrike)))
-  (message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
+                        'face 'Man-overstrike))))
 
 (defun Man-highlight-references (&optional xref-man-type)
   "Highlight the references on mouse-over.
@@ -1288,8 +1308,6 @@ 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 (not Man-sed-script))
       (progn
        (goto-char (point-min))
@@ -1311,8 +1329,35 @@ script would have done them."
   ;; their preceding chars (but don't put Man-overstrike).  (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))
+  (Man-softhyphen-to-minus))
+
+(defun Man-bgproc-filter (process string)
+  "Manpage background process filter.
+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 STRING is the entire string of output."
+  (save-excursion
+    (let ((Man-buffer (process-buffer process)))
+      (if (null (buffer-name Man-buffer)) ;; deleted buffer
+         (set-process-buffer process nil)
+
+       (with-current-buffer Man-buffer
+         (let ((inhibit-read-only t)
+               (beg (marker-position (process-mark process))))
+           (save-excursion
+             (goto-char beg)
+             (insert string)
+             (save-restriction
+               (narrow-to-region
+                (save-excursion
+                  (goto-char beg)
+                  (line-beginning-position))
+                (point))
+               (if Man-fontify-manpage-flag
+                   (Man-fontify-manpage)
+                 (Man-cleanup-manpage)))
+             (set-marker (process-mark process) (point-max)))))))))
 
 (defun Man-bgproc-sentinel (process msg)
   "Manpage background process sentinel.
@@ -1331,63 +1376,84 @@ manpage command."
            (set-process-buffer process nil))
 
       (with-current-buffer Man-buffer
-       (let ((case-fold-search nil))
-         (goto-char (point-min))
-         (cond ((or (looking-at "No \\(manual \\)*entry for")
-                    (looking-at "[^\n]*: nothing appropriate$"))
-                (setq err-mess (buffer-substring (point)
-                                                 (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))))
-                (or (zerop (length msg))
-                    (progn
-                      (setq err-mess
-                            (concat (buffer-name Man-buffer)
-                                    ": process "
-                                    (let ((eos (1- (length msg))))
-                                      (if (= (aref msg eos) ?\n)
-                                          (substring msg 0 eos) msg))))
-                      (goto-char (point-max))
-                      (insert (format "\nprocess %s" msg))))
-                ))
-        (if delete-buff
-            (kill-buffer Man-buffer)
-          (if Man-fontify-manpage-flag
-              (Man-fontify-manpage)
-            (Man-cleanup-manpage))
-
-          (run-hooks 'Man-cooked-hook)
-         (Man-mode)
-
-         (if (not Man-page-list)
-             (let ((args Man-arguments))
-               (kill-buffer (current-buffer))
-               (user-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.
-
-       (if (not delete-buff)
-           (Man-notify-when-ready Man-buffer))
+       (save-excursion
+         (let ((case-fold-search nil))
+           (goto-char (point-min))
+           (cond ((or (looking-at "No \\(manual \\)*entry for")
+                      (looking-at "[^\n]*: nothing appropriate$"))
+                  (setq err-mess (buffer-substring (point)
+                                                   (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))))
+                  (or (zerop (length msg))
+                      (progn
+                        (setq err-mess
+                              (concat (buffer-name Man-buffer)
+                                      ": process "
+                                      (let ((eos (1- (length msg))))
+                                        (if (= (aref msg eos) ?\n)
+                                            (substring msg 0 eos) msg))))
+                        (goto-char (point-max))
+                        (insert (format "\nprocess %s" msg))))
+                  ))
+           (if delete-buff
+               (if (window-live-p (get-buffer-window Man-buffer t))
+                   (quit-restore-window
+                    (get-buffer-window Man-buffer t) 'kill)
+                 (kill-buffer Man-buffer))
+
+             (run-hooks 'Man-cooked-hook)
+
+             (Man-build-page-list)
+             (Man-strip-page-headers)
+             (Man-unindent)
+             (Man-goto-page 1 t)
+
+             (if (not Man-page-list)
+                 (let ((args Man-arguments))
+                   (if (window-live-p (get-buffer-window (current-buffer) t))
+                       (quit-restore-window
+                        (get-buffer-window (current-buffer) t) 'kill)
+                     (kill-buffer (current-buffer)))
+                    ;; Entries hyphenated due to the window's width
+                    ;; won't be found in the man database, so remove
+                    ;; the hyphenation -- assuming Groff hyphenates
+                    ;; either with hyphen-minus (ASCII 45, #x2d),
+                    ;; hyphen (#x2010) or soft hyphen (#xad) -- and
+                    ;; look again.
+                   (if (string-match "[-‐­]" args)
+                       (let ((str (replace-match "" nil nil args)))
+                         (Man-getpage-in-background str))
+                      (message "Can't find the %s manpage"
+                               (Man-page-from-arguments args))))
+
+               (if Man-fontify-manpage-flag
+                   (message "%s man page formatted"
+                            (Man-page-from-arguments Man-arguments))
+                 (message "%s man page cleaned up"
+                          (Man-page-from-arguments Man-arguments)))
+               (unless (and (processp process)
+                            (not (eq (process-status process) 'exit)))
+                 (setq mode-line-process nil))
+               (set-buffer-modified-p nil)))))
 
        (if err-mess
-           (error "%s" err-mess))
+           (message "%s" err-mess))
        ))))
 
 (defun Man-page-from-arguments (args)
@@ -1431,7 +1497,7 @@ The following man commands are available in the buffer.  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-notify-method'            What happens when manpage is ready to display.
 `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.
@@ -1460,11 +1526,7 @@ The following key bindings are currently in effect in the buffer:
   (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)
-  (Man-goto-page 1 t))
+       'Man-bookmark-make-record))
 
 (defsubst Man-build-section-alist ()
   "Build the list of manpage sections."
@@ -1518,7 +1580,6 @@ The following key bindings are currently in effect in the buffer:
        (page-end (point-max))
        (header ""))
     (goto-char page-start)
-    ;; (switch-to-buffer (current-buffer))(debug)
     (while (not (eobp))
       (setq header
            (if (looking-at Man-page-header-regexp)