bug#12098: How to trap errors in man?

[Juri Linkov]

> 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.