mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +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:
parent
e88be844bf
commit
eef32d13da
@ -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"
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user