Subject: bug#12098: How to trap errors in man?

From: Juri Linkov <[email-masked]>
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.