-;;; esh-cmd --- command invocation
+;;; esh-cmd.el --- command invocation
-;; Copyright (C) 1999, 2000 Free Sofware Foundation
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;; 2005 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw@gnu.org>
;; This file is part of GNU Emacs.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
(provide 'esh-cmd)
pressing <RET>. There are several different kinds of commands,
however."
:tag "Command invocation"
- :link '(info-link "(eshell.info)Command invocation")
+ ;; :link '(info-link "(eshell)Command invocation")
:group 'eshell)
;;; Commentary:
:type 'hook
:group 'eshell-cmd)
+(defcustom eshell-complex-commands nil
+ "*A list of commands names or functions, that determine complexity.
+That is, if a command is defined by a function named eshell/NAME,
+and NAME is part of this list, it is invoked as a complex command.
+Complex commands are always correct, but run much slower. If a
+command works fine without being part of this list, then it doesn't
+need to be.
+
+If an entry is a function, it will be called with the name, and should
+return non-nil if the command is complex."
+ :type '(repeat :tag "Commands"
+ (choice (string :tag "Name")
+ (function :tag "Predicate")))
+ :group 'eshell-cmd)
+
;;; Code:
(require 'esh-util)
(set (make-local-variable 'eshell-last-command-name) nil)
(set (make-local-variable 'eshell-last-async-proc) nil)
- (make-local-hook 'eshell-kill-hook)
(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]
- (make-local-hook 'eshell-post-command-hook)
(add-hook 'eshell-post-command-hook
(function
(lambda ()
(setq eshell-current-command nil
eshell-last-async-proc nil))) nil t)
- (make-local-hook 'eshell-parse-argument-hook)
(add-hook 'eshell-parse-argument-hook
'eshell-parse-subcommand-argument nil t)
(add-hook 'eshell-parse-argument-hook
'eshell-parse-lisp-argument nil t)
(when (eshell-using-module 'eshell-cmpl)
- (make-local-hook 'pcomplete-try-first-hook)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-lisp-symbols nil t)))
(defun eshell-rewrite-named-command (terms)
"If no other rewriting rule transforms TERMS, assume a named command."
- (list (if eshell-in-pipeline-p
- 'eshell-named-command*
- 'eshell-named-command)
- (car terms)
- (and (cdr terms)
- (append (list 'list) (cdr terms)))))
+ (let ((sym (if eshell-in-pipeline-p
+ 'eshell-named-command*
+ 'eshell-named-command))
+ (cmd (car terms))
+ (args (cdr terms)))
+ (if args
+ (list sym cmd (append (list 'list) (cdr terms)))
+ (list sym cmd))))
(eshell-deftest cmd named-command
"Execute named command"
(if (listp elem)
elem
(list 'list elem))))
- (cdddr terms))))
+ (cdr (cddr terms)))))
(list 'eshell-command-body
(list 'quote (list nil)))
(list 'eshell-test-body
(eshell-structure-basic-command
'if '("if" "unless") (car terms)
(eshell-invokify-arg (cadr terms) nil t)
- (eshell-invokify-arg
- (if (= (length terms) 5)
- (car (last terms 3))
- (car (last terms))) t)
- (eshell-invokify-arg
- (if (= (length terms) 5)
- (car (last terms))) t))))
+ (list 'eshell-protect
+ (eshell-invokify-arg
+ (if (= (length terms) 4)
+ (car (last terms 2))
+ (car (last terms))) t))
+ (if (= (length terms) 4)
+ (list 'eshell-protect
+ (eshell-invokify-arg
+ (car (last terms)))) t))))
(defun eshell-exit-success-p ()
"Return non-nil if the last command was \"successful\".
For a bit of Lisp code, this means a return value of non-nil.
For an external command, it means an exit code of 0."
- (if (string= eshell-last-command-name "#<Lisp>")
+ (if (save-match-data
+ (string-match "#<\\(Lisp object\\|function .*\\)>"
+ eshell-last-command-name))
eshell-last-command-result
(= eshell-last-command-status 0)))
(assert (car sep-terms))
(setq final (eshell-structure-basic-command
'if (string= (car sep-terms) "&&") "if"
- (list 'eshell-commands (car results))
- final
+ (list 'eshell-protect (car results))
+ (list 'eshell-protect final)
nil t)
results (cdr results)
sep-terms (cdr sep-terms)))
(list 'eshell-lisp-command (list 'quote obj)))
(ignore (goto-char here))))))
-(defun eshell-separate-commands
- (terms separator &optional reversed last-terms-sym)
+(defun eshell-separate-commands (terms separator &optional
+ reversed last-terms-sym)
"Separate TERMS using SEPARATOR.
If REVERSED is non-nil, the list of separated term groups will be
-returned in reverse order. If LAST-TERMS-SYM is a symbol, it's value
+returned in reverse order. If LAST-TERMS-SYM is a symbol, its value
will be set to a list of all the separator operators found (or '(list
nil)' if none)."
(let ((sub-terms (list t))
(defmacro eshell-do-subjob (object)
"Evaluate a command OBJECT as a subjob.
-We indicate thet the process was run in the background by returned it
+We indicate that the process was run in the background by returning it
ensconced in a list."
`(let ((eshell-current-subjob-p t))
,object))
(eshell-errorn (error-message-string err))
(eshell-close-handles 1)))))
+(defmacro eshell-copy-handles (object)
+ "Duplicate current I/O handles, so OBJECT works with its own copy."
+ `(let ((eshell-current-handles
+ (eshell-create-handles
+ (car (aref eshell-current-handles
+ eshell-output-handle)) nil
+ (car (aref eshell-current-handles
+ eshell-error-handle)) nil)))
+ ,object))
+
(defmacro eshell-protect (object)
"Protect I/O handles, so they aren't get closed after eval'ing OBJECT."
`(progn
(defmacro eshell-do-pipelines (pipeline)
"Execute the commands in PIPELINE, connecting each to one another."
(when (setq pipeline (cadr pipeline))
- `(let ((eshell-current-handles
- (eshell-create-handles
- (car (aref eshell-current-handles
- eshell-output-handle)) nil
- (car (aref eshell-current-handles
- eshell-error-handle)) nil)))
+ `(eshell-copy-handles
+ (progn
+ ,(when (cdr pipeline)
+ `(let (nextproc)
+ (progn
+ (set 'nextproc
+ (eshell-do-pipelines (quote ,(cdr pipeline))))
+ (eshell-set-output-handle ,eshell-output-handle
+ 'append nextproc)
+ (eshell-set-output-handle ,eshell-error-handle
+ 'append nextproc)
+ (set 'tailproc (or tailproc nextproc)))))
+ ,(let ((head (car pipeline)))
+ (if (memq (car head) '(let progn))
+ (setq head (car (last head))))
+ (when (memq (car head) eshell-deferrable-commands)
+ (ignore
+ (setcar head
+ (intern-soft
+ (concat (symbol-name (car head)) "*"))))))
+ ,(car pipeline)))))
+
+(defmacro eshell-do-pipelines-synchronously (pipeline)
+ "Execute the commands in PIPELINE in sequence synchronously.
+Output of each command is passed as input to the next one in the pipeline.
+This is used on systems where `start-process' is not supported."
+ (when (setq pipeline (cadr pipeline))
+ `(let (result)
(progn
,(when (cdr pipeline)
- `(let (nextproc)
+ `(let (output-marker)
(progn
- (set 'nextproc
- (eshell-do-pipelines (quote ,(cdr pipeline))))
+ (set 'output-marker ,(point-marker))
(eshell-set-output-handle ,eshell-output-handle
- 'append nextproc)
+ 'append output-marker)
(eshell-set-output-handle ,eshell-error-handle
- 'append nextproc)
- (set 'tailproc (or tailproc nextproc)))))
+ 'append output-marker))))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
(setq head (car (last head))))
+ ;;; FIXME: is deferrable significant here?
(when (memq (car head) eshell-deferrable-commands)
(ignore
(setcar head
(intern-soft
(concat (symbol-name (car head)) "*"))))))
- ,(car pipeline)))))
+ ;; The last process in the pipe should get its handles
+ ;; redirected as we found them before running the pipe.
+ ,(if (null (cdr pipeline))
+ `(progn
+ (set 'eshell-current-handles tail-handles)
+ (set 'eshell-in-pipeline-p nil)))
+ (set 'result ,(car pipeline))
+ ;; tailproc gets the result of the last successful process in
+ ;; the pipeline.
+ (set 'tailproc (or result tailproc))
+ ,(if (cdr pipeline)
+ `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
+ result))))
(defalias 'eshell-process-identity 'identity)
"Execute the commands in PIPELINE, connecting each to one another."
`(let ((eshell-in-pipeline-p t) tailproc)
(progn
- (eshell-do-pipelines ,pipeline)
+ ,(if (fboundp 'start-process)
+ `(eshell-do-pipelines ,pipeline)
+ `(let ((tail-handles (eshell-create-handles
+ (car (aref eshell-current-handles
+ ,eshell-output-handle)) nil
+ (car (aref eshell-current-handles
+ ,eshell-error-handle)) nil)))
+ (eshell-do-pipelines-synchronously ,pipeline)))
(eshell-process-identity tailproc))))
(defmacro eshell-as-subcommand (command)
(if subform
(concat "\n\n" (eshell-stringify subform)) ""))))))
+(defun eshell-invoke-directly (command input)
+ (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name)
+ (if (and (eq (car base) 'eshell-trap-errors)
+ (eq (car (cadr base)) 'eshell-named-command))
+ (setq name (cadr (cadr base))))
+ (and name (stringp name)
+ (not (member name eshell-complex-commands))
+ (catch 'simple
+ (progn
+ (eshell-for pred eshell-complex-commands
+ (if (and (functionp pred)
+ (funcall pred name))
+ (throw 'simple nil)))
+ t))
+ (fboundp (intern-soft (concat "eshell/" name))))))
+
(defun eshell-eval-command (command &optional input)
"Evaluate the given COMMAND iteratively."
(if eshell-current-command
(erase-buffer)
(insert "command: \"" input "\"\n"))))
(setq eshell-current-command command)
- (eshell-resume-eval)))
+ (let ((delim (catch 'eshell-incomplete
+ (eshell-resume-eval))))
+ ;; On systems that don't support async subprocesses, eshell-resume
+ ;; can return t. Don't treat that as an error.
+ (if (listp delim)
+ (setq delim (car delim)))
+ (if (and delim (not (eq delim t)))
+ (error "Unmatched delimiter: %c" delim)))))
(defun eshell-resume-command (proc status)
"Resume the current command when a process ends."
(when proc
- (unless (or (string= "stopped" status)
+ (unless (or (not (stringp status))
+ (string= "stopped" status)
(string-match eshell-reset-signals status))
(if (eq proc (eshell-interactive-process))
(eshell-resume-eval)))))
(setq retval
(eshell-do-eval
eshell-current-command))))))
- (if proc
+ (if (eshell-processp proc)
(ignore (setq eshell-last-async-proc proc))
(cadr retval)))))
(error
object)
(defconst function-p-func
- (if (eshell-under-xemacs-p)
+ (if (fboundp 'compiled-function-p)
'compiled-function-p
'byte-code-function-p))
(when (car eshell-command-body)
(assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body))
- (setcar eshell-command-body nil))
+ (setcar eshell-command-body nil)
+ (setcar eshell-test-body nil))
(unless (car eshell-test-body)
(setcar eshell-test-body (eshell-copy-tree (car args))))
- (if (and (car eshell-test-body)
- (not (eq (car eshell-test-body) 0)))
- (while (cadr (eshell-do-eval (car eshell-test-body)))
- (setcar eshell-test-body 0)
- (setcar eshell-command-body (eshell-copy-tree (cadr args)))
- (eshell-do-eval (car eshell-command-body) synchronous-p)
- (setcar eshell-command-body nil)
- (setcar eshell-test-body (eshell-copy-tree (car args)))))
+ (while (cadr (eshell-do-eval (car eshell-test-body)))
+ (setcar eshell-command-body (eshell-copy-tree (cadr args)))
+ (eshell-do-eval (car eshell-command-body) synchronous-p)
+ (setcar eshell-command-body nil)
+ (setcar eshell-test-body (eshell-copy-tree (car args))))
(setcar eshell-command-body nil))
((eq (car form) 'if)
;; `eshell-copy-tree' is needed here so that the test argument
;; doesn't get modified and thus always yield the same result.
- (when (car eshell-command-body)
- (assert (not synchronous-p))
- (eshell-do-eval (car eshell-command-body))
- (setcar eshell-command-body nil))
- (unless (car eshell-test-body)
- (setcar eshell-test-body (eshell-copy-tree (car args))))
- (if (and (car eshell-test-body)
- (not (eq (car eshell-test-body) 0)))
- (if (cadr (eshell-do-eval (car eshell-test-body)))
- (progn
- (setcar eshell-test-body 0)
- (setcar eshell-command-body (eshell-copy-tree (cadr args)))
- (eshell-do-eval (car eshell-command-body) synchronous-p))
- (setcar eshell-test-body 0)
- (setcar eshell-command-body (eshell-copy-tree (car (cddr args))))
- (eshell-do-eval (car eshell-command-body) synchronous-p)))
- (setcar eshell-command-body nil))
+ (if (car eshell-command-body)
+ (progn
+ (assert (not synchronous-p))
+ (eshell-do-eval (car eshell-command-body)))
+ (unless (car eshell-test-body)
+ (setcar eshell-test-body (eshell-copy-tree (car args))))
+ (if (cadr (eshell-do-eval (car eshell-test-body)))
+ (setcar eshell-command-body (eshell-copy-tree (cadr args)))
+ (setcar eshell-command-body (eshell-copy-tree (car (cddr args)))))
+ (eshell-do-eval (car eshell-command-body) synchronous-p))
+ (setcar eshell-command-body nil)
+ (setcar eshell-test-body nil))
((eq (car form) 'setcar)
(setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
(eval form))
((eq (car form) 'prog1)
(cadr form))
(t
+ ;; If a command desire to replace its execution form with
+ ;; another command form, all it needs to do is throw the new
+ ;; form using the exception tag `eshell-replace-command'.
+ ;; For example, let's say that the form currently being
+ ;; eval'd is:
+ ;;
+ ;; (eshell-named-command "hello")
+ ;;
+ ;; Now, let's assume the 'hello' command is an Eshell alias,
+ ;; the definition of which yields the command:
+ ;;
+ ;; (eshell-named-command "echo" (list "Hello" "world"))
+ ;;
+ ;; What the alias code would like to do is simply substitute
+ ;; the alias form for the original form. To accomplish
+ ;; this, all it needs to do is to throw the substitution
+ ;; form with the `eshell-replace-command' tag, and the form
+ ;; will be replaced within the current command, and
+ ;; execution will then resume (iteratively) as before.
+ ;; Thus, aliases can even contain references to asynchronous
+ ;; sub-commands, and things will still work out as they
+ ;; should.
(let (result new-form)
- ;; If a command desire to replace its execution form with
- ;; another command form, all it needs to do is throw the
- ;; new form using the exception tag
- ;; `eshell-replace-command'. For example, let's say that
- ;; the form currently being eval'd is:
- ;;
- ;; (eshell-named-command \"hello\")
- ;;
- ;; Now, let's assume the 'hello' command is an Eshell
- ;; alias, the definition of which yields the command:
- ;;
- ;; (eshell-named-command \"echo\" (list \"Hello\" \"world\"))
- ;;
- ;; What the alias code would like to do is simply
- ;; substitute the alias form for the original form. To
- ;; accomplish this, all it needs to do is to throw the
- ;; substitution form with the `eshell-replace-command'
- ;; tag, and the form will be replaced within the current
- ;; command, and execution will then resume (iteratively)
- ;; as before. Thus, aliases can even contain references
- ;; to asynchronous sub-commands, and things will still
- ;; work out as they should.
(if (setq new-form
(catch 'eshell-replace-command
(ignore
(if (and (memq (car form) eshell-deferrable-commands)
(not eshell-current-subjob-p)
result
- (processp result))
+ (eshell-processp result))
(if synchronous-p
(eshell/wait result)
(eshell-manipulate "inserting ignore form"
"Identify the COMMAND, and where it is located."
(eshell-for name (cons command names)
(let (program alias direct)
- (if (eq (aref name 0) ?*)
+ (if (eq (aref name 0) eshell-explicit-command-char)
(setq name (substring name 1)
direct t))
(if (and (not direct)
(setq program (eshell-search-path name))
(let* ((esym (eshell-find-alias-function name))
(sym (or esym (intern-soft name))))
- (if (and sym (fboundp sym)
- (or esym eshell-prefer-lisp-functions
- (not program)))
+ (if (and (or esym (and sym (fboundp sym)))
+ (or eshell-prefer-lisp-functions (not direct)))
(let ((desc (let ((inhibit-redisplay t))
(save-window-excursion
(prog1
(setq desc (substring desc 0
(1- (or (string-match "\n" desc)
(length desc)))))
- (kill-buffer "*Help*")
+ (if (buffer-live-p (get-buffer "*Help*"))
+ (kill-buffer "*Help*"))
(setq program (or desc name))))))
(if (not program)
(eshell-error (format "which: no %s in (%s)\n"
name (getenv "PATH")))
(eshell-printn program)))))
+(put 'eshell/which 'eshell-no-numeric-conversions t)
+
(defun eshell-named-command (command &optional args)
"Insert output from a plain COMMAND, using ARGS.
COMMAND may result in an alias being executed, or a plain command."
(defun eshell-find-alias-function (name)
"Check whether a function called `eshell/NAME' exists."
(let* ((sym (intern-soft (concat "eshell/" name)))
- (file (symbol-file sym))
- module-sym)
+ (file (symbol-file sym 'defun)))
+ ;; If the function exists, but is defined in an eshell module
+ ;; that's not currently enabled, don't report it as found
(if (and file
(string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
- (setq file (concat "eshell-" (match-string 2 file))))
- (setq module-sym
- (and sym file (fboundp 'symbol-file)
+ (let ((module-sym
(intern (file-name-sans-extension
- (file-name-nondirectory file)))))
- (and sym (functionp sym)
- (or (not module-sym)
- (eshell-using-module module-sym)
- (memq module-sym (eshell-subgroups 'eshell)))
- sym)))
+ (file-name-nondirectory
+ (concat "eshell-" (match-string 2 file)))))))
+ (if (and (functionp sym)
+ (or (null module-sym)
+ (eshell-using-module module-sym)
+ (memq module-sym (eshell-subgroups 'eshell))))
+ sym))
+ ;; Otherwise, if it's bound, return it.
+ (if (functionp sym)
+ sym))))
(defun eshell-plain-command (command args)
"Insert output from a plain COMMAND, using ARGS.
(defun eshell-lisp-command (object &optional args)
"Insert Lisp OBJECT, using ARGS if a function."
- (setq eshell-last-arguments args
- eshell-last-command-name "#<Lisp>")
(catch 'eshell-external ; deferred to an external command
(let* ((eshell-ensure-newline-p (eshell-interactive-output-p))
(result
(if (functionp object)
- (eshell-apply object args)
+ (progn
+ (setq eshell-last-arguments args
+ eshell-last-command-name
+ (concat "#<function " (symbol-name object) ">"))
+ ;; if any of the arguments are flagged as numbers
+ ;; waiting for conversion, convert them now
+ (unless (get object 'eshell-no-numeric-conversions)
+ (while args
+ (let ((arg (car args)))
+ (if (and (stringp arg)
+ (> (length arg) 0)
+ (not (text-property-not-all
+ 0 (length arg) 'number t arg)))
+ (setcar args (string-to-number arg))))
+ (setq args (cdr args))))
+ (eshell-apply object eshell-last-arguments))
+ (setq eshell-last-arguments args
+ eshell-last-command-name "#<Lisp object>")
(eshell-eval object))))
(if (and eshell-ensure-newline-p
(save-excursion
(defalias 'eshell-lisp-command* 'eshell-lisp-command)
+;;; arch-tag: 8e4f3867-a0c5-441f-96ba-ddd142d94366
;;; esh-cmd.el ends here