From: Jim Porter Date: Wed, 17 Jul 2024 05:07:33 +0000 (-0700) Subject: Improve handling of deferrable Eshell commands X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=91ef3f905742a450b2aed7491fc55a5ca84013da;p=emacs.git 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. (cherry picked from commit 1550213613b397da6e879cc0d00ede916f6c62cc) --- 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 @@ return non-nil if the command is complex." :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 @@ otherwise t.") (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 @@ command hooks should be run before and after the 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 @@ function." ;; 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 @@ returning it as (:eshell-background . PROCESSES)." (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 @@ this grossness will be made to disappear by using `call/cc'..." `(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 @@ current ones (see `eshell-duplicate-handles')." (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 @@ first command invocation in the pipeline (usually t or nil). 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 @@ supported." ,(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 @@ A command can be invoked directly if all of the following are true: * 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 @@ A command can be invoked directly if all of the following are true: * 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 @@ COMMAND may result in an alias being executed, or a plain 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 @@ a string naming a Lisp function." 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 @@ ((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 @@ `(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 @@ This should also wait for the subcommand." (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