1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-23 10:34:07 +00:00

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.
This commit is contained in:
Jim Porter 2023-09-22 18:22:34 -07:00
parent e88be844bf
commit eef32d13da
3 changed files with 91 additions and 52 deletions

View File

@ -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"

View File

@ -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

View File

@ -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