* bug#66164: 30.0.50; [PATCH] Use 'unwind-protect' in some more places in Eshell
@ 2023-09-23 4:49 Jim Porter
2023-09-26 19:34 ` Jim Porter
0 siblings, 1 reply; 2+ messages in thread
From: Jim Porter @ 2023-09-23 4:49 UTC (permalink / raw)
To: 66164
[-- Attachment #1: Type: text/plain, Size: 624 bytes --]
(I debated just pushing this since it's mostly an implementation detail
in Eshell, but it's a complex-enough patch that I figured it couldn't
hurt to see if anyone has thoughts beforehand.)
The main reason for this patch is to simplify some Eshell logic as a
preliminary for better support of background commands (bug#660666),
which in turn is a preliminary for adding job control to Eshell.
However, this does also fix a couple edge cases with how Eshell unwinds
its command forms in response to error handling (e.g. previously,
calling 'top-level' inside an Eshell command didn't actually exit
recursive editing).
[-- Attachment #2: 0001-Use-unwind-protect-in-more-places-in-Eshell.patch --]
[-- Type: text/plain, Size: 13612 bytes --]
From 36dbc139a922a9eb7c34b1ce1de40415d5f59f21 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
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"))
+\f
+;; 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
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#66164: 30.0.50; [PATCH] Use 'unwind-protect' in some more places in Eshell
2023-09-23 4:49 bug#66164: 30.0.50; [PATCH] Use 'unwind-protect' in some more places in Eshell Jim Porter
@ 2023-09-26 19:34 ` Jim Porter
0 siblings, 0 replies; 2+ messages in thread
From: Jim Porter @ 2023-09-26 19:34 UTC (permalink / raw)
To: 66164-done
Version: 30.1
On 9/22/2023 9:49 PM, Jim Porter wrote:
> The main reason for this patch is to simplify some Eshell logic as a
> preliminary for better support of background commands (bug#660666),
> which in turn is a preliminary for adding job control to Eshell.
> However, this does also fix a couple edge cases with how Eshell unwinds
> its command forms in response to error handling (e.g. previously,
> calling 'top-level' inside an Eshell command didn't actually exit
> recursive editing).
Pushed to master as eef32d13da5, and closing this bug..
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-09-26 19:34 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-09-23 4:49 bug#66164: 30.0.50; [PATCH] Use 'unwind-protect' in some more places in Eshell Jim Porter
2023-09-26 19:34 ` Jim Porter
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.