diff options
| author | Jens Schmidt | 2025-04-12 00:02:56 +0200 |
|---|---|---|
| committer | Juri Linkov | 2025-04-15 21:20:55 +0300 |
| commit | f67e64028efd2d2b12126039ffd830e769015910 (patch) | |
| tree | dbc11952a8b73285390b48f47d7c0a5006d884f0 | |
| parent | 1d3b1b7d88d7710aed9403c3ce750042387dfe5c (diff) | |
| download | emacs-f67e64028efd2d2b12126039ffd830e769015910.tar.gz emacs-f67e64028efd2d2b12126039ffd830e769015910.zip | |
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)
| -rw-r--r-- | lisp/man.el | 46 |
1 files changed, 29 insertions, 17 deletions
diff --git a/lisp/man.el b/lisp/man.el index 4d5e8e323ca..d34d9154052 100644 --- a/lisp/man.el +++ b/lisp/man.el | |||
| @@ -1166,6 +1166,7 @@ for the current invocation." | |||
| 1166 | 1166 | ||
| 1167 | (defmacro Man-start-calling (&rest body) | 1167 | (defmacro Man-start-calling (&rest body) |
| 1168 | "Start the man command in `body' after setting up the environment." | 1168 | "Start the man command in `body' after setting up the environment." |
| 1169 | (declare (debug t)) | ||
| 1169 | `(let ((process-environment (copy-sequence process-environment)) | 1170 | `(let ((process-environment (copy-sequence process-environment)) |
| 1170 | ;; The following is so Awk script gets \n intact | 1171 | ;; The following is so Awk script gets \n intact |
| 1171 | ;; But don't prevent decoding of the outside. | 1172 | ;; But don't prevent decoding of the outside. |
| @@ -1253,7 +1254,7 @@ Return the buffer in which the manpage will appear." | |||
| 1253 | exit-status))) | 1254 | exit-status))) |
| 1254 | (setq msg exit-status)) | 1255 | (setq msg exit-status)) |
| 1255 | (man--maybe-fontify-manpage) | 1256 | (man--maybe-fontify-manpage) |
| 1256 | (Man-bgproc-sentinel bufname msg)))))) | 1257 | (Man-bgproc-sentinel (cons buffer exit-status) msg)))))) |
| 1257 | buffer)) | 1258 | buffer)) |
| 1258 | 1259 | ||
| 1259 | (defun Man-update-manpage () | 1260 | (defun Man-update-manpage () |
| @@ -1541,17 +1542,26 @@ command is run. Second argument STRING is the entire string of output." | |||
| 1541 | "Manpage background process sentinel. | 1542 | "Manpage background process sentinel. |
| 1542 | When manpage command is run asynchronously, PROCESS is the process | 1543 | When manpage command is run asynchronously, PROCESS is the process |
| 1543 | object for the manpage command; when manpage command is run | 1544 | object for the manpage command; when manpage command is run |
| 1544 | synchronously, PROCESS is the name of the buffer where the manpage | 1545 | synchronously, PROCESS is a cons (BUFFER . EXIT-STATUS) of the buffer |
| 1545 | command is run. Second argument MSG is the exit message of the | 1546 | where the manpage command has run and the exit status of the manpage |
| 1546 | manpage command." | 1547 | command. Second argument MSG is the exit message of the manpage |
| 1547 | (let ((Man-buffer (if (stringp process) (get-buffer process) | 1548 | command." |
| 1548 | (process-buffer process))) | 1549 | (let ((asynchronous (processp process)) |
| 1550 | Man-buffer process-status exit-status | ||
| 1549 | (delete-buff nil) | 1551 | (delete-buff nil) |
| 1550 | message) | 1552 | message) |
| 1551 | 1553 | ||
| 1554 | (if asynchronous | ||
| 1555 | (setq Man-buffer (process-buffer process) | ||
| 1556 | process-status (process-status process) | ||
| 1557 | exit-status (process-exit-status process)) | ||
| 1558 | (setq Man-buffer (car process) | ||
| 1559 | process-status 'exit | ||
| 1560 | exit-status (cdr process))) | ||
| 1561 | |||
| 1552 | (if (not (buffer-live-p Man-buffer)) ;; deleted buffer | 1562 | (if (not (buffer-live-p Man-buffer)) ;; deleted buffer |
| 1553 | (or (stringp process) | 1563 | (and asynchronous |
| 1554 | (set-process-buffer process nil)) | 1564 | (set-process-buffer process nil)) |
| 1555 | 1565 | ||
| 1556 | (with-current-buffer Man-buffer | 1566 | (with-current-buffer Man-buffer |
| 1557 | (save-excursion | 1567 | (save-excursion |
| @@ -1570,15 +1580,14 @@ manpage command." | |||
| 1570 | ;; `Man-highlight-references'. The \\s- bits here are | 1580 | ;; `Man-highlight-references'. The \\s- bits here are |
| 1571 | ;; meant to allow for multiple options with -k among them. | 1581 | ;; meant to allow for multiple options with -k among them. |
| 1572 | ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments) | 1582 | ((and (string-match "\\(\\`\\|\\s-\\)-k\\s-" Man-arguments) |
| 1573 | (eq (process-status process) 'exit) | 1583 | (eq process-status 'exit) |
| 1574 | (= (process-exit-status process) 0) | 1584 | (= exit-status 0) |
| 1575 | (= (point-min) (point-max))) | 1585 | (= (point-min) (point-max))) |
| 1576 | (setq message (format "%s: no matches" Man-arguments) | 1586 | (setq message (format "%s: no matches" Man-arguments) |
| 1577 | delete-buff t)) | 1587 | delete-buff t)) |
| 1578 | 1588 | ||
| 1579 | ((or (stringp process) | 1589 | ((not (and (eq process-status 'exit) |
| 1580 | (not (and (eq (process-status process) 'exit) | 1590 | (= exit-status 0))) |
| 1581 | (= (process-exit-status process) 0)))) | ||
| 1582 | (or (zerop (length msg)) | 1591 | (or (zerop (length msg)) |
| 1583 | (progn | 1592 | (progn |
| 1584 | (setq message | 1593 | (setq message |
| @@ -1630,10 +1639,13 @@ manpage command." | |||
| 1630 | (progn | 1639 | (progn |
| 1631 | (quit-restore-window | 1640 | (quit-restore-window |
| 1632 | (get-buffer-window Man-buffer t) 'kill) | 1641 | (get-buffer-window Man-buffer t) 'kill) |
| 1633 | ;; Ensure that we end up in the correct window. | 1642 | ;; Ensure that we end up in the correct window. Which is |
| 1634 | (let ((old-window (old-selected-window))) | 1643 | ;; only relevant in rather special cases and if we have |
| 1635 | (when (window-live-p old-window) | 1644 | ;; been called in an asynchronous fashion, see bug#38164. |
| 1636 | (select-window old-window)))) | 1645 | (and asynchronous |
| 1646 | (let ((old-window (old-selected-window))) | ||
| 1647 | (when (window-live-p old-window) | ||
| 1648 | (select-window old-window))))) | ||
| 1637 | (kill-buffer Man-buffer))) | 1649 | (kill-buffer Man-buffer))) |
| 1638 | 1650 | ||
| 1639 | (when message | 1651 | (when message |