From 36dbc139a922a9eb7c34b1ce1de40415d5f59f21 Mon Sep 17 00:00:00 2001 From: Jim Porter 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