Subject: 30.0.50; [PATCH] Use 'unwind-protect' in some more places in Eshell

From: Jim Porter <[email-masked]>
Date: Fri, 22 Sep 2023 21:49:34 -0700

(I debated just pushing this since it's mostly an implementation detail 
in Eshell, but it's a complex-enough patch that I figured it couldn't 
hurt to see if anyone has thoughts beforehand.)

The main reason for this patch is to simplify some Eshell logic as a 
preliminary for better support of background commands (bug#660666), 
which in turn is a preliminary for adding job control to Eshell. 
However, this does also fix a couple edge cases with how Eshell unwinds 
its command forms in response to error handling (e.g. previously, 
calling 'top-level' inside an Eshell command didn't actually exit 
recursive editing).

From 36dbc139a922a9eb7c34b1ce1de40415d5f59f21 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
Date: Fri, 22 Sep 2023 18:22:34 -0700
Subject: [PATCH] Use 'unwind-protect' in more places in Eshell

This lets us simplify the logic for how we reset
'eshell-current-command' and 'eshell-last-async-procs', as well as
improving correctness of Eshell command forms in a few esoteric
scenarios.  Additionally, this helps set the stage for better support
of background commands in Eshell.

* lisp/eshell/esh-cmd.el (eshell-cmd-initialize): Remove addition to
'eshell-post-command-hook'; this is handled in 'eshell-resume-command'
and 'eshell-resume-eval' now.
(eshell-resume-command): Handle resetting the prompt as needed.
(eshell-resume-eval): Use 'unwind-protect' to ensure that we set
'eshell-last-async-procs' and 'eshell-current-comment' at the right
times.
(eshell-parse-command, eshell-trap-errors, eshell-manipulate): Use
'unwind-protect'.
(eshell-do-eval): Allow 'eshell-defer' to pass through
'unwind-protect' forms without actually calling the unwinding forms
(yet).

* lisp/eshell/esh-proc.el (eshell-kill-process-function)
(eshell-reset-after-proc): Make obsolete.  The behavior is now handled
in 'eshell-resume-command'.
(eshell-gather-process-output, eshell-sentinel)
(eshell-interrupt-process, eshell-kill-process, eshell-quit-process)
(eshell-stop-process, eshell-continue-process): Run 'eshell-kill-hook'
directly.

* test/lisp/eshell/esh-cmd-tests.el (esh-cmd-test/throw): New test.
---
 lisp/eshell/esh-cmd.el            | 111 ++++++++++++++++++------------
 lisp/eshell/esh-proc.el           |  16 +++--
 test/lisp/eshell/esh-cmd-tests.el |  16 +++++
 3 files changed, 91 insertions(+), 52 deletions(-)

diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index b4d9b044a7b..1d828bd7f82 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -319,17 +319,6 @@ eshell-cmd-initialize
   (setq-local eshell-last-async-procs nil)
 
   (add-hook 'eshell-kill-hook #'eshell-resume-command nil t)
-
-  ;; make sure that if a command is over, and no process is being
-  ;; waited for, that `eshell-current-command' is set to nil.  This
-  ;; situation can occur, for example, if a Lisp function results in
-  ;; `debug' being called, and the user then types \\[top-level]
-  (add-hook 'eshell-post-command-hook
-            (lambda ()
-              (setq eshell-current-command nil
-                    eshell-last-async-procs nil))
-            nil t)
-
   (add-hook 'eshell-parse-argument-hook
 	    #'eshell-parse-subcommand-argument nil t)
   (add-hook 'eshell-parse-argument-hook
@@ -432,8 +421,9 @@ eshell-parse-command
     (if toplevel
 	`(eshell-commands (progn
                             (run-hooks 'eshell-pre-command-hook)
-                            (catch 'top-level (progn ,@commands))
-                            (run-hooks 'eshell-post-command-hook)))
+                            (unwind-protect
+                                (progn ,@commands)
+                              (run-hooks 'eshell-post-command-hook))))
       (macroexp-progn commands))))
 
 (defun eshell-debug-show-parsed-args (terms)
@@ -772,15 +762,14 @@ eshell-trap-errors
 
 Someday, when Scheme will become the dominant Emacs language, all of
 this grossness will be made to disappear by using `call/cc'..."
-  `(let ((eshell-this-command-hook '(ignore)))
-     (eshell-condition-case err
-	 (prog1
-	     ,object
-	   (mapc #'funcall eshell-this-command-hook))
-       (error
-	(mapc #'funcall eshell-this-command-hook)
-	(eshell-errorn (error-message-string err))
-	(eshell-close-handles 1)))))
+  `(eshell-condition-case err
+       (let ((eshell-this-command-hook '(ignore)))
+         (unwind-protect
+             ,object
+           (mapc #'funcall eshell-this-command-hook)))
+     (error
+      (eshell-errorn (error-message-string err))
+      (eshell-close-handles 1))))
 
 (defvar eshell-output-handle)           ;Defined in esh-io.el.
 (defvar eshell-error-handle)            ;Defined in esh-io.el.
@@ -1015,30 +1004,41 @@ eshell-eval-command
 (defun eshell-resume-command (proc status)
   "Resume the current command when a pipeline ends."
   (when (and proc
-             ;; Make sure STATUS is something we want to handle.
-             (stringp status)
-             (not (string= "stopped" status))
-             (not (string-match eshell-reset-signals status))
              ;; Make sure PROC is one of our foreground processes and
              ;; that all of those processes are now dead.
              (member proc eshell-last-async-procs)
              (not (seq-some #'eshell-process-active-p eshell-last-async-procs)))
-    (eshell-resume-eval)))
+    (if (and ;; Check STATUS to determine whether we want to resume or
+             ;; abort the command.
+             (stringp status)
+             (not (string= "stopped" status))
+             (not (string-match eshell-reset-signals status)))
+        (eshell-resume-eval)
+      (setq eshell-last-async-procs nil)
+      (setq eshell-current-command nil)
+      (declare-function eshell-reset "esh-mode" (&optional no-hooks))
+      (eshell-reset))))
 
 (defun eshell-resume-eval ()
   "Destructively evaluate a form which may need to be deferred."
   (setq eshell-last-async-procs nil)
   (when eshell-current-command
     (eshell-condition-case err
-        (let* (retval
-               (procs (catch 'eshell-defer
-                        (ignore
-                         (setq retval
-                               (eshell-do-eval
-                                eshell-current-command))))))
-          (if retval
-              (cadr retval)
-            (ignore (setq eshell-last-async-procs procs))))
+        (let (retval procs)
+          (unwind-protect
+              (progn
+                (setq procs (catch 'eshell-defer
+                              (ignore (setq retval
+                                            (eshell-do-eval
+                                             eshell-current-command)))))
+                (when retval
+                  (cadr retval)))
+            (setq eshell-last-async-procs procs)
+            ;; If we didn't defer this command, clear it out.  This
+            ;; applies both when the command has finished normally,
+            ;; and when a signal or thrown value causes us to unwind.
+            (unless procs
+              (setq eshell-current-command nil))))
       (error
        (error (error-message-string err))))))
 
@@ -1051,9 +1051,10 @@ eshell-manipulate
        (let ((,tag-symbol ,tag))
          (eshell-always-debug-command 'form
            "%s\n\n%s" ,tag-symbol (eshell-stringify ,form))
-         ,@body
-         (eshell-always-debug-command 'form
-           "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form))))))
+         (unwind-protect
+             (progn ,@body)
+           (eshell-always-debug-command 'form
+             "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form)))))))
 
 (defun eshell-do-eval (form &optional synchronous-p)
   "Evaluate FORM, simplifying it as we go.
@@ -1181,20 +1182,40 @@ eshell-do-eval
             ;; If we get here, there was no `eshell-defer' thrown, so
             ;; just return the `let' body's result.
             result)))
-       ((memq (car form) '(catch condition-case unwind-protect))
-	;; `condition-case' and `unwind-protect' have to be
-	;; handled specially, because we only want to call
-	;; `eshell-do-eval' on their first form.
+       ((memq (car form) '(catch condition-case))
+        ;; `catch' and `condition-case' have to be handled specially,
+        ;; because we only want to call `eshell-do-eval' on their
+        ;; second forms.
 	;;
 	;; NOTE: This requires obedience by all forms which this
 	;; function might encounter, that they do not contain
 	;; other special forms.
-	(unless (eq (car form) 'unwind-protect)
-	  (setq args (cdr args)))
+        (setq args (cdr args))
 	(unless (eq (caar args) 'eshell-do-eval)
           (eshell-manipulate form "handling special form"
 	    (setcar args `(eshell-do-eval ',(car args) ,synchronous-p))))
 	(eval form))
+       ((eq (car form) 'unwind-protect)
+        ;; `unwind-protect' has to be handled specially, because we
+        ;; only want to call `eshell-do-eval' on its first form, and
+        ;; we need to ensure we let `eshell-defer' through without
+        ;; evaluating the unwind forms.
+        (let (deferred)
+          (unwind-protect
+              (eshell-manipulate form "handling `unwind-protect' body form"
+                (setq deferred
+                      (catch 'eshell-defer
+                        (ignore
+                         (setcar args (eshell-do-eval
+                                       (car args) synchronous-p)))))
+                (car args))
+            (if deferred
+                (throw 'eshell-defer deferred)
+              (eshell-manipulate form "handling `unwind-protect' unwind forms"
+                (pop args)
+                (while args
+                  (setcar args (eshell-do-eval (car args) synchronous-p))
+                  (pop args)))))))
        ((eq (car form) 'setq)
 	(if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)"))
         (eshell-manipulate form "evaluating arguments to setq"
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index e564c755320..d15e1e7d09b 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -129,6 +129,7 @@ eshell-kill-process-function
   "Function run when killing a process.
 Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
 PROC and STATUS to functions on the latter."
+  (declare (obsolete nil "30.1"))
   ;; Was there till 24.1, but it is not optional.
   (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
   ;; Only reset the prompt if this process is running interactively.
@@ -151,6 +152,7 @@ eshell-reset-after-proc
   "Reset the command input location after a process terminates.
 The signals which will cause this to happen are matched by
 `eshell-reset-signals'."
+  (declare (obsolete nil "30.1"))
   (when (and (stringp status)
 	     (string-match eshell-reset-signals status))
     (require 'esh-mode)
@@ -434,7 +436,7 @@ eshell-gather-process-output
 	(eshell-close-handles
          (if (numberp exit-status) exit-status -1)
          (list 'quote (and (numberp exit-status) (= exit-status 0))))
-	(eshell-kill-process-function command exit-status)
+	(run-hook-with-args 'eshell-kill-hook command exit-status)
 	(or (bound-and-true-p eshell-in-pipeline-p)
 	    (setq eshell-last-sync-output-start nil))
 	(if (not (numberp exit-status))
@@ -550,7 +552,7 @@ eshell-sentinel
                           (eshell-debug-command 'process
                             "finished external process `%s'" proc)
                           (if primary
-                              (eshell-kill-process-function proc string)
+                              (run-hook-with-args 'eshell-kill-hook proc string)
                             (setcar stderr-live nil))))))
               (funcall finish-io)))
         (when-let ((entry (assq proc eshell-process-list)))
@@ -647,25 +649,25 @@ eshell-interrupt-process
   "Interrupt a process."
   (interactive)
   (unless (eshell-process-interact 'interrupt-process)
-    (eshell-kill-process-function nil "interrupt")))
+    (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
 
 (defun eshell-kill-process ()
   "Kill a process."
   (interactive)
   (unless (eshell-process-interact 'kill-process)
-    (eshell-kill-process-function nil "killed")))
+    (run-hook-with-args 'eshell-kill-hook nil "killed")))
 
 (defun eshell-quit-process ()
   "Send quit signal to process."
   (interactive)
   (unless (eshell-process-interact 'quit-process)
-    (eshell-kill-process-function nil "quit")))
+    (run-hook-with-args 'eshell-kill-hook nil "quit")))
 
 ;(defun eshell-stop-process ()
 ;  "Send STOP signal to process."
 ;  (interactive)
 ;  (unless (eshell-process-interact 'stop-process)
-;    (eshell-kill-process-function nil "stopped")))
+;    (run-hook-with-args 'eshell-kill-hook nil "stopped")))
 
 ;(defun eshell-continue-process ()
 ;  "Send CONTINUE signal to process."
@@ -674,7 +676,7 @@ eshell-quit-process
 ;    ;; jww (1999-09-17): this signal is not dealt with yet.  For
 ;    ;; example, `eshell-reset' will be called, and so will
 ;    ;; `eshell-resume-eval'.
-;    (eshell-kill-process-function nil "continue")))
+;    (run-hook-with-args 'eshell-kill-hook nil "continue")))
 
 (provide 'esh-proc)
 ;;; esh-proc.el ends here
diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el
index 7c384471e93..643038f89ff 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -442,4 +442,20 @@ esh-cmd-test/unless-else-statement-ext-cmd
   (eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}"
                                "no"))
 
+
+;; Error handling
+
+(ert-deftest esh-cmd-test/throw ()
+  "Test that calling `throw' as an Eshell command unwinds everything properly."
+  (with-temp-eshell
+   (should (= (catch 'tag
+                (eshell-insert-command
+                 "echo hi; (throw 'tag 42); echo bye"))
+              42))
+   (should (eshell-match-output "\\`hi\n\\'"))
+   (should-not eshell-current-command)
+   (should-not eshell-last-async-procs)
+   ;; Make sure we can call another command after throwing.
+   (eshell-match-command-output "echo again" "\\`again\n")))
+
 ;; esh-cmd-tests.el ends here
-- 
2.25.1