diff options
| author | Jim Porter | 2023-09-22 18:22:34 -0700 |
|---|---|---|
| committer | Jim Porter | 2023-09-26 12:29:52 -0700 |
| commit | eef32d13da58d9773d6e1889b8de42e5d1711ad5 (patch) | |
| tree | e1fbeb7b349b879c161c0c42533fb39b1241a142 | |
| parent | e88be844bf774b336ab67995e435416328b53776 (diff) | |
| download | emacs-eef32d13da58d9773d6e1889b8de42e5d1711ad5.tar.gz emacs-eef32d13da58d9773d6e1889b8de42e5d1711ad5.zip | |
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.
| -rw-r--r-- | lisp/eshell/esh-cmd.el | 111 | ||||
| -rw-r--r-- | lisp/eshell/esh-proc.el | 16 | ||||
| -rw-r--r-- | 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." | |||
| 319 | (setq-local eshell-last-async-procs nil) | 319 | (setq-local eshell-last-async-procs nil) |
| 320 | 320 | ||
| 321 | (add-hook 'eshell-kill-hook #'eshell-resume-command nil t) | 321 | (add-hook 'eshell-kill-hook #'eshell-resume-command nil t) |
| 322 | |||
| 323 | ;; make sure that if a command is over, and no process is being | ||
| 324 | ;; waited for, that `eshell-current-command' is set to nil. This | ||
| 325 | ;; situation can occur, for example, if a Lisp function results in | ||
| 326 | ;; `debug' being called, and the user then types \\[top-level] | ||
| 327 | (add-hook 'eshell-post-command-hook | ||
| 328 | (lambda () | ||
| 329 | (setq eshell-current-command nil | ||
| 330 | eshell-last-async-procs nil)) | ||
| 331 | nil t) | ||
| 332 | |||
| 333 | (add-hook 'eshell-parse-argument-hook | 322 | (add-hook 'eshell-parse-argument-hook |
| 334 | #'eshell-parse-subcommand-argument nil t) | 323 | #'eshell-parse-subcommand-argument nil t) |
| 335 | (add-hook 'eshell-parse-argument-hook | 324 | (add-hook 'eshell-parse-argument-hook |
| @@ -432,8 +421,9 @@ command hooks should be run before and after the command." | |||
| 432 | (if toplevel | 421 | (if toplevel |
| 433 | `(eshell-commands (progn | 422 | `(eshell-commands (progn |
| 434 | (run-hooks 'eshell-pre-command-hook) | 423 | (run-hooks 'eshell-pre-command-hook) |
| 435 | (catch 'top-level (progn ,@commands)) | 424 | (unwind-protect |
| 436 | (run-hooks 'eshell-post-command-hook))) | 425 | (progn ,@commands) |
| 426 | (run-hooks 'eshell-post-command-hook)))) | ||
| 437 | (macroexp-progn commands)))) | 427 | (macroexp-progn commands)))) |
| 438 | 428 | ||
| 439 | (defun eshell-debug-show-parsed-args (terms) | 429 | (defun eshell-debug-show-parsed-args (terms) |
| @@ -772,15 +762,14 @@ to this hook using `nconc', and *not* `add-hook'. | |||
| 772 | 762 | ||
| 773 | Someday, when Scheme will become the dominant Emacs language, all of | 763 | Someday, when Scheme will become the dominant Emacs language, all of |
| 774 | this grossness will be made to disappear by using `call/cc'..." | 764 | this grossness will be made to disappear by using `call/cc'..." |
| 775 | `(let ((eshell-this-command-hook '(ignore))) | 765 | `(eshell-condition-case err |
| 776 | (eshell-condition-case err | 766 | (let ((eshell-this-command-hook '(ignore))) |
| 777 | (prog1 | 767 | (unwind-protect |
| 778 | ,object | 768 | ,object |
| 779 | (mapc #'funcall eshell-this-command-hook)) | 769 | (mapc #'funcall eshell-this-command-hook))) |
| 780 | (error | 770 | (error |
| 781 | (mapc #'funcall eshell-this-command-hook) | 771 | (eshell-errorn (error-message-string err)) |
| 782 | (eshell-errorn (error-message-string err)) | 772 | (eshell-close-handles 1)))) |
| 783 | (eshell-close-handles 1))))) | ||
| 784 | 773 | ||
| 785 | (defvar eshell-output-handle) ;Defined in esh-io.el. | 774 | (defvar eshell-output-handle) ;Defined in esh-io.el. |
| 786 | (defvar eshell-error-handle) ;Defined in esh-io.el. | 775 | (defvar eshell-error-handle) ;Defined in esh-io.el. |
| @@ -1015,30 +1004,41 @@ process(es) in a cons cell like: | |||
| 1015 | (defun eshell-resume-command (proc status) | 1004 | (defun eshell-resume-command (proc status) |
| 1016 | "Resume the current command when a pipeline ends." | 1005 | "Resume the current command when a pipeline ends." |
| 1017 | (when (and proc | 1006 | (when (and proc |
| 1018 | ;; Make sure STATUS is something we want to handle. | ||
| 1019 | (stringp status) | ||
| 1020 | (not (string= "stopped" status)) | ||
| 1021 | (not (string-match eshell-reset-signals status)) | ||
| 1022 | ;; Make sure PROC is one of our foreground processes and | 1007 | ;; Make sure PROC is one of our foreground processes and |
| 1023 | ;; that all of those processes are now dead. | 1008 | ;; that all of those processes are now dead. |
| 1024 | (member proc eshell-last-async-procs) | 1009 | (member proc eshell-last-async-procs) |
| 1025 | (not (seq-some #'eshell-process-active-p eshell-last-async-procs))) | 1010 | (not (seq-some #'eshell-process-active-p eshell-last-async-procs))) |
| 1026 | (eshell-resume-eval))) | 1011 | (if (and ;; Check STATUS to determine whether we want to resume or |
| 1012 | ;; abort the command. | ||
| 1013 | (stringp status) | ||
| 1014 | (not (string= "stopped" status)) | ||
| 1015 | (not (string-match eshell-reset-signals status))) | ||
| 1016 | (eshell-resume-eval) | ||
| 1017 | (setq eshell-last-async-procs nil) | ||
| 1018 | (setq eshell-current-command nil) | ||
| 1019 | (declare-function eshell-reset "esh-mode" (&optional no-hooks)) | ||
| 1020 | (eshell-reset)))) | ||
| 1027 | 1021 | ||
| 1028 | (defun eshell-resume-eval () | 1022 | (defun eshell-resume-eval () |
| 1029 | "Destructively evaluate a form which may need to be deferred." | 1023 | "Destructively evaluate a form which may need to be deferred." |
| 1030 | (setq eshell-last-async-procs nil) | 1024 | (setq eshell-last-async-procs nil) |
| 1031 | (when eshell-current-command | 1025 | (when eshell-current-command |
| 1032 | (eshell-condition-case err | 1026 | (eshell-condition-case err |
| 1033 | (let* (retval | 1027 | (let (retval procs) |
| 1034 | (procs (catch 'eshell-defer | 1028 | (unwind-protect |
| 1035 | (ignore | 1029 | (progn |
| 1036 | (setq retval | 1030 | (setq procs (catch 'eshell-defer |
| 1037 | (eshell-do-eval | 1031 | (ignore (setq retval |
| 1038 | eshell-current-command)))))) | 1032 | (eshell-do-eval |
| 1039 | (if retval | 1033 | eshell-current-command))))) |
| 1040 | (cadr retval) | 1034 | (when retval |
| 1041 | (ignore (setq eshell-last-async-procs procs)))) | 1035 | (cadr retval))) |
| 1036 | (setq eshell-last-async-procs procs) | ||
| 1037 | ;; If we didn't defer this command, clear it out. This | ||
| 1038 | ;; applies both when the command has finished normally, | ||
| 1039 | ;; and when a signal or thrown value causes us to unwind. | ||
| 1040 | (unless procs | ||
| 1041 | (setq eshell-current-command nil)))) | ||
| 1042 | (error | 1042 | (error |
| 1043 | (error (error-message-string err)))))) | 1043 | (error (error-message-string err)))))) |
| 1044 | 1044 | ||
| @@ -1051,9 +1051,10 @@ process(es) in a cons cell like: | |||
| 1051 | (let ((,tag-symbol ,tag)) | 1051 | (let ((,tag-symbol ,tag)) |
| 1052 | (eshell-always-debug-command 'form | 1052 | (eshell-always-debug-command 'form |
| 1053 | "%s\n\n%s" ,tag-symbol (eshell-stringify ,form)) | 1053 | "%s\n\n%s" ,tag-symbol (eshell-stringify ,form)) |
| 1054 | ,@body | 1054 | (unwind-protect |
| 1055 | (eshell-always-debug-command 'form | 1055 | (progn ,@body) |
| 1056 | "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form)))))) | 1056 | (eshell-always-debug-command 'form |
| 1057 | "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form))))))) | ||
| 1057 | 1058 | ||
| 1058 | (defun eshell-do-eval (form &optional synchronous-p) | 1059 | (defun eshell-do-eval (form &optional synchronous-p) |
| 1059 | "Evaluate FORM, simplifying it as we go. | 1060 | "Evaluate FORM, simplifying it as we go. |
| @@ -1181,20 +1182,40 @@ have been replaced by constants." | |||
| 1181 | ;; If we get here, there was no `eshell-defer' thrown, so | 1182 | ;; If we get here, there was no `eshell-defer' thrown, so |
| 1182 | ;; just return the `let' body's result. | 1183 | ;; just return the `let' body's result. |
| 1183 | result))) | 1184 | result))) |
| 1184 | ((memq (car form) '(catch condition-case unwind-protect)) | 1185 | ((memq (car form) '(catch condition-case)) |
| 1185 | ;; `condition-case' and `unwind-protect' have to be | 1186 | ;; `catch' and `condition-case' have to be handled specially, |
| 1186 | ;; handled specially, because we only want to call | 1187 | ;; because we only want to call `eshell-do-eval' on their |
| 1187 | ;; `eshell-do-eval' on their first form. | 1188 | ;; second forms. |
| 1188 | ;; | 1189 | ;; |
| 1189 | ;; NOTE: This requires obedience by all forms which this | 1190 | ;; NOTE: This requires obedience by all forms which this |
| 1190 | ;; function might encounter, that they do not contain | 1191 | ;; function might encounter, that they do not contain |
| 1191 | ;; other special forms. | 1192 | ;; other special forms. |
| 1192 | (unless (eq (car form) 'unwind-protect) | 1193 | (setq args (cdr args)) |
| 1193 | (setq args (cdr args))) | ||
| 1194 | (unless (eq (caar args) 'eshell-do-eval) | 1194 | (unless (eq (caar args) 'eshell-do-eval) |
| 1195 | (eshell-manipulate form "handling special form" | 1195 | (eshell-manipulate form "handling special form" |
| 1196 | (setcar args `(eshell-do-eval ',(car args) ,synchronous-p)))) | 1196 | (setcar args `(eshell-do-eval ',(car args) ,synchronous-p)))) |
| 1197 | (eval form)) | 1197 | (eval form)) |
| 1198 | ((eq (car form) 'unwind-protect) | ||
| 1199 | ;; `unwind-protect' has to be handled specially, because we | ||
| 1200 | ;; only want to call `eshell-do-eval' on its first form, and | ||
| 1201 | ;; we need to ensure we let `eshell-defer' through without | ||
| 1202 | ;; evaluating the unwind forms. | ||
| 1203 | (let (deferred) | ||
| 1204 | (unwind-protect | ||
| 1205 | (eshell-manipulate form "handling `unwind-protect' body form" | ||
| 1206 | (setq deferred | ||
| 1207 | (catch 'eshell-defer | ||
| 1208 | (ignore | ||
| 1209 | (setcar args (eshell-do-eval | ||
| 1210 | (car args) synchronous-p))))) | ||
| 1211 | (car args)) | ||
| 1212 | (if deferred | ||
| 1213 | (throw 'eshell-defer deferred) | ||
| 1214 | (eshell-manipulate form "handling `unwind-protect' unwind forms" | ||
| 1215 | (pop args) | ||
| 1216 | (while args | ||
| 1217 | (setcar args (eshell-do-eval (car args) synchronous-p)) | ||
| 1218 | (pop args))))))) | ||
| 1198 | ((eq (car form) 'setq) | 1219 | ((eq (car form) 'setq) |
| 1199 | (if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)")) | 1220 | (if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)")) |
| 1200 | (eshell-manipulate form "evaluating arguments to setq" | 1221 | (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 | |||
| 129 | "Function run when killing a process. | 129 | "Function run when killing a process. |
| 130 | Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments | 130 | Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments |
| 131 | PROC and STATUS to functions on the latter." | 131 | PROC and STATUS to functions on the latter." |
| 132 | (declare (obsolete nil "30.1")) | ||
| 132 | ;; Was there till 24.1, but it is not optional. | 133 | ;; Was there till 24.1, but it is not optional. |
| 133 | (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) | 134 | (remove-hook 'eshell-kill-hook #'eshell-reset-after-proc) |
| 134 | ;; Only reset the prompt if this process is running interactively. | 135 | ;; Only reset the prompt if this process is running interactively. |
| @@ -151,6 +152,7 @@ PROC and STATUS to functions on the latter." | |||
| 151 | "Reset the command input location after a process terminates. | 152 | "Reset the command input location after a process terminates. |
| 152 | The signals which will cause this to happen are matched by | 153 | The signals which will cause this to happen are matched by |
| 153 | `eshell-reset-signals'." | 154 | `eshell-reset-signals'." |
| 155 | (declare (obsolete nil "30.1")) | ||
| 154 | (when (and (stringp status) | 156 | (when (and (stringp status) |
| 155 | (string-match eshell-reset-signals status)) | 157 | (string-match eshell-reset-signals status)) |
| 156 | (require 'esh-mode) | 158 | (require 'esh-mode) |
| @@ -434,7 +436,7 @@ Used only on systems which do not support async subprocesses.") | |||
| 434 | (eshell-close-handles | 436 | (eshell-close-handles |
| 435 | (if (numberp exit-status) exit-status -1) | 437 | (if (numberp exit-status) exit-status -1) |
| 436 | (list 'quote (and (numberp exit-status) (= exit-status 0)))) | 438 | (list 'quote (and (numberp exit-status) (= exit-status 0)))) |
| 437 | (eshell-kill-process-function command exit-status) | 439 | (run-hook-with-args 'eshell-kill-hook command exit-status) |
| 438 | (or (bound-and-true-p eshell-in-pipeline-p) | 440 | (or (bound-and-true-p eshell-in-pipeline-p) |
| 439 | (setq eshell-last-sync-output-start nil)) | 441 | (setq eshell-last-sync-output-start nil)) |
| 440 | (if (not (numberp exit-status)) | 442 | (if (not (numberp exit-status)) |
| @@ -550,7 +552,7 @@ PROC is the process that's exiting. STRING is the exit message." | |||
| 550 | (eshell-debug-command 'process | 552 | (eshell-debug-command 'process |
| 551 | "finished external process `%s'" proc) | 553 | "finished external process `%s'" proc) |
| 552 | (if primary | 554 | (if primary |
| 553 | (eshell-kill-process-function proc string) | 555 | (run-hook-with-args 'eshell-kill-hook proc string) |
| 554 | (setcar stderr-live nil)))))) | 556 | (setcar stderr-live nil)))))) |
| 555 | (funcall finish-io))) | 557 | (funcall finish-io))) |
| 556 | (when-let ((entry (assq proc eshell-process-list))) | 558 | (when-let ((entry (assq proc eshell-process-list))) |
| @@ -647,25 +649,25 @@ See the variable `eshell-kill-processes-on-exit'." | |||
| 647 | "Interrupt a process." | 649 | "Interrupt a process." |
| 648 | (interactive) | 650 | (interactive) |
| 649 | (unless (eshell-process-interact 'interrupt-process) | 651 | (unless (eshell-process-interact 'interrupt-process) |
| 650 | (eshell-kill-process-function nil "interrupt"))) | 652 | (run-hook-with-args 'eshell-kill-hook nil "interrupt"))) |
| 651 | 653 | ||
| 652 | (defun eshell-kill-process () | 654 | (defun eshell-kill-process () |
| 653 | "Kill a process." | 655 | "Kill a process." |
| 654 | (interactive) | 656 | (interactive) |
| 655 | (unless (eshell-process-interact 'kill-process) | 657 | (unless (eshell-process-interact 'kill-process) |
| 656 | (eshell-kill-process-function nil "killed"))) | 658 | (run-hook-with-args 'eshell-kill-hook nil "killed"))) |
| 657 | 659 | ||
| 658 | (defun eshell-quit-process () | 660 | (defun eshell-quit-process () |
| 659 | "Send quit signal to process." | 661 | "Send quit signal to process." |
| 660 | (interactive) | 662 | (interactive) |
| 661 | (unless (eshell-process-interact 'quit-process) | 663 | (unless (eshell-process-interact 'quit-process) |
| 662 | (eshell-kill-process-function nil "quit"))) | 664 | (run-hook-with-args 'eshell-kill-hook nil "quit"))) |
| 663 | 665 | ||
| 664 | ;(defun eshell-stop-process () | 666 | ;(defun eshell-stop-process () |
| 665 | ; "Send STOP signal to process." | 667 | ; "Send STOP signal to process." |
| 666 | ; (interactive) | 668 | ; (interactive) |
| 667 | ; (unless (eshell-process-interact 'stop-process) | 669 | ; (unless (eshell-process-interact 'stop-process) |
| 668 | ; (eshell-kill-process-function nil "stopped"))) | 670 | ; (run-hook-with-args 'eshell-kill-hook nil "stopped"))) |
| 669 | 671 | ||
| 670 | ;(defun eshell-continue-process () | 672 | ;(defun eshell-continue-process () |
| 671 | ; "Send CONTINUE signal to process." | 673 | ; "Send CONTINUE signal to process." |
| @@ -674,7 +676,7 @@ See the variable `eshell-kill-processes-on-exit'." | |||
| 674 | ; ;; jww (1999-09-17): this signal is not dealt with yet. For | 676 | ; ;; jww (1999-09-17): this signal is not dealt with yet. For |
| 675 | ; ;; example, `eshell-reset' will be called, and so will | 677 | ; ;; example, `eshell-reset' will be called, and so will |
| 676 | ; ;; `eshell-resume-eval'. | 678 | ; ;; `eshell-resume-eval'. |
| 677 | ; (eshell-kill-process-function nil "continue"))) | 679 | ; (run-hook-with-args 'eshell-kill-hook nil "continue"))) |
| 678 | 680 | ||
| 679 | (provide 'esh-proc) | 681 | (provide 'esh-proc) |
| 680 | ;;; esh-proc.el ends here | 682 | ;;; 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." | |||
| 442 | (eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}" | 442 | (eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}" |
| 443 | "no")) | 443 | "no")) |
| 444 | 444 | ||
| 445 | |||
| 446 | ;; Error handling | ||
| 447 | |||
| 448 | (ert-deftest esh-cmd-test/throw () | ||
| 449 | "Test that calling `throw' as an Eshell command unwinds everything properly." | ||
| 450 | (with-temp-eshell | ||
| 451 | (should (= (catch 'tag | ||
| 452 | (eshell-insert-command | ||
| 453 | "echo hi; (throw 'tag 42); echo bye")) | ||
| 454 | 42)) | ||
| 455 | (should (eshell-match-output "\\`hi\n\\'")) | ||
| 456 | (should-not eshell-current-command) | ||
| 457 | (should-not eshell-last-async-procs) | ||
| 458 | ;; Make sure we can call another command after throwing. | ||
| 459 | (eshell-match-command-output "echo again" "\\`again\n"))) | ||
| 460 | |||
| 445 | ;; esh-cmd-tests.el ends here | 461 | ;; esh-cmd-tests.el ends here |