1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-11 16:08:13 +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) (setq-local eshell-last-async-procs nil)
(add-hook 'eshell-kill-hook #'eshell-resume-command nil t) (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 (add-hook 'eshell-parse-argument-hook
#'eshell-parse-subcommand-argument nil t) #'eshell-parse-subcommand-argument nil t)
(add-hook 'eshell-parse-argument-hook (add-hook 'eshell-parse-argument-hook
@ -432,8 +421,9 @@ command hooks should be run before and after the command."
(if toplevel (if toplevel
`(eshell-commands (progn `(eshell-commands (progn
(run-hooks 'eshell-pre-command-hook) (run-hooks 'eshell-pre-command-hook)
(catch 'top-level (progn ,@commands)) (unwind-protect
(run-hooks 'eshell-post-command-hook))) (progn ,@commands)
(run-hooks 'eshell-post-command-hook))))
(macroexp-progn commands)))) (macroexp-progn commands))))
(defun eshell-debug-show-parsed-args (terms) (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 Someday, when Scheme will become the dominant Emacs language, all of
this grossness will be made to disappear by using `call/cc'..." this grossness will be made to disappear by using `call/cc'..."
`(let ((eshell-this-command-hook '(ignore))) `(eshell-condition-case err
(eshell-condition-case err (let ((eshell-this-command-hook '(ignore)))
(prog1 (unwind-protect
,object ,object
(mapc #'funcall eshell-this-command-hook)) (mapc #'funcall eshell-this-command-hook)))
(error (error
(mapc #'funcall eshell-this-command-hook) (eshell-errorn (error-message-string err))
(eshell-errorn (error-message-string err)) (eshell-close-handles 1))))
(eshell-close-handles 1)))))
(defvar eshell-output-handle) ;Defined in esh-io.el. (defvar eshell-output-handle) ;Defined in esh-io.el.
(defvar eshell-error-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) (defun eshell-resume-command (proc status)
"Resume the current command when a pipeline ends." "Resume the current command when a pipeline ends."
(when (and proc (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 ;; Make sure PROC is one of our foreground processes and
;; that all of those processes are now dead. ;; that all of those processes are now dead.
(member proc eshell-last-async-procs) (member proc eshell-last-async-procs)
(not (seq-some #'eshell-process-active-p 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 () (defun eshell-resume-eval ()
"Destructively evaluate a form which may need to be deferred." "Destructively evaluate a form which may need to be deferred."
(setq eshell-last-async-procs nil) (setq eshell-last-async-procs nil)
(when eshell-current-command (when eshell-current-command
(eshell-condition-case err (eshell-condition-case err
(let* (retval (let (retval procs)
(procs (catch 'eshell-defer (unwind-protect
(ignore (progn
(setq retval (setq procs (catch 'eshell-defer
(eshell-do-eval (ignore (setq retval
eshell-current-command)))))) (eshell-do-eval
(if retval eshell-current-command)))))
(cadr retval) (when retval
(ignore (setq eshell-last-async-procs procs)))) (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 (error-message-string err)))))) (error (error-message-string err))))))
@ -1051,9 +1051,10 @@ process(es) in a cons cell like:
(let ((,tag-symbol ,tag)) (let ((,tag-symbol ,tag))
(eshell-always-debug-command 'form (eshell-always-debug-command 'form
"%s\n\n%s" ,tag-symbol (eshell-stringify ,form)) "%s\n\n%s" ,tag-symbol (eshell-stringify ,form))
,@body (unwind-protect
(eshell-always-debug-command 'form (progn ,@body)
"done %s\n\n%s" ,tag-symbol (eshell-stringify ,form)))))) (eshell-always-debug-command 'form
"done %s\n\n%s" ,tag-symbol (eshell-stringify ,form)))))))
(defun eshell-do-eval (form &optional synchronous-p) (defun eshell-do-eval (form &optional synchronous-p)
"Evaluate FORM, simplifying it as we go. "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 ;; If we get here, there was no `eshell-defer' thrown, so
;; just return the `let' body's result. ;; just return the `let' body's result.
result))) result)))
((memq (car form) '(catch condition-case unwind-protect)) ((memq (car form) '(catch condition-case))
;; `condition-case' and `unwind-protect' have to be ;; `catch' and `condition-case' have to be handled specially,
;; handled specially, because we only want to call ;; because we only want to call `eshell-do-eval' on their
;; `eshell-do-eval' on their first form. ;; second forms.
;; ;;
;; NOTE: This requires obedience by all forms which this ;; NOTE: This requires obedience by all forms which this
;; function might encounter, that they do not contain ;; function might encounter, that they do not contain
;; other special forms. ;; other special forms.
(unless (eq (car form) 'unwind-protect) (setq args (cdr args))
(setq args (cdr args)))
(unless (eq (caar args) 'eshell-do-eval) (unless (eq (caar args) 'eshell-do-eval)
(eshell-manipulate form "handling special form" (eshell-manipulate form "handling special form"
(setcar args `(eshell-do-eval ',(car args) ,synchronous-p)))) (setcar args `(eshell-do-eval ',(car args) ,synchronous-p))))
(eval form)) (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) ((eq (car form) 'setq)
(if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)")) (if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)"))
(eshell-manipulate form "evaluating arguments to setq" (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. "Function run when killing a process.
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter." PROC and STATUS to functions on the latter."
(declare (obsolete nil "30.1"))
;; Was there till 24.1, but it is not optional. ;; Was there till 24.1, but it is not optional.
(remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
;; Only reset the prompt if this process is running interactively. ;; 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. "Reset the command input location after a process terminates.
The signals which will cause this to happen are matched by The signals which will cause this to happen are matched by
`eshell-reset-signals'." `eshell-reset-signals'."
(declare (obsolete nil "30.1"))
(when (and (stringp status) (when (and (stringp status)
(string-match eshell-reset-signals status)) (string-match eshell-reset-signals status))
(require 'esh-mode) (require 'esh-mode)
@ -434,7 +436,7 @@ Used only on systems which do not support async subprocesses.")
(eshell-close-handles (eshell-close-handles
(if (numberp exit-status) exit-status -1) (if (numberp exit-status) exit-status -1)
(list 'quote (and (numberp exit-status) (= exit-status 0)))) (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) (or (bound-and-true-p eshell-in-pipeline-p)
(setq eshell-last-sync-output-start nil)) (setq eshell-last-sync-output-start nil))
(if (not (numberp exit-status)) (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 (eshell-debug-command 'process
"finished external process `%s'" proc) "finished external process `%s'" proc)
(if primary (if primary
(eshell-kill-process-function proc string) (run-hook-with-args 'eshell-kill-hook proc string)
(setcar stderr-live nil)))))) (setcar stderr-live nil))))))
(funcall finish-io))) (funcall finish-io)))
(when-let ((entry (assq proc eshell-process-list))) (when-let ((entry (assq proc eshell-process-list)))
@ -647,25 +649,25 @@ See the variable `eshell-kill-processes-on-exit'."
"Interrupt a process." "Interrupt a process."
(interactive) (interactive)
(unless (eshell-process-interact 'interrupt-process) (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 () (defun eshell-kill-process ()
"Kill a process." "Kill a process."
(interactive) (interactive)
(unless (eshell-process-interact 'kill-process) (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 () (defun eshell-quit-process ()
"Send quit signal to process." "Send quit signal to process."
(interactive) (interactive)
(unless (eshell-process-interact 'quit-process) (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 () ;(defun eshell-stop-process ()
; "Send STOP signal to process." ; "Send STOP signal to process."
; (interactive) ; (interactive)
; (unless (eshell-process-interact 'stop-process) ; (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 () ;(defun eshell-continue-process ()
; "Send CONTINUE signal to 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 ; ;; jww (1999-09-17): this signal is not dealt with yet. For
; ;; example, `eshell-reset' will be called, and so will ; ;; example, `eshell-reset' will be called, and so will
; ;; `eshell-resume-eval'. ; ;; `eshell-resume-eval'.
; (eshell-kill-process-function nil "continue"))) ; (run-hook-with-args 'eshell-kill-hook nil "continue")))
(provide 'esh-proc) (provide 'esh-proc)
;;; esh-proc.el ends here ;;; 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}" (eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}"
"no")) "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 ;; esh-cmd-tests.el ends here