;;; esh-cmd.el --- command invocation
-;; Copyright (C) 1999-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
(require 'esh-ext)
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'pcomplete))
:group 'eshell-cmd)
(defcustom eshell-debug-command nil
- "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]."
+ "If non-nil, enable Eshell debugging code.
+This is slow, and only useful for debugging problems with Eshell.
+If you change this without using customize after Eshell has loaded,
+you must re-load 'esh-cmd.el'."
+ :initialize 'custom-initialize-default
+ :set (lambda (symbol value)
+ (set symbol value)
+ (load-library "esh-cmd"))
:type 'boolean
:group 'eshell-cmd)
'(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 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."
(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)
(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)
(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))))
(defvar eshell-command-body)
(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
+ (append
+ ,@(mapcar
+ (lambda (elem)
+ (if (listp elem)
+ elem
+ `(list ,elem)))
+ (cdr (cddr terms)))))
+ (eshell-command-body '(nil))
+ (eshell-test-body '(nil)))
+ (while (consp for-items)
+ (let ((,(intern (cadr terms)) (car for-items)))
+ (eshell-protect
+ ,(eshell-invokify-arg body t)))
+ (setq for-items (cdr 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\".
(list
(if (<= (length pieces) 1)
(car pieces)
- (assert (not eshell-in-pipeline-p))
- (list 'eshell-execute-pipeline
- (list 'quote pieces))))))
+ (cl-assert (not eshell-in-pipeline-p))
+ `(eshell-execute-pipeline (quote ,pieces))))))
(setq bp (cdr bp))))
;; `results' might be empty; this happens in the case of
;; multi-line input
results (cdr results)
sep-terms (nreverse sep-terms))
(while results
- (assert (car sep-terms))
+ (cl-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-copy-handles
(progn
,(when (cdr pipeline)
- `(let (nextproc)
- (progn
- (set '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)
- (set 'tailproc (or tailproc nextproc)))))
+ `(let ((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))))
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 (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
- (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))))
+ `(progn
+ ,(when (cdr pipeline)
+ `(let ((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
+ (setq eshell-current-handles tail-handles)
+ (setq eshell-in-pipeline-p nil)))
+ (let ((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)
(eshell-print "errors\n"))
(if eshell-debug-command
(eshell-print "commands\n")))
- ((or (string= (car args) "-h")
- (string= (car args) "--help"))
+ ((member (car args) '("-h" "--help"))
(eshell-print "usage: eshell-debug [kinds]
This command is used to aid in debugging problems related to Eshell
;; 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
(with-current-buffer (get-buffer-create "*eshell last cmd*")
(erase-buffer)
(defmacro eshell-manipulate (tag &rest commands)
"Manipulate a COMMAND form, with TAG as a debug identifier."
+ (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))
,@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.
;; `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))
+ (cl-assert (not synchronous-p))
(eshell-do-eval (car eshell-command-body))
(setcar eshell-command-body nil)
(setcar eshell-test-body nil))
(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))))
;; doesn't get modified and thus always yield the same result.
(if (car eshell-command-body)
(progn
- (assert (not synchronous-p))
+ (cl-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)))))
+ (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))
(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))
+ ((eq (car form) 'setq)
+ (if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)"))
+ (eshell-manipulate "evaluating arguments to setq"
+ (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)))
+ (list 'quote (eval form)))
(t
(if (and args (not (memq (car form) '(run-hooks))))
(eshell-manipulate
;; Thus, aliases can even contain references to asynchronous
;; sub-commands, and things will still work out as they
;; should.
- (let (result new-form)
- (if (setq new-form
- (catch 'eshell-replace-command
- (ignore
- (setq result (eval form)))))
+ (let* (result
+ (new-form
+ (catch 'eshell-replace-command
+ (ignore
+ (setq result (eval form))))))
+ (if new-form
(progn
(eshell-manipulate "substituting replacement form"
(setcar form (car new-form))
(setq eshell-last-arguments args
eshell-last-command-name (eshell-stringify command))
(run-hook-with-args 'eshell-prepare-command-hook)
- (assert (stringp eshell-last-command-name))
+ (cl-assert (stringp eshell-last-command-name))
(if eshell-last-command-name
(or (run-hook-with-args-until-success
'eshell-named-command-hook eshell-last-command-name
(if (and file
(string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
(let ((module-sym
- (intern (file-name-sans-extension
- (file-name-nondirectory
- (concat "eshell-" (match-string 2 file)))))))
+ (intern (file-name-base (concat "eshell-" (match-string 2 file))))))
(if (and (functionp sym)
(or (null module-sym)
(eshell-using-module module-sym)
PRINTER and ERRPRINT are functions to use for printing regular
messages, and errors. FORM-P should be non-nil if FUNC-OR-FORM
represent a lisp form; ARGS will be ignored in that case."
- (let (result)
- (eshell-condition-case err
- (progn
- (setq result
- (save-current-buffer
- (if form-p
- (eval func-or-form)
- (apply func-or-form args))))
- (and result (funcall printer result))
- result)
- (error
- (let ((msg (error-message-string err)))
- (if (and (not form-p)
- (string-match "^Wrong number of arguments" msg)
- (fboundp 'eldoc-get-fnsym-args-string))
- (let ((func-doc (eldoc-get-fnsym-args-string func-or-form)))
- (setq msg (format "usage: %s" func-doc))))
- (funcall errprint msg))
- nil))))
+ (eshell-condition-case err
+ (let ((result
+ (save-current-buffer
+ (if form-p
+ (eval func-or-form)
+ (apply func-or-form args)))))
+ (and result (funcall printer result))
+ result)
+ (error
+ (let ((msg (error-message-string err)))
+ (if (and (not form-p)
+ (string-match "^Wrong number of arguments" msg)
+ (fboundp 'eldoc-get-fnsym-args-string))
+ (let ((func-doc (eldoc-get-fnsym-args-string func-or-form)))
+ (setq msg (format "usage: %s" func-doc))))
+ (funcall errprint msg))
+ nil)))
(defsubst eshell-apply* (printer errprint func args)
"Call FUNC, with ARGS, trapping errors and return them as output.
"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
HCoop / bpt / emacs.git / blobdiff