Better handle errors after sync man invocations

* lisp/man.el (Man-start-calling): Declare as debuggable.
(Man-getpage-in-background): Call `Man-bgproc-sentinel' with a
cons (BUFFER . EXIT-STATUS) as PROCESS argument for synchronous calls.
(Man-bgproc-sentinel): Use that information to handle those more
similarly to asynchronous calls.  Do not employ window selection hacks
for synchronous calls.  (Bug#77755)

(cherry picked from commit f67e64028efd2d2b12126039ffd830e769015910)

diff --git a/lisp/man.el b/lisp/man.el
index d6a2f6f5b91a69a18e9188eed9b4e405a805280d..65b7b85749c83ce059334a8204781b8cc11223e1 100644 (file)
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1151,6 +1151,7 @@ for the current invocation."
 
 (defmacro Man-start-calling (&rest body)
   "Start the man command in `body' after setting up the environment."
+  (declare (debug t))
   `(let ((process-environment (copy-sequence process-environment))
        ;; The following is so Awk script gets \n intact
        ;; But don't prevent decoding of the outside.
@@ -1238,7 +1239,7 @@ Return the buffer in which the manpage will appear."
                                    exit-status)))
                 (setq msg exit-status))
             (man--maybe-fontify-manpage)
-            (Man-bgproc-sentinel bufname msg))))))
+            (Man-bgproc-sentinel (cons buffer exit-status) msg))))))
     buffer))
 
 (defun Man-update-manpage ()
@@ -1526,17 +1527,26 @@ command is run.  Second argument STRING is the entire string of output."
   "Manpage background process sentinel.
 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 MSG is the exit message of the
-manpage command."
-  (let ((Man-buffer (if (stringp process) (get-buffer process)
-                     (process-buffer process)))
+synchronously, PROCESS is a cons (BUFFER . EXIT-STATUS) of the buffer
+where the manpage command has run and the exit status of the manpage
+command.  Second argument MSG is the exit message of the manpage
+command."
+  (let ((asynchronous (processp process))
+        Man-buffer process-status exit-status
        (delete-buff nil)
        message)
 
+    (if asynchronous
+        (setq Man-buffer     (process-buffer process)
+              process-status (process-status process)
+              exit-status    (process-exit-status process))
+      (setq Man-buffer     (car process)
+            process-status 'exit
+            exit-status    (cdr process)))
+
     (if (not (buffer-live-p Man-buffer)) ;; deleted buffer
-       (or (stringp process)
-           (set-process-buffer process nil))
+       (and asynchronous
+            (set-process-buffer process nil))
 
       (with-current-buffer Man-buffer
        (save-excursion
@@ -1555,15 +1565,14 @@ manpage command."
                  ;; `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)
+                       (eq process-status 'exit)
+                       (= exit-status 0)
                        (= (point-min) (point-max)))
                   (setq message (format "%s: no matches" Man-arguments)
                         delete-buff t))
 
-                 ((or (stringp process)
-                      (not (and (eq (process-status process) 'exit)
-                                (= (process-exit-status process) 0))))
+                 ((not (and (eq process-status 'exit)
+                            (= exit-status 0)))
                   (or (zerop (length msg))
                       (progn
                         (setq message
@@ -1615,10 +1624,13 @@ manpage command."
             (progn
               (quit-restore-window
                (get-buffer-window Man-buffer t) 'kill)
-              ;; Ensure that we end up in the correct window.
-              (let ((old-window (old-selected-window)))
-                (when (window-live-p old-window)
-                  (select-window old-window))))
+              ;; Ensure that we end up in the correct window.  Which is
+              ;; only relevant in rather special cases and if we have
+              ;; been called in an asynchronous fashion, see bug#38164.
+              (and asynchronous
+                   (let ((old-window (old-selected-window)))
+                     (when (window-live-p old-window)
+                       (select-window old-window)))))
           (kill-buffer Man-buffer)))
 
       (when message