Package: emacs;
Reported by: Reuben Thomas <rrt <at> sc3d.org>
Date: Tue, 31 Jul 2012 12:02:02 UTC
Severity: wishlist
Tags: wontfix
Done: Lars Ingebrigtsen <larsi <at> gnus.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Juri Linkov <juri <at> jurta.org> To: Reuben Thomas <rrt <at> sc3d.org> Cc: 12098 <at> debbugs.gnu.org Subject: bug#12098: How to trap errors in man? Date: Wed, 01 Aug 2012 11:23:30 +0300
> There are plenty of things that freeze the session for much longer
> than the fraction of a second it takes to format most man pages! Even
> bash(1) only takes about a second.
You are right, the largest man page `man bash' takes just 2 sec to format,
so perhaps it makes no sense to run the man command asynchronously nowadays.
The patch below introduces a new variable `Man-async' whose value
could be set to nil to run `man' synchronously.
> Are you sure about that bug number? I looked and it seems to be about
> window layout.
That's right, currently the async mode of man has its peculiarities:
it arranges window layouts after formatting is done, so formatting
can't fit into window layout.
So perhaps we should have two asynchronous modes:
1. delay changes in window configuration
until the process is finished and man page is formatted.
2. prepare window layout before formatting;
I'm still not sure whether we need the former for backward compatibility,
so `Man-async' could have a special value for it.
> I can't see how to use this to communicate back to a particular caller
> that man failed; help?
I don't know if it's possible with lack of multi-threading
to yield to the command loop while waiting for the process output.
But with the following patch you can run `man' synchronously
by using just `(let ((Man-async nil)) (man "bash"))' when its
default value is not nil.
=== modified file 'lisp/man.el'
--- lisp/man.el 2012-07-11 23:13:41 +0000
+++ lisp/man.el 2012-08-01 08:23:10 +0000
@@ -144,6 +144,20 @@ (defcustom Man-reverse-face 'highlight
:type 'face
:group 'man)
+(defcustom Man-async nil
+ "Synchronicity of the manpage command.
+If nil, run the manpage command synchronously.
+If t, run the manpage command asynchronously
+preparing output windows before the process is started.
+If the value is `delayed', run the manpage command
+asynchronously but delay changes in window configuration
+until the process is finished and man page is formatted."
+ :type '(choice (const :tag "Synchronous" nil)
+ (const :tag "Asynchronous" t)
+ (const :tag "Delayed" delayed))
+ :group 'man
+ :version "24.2")
+
;; Use the value of the obsolete user option Man-notify, if set.
(defcustom Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
"Selects the behavior when manpage is ready.
@@ -904,16 +920,37 @@ (defun Man-getpage-in-background (topic)
Return the buffer in which the manpage will appear."
(let* ((man-args topic)
(bufname (concat "*Man " man-args "*"))
- (buffer (get-buffer bufname)))
+ (buffer (get-buffer bufname))
+ (procbufname (concat " " bufname))
+ procbuffer)
(if buffer
(Man-notify-when-ready buffer)
(require 'env)
- (message "Invoking %s %s in the background" manual-program man-args)
- (setq buffer (generate-new-buffer bufname))
- (with-current-buffer buffer
- (setq buffer-undo-list t)
- (setq Man-original-frame (selected-frame))
- (setq Man-arguments man-args))
+ (cond
+ ((eq Man-async 'delayed)
+ (message "Invoking %s %s in the background" manual-program man-args)
+ (setq buffer (generate-new-buffer bufname))
+ (with-current-buffer buffer
+ (setq buffer-undo-list t)
+ (setq Man-original-frame (selected-frame))
+ (setq Man-arguments man-args)))
+ (t
+ (setq buffer (generate-new-buffer bufname))
+ (setq procbuffer (generate-new-buffer procbufname))
+ ;; Display empty output buffer.
+ (unless (memq Man-notify-method '(polite quiet meek))
+ (Man-notify-when-ready buffer))
+ (with-current-buffer buffer
+ (insert (format "Invoking %s %s in the background\n"
+ manual-program man-args))
+ (setq buffer-undo-list t)
+ (setq Man-original-frame (selected-frame))
+ (setq Man-arguments man-args))
+ (with-current-buffer procbuffer
+ (setq buffer-undo-list t)
+ (setq Man-original-frame (selected-frame))
+ (setq Man-arguments man-args))))
+
(let ((process-environment (copy-sequence process-environment))
;; The following is so Awk script gets \n intact
;; But don't prevent decoding of the outside.
@@ -952,16 +989,26 @@ (defun Man-getpage-in-background (topic)
(cond
((and (integerp Man-width) (> Man-width 0))
Man-width)
- (Man-width (frame-width))
- ((window-width))))))
+ (Man-width
+ (if (eq Man-async 'delayed)
+ (frame-width)
+ (with-selected-window (get-buffer-window
+ buffer t)
+ (frame-width))))
+ (t
+ (if (eq Man-async 'delayed)
+ (window-width)
+ (with-selected-window (get-buffer-window
+ buffer t)
+ (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)
+ (if (and Man-async (fboundp 'start-process))
(set-process-sentinel
- (start-process manual-program buffer
+ (start-process manual-program (if (eq Man-async 'delayed) buffer procbuffer)
(if (memq system-type '(cygwin windows-nt))
shell-file-name
"sh")
@@ -969,7 +1016,7 @@ (defun Man-getpage-in-background (topic)
(format (Man-build-man-command) man-args))
'Man-bgproc-sentinel)
(let ((exit-status
- (call-process shell-file-name nil (list buffer nil) nil
+ (call-process shell-file-name nil (list procbuffer nil) nil
shell-command-switch
(format (Man-build-man-command) man-args)))
(msg ""))
@@ -980,7 +1027,7 @@ (defun Man-getpage-in-background (topic)
(format "exited abnormally with code %d"
exit-status)))
(setq msg exit-status))
- (Man-bgproc-sentinel bufname msg)))))
+ (Man-bgproc-sentinel procbufname msg)))))
buffer))
(defun Man-notify-when-ready (man-buffer)
@@ -1216,16 +1263,18 @@ (defun Man-bgproc-sentinel (process msg)
synchronously, PROCESS is the name of the buffer where the manpage
command is run. Second argument MSG is the exit message of the
manpage command."
- (let ((Man-buffer (if (stringp process) (get-buffer process)
- (process-buffer process)))
- (delete-buff nil)
- (err-mess nil))
+ (let* ((Man-procbuffer (if (stringp process) (get-buffer process)
+ (process-buffer process)))
+ (Man-buffer (get-buffer (replace-regexp-in-string
+ "\\` " "" (buffer-name Man-procbuffer))))
+ (delete-buff nil)
+ (err-mess nil))
(if (null (buffer-name Man-buffer)) ;; deleted buffer
(or (stringp process)
(set-process-buffer process nil))
- (with-current-buffer Man-buffer
+ (with-current-buffer Man-procbuffer
(let ((case-fold-search nil))
(goto-char (point-min))
(cond ((or (looking-at "No \\(manual \\)*entry for")
@@ -1261,11 +1310,17 @@ (defun Man-bgproc-sentinel (process msg)
(Man-fontify-manpage)
(Man-cleanup-manpage))
+ (unless (eq Man-async 'delayed)
+ (copy-to-buffer Man-buffer (point-min) (point-max))))))
+
+ (unless delete-buff
+ (with-current-buffer (if (eq Man-async 'delayed) Man-procbuffer Man-buffer)
(run-hooks 'Man-cooked-hook)
(Man-mode)
@@ -1279,11 +1342,13 @@ (defun Man-bgproc-sentinel (process msg)
;; Man-notify-when-ready because it may switch buffers.
(if (not delete-buff)
- (Man-notify-when-ready Man-buffer))
+ (when (or (eq Man-async 'delayed)
+ (memq Man-notify-method '(polite quiet meek)))
+ (Man-notify-when-ready Man-buffer)))
(if err-mess
(error "%s" err-mess))
- ))))
+ )))
(defun Man-page-from-arguments (args)
;; Skip arguments and only print the page name.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.