Commit a4b0fffe authored by Juri Linkov's avatar Juri Linkov
Browse files

Display man pages immediately and use process-filter to format them asynchronously.

* lisp/man.el (Man-width): Doc fix.
(man): Doc fix.
(Man-start-calling): Use `with-selected-window' to get
`frame-width' and `window-width'.
(Man-getpage-in-background): Call `Man-notify-when-ready'
immediately after creating a new buffer.  Call `Man-mode' and set
`mode-line-process' in the created buffer.  Set process-filter to
`Man-bgproc-filter' in start-process branch.  In call-process branch
call either `Man-fontify-manpage' or `Man-cleanup-manpage'.
Use `Man-start-calling' inside `with-current-buffer'.
(Man-fontify-manpage): Don't print messages.  Fix boundary condition.
(Man-cleanup-manpage): Don't print messages.
(Man-bgproc-filter): New function.
(Man-bgproc-sentinel): Add `save-excursion' to keep point when
user moved it during asynchronous formatting.  Move calls of
`Man-fontify-manpage' and `Man-cleanup-manpage' to
`Man-bgproc-filter'.  Move the call of `Man-mode' to
`Man-getpage-in-background'.  Use `quit-restore-window'
instead of `kill-buffer'.  Use `message' instead of `error'
because errors are catched by process sentinel.
(Man-mode): Move calls of `Man-build-page-list',
`Man-strip-page-headers', `Man-unindent', `Man-goto-page' to
`Man-bgproc-sentinel'.  Doc fix.  (Bug#2588, bug#5054, bug#9084, bug#17831)
parent dd72a0ca
2014-07-01 Juri Linkov <juri@jurta.org>
* man.el: Display man pages immediately and use process-filter
to format them asynchronously.
(Man-width): Doc fix.
(man): Doc fix.
(Man-start-calling): Use `with-selected-window' to get
`frame-width' and `window-width'.
(Man-getpage-in-background): Call `Man-notify-when-ready'
immediately after creating a new buffer. Call `Man-mode' and set
`mode-line-process' in the created buffer. Set process-filter to
`Man-bgproc-filter' in start-process branch. In call-process branch
call either `Man-fontify-manpage' or `Man-cleanup-manpage'.
Use `Man-start-calling' inside `with-current-buffer'.
(Man-fontify-manpage): Don't print messages. Fix boundary condition.
(Man-cleanup-manpage): Don't print messages.
(Man-bgproc-filter): New function.
(Man-bgproc-sentinel): Add `save-excursion' to keep point when
user moved it during asynchronous formatting. Move calls of
`Man-fontify-manpage' and `Man-cleanup-manpage' to
`Man-bgproc-filter'. Move the call of `Man-mode' to
`Man-getpage-in-background'. Use `quit-restore-window'
instead of `kill-buffer'. Use `message' instead of `error'
because errors are catched by process sentinel.
(Man-mode): Move calls of `Man-build-page-list',
`Man-strip-page-headers', `Man-unindent', `Man-goto-page' to
`Man-bgproc-sentinel'. Doc fix. (Bug#2588, bug#5054, bug#9084, bug#17831)
2014-07-01 Mario Lang <mlang@delysid.org> 2014-07-01 Mario Lang <mlang@delysid.org>
   
