;;; esh-cmd.el --- command invocation
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(require 'esh-ext)
(eval-when-compile
+ (require 'cl)
(require 'pcomplete))
:group 'eshell)
(defcustom eshell-prefer-lisp-functions nil
- "*If non-nil, prefer Lisp functions to external commands."
+ "If non-nil, prefer Lisp functions to external commands."
:type 'boolean
:group 'eshell-cmd)
(defcustom eshell-lisp-regexp "\\([(`]\\|#'\\)"
- "*A regexp which, if matched at beginning of an argument, means Lisp.
+ "A regexp which, if matched at beginning of an argument, means Lisp.
Such arguments will be passed to `read', and then evaluated."
:type 'regexp
:group 'eshell-cmd)
(defcustom eshell-pre-command-hook nil
- "*A hook run before each interactive command is invoked."
+ "A hook run before each interactive command is invoked."
:type 'hook
:group 'eshell-cmd)
(defcustom eshell-post-command-hook nil
- "*A hook run after each interactive command is invoked."
+ "A hook run after each interactive command is invoked."
:type 'hook
:group 'eshell-cmd)
(defcustom eshell-prepare-command-hook nil
- "*A set of functions called to prepare a named command.
+ "A set of functions called to prepare a named command.
The command name and its argument are in `eshell-last-command-name'
and `eshell-last-arguments'. The functions on this hook can change
the value of these symbols if necessary.
:group 'eshell-cmd)
(defcustom eshell-named-command-hook nil
- "*A set of functions called before a named command is invoked.
+ "A set of functions called before a named command is invoked.
Each function will be passed the command name and arguments that were
passed to `eshell-named-command'.
(defcustom eshell-pre-rewrite-command-hook
'(eshell-no-command-conversion
eshell-subcommand-arg-values)
- "*A hook run before command rewriting begins.
+ "A hook run before command rewriting begins.
The terms of the command to be rewritten is passed as arguments, and
may be modified in place. Any return value is ignored."
:type 'hook
eshell-rewrite-sexp-command
eshell-rewrite-initial-subcommand
eshell-rewrite-named-command)
- "*A set of functions used to rewrite the command argument.
+ "A set of functions used to rewrite the command argument.
Once parsing of a command line is completed, the next step is to
rewrite the initial argument into something runnable.
:group 'eshell-cmd)
(defcustom eshell-post-rewrite-command-hook nil
- "*A hook run after command rewriting is finished.
+ "A hook run after command rewriting is finished.
Each function is passed the symbol containing the rewritten command,
which may be modified directly. Any return value is ignored."
:type 'hook
:group 'eshell-cmd)
(defcustom eshell-complex-commands '("ls")
- "*A list of commands names or functions, that determine complexity.
+ "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
;;; User Variables:
-(defcustom eshell-cmd-load-hook '(eshell-cmd-initialize)
- "*A hook that gets run when `eshell-cmd' is loaded."
+(defcustom eshell-cmd-load-hook nil
+ "A hook that gets run when `eshell-cmd' is loaded."
+ :version "24.1" ; removed eshell-cmd-initialize
:type 'hook
:group 'eshell-cmd)
(defcustom eshell-debug-command nil
- "*If non-nil, enable debugging code. SSLLOOWW.
+ "If non-nil, enable debugging code. SSLLOOWW.
This option is only useful for reporting bugs. If you enable it, you
will have to visit the file 'eshell-cmd.el' and run the command
\\[eval-buffer]."
'(eshell-named-command
eshell-lisp-command
eshell-process-identity)
- "*A list of functions which might return an ansychronous process.
+ "A list of functions which might return an ansychronous process.
If they return a process object, execution of the calling Eshell
command will wait for completion (in the background) before finishing
the command."
'((eshell-in-subcommand-p t)
(default-directory default-directory)
(process-environment (eshell-copy-environment)))
- "*A list of `let' bindings for subcommand environments."
+ "A list of `let' bindings for subcommand environments."
:type 'sexp
:group 'eshell-cmd)
(defvar eshell-current-command nil)
(defvar eshell-command-name nil)
(defvar eshell-command-arguments nil)
-(defvar eshell-in-pipeline-p nil)
+(defvar eshell-in-pipeline-p nil
+ "Internal Eshell variable, non-nil inside a pipeline.
+Has the value 'first, 'last for the first/last commands in the pipeline,
+otherwise t.")
(defvar eshell-in-subcommand-p nil)
(defvar eshell-last-arguments nil)
(defvar eshell-last-command-name nil)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-lisp-symbols nil t)))
-(eshell-deftest var last-result-var
- "\"last result\" variable"
- (eshell-command-result-p "+ 1 2; + $$ 2" "3\n5\n"))
-
-(eshell-deftest var last-result-var2
- "\"last result\" variable"
- (eshell-command-result-p "+ 1 2; + $$ $$" "3\n6\n"))
-
-(eshell-deftest var last-arg-var
- "\"last arg\" variable"
- (eshell-command-result-p "+ 1 2; + $_ 4" "3\n6\n"))
-
(defun eshell-complete-lisp-symbols ()
"If there is a user reference, complete it."
(let ((arg (pcomplete-actual-arg)))
(if (consp command)
(eshell-parse-arguments (car command) (cdr command))
(let ((here (point))
- (inhibit-point-motion-hooks t)
- after-change-functions)
- (insert command)
- (prog1
- (eshell-parse-arguments here (point))
- (delete-region here (point)))))
+ (inhibit-point-motion-hooks t))
+ (with-silent-modifications
+ ;; FIXME: Why not use a temporary buffer and avoid this
+ ;; "insert&delete" business? --Stef
+ (insert command)
+ (prog1
+ (eshell-parse-arguments here (point))
+ (delete-region here (point))))))
args))
(commands
(mapcar
(function
(lambda (cmd)
- (if (or (not (car sep-terms))
- (string= (car sep-terms) ";"))
- (setq cmd
- (eshell-parse-pipeline cmd (not (car sep-terms))))
- (setq cmd
- (list 'eshell-do-subjob
- (list 'list (eshell-parse-pipeline cmd)))))
+ (setq cmd
+ (if (or (not (car sep-terms))
+ (string= (car sep-terms) ";"))
+ (eshell-parse-pipeline cmd (not (car sep-terms)))
+ `(eshell-do-subjob
+ (list ,(eshell-parse-pipeline cmd)))))
(setq sep-terms (cdr sep-terms))
(if eshell-in-pipeline-p
cmd
- (list 'eshell-trap-errors cmd))))
+ `(eshell-trap-errors ,cmd))))
(eshell-separate-commands terms "[&;]" nil 'sep-terms))))
(let ((cmd commands))
(while cmd
(if (cdr cmd)
- (setcar cmd (list 'eshell-commands (car cmd))))
+ (setcar cmd `(eshell-commands ,(car cmd))))
(setq cmd (cdr cmd))))
(setq commands
- (append (list 'progn)
- (if top-level
- (list '(run-hooks 'eshell-pre-command-hook)))
- (if (not top-level)
- commands
- (list
- (list 'catch (quote 'top-level)
- (append (list 'progn) commands))
- '(run-hooks 'eshell-post-command-hook)))))
+ `(progn
+ ,@(if top-level
+ '((run-hooks 'eshell-pre-command-hook)))
+ ,@(if (not top-level)
+ commands
+ `((catch 'top-level (progn ,@commands))
+ (run-hooks 'eshell-post-command-hook)))))
(if top-level
- (list 'eshell-commands commands)
+ `(eshell-commands ,commands)
commands)))
(defun eshell-debug-command (tag subform)
"Output a debugging message to '*eshell last cmd*'."
(let ((buf (get-buffer-create "*eshell last cmd*"))
(text (eshell-stringify eshell-current-command)))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(if (not tag)
(erase-buffer)
(insert "\n\C-l\n" tag "\n\n" text
(while terms
(if (and (listp (car terms))
(eq (caar terms) 'eshell-as-subcommand))
- (setcar terms (list 'eshell-convert
- (list 'eshell-command-to-value
- (car terms)))))
+ (setcar terms `(eshell-convert
+ (eshell-command-to-value ,(car terms)))))
(setq terms (cdr terms))))
(defun eshell-rewrite-sexp-command (terms)
(eq (caar terms) 'eshell-command-to-value))
(car (cdar terms))))
-(eshell-deftest cmd lisp-command
- "Evaluate Lisp command"
- (eshell-command-result-p "(+ 1 2)" "3"))
-
-(eshell-deftest cmd lisp-command-args
- "Evaluate Lisp command (ignore args)"
- (eshell-command-result-p "(+ 1 2) 3" "3"))
-
(defun eshell-rewrite-initial-subcommand (terms)
"Rewrite a subcommand in initial position, such as '{+ 1 2}'."
(if (and (listp (car terms))
(eq (caar terms) 'eshell-as-subcommand))
(car terms)))
-(eshell-deftest cmd subcommand
- "Run subcommand"
- (eshell-command-result-p "{+ 1 2}" "3\n"))
-
-(eshell-deftest cmd subcommand-args
- "Run subcommand (ignore args)"
- (eshell-command-result-p "{+ 1 2} 3" "3\n"))
-
-(eshell-deftest cmd subcommand-lisp
- "Run subcommand + Lisp form"
- (eshell-command-result-p "{(+ 1 2)}" "3\n"))
-
(defun eshell-rewrite-named-command (terms)
"If no other rewriting rule transforms TERMS, assume a named command."
(let ((sym (if eshell-in-pipeline-p
(cmd (car terms))
(args (cdr terms)))
(if args
- (list sym cmd (append (list 'list) (cdr terms)))
+ (list sym cmd `(list ,@(cdr terms)))
(list sym cmd))))
-(eshell-deftest cmd named-command
- "Execute named command"
- (eshell-command-result-p "+ 1 2" "3\n"))
-
-(eval-when-compile
- (defvar eshell-command-body)
- (defvar eshell-test-body))
+(defvar eshell-command-body)
+(defvar eshell-test-body)
(defsubst eshell-invokify-arg (arg &optional share-output silent)
"Change ARG so it can be invoked from a structured command.
(eq (car (cadr arg)) 'eshell-command-to-value))
(if share-output
(cadr (cadr arg))
- (list 'eshell-commands (cadr (cadr arg))
- silent))
+ `(eshell-commands ,(cadr (cadr arg)) ,silent))
arg))
+(defvar eshell-last-command-status) ;Define in esh-io.el.
+
(defun eshell-rewrite-for-command (terms)
"Rewrite a `for' command into its equivalent Eshell command form.
Because the implementation of `for' relies upon conditional evaluation
of its argument (i.e., use of a Lisp special form), it must be
implemented via rewriting, rather than as a function."
- (if (and (stringp (car terms))
- (string= (car terms) "for")
- (stringp (nth 2 terms))
- (string= (nth 2 terms) "in"))
+ (if (and (equal (car terms) "for")
+ (equal (nth 2 terms) "in"))
(let ((body (car (last terms))))
(setcdr (last terms 2) nil)
- (list
- 'let (list (list 'for-items
- (append
- (list 'append)
- (mapcar
- (function
- (lambda (elem)
- (if (listp elem)
- elem
- (list 'list elem))))
- (cdr (cddr terms)))))
- (list 'eshell-command-body
- (list 'quote (list nil)))
- (list 'eshell-test-body
- (list 'quote (list nil))))
- (list
- 'progn
- (list
- 'while (list 'car (list 'symbol-value
- (list 'quote 'for-items)))
- (list
- 'progn
- (list 'let
- (list (list (intern (cadr terms))
- (list 'car
- (list 'symbol-value
- (list 'quote 'for-items)))))
- (list 'eshell-protect
- (eshell-invokify-arg body t)))
- (list 'setcar 'for-items
- (list 'cadr
- (list 'symbol-value
- (list 'quote 'for-items))))
- (list 'setcdr 'for-items
- (list 'cddr
- (list 'symbol-value
- (list 'quote 'for-items))))))
- (list 'eshell-close-handles
- 'eshell-last-command-status
- (list 'list (quote 'quote)
- 'eshell-last-command-result)))))))
+ `(let ((for-items
+ ;; Apparently, eshell-do-eval only works for immutable
+ ;; let-bindings, i.e. we cannot use `setq' on `for-items'.
+ ;; Instead we store the list in the car of a cons-cell (which
+ ;; acts as a ref-cell) so we can setcar instead of setq.
+ (list
+ (append
+ ,@(mapcar
+ (lambda (elem)
+ (if (listp elem)
+ elem
+ `(list ,elem)))
+ (cdr (cddr terms))))))
+ (eshell-command-body '(nil))
+ (eshell-test-body '(nil)))
+ (while (consp (car for-items))
+ (let ((,(intern (cadr terms)) (caar for-items)))
+ (eshell-protect
+ ,(eshell-invokify-arg body t)))
+ (setcar for-items (cdar for-items)))
+ (eshell-close-handles
+ eshell-last-command-status
+ (list 'quote eshell-last-command-result))))))
(defun eshell-structure-basic-command (func names keyword test body
&optional else vocal-test)
;; that determine the truth of the statement.
(unless (eq (car test) 'eshell-convert)
(setq test
- (list 'progn test
- (list 'eshell-exit-success-p))))
+ `(progn ,test
+ (eshell-exit-success-p))))
;; should we reverse the sense of the test? This depends
;; on the `names' parameter. If it's the symbol nil, yes.
(if (or (eq names nil)
(and (listp names)
(string= keyword (cadr names))))
- (setq test (list 'not test)))
+ (setq test `(not ,test)))
;; finally, create the form that represents this structured
;; command
- (list
- 'let (list (list 'eshell-command-body
- (list 'quote (list nil)))
- (list 'eshell-test-body
- (list 'quote (list nil))))
- (list func test body else)
- (list 'eshell-close-handles
- 'eshell-last-command-status
- (list 'list (quote 'quote)
- 'eshell-last-command-result))))
+ `(let ((eshell-command-body '(nil))
+ (eshell-test-body '(nil)))
+ (,func ,test ,body ,else)
+ (eshell-close-handles
+ eshell-last-command-status
+ (list 'quote eshell-last-command-result))))
(defun eshell-rewrite-while-command (terms)
"Rewrite a `while' command into its equivalent Eshell command form.
(eshell-structure-basic-command
'while '("while" "until") (car terms)
(eshell-invokify-arg (cadr terms) nil t)
- (list 'eshell-protect
- (eshell-invokify-arg (car (last terms)) t)))))
+ `(eshell-protect
+ ,(eshell-invokify-arg (car (last terms)) t)))))
(defun eshell-rewrite-if-command (terms)
"Rewrite an `if' command into its equivalent Eshell command form.
(eshell-structure-basic-command
'if '("if" "unless") (car terms)
(eshell-invokify-arg (cadr terms) nil t)
- (list 'eshell-protect
- (eshell-invokify-arg
- (if (= (length terms) 4)
- (car (last terms 2))
- (car (last terms))) t))
+ `(eshell-protect
+ ,(eshell-invokify-arg (car (last terms (if (= (length terms) 4) 2)))
+ t))
(if (= (length terms) 4)
- (list 'eshell-protect
- (eshell-invokify-arg
- (car (last terms)))) t))))
+ `(eshell-protect
+ ,(eshell-invokify-arg (car (last terms)))) t))))
+
+(defvar eshell-last-command-result) ;Defined in esh-io.el.
(defun eshell-exit-success-p ()
"Return non-nil if the last command was \"successful\".
(if (<= (length pieces) 1)
(car pieces)
(assert (not eshell-in-pipeline-p))
- (list 'eshell-execute-pipeline
- (list 'quote pieces))))))
+ `(eshell-execute-pipeline (quote ,pieces))))))
(setq bp (cdr bp))))
;; `results' might be empty; this happens in the case of
;; multi-line input
(assert (car sep-terms))
(setq final (eshell-structure-basic-command
'if (string= (car sep-terms) "&&") "if"
- (list 'eshell-protect (car results))
- (list 'eshell-protect final)
+ `(eshell-protect ,(car results))
+ `(eshell-protect ,final)
nil t)
results (cdr results)
sep-terms (cdr sep-terms)))
(throw 'eshell-incomplete ?\{)
(when (eshell-arg-delimiter (1+ end))
(prog1
- (list 'eshell-as-subcommand
- (eshell-parse-command (cons (1+ (point)) end)))
+ `(eshell-as-subcommand
+ ,(eshell-parse-command (cons (1+ (point)) end)))
(goto-char (1+ end))))))))
(defun eshell-parse-lisp-argument ()
(end-of-file
(throw 'eshell-incomplete ?\()))))
(if (eshell-arg-delimiter)
- (list 'eshell-command-to-value
- (list 'eshell-lisp-command (list 'quote obj)))
+ `(eshell-command-to-value
+ (eshell-lisp-command (quote ,obj)))
(ignore (goto-char here))))))
(defun eshell-separate-commands (terms separator &optional
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 (list 'ignore)))
+ `(let ((eshell-this-command-hook '(ignore)))
(eshell-condition-case err
(prog1
,object
(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.
+
(defmacro eshell-copy-handles (object)
"Duplicate current I/O handles, so OBJECT works with its own copy."
`(let ((eshell-current-handles
(eshell-protect-handles eshell-current-handles)
,object))
-(defmacro eshell-do-pipelines (pipeline)
- "Execute the commands in PIPELINE, connecting each to one another."
+(defmacro eshell-do-pipelines (pipeline &optional notfirst)
+ "Execute the commands in PIPELINE, connecting each to one another.
+This macro calls itself recursively, with NOTFIRST non-nil."
(when (setq pipeline (cadr pipeline))
`(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)))))
+ (setq nextproc
+ (eshell-do-pipelines (quote ,(cdr pipeline)) t))
+ (eshell-set-output-handle ,eshell-output-handle
+ 'append nextproc)
+ (eshell-set-output-handle ,eshell-error-handle
+ 'append nextproc)
+ (setq tailproc (or tailproc nextproc))))
,(let ((head (car pipeline)))
(if (memq (car head) '(let progn))
(setq head (car (last head))))
(setcar head
(intern-soft
(concat (symbol-name (car head)) "*"))))))
- ,(car pipeline)))))
+ ;; First and last elements in a pipeline may need special treatment.
+ ;; (Currently only eshell-ls-files uses 'last.)
+ ;; Affects process-connection-type in eshell-gather-process-output.
+ (let ((eshell-in-pipeline-p
+ ,(cond ((not notfirst) (quote 'first))
+ ((cdr pipeline) t)
+ (t (quote 'last)))))
+ ,(car pipeline))))))
(defmacro eshell-do-pipelines-synchronously (pipeline)
"Execute the commands in PIPELINE in sequence synchronously.
This is used on systems where `start-process' is not supported."
(when (setq pipeline (cadr pipeline))
`(let (result)
- (progn
- ,(when (cdr pipeline)
- `(let (output-marker)
- (progn
- (set 'output-marker ,(point-marker))
- (eshell-set-output-handle ,eshell-output-handle
- 'append output-marker)
- (eshell-set-output-handle ,eshell-error-handle
- '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
+ ,(when (cdr pipeline)
+ `(let (output-marker)
+ (setq output-marker ,(point-marker))
+ (eshell-set-output-handle ,eshell-output-handle
+ 'append output-marker)
+ (eshell-set-output-handle ,eshell-error-handle
+ '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)) "*"))))))
;; 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))))
+ ;; redirected as we found them before running the pipe.
+ ,(if (null (cdr pipeline))
+ `(progn
+ (setq eshell-current-handles tail-handles)
+ (setq eshell-in-pipeline-p nil)))
+ (setq result ,(car pipeline))
+ ;; tailproc gets the result of the last successful process in
+ ;; the pipeline.
+ (setq tailproc (or result tailproc))
+ ,(if (cdr pipeline)
+ `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
+ result)))
(defalias 'eshell-process-identity 'identity)
(not (member name eshell-complex-commands))
(catch 'simple
(progn
- (eshell-for pred eshell-complex-commands
+ (dolist (pred eshell-complex-commands)
(if (and (functionp pred)
(funcall pred name))
(throw 'simple nil)))
;; we can just stick the new command at the end of the current
;; one, and everything will happen as it should
(setcdr (last (cdr eshell-current-command))
- (list (list 'let '((here (and (eobp) (point))))
- (and input
- (list 'insert-and-inherit
- (concat input "\n")))
- '(if here
- (eshell-update-markers here))
- (list 'eshell-do-eval
- (list 'quote command)))))
+ (list `(let ((here (and (eobp) (point))))
+ ,(and input
+ `(insert-and-inherit ,(concat input "\n")))
+ (if here
+ (eshell-update-markers here))
+ (eshell-do-eval ',command))))
(and eshell-debug-command
- (save-excursion
- (let ((buf (get-buffer-create "*eshell last cmd*")))
- (set-buffer buf)
- (erase-buffer)
- (insert "command: \"" input "\"\n"))))
+ (with-current-buffer (get-buffer-create "*eshell last cmd*")
+ (erase-buffer)
+ (insert "command: \"" input "\"\n")))
(setq eshell-current-command command)
(let ((delim (catch 'eshell-incomplete
(eshell-resume-eval))))
(defmacro eshell-manipulate (tag &rest commands)
"Manipulate a COMMAND form, with TAG as a debug identifier."
- (if (not eshell-debug-command)
+ (declare (indent 1))
+ ;; Check `bound'ness since at compile time the code until here has not
+ ;; executed yet.
+ (if (not (and (boundp 'eshell-debug-command) eshell-debug-command))
`(progn ,@commands)
`(progn
(eshell-debug-command ,(eval tag) form)
,@commands
(eshell-debug-command ,(concat "done " (eval tag)) form))))
-(put 'eshell-manipulate 'lisp-indent-function 1)
-
-;; eshell-lookup-function, eshell-functionp, and eshell-macrop taken
-;; from edebug
-
-(defsubst eshell-lookup-function (object)
- "Return the ultimate function definition of OBJECT."
- (while (and (symbolp object) (fboundp object))
- (setq object (symbol-function object)))
- object)
-
-(defconst function-p-func
- (if (fboundp 'compiled-function-p)
- 'compiled-function-p
- 'byte-code-function-p))
-
-(defsubst eshell-functionp (object)
- "Returns the function named by OBJECT, or nil if it is not a function."
- (setq object (eshell-lookup-function object))
- (if (or (subrp object)
- (funcall function-p-func object)
- (and (listp object)
- (eq (car object) 'lambda)
- (listp (car (cdr object)))))
- object))
-
(defsubst eshell-macrop (object)
"Return t if OBJECT is a macro or nil otherwise."
- (setq object (eshell-lookup-function object))
- (if (and (listp object)
- (eq 'macro (car object))
- (eshell-functionp (cdr object)))
- t))
+ (and (symbolp object) (fboundp object)
+ (setq object (indirect-function object))
+ (listp object)
+ (eq 'macro (car object))
+ (functionp (cdr object))))
(defun eshell-do-eval (form &optional synchronous-p)
"Evaluate form, simplifying it as we go.
(unless (car eshell-test-body)
(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)))
+ (setcar eshell-command-body
+ (if (cddr args)
+ `(progn ,@(eshell-copy-tree (cdr args)))
+ (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))))
(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)))))
+ (setcar eshell-command-body
+ (eshell-copy-tree
+ (if (cadr (eshell-do-eval (car eshell-test-body)))
+ (cadr args)
+ (car (cddr args)))))
(eshell-do-eval (car eshell-command-body) synchronous-p))
(setcar eshell-command-body nil)
(setcar eshell-test-body nil))
(if (and (eq (car form) 'let)
(not (eq (car (cadr args)) 'eshell-do-eval)))
(eshell-manipulate "evaluating let args"
- (eshell-for letarg (car args)
+ (dolist (letarg (car args))
(if (and (listp letarg)
(not (eq (cadr letarg) 'quote)))
(setcdr letarg
(setq args (cdr args)))
(unless (eq (caar args) 'eshell-do-eval)
(eshell-manipulate "handling special form"
- (setcar args (list 'eshell-do-eval
- (list 'quote (car args))
- synchronous-p))))
+ (setcar args `(eshell-do-eval ',(car args) ,synchronous-p))))
(eval form))
(t
(if (and args (not (memq (car form) '(run-hooks))))
(defun eshell/which (command &rest names)
"Identify the COMMAND, and where it is located."
- (eshell-for name (cons command names)
+ (dolist (name (cons command names))
(let (program alias direct)
(if (eq (aref name 0) eshell-explicit-command-char)
(setq name (substring name 1)
(prog1
(describe-function sym)
(message nil))))))
- (setq desc (substring desc 0
- (1- (or (string-match "\n" desc)
- (length desc)))))
+ (setq desc (if desc (substring desc 0
+ (1- (or (string-match "\n" desc)
+ (length desc))))
+ ;; This should not happen.
+ (format "%s is defined, \
+but no documentation was found" name)))
(if (buffer-live-p (get-buffer "*Help*"))
(kill-buffer "*Help*"))
(setq program (or desc name))))))
"Evaluate FORM, trapping errors and returning them."
(eshell-eval* 'eshell-printn 'eshell-errorn form))
+(defvar eshell-last-output-end) ;Defined in esh-mode.el.
+
(defun eshell-lisp-command (object &optional args)
"Insert Lisp OBJECT, using ARGS if a function."
(catch 'eshell-external ; deferred to an external command
(provide 'esh-cmd)
-;; arch-tag: 8e4f3867-a0c5-441f-96ba-ddd142d94366
;;; esh-cmd.el ends here
HCoop / bpt / emacs.git / blobdiff