master eef32d13da5: Use 'unwind-protect' in more places in Eshell

[Jim Porter]

branch: master
commit eef32d13da58d9773d6e1889b8de42e5d1711ad5
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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 (bug#66164).
    
    * 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 @@ This only returns external (non-Lisp) processes."
   (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 @@ command hooks should be run before and after the 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 @@ to this hook using `nconc', and *not* `add-hook'.
 
 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 @@ process(es) in a cons cell like:
 (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 @@ process(es) in a cons cell like:
        (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 @@ have been replaced by constants."
             ;; 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 @@ To add or remove elements of this list, see
   "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 @@ PROC and STATUS to functions on the latter."
   "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 @@ Used only on systems which do not support async 
subprocesses.")
        (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 @@ PROC is the process that's exiting.  STRING is the exit 
message."
                           (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 @@ See the variable `eshell-kill-processes-on-exit'."
   "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 @@ See the variable `eshell-kill-processes-on-exit'."
 ;    ;; 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 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
   (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