* net/gnutls.el (gnutls-negotiate): Prevent destructive modification of * net/gnutls.el (gnutls-negotiate): Prevent destructive modification of
......
...@@ -173,13 +173,12 @@ Any other value of `Man-notify-method' is equivalent to `meek'." ...@@ -173,13 +173,12 @@ Any other value of `Man-notify-method' is equivalent to `meek'."
(defcustom Man-width nil (defcustom Man-width nil
"Number of columns for which manual pages should be formatted. "Number of columns for which manual pages should be formatted.
If nil, the width of the window selected at the moment of man If nil, use the width of the window where the manpage is displayed.
invocation is used. If non-nil, the width of the frame selected If non-nil, use the width of the frame where the manpage is displayed.
at the moment of man invocation is used. The value also can be a The value also can be a positive integer for a fixed width."
positive integer."
:type '(choice (const :tag "Window width" nil) :type '(choice (const :tag "Window width" nil)
(const :tag "Frame width" t) (const :tag "Frame width" t)
(integer :tag "Specific width" :value 65)) (integer :tag "Fixed width" :value 65))
:group 'man) :group 'man)
(defcustom Man-frame-parameters nil (defcustom Man-frame-parameters nil
...@@ -930,12 +929,14 @@ test/automated/man-tests.el in the emacs bzr repository." ...@@ -930,12 +929,14 @@ test/automated/man-tests.el in the emacs bzr repository."
;;;###autoload ;;;###autoload
(defun man (man-args) (defun man (man-args)
"Get a Un*x manual page and put it in a buffer. "Get a Un*x manual page and put it in a buffer.
This command is the top-level command in the man package. It This command is the top-level command in the man package.
runs a Un*x command to retrieve and clean a manpage in the It runs a Un*x command to retrieve and clean a manpage in the
background and places the results in a `Man-mode' browsing background and places the results in a `Man-mode' browsing
buffer. See variable `Man-notify-method' for what happens when buffer. The variable `Man-width' defines the number of columns in
the buffer is ready. If a buffer already exists for this man formatted manual pages. The buffer is displayed immediately.
page, it will display 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 For a manpage from a particular section, use either of the
following. \"cat(1)\" is how cross-references appear and is following. \"cat(1)\" is how cross-references appear and is
...@@ -1030,15 +1031,22 @@ names or descriptions. The pattern argument is usually an ...@@ -1030,15 +1031,22 @@ names or descriptions. The pattern argument is usually an
;; ther is available). ;; ther is available).
(when (or window-system (when (or window-system
(not (or (getenv "MANWIDTH") (getenv "COLUMNS")))) (not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
;; This isn't strictly correct, since we don't know how ;; Since the page buffer is displayed beforehand,
;; the page will actually be displayed, but it seems ;; we can select its window and get the window/frame width.
;; reasonable.
(setenv "COLUMNS" (number-to-string (setenv "COLUMNS" (number-to-string
(cond (cond
((and (integerp Man-width) (> Man-width 0)) ((and (integerp Man-width) (> Man-width 0))
Man-width) Man-width)
(Man-width (frame-width)) (Man-width
((window-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 ;; 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 ;; 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). ;; env-var was added to allow control of this (see Debian Bug#340673).
...@@ -1057,20 +1065,29 @@ Return the buffer in which the manpage will appear." ...@@ -1057,20 +1065,29 @@ Return the buffer in which the manpage will appear."
(message "Invoking %s %s in the background" manual-program man-args) (message "Invoking %s %s in the background" manual-program man-args)
(setq buffer (generate-new-buffer bufname)) (setq buffer (generate-new-buffer bufname))
(with-current-buffer buffer (with-current-buffer buffer
(Man-notify-when-ready buffer)
(setq buffer-undo-list t) (setq buffer-undo-list t)
(setq Man-original-frame (selected-frame)) (setq Man-original-frame (selected-frame))
(setq Man-arguments man-args)) (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 (Man-start-calling
(if (fboundp 'start-process) (if (fboundp 'start-process)
(set-process-sentinel (let ((proc (start-process
(start-process manual-program buffer manual-program buffer
(if (memq system-type '(cygwin windows-nt)) (if (memq system-type '(cygwin windows-nt))
shell-file-name shell-file-name
"sh") "sh")
shell-command-switch shell-command-switch
(format (Man-build-man-command) man-args)) (format (Man-build-man-command) man-args))))
'Man-bgproc-sentinel) (set-process-sentinel proc 'Man-bgproc-sentinel)
(let ((exit-status (set-process-filter proc 'Man-bgproc-filter))
(let* ((inhibit-read-only t)
(exit-status
(call-process shell-file-name nil (list buffer nil) nil (call-process shell-file-name nil (list buffer nil) nil
shell-command-switch shell-command-switch
(format (Man-build-man-command) man-args))) (format (Man-build-man-command) man-args)))
...@@ -1082,7 +1099,10 @@ Return the buffer in which the manpage will appear." ...@@ -1082,7 +1099,10 @@ Return the buffer in which the manpage will appear."
(format "exited abnormally with code %d" (format "exited abnormally with code %d"
exit-status))) exit-status)))
(setq msg exit-status)) (setq msg exit-status))
(Man-bgproc-sentinel bufname msg))))) (if Man-fontify-manpage-flag
(Man-fontify-manpage)
(Man-cleanup-manpage))
(Man-bgproc-sentinel bufname msg))))))
buffer)) buffer))
(defun Man-update-manpage () (defun Man-update-manpage ()
...@@ -1168,7 +1188,6 @@ See the variable `Man-notify-method' for the different notification behaviors." ...@@ -1168,7 +1188,6 @@ See the variable `Man-notify-method' for the different notification behaviors."
"Convert overstriking and underlining to the correct fonts. "Convert overstriking and underlining to the correct fonts.
Same for the ANSI bold and normal escape sequences." Same for the ANSI bold and normal escape sequences."
(interactive) (interactive)
(message "Please wait: formatting the %s man page..." Man-arguments)
(goto-char (point-min)) (goto-char (point-min))
;; Fontify ANSI escapes. ;; Fontify ANSI escapes.
(let ((ansi-color-apply-face-function (let ((ansi-color-apply-face-function
...@@ -1183,7 +1202,7 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1183,7 +1202,7 @@ Same for the ANSI bold and normal escape sequences."
;; Multibyte characters exist. ;; Multibyte characters exist.
(progn (progn
(goto-char (point-min)) (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) (backward-delete-char 4)
(put-text-property (point) (1+ (point)) 'face 'Man-underline)) (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min)) (goto-char (point-min))
...@@ -1191,7 +1210,7 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1191,7 +1210,7 @@ Same for the ANSI bold and normal escape sequences."
(backward-delete-char 4) (backward-delete-char 4)
(put-text-property (1- (point)) (point) 'face 'Man-underline)))) (put-text-property (1- (point)) (point) 'face 'Man-underline))))
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "_\b" nil t) (while (and (search-forward "_\b" nil t) (not (eobp)))
(backward-delete-char 2) (backward-delete-char 2)
(put-text-property (point) (1+ (point)) 'face 'Man-underline)) (put-text-property (point) (1+ (point)) 'face 'Man-underline))
(goto-char (point-min)) (goto-char (point-min))
...@@ -1223,8 +1242,7 @@ Same for the ANSI bold and normal escape sequences." ...@@ -1223,8 +1242,7 @@ Same for the ANSI bold and normal escape sequences."
(while (re-search-forward Man-heading-regexp nil t) (while (re-search-forward Man-heading-regexp nil t)
(put-text-property (match-beginning 0) (put-text-property (match-beginning 0)
(match-end 0) (match-end 0)
'face 'Man-overstrike))) 'face 'Man-overstrike))))
(message "%s man page formatted" (Man-page-from-arguments Man-arguments)))
(defun Man-highlight-references (&optional xref-man-type) (defun Man-highlight-references (&optional xref-man-type)
"Highlight the references on mouse-over. "Highlight the references on mouse-over.
...@@ -1286,8 +1304,6 @@ Normally skip any jobs that should have been done by the sed script, ...@@ -1286,8 +1304,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 but when called interactively, do those jobs even if the sed
script would have done them." script would have done them."
(interactive "p") (interactive "p")
(message "Please wait: cleaning up the %s man page..."
Man-arguments)
(if (or interactive (not Man-sed-script)) (if (or interactive (not Man-sed-script))
(progn (progn
(goto-char (point-min)) (goto-char (point-min))
...@@ -1309,8 +1325,35 @@ script would have done them." ...@@ -1309,8 +1325,35 @@ script would have done them."
;; their preceding chars (but don't put Man-overstrike). (Bug#5566) ;; their preceding chars (but don't put Man-overstrike). (Bug#5566)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward ".\b" nil t) (backward-delete-char 2)) (while (re-search-forward ".\b" nil t) (backward-delete-char 2))
(Man-softhyphen-to-minus) (Man-softhyphen-to-minus))
(message "%s man page cleaned up" Man-arguments))
(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) (defun Man-bgproc-sentinel (process msg)
"Manpage background process sentinel. "Manpage background process sentinel.
...@@ -1329,6 +1372,7 @@ manpage command." ...@@ -1329,6 +1372,7 @@ manpage command."
(set-process-buffer process nil)) (set-process-buffer process nil))
(with-current-buffer Man-buffer (with-current-buffer Man-buffer
(save-excursion
(let ((case-fold-search nil)) (let ((case-fold-search nil))
(goto-char (point-min)) (goto-char (point-min))
(cond ((or (looking-at "No \\(manual \\)*entry for") (cond ((or (looking-at "No \\(manual \\)*entry for")
...@@ -1364,28 +1408,38 @@ manpage command." ...@@ -1364,28 +1408,38 @@ manpage command."
(insert (format "\nprocess %s" msg)))) (insert (format "\nprocess %s" msg))))
)) ))
(if delete-buff (if delete-buff
(kill-buffer Man-buffer) (if (window-live-p (get-buffer-window Man-buffer t))
(if Man-fontify-manpage-flag (quit-restore-window
(Man-fontify-manpage) (get-buffer-window Man-buffer t) 'kill)
(Man-cleanup-manpage)) (kill-buffer Man-buffer))
(run-hooks 'Man-cooked-hook) (run-hooks 'Man-cooked-hook)
(Man-mode)
(Man-build-page-list)
(Man-strip-page-headers)
(Man-unindent)
(Man-goto-page 1 t)
(if (not Man-page-list) (if (not Man-page-list)
(let ((args Man-arguments)) (let ((args Man-arguments))
(kill-buffer (current-buffer)) (if (window-live-p (get-buffer-window (current-buffer) t))
(user-error "Can't find the %s manpage" (quit-restore-window
(get-buffer-window (current-buffer) t) 'kill)
(kill-buffer (current-buffer)))
(message "Can't find the %s manpage"
(Man-page-from-arguments args))) (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) (if Man-fontify-manpage-flag
(Man-notify-when-ready Man-buffer)) (message "%s man page formatted"
(Man-page-from-arguments Man-arguments))
(message "%s man page cleaned up" 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 (if err-mess
(error "%s" err-mess)) (message "%s" err-mess))
)))) ))))
(defun Man-page-from-arguments (args) (defun Man-page-from-arguments (args)
...@@ -1429,7 +1483,7 @@ The following man commands are available in the buffer. Try ...@@ -1429,7 +1483,7 @@ The following man commands are available in the buffer. Try
The following variables may be of some use. Try The following variables may be of some use. Try
\"\\[describe-variable] <variable-name> RET\" for more information: \"\\[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-downcase-section-letters-flag' Force section letters to lower case.
`Man-circular-pages-flag' Treat multiple manpage list as circular. `Man-circular-pages-flag' Treat multiple manpage list as circular.
`Man-section-translations-alist' List of section numbers and their Un*x equiv. `Man-section-translations-alist' List of section numbers and their Un*x equiv.
...@@ -1458,11 +1512,7 @@ The following key bindings are currently in effect in the buffer: ...@@ -1458,11 +1512,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-regexp) Man-heading-regexp)
(set (make-local-variable 'outline-level) (lambda () 1)) (set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'bookmark-make-record-function) (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)
(Man-goto-page 1 t))
(defsubst Man-build-section-alist () (defsubst Man-build-section-alist ()
"Build the list of manpage sections." "Build the list of manpage sections."
...@@ -1516,7 +1566,6 @@ The following key bindings are currently in effect in the buffer: ...@@ -1516,7 +1566,6 @@ The following key bindings are currently in effect in the buffer:
(page-end (point-max)) (page-end (point-max))
(header "")) (header ""))
(goto-char page-start) (goto-char page-start)
;; (switch-to-buffer (current-buffer))(debug)
(while (not (eobp)) (while (not (eobp))
(setq header (setq header
(if (looking-at Man-page-header-regexp) (if (looking-at Man-page-header-regexp)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment