From 0dd4f3fb123a626662b0951f8dea49ec2e78a3d3 Mon Sep 17 00:00:00 2001 From: Jim Porter Date: Tue, 16 Jul 2024 22:07:33 -0700 Subject: [PATCH 1/2] Improve handling of deferrable Eshell commands Now, we use the 'eshell-deferrable' wrapper to wrap a form that returns a process (or list thereof). This improves upon the old method, which failed to handle 'eshell-replace-command' correctly. In that case, Eshell would fail to unmark commands as deferrable when necessary (e.g. for commands in pipelines). * lisp/eshell/esh-cmd.el (eshell-deferrable-commands): Make into a defvar. (eshell-deferrable): New function... (eshell-structure-basic-command): ... use it. (eshell-trap-errors): Rename to... (eshell-do-command): ... this, and use 'eshell-deferrable'. Update callers. (eshell--unmark-deferrable): Remove. Update callers. (eshell-execute-pipeline): Remove 'eshell-process-identity'. (eshell-process-identity, eshell-named-command*, eshell-lisp-command*): Make obsolete. * test/lisp/eshell/esh-cmd-tests.el (eshell-test-replace-command): New function. (esh-cmd-test/pipeline/replace-command): New test. --- lisp/eshell/esh-cmd.el | 67 +++++++++++----------------- test/lisp/eshell/em-extpipe-tests.el | 2 +- test/lisp/eshell/em-tramp-tests.el | 3 +- test/lisp/eshell/esh-cmd-tests.el | 18 ++++++++ 4 files changed, 47 insertions(+), 43 deletions(-) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index c8579c83405..099e97a083d 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -240,16 +240,6 @@ eshell-cmd-load-hook :version "24.1" ; removed eshell-cmd-initialize :type 'hook) -(defcustom eshell-deferrable-commands - '(eshell-named-command - eshell-lisp-command - eshell-process-identity) - "A list of functions which might return an asynchronous process. -If they return a process object, execution of the calling Eshell -command will wait for completion (in the background) before finishing -the command." - :type '(repeat function)) - (defcustom eshell-subcommand-bindings '((eshell-in-subcommand-p t) (eshell-in-pipeline-p nil) @@ -289,6 +279,12 @@ eshell-in-subcommand-p (defvar eshell-last-arguments nil) (defvar eshell-last-command-name nil) +(defvar eshell-deferrable-commands '(eshell-deferrable) + "A list of functions which might return a deferrable process. +If they return a process object (or list thereof), execution of the +calling Eshell command will wait for completion (in the background) +before finishing the command.") + (defvar eshell-allow-commands t "If non-nil, allow evaluating command forms (including Lisp forms). If you want to forbid command forms, you can let-bind this to a @@ -426,7 +422,7 @@ eshell-parse-command (error "Empty command before `&'")) (setq cmd (eshell-parse-pipeline cmd)) (unless eshell-in-pipeline-p - (setq cmd `(eshell-trap-errors ,cmd))) + (setq cmd `(eshell-do-command ,cmd))) ;; Copy I/O handles so each full statement can manipulate ;; them if they like. Steal the handles for the last ;; command (first in our reversed list); we won't use the @@ -565,7 +561,7 @@ eshell-structure-basic-command ;; statement. (unless (memq (car test) '(eshell-convert eshell-escape-arg)) (setq test - `(progn ,test + `(progn (eshell-deferrable ,test) (eshell-exit-success-p)))) ;; should we reverse the sense of the test? This depends @@ -776,7 +772,7 @@ eshell-commands (defvar eshell-this-command-hook nil) -(defmacro eshell-trap-errors (object) +(defmacro eshell-do-command (object) "Trap any errors that occur, so they are not entirely fatal. Also, the variable `eshell-this-command-hook' is available for the duration of OBJECT's evaluation. Note that functions should be added @@ -787,12 +783,19 @@ eshell-trap-errors `(eshell-condition-case err (let ((eshell-this-command-hook '(ignore))) (unwind-protect - ,object + (eshell-deferrable ,object) (mapc #'funcall eshell-this-command-hook))) (error (eshell-errorn (error-message-string err)) (eshell-close-handles 1)))) +(define-obsolete-function-alias 'eshell-trap-errors #'eshell-do-command "31.1") + +(defalias 'eshell-deferrable 'identity + "A wrapper to mark a particular form as potentially deferrable. +If the wrapped form returns a process (or list thereof), Eshell will +wait for completion in the background for the process(es) to complete.") + (defmacro eshell-with-copied-handles (object &optional steal-p) "Duplicate current I/O handles, so OBJECT works with its own copy. If STEAL-P is non-nil, these new handles will be stolen from the @@ -810,27 +813,12 @@ eshell-protect (eshell-protect-handles eshell-current-handles) ,object)) -(defun eshell--unmark-deferrable (command) - "If COMMAND is (or ends with) a deferrable command, unmark it as such. -This changes COMMAND in-place by converting function calls listed -in `eshell-deferrable-commands' to their non-deferrable forms so -that Eshell doesn't erroneously allow deferring it. For example, -`eshell-named-command' becomes `eshell-named-command*'." - (let ((cmd command)) - (when (memq (car cmd) '(let progn)) - (setq cmd (car (last cmd)))) - (when (memq (car cmd) eshell-deferrable-commands) - (setcar cmd (intern-soft - (concat (symbol-name (car cmd)) "*")))) - command)) - (defmacro eshell-do-pipelines (pipeline &optional notfirst) "Execute the commands in PIPELINE, connecting each to one another. Returns a list of the processes in the pipeline. This macro calls itself recursively, with NOTFIRST non-nil." (when (setq pipeline (cadr pipeline)) - (eshell--unmark-deferrable (car pipeline)) `(eshell-with-copied-handles (let ((next-procs ,(when (cdr pipeline) @@ -860,8 +848,6 @@ eshell-do-pipelines-synchronously This is used on systems where async subprocesses are not supported." (when (setq pipeline (cadr pipeline)) - ;; FIXME: is deferrable significant here? - (eshell--unmark-deferrable (car pipeline)) `(prog1 (eshell-with-copied-handles (progn @@ -879,14 +865,13 @@ eshell-do-pipelines-synchronously ,(when (cdr pipeline) `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))))) -(defalias 'eshell-process-identity 'identity) +(define-obsolete-function-alias 'eshell-process-identity #'identity "31.1") (defmacro eshell-execute-pipeline (pipeline) "Execute the commands in PIPELINE, connecting each to one another." - `(eshell-process-identity - ,(if eshell-supports-asynchronous-processes - `(remove nil (eshell-do-pipelines ,pipeline)) - `(eshell-do-pipelines-synchronously ,pipeline)))) + (if eshell-supports-asynchronous-processes + `(remove nil (eshell-do-pipelines ,pipeline)) + `(eshell-do-pipelines-synchronously ,pipeline))) (defmacro eshell-as-subcommand (command) "Execute COMMAND as a subcommand. @@ -951,7 +936,7 @@ eshell--invoke-command-directly-p * The command is of the form (eshell-with-copied-handles - (eshell-trap-errors (eshell-named-command NAME [ARGS])) _). + (eshell-do-command (eshell-named-command NAME [ARGS])) _). * NAME is a string referring to an alias function and isn't a complex command (see `eshell-complex-commands'). @@ -959,7 +944,7 @@ eshell--invoke-command-directly-p * Any subcommands in ARGS can also be invoked directly." (pcase command (`(eshell-with-copied-handles - (eshell-trap-errors (eshell-named-command ,name . ,args)) + (eshell-do-command (eshell-named-command ,name . ,args)) ,_) (and name (stringp name) (not (member name eshell-complex-commands)) @@ -1360,7 +1345,8 @@ eshell-named-command (eshell-plain-command eshell-last-command-name eshell-last-arguments)))) -(defalias 'eshell-named-command* 'eshell-named-command) +(define-obsolete-function-alias 'eshell-named-command* #'eshell-named-command + "31.1") (defun eshell-find-alias-function (name) "Check whether a function called `eshell/NAME' exists." @@ -1558,7 +1544,8 @@ eshell-lisp-command 2) (list 'quote result))))) -(defalias 'eshell-lisp-command* #'eshell-lisp-command) +(define-obsolete-function-alias 'eshell-lisp-command* #'eshell-lisp-command + "31.1") (provide 'esh-cmd) diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index c5f1301cd3b..4c3adbc2d90 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -40,7 +40,7 @@ em-extpipe-tests--deftest ((should-parse (expected) `(let ((shell-file-name "sh") (shell-command-switch "-c")) - ;; Strip `eshell-trap-errors'. + ;; Strip `eshell-do-command'. (should (equal ,expected (cadadr (eshell-parse-command input)))))) (with-substitute-for-temp (&rest body) diff --git a/test/lisp/eshell/em-tramp-tests.el b/test/lisp/eshell/em-tramp-tests.el index 3be5d3542ca..49dd5a78c3d 100644 --- a/test/lisp/eshell/em-tramp-tests.el +++ b/test/lisp/eshell/em-tramp-tests.el @@ -29,8 +29,7 @@ em-tramp-test/should-replace-command `(should (equal (catch 'eshell-replace-command ,form) (list 'eshell-with-copied-handles - (list 'eshell-trap-errors - ,replacement) + (list 'eshell-do-command ,replacement) t)))) (ert-deftest em-tramp-test/su-default () diff --git a/test/lisp/eshell/esh-cmd-tests.el b/test/lisp/eshell/esh-cmd-tests.el index d8124a19af6..18ea1f9a9d6 100644 --- a/test/lisp/eshell/esh-cmd-tests.el +++ b/test/lisp/eshell/esh-cmd-tests.el @@ -34,6 +34,10 @@ (defvar eshell-test-value nil) +(defun eshell-test-replace-command (command &rest args) + "Run COMMAND with ARGS by throwing `eshell-replace-command'." + (throw 'eshell-replace-command `(eshell-named-command ,command ',args))) + ;;; Tests: @@ -265,6 +269,20 @@ esh-cmd-test/reset-in-pipeline/lisp (format template "format \"%s\" eshell-in-pipeline-p") "nil"))) +(ert-deftest esh-cmd-test/pipeline/replace-command () + "Ensure that `eshell-replace-command' doesn't affect Eshell deferral. +Pipelines want to defer (yield) execution after starting all the +processes in the pipeline, not before. This lets us track all the +processes correctly." + (skip-unless (and (executable-find "sleep") + (executable-find "cat"))) + (with-temp-eshell + (eshell-insert-command "eshell-test-replace-command *sleep 1 | cat") + ;; Make sure both processes are in `eshell-foreground-command'; this + ;; makes sure that the first command (which was replaced via + ;; `eshell-replace-command' isn't deferred by `eshell-do-eval'. + (should (= (length (cadr eshell-foreground-command)) 2)))) + ;; Control flow statements -- 2.25.1