]> code.delx.au - gnu-emacs/blobdiff - lisp/eshell/esh-cmd.el
Bump version to 25.0.95
[gnu-emacs] / lisp / eshell / esh-cmd.el
index cac33f130f15feeaff94ac89081efd6f3b633534..d3613d31405840dd2fc788c308931832991c3bbb 100644 (file)
@@ -1,6 +1,6 @@
-;;; esh-cmd.el --- command invocation
+;;; esh-cmd.el --- command invocation  -*- lexical-binding:t -*-
 
-;; Copyright (C) 1999-201 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2016 Free Software Foundation, Inc.
 
 ;; Author: John Wiegley <johnw@gnu.org>
 
 (require 'esh-ext)
 
 (eval-when-compile
-  (require 'cl)
+  (require 'cl-lib)
   (require 'pcomplete))
 
 
@@ -165,13 +165,13 @@ In order to substitute an alternate command form for execution, the
 hook function should throw it using the tag `eshell-replace-command'.
 For example:
 
-  (add-hook 'eshell-named-command-hook 'subst-with-cd)
+  (add-hook \\='eshell-named-command-hook \\='subst-with-cd)
   (defun subst-with-cd (command args)
-    (throw 'eshell-replace-command
+    (throw \\='eshell-replace-command
           (eshell-parse-command \"cd\" args)))
 
 Although useless, the above code will cause any non-glob, non-Lisp
-command (i.e., 'ls' as opposed to '*ls' or '(ls)') to be replaced by a
+command (i.e., `ls' as opposed to `*ls' or `(ls)') to be replaced by a
 call to `cd' using the arguments that were passed to the function."
   :type 'hook
   :group 'eshell-cmd)
@@ -205,12 +205,16 @@ forms or strings)."
   :type 'hook
   :group 'eshell-cmd)
 
-(defcustom eshell-post-rewrite-command-hook nil
+(defvar eshell-post-rewrite-command-function #'identity
+  "Function run after command rewriting is finished.
+Takes the (rewritten) command, modifies it as it sees fit and returns
+the new result to use instead.")
+(defvar eshell-post-rewrite-command-hook nil
   "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)
+which may be modified directly.  Any return value is ignored.")
+(make-obsolete-variable 'eshell-post-rewrite-command-hook
+                        'eshell-post-rewrite-command-function "24.4")
 
 (defcustom eshell-complex-commands '("ls")
   "A list of commands names or functions, that determine complexity.
@@ -236,10 +240,14 @@ return non-nil if the command is complex."
   :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)
 
@@ -247,7 +255,7 @@ will have to visit the file 'eshell-cmd.el' and run the command
   '(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."
@@ -276,7 +284,7 @@ command line.")
 (defvar eshell-command-arguments 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,
+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)
@@ -331,13 +339,15 @@ otherwise t.")
 
 ;; Command parsing
 
-(defun eshell-parse-command (command &optional args top-level)
+(defvar eshell--sep-terms)
+
+(defun eshell-parse-command (command &optional args toplevel)
   "Parse the COMMAND, adding ARGS if given.
 COMMAND can either be a string, or a cons cell demarcating a buffer
-region.  TOP-LEVEL, if non-nil, means that the outermost command (the
+region.  TOPLEVEL, if non-nil, means that the outermost command (the
 user's input command) is being parsed, and that pre and post command
 hooks should be run before and after the command."
-  (let* (sep-terms
+  (let* (eshell--sep-terms
         (terms
          (append
           (if (consp command)
@@ -357,35 +367,30 @@ hooks should be run before and after the command."
           (function
            (lambda (cmd)
               (setq cmd
-                    (if (or (not (car sep-terms))
-                            (string= (car sep-terms) ";"))
-                       (eshell-parse-pipeline cmd (not (car sep-terms)))
+                    (if (or (not (car eshell--sep-terms))
+                            (string= (car eshell--sep-terms) ";"))
+                       (eshell-parse-pipeline cmd)
                      `(eshell-do-subjob
                         (list ,(eshell-parse-pipeline cmd)))))
-             (setq sep-terms (cdr sep-terms))
+             (setq eshell--sep-terms (cdr eshell--sep-terms))
              (if eshell-in-pipeline-p
                  cmd
                `(eshell-trap-errors ,cmd))))
-          (eshell-separate-commands terms "[&;]" nil 'sep-terms))))
+          (eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
     (let ((cmd commands))
       (while cmd
        (if (cdr cmd)
            (setcar cmd `(eshell-commands ,(car cmd))))
        (setq cmd (cdr cmd))))
-    (setq commands
-         `(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
-       `(eshell-commands ,commands)
-      commands)))
+    (if toplevel
+       `(eshell-commands (progn
+                            (run-hooks 'eshell-pre-command-hook)
+                            (catch 'top-level (progn ,@commands))
+                            (run-hooks 'eshell-post-command-hook)))
+      (macroexp-progn commands))))
 
 (defun eshell-debug-command (tag subform)
-  "Output a debugging message to '*eshell last cmd*'."
+  "Output a debugging message to `*eshell last cmd*'."
   (let ((buf (get-buffer-create "*eshell last cmd*"))
        (text (eshell-stringify eshell-current-command)))
     (with-current-buffer buf
@@ -419,14 +424,14 @@ hooks should be run before and after the command."
     (setq terms (cdr terms))))
 
 (defun eshell-rewrite-sexp-command (terms)
-  "Rewrite a sexp in initial position, such as '(+ 1 2)'."
+  "Rewrite a sexp in initial position, such as `(+ 1 2)'."
   ;; this occurs when a Lisp expression is in first position
   (if (and (listp (car terms))
           (eq (caar terms) 'eshell-command-to-value))
       (car (cdar terms))))
 
 (defun eshell-rewrite-initial-subcommand (terms)
-  "Rewrite a subcommand in initial position, such as '{+ 1 2}'."
+  "Rewrite a subcommand in initial position, such as `{+ 1 2}'."
   (if (and (listp (car terms))
           (eq (caar terms) 'eshell-as-subcommand))
       (car terms)))
@@ -469,6 +474,8 @@ the second is ignored."
     arg))
 
 (defvar eshell-last-command-status)     ;Define in esh-io.el.
+(defvar eshell--local-vars nil
+  "List of locally bound vars that should take precedence over env-vars.")
 
 (defun eshell-rewrite-for-command (terms)
   "Rewrite a `for' command into its equivalent Eshell command form.
@@ -480,32 +487,34 @@ implemented via rewriting, rather than as a function."
       (let ((body (car (last terms))))
        (setcdr (last terms 2) nil)
        `(let ((for-items
-                (append
-                 ,@(mapcar
-                    (lambda (elem)
-                      (if (listp elem)
-                          elem
-                        `(list ,elem)))
-                    (cdr (cddr terms)))))
-               (eshell-command-body '(nil))
+               (copy-tree
+                (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)))
+          (while (car for-items)
+            (let ((,(intern (cadr terms)) (car for-items))
+                  (eshell--local-vars (cons ',(intern (cadr terms))
+                                           eshell--local-vars)))
+              (eshell-protect
+               ,(eshell-invokify-arg body t)))
+            (setcar for-items (cadr for-items))
+            (setcdr for-items (cddr 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)
+                                           &optional else)
   "With TERMS, KEYWORD, and two NAMES, structure a basic command.
 The first of NAMES should be the positive form, and the second the
 negative.  It's not likely that users should ever need to call this
-function.
-
-If VOCAL-TEST is non-nil, it means output from the test should be
-shown, as well as output from the body."
+function."
   ;; If the test form begins with `eshell-convert', it means
   ;; something data-wise will be returned, and we should let
   ;; that determine the truth of the statement.
@@ -575,11 +584,13 @@ For an external command, it means an exit code of 0."
       eshell-last-command-result
     (= eshell-last-command-status 0)))
 
-(defun eshell-parse-pipeline (terms &optional final-p)
+(defvar eshell--cmd)
+
+(defun eshell-parse-pipeline (terms)
   "Parse a pipeline from TERMS, return the appropriate Lisp forms."
-  (let* (sep-terms
+  (let* (eshell--sep-terms
         (bigpieces (eshell-separate-commands terms "\\(&&\\|||\\)"
-                                             nil 'sep-terms))
+                                             nil 'eshell--sep-terms))
         (bp bigpieces)
         (results (list t))
         final)
@@ -592,14 +603,17 @@ For an external command, it means an exit code of 0."
              (run-hook-with-args 'eshell-pre-rewrite-command-hook cmd)
              (setq cmd (run-hook-with-args-until-success
                         'eshell-rewrite-command-hook cmd))
-             (run-hook-with-args 'eshell-post-rewrite-command-hook 'cmd)
-             (setcar p cmd))
+             (let ((eshell--cmd cmd))
+               (run-hook-with-args 'eshell-post-rewrite-command-hook
+                                   'eshell--cmd)
+               (setq cmd eshell--cmd))
+             (setcar p (funcall eshell-post-rewrite-command-function cmd)))
            (setq p (cdr p)))
          (nconc results
                 (list
                  (if (<= (length pieces) 1)
                      (car pieces)
-                   (assert (not eshell-in-pipeline-p))
+                   (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
@@ -608,20 +622,19 @@ For an external command, it means an exit code of 0."
          results (nreverse results)
          final (car results)
          results (cdr results)
-         sep-terms (nreverse sep-terms))
+         eshell--sep-terms (nreverse eshell--sep-terms))
     (while results
-      (assert (car sep-terms))
+      (cl-assert (car eshell--sep-terms))
       (setq final (eshell-structure-basic-command
-                  'if (string= (car sep-terms) "&&") "if"
+                  'if (string= (car eshell--sep-terms) "&&") "if"
                   `(eshell-protect ,(car results))
-                  `(eshell-protect ,final)
-                  nil t)
+                  `(eshell-protect ,final))
            results (cdr results)
-           sep-terms (cdr sep-terms)))
+           eshell--sep-terms (cdr eshell--sep-terms)))
     final))
 
 (defun eshell-parse-subcommand-argument ()
-  "Parse a subcommand argument of the form '{command}'."
+  "Parse a subcommand argument of the form `{command}'."
   (if (and (not eshell-current-argument)
           (not eshell-current-quoted)
           (eq (char-after) ?\{)
@@ -643,7 +656,7 @@ For an external command, it means an exit code of 0."
           (looking-at eshell-lisp-regexp))
       (let* ((here (point))
             (obj
-             (condition-case err
+             (condition-case nil
                  (read (current-buffer))
                (end-of-file
                 (throw 'eshell-incomplete ?\()))))
@@ -657,8 +670,8 @@ For an external command, it means an exit code of 0."
   "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, its value
-will be set to a list of all the separator operators found (or '(list
-nil)' if none)."
+will be set to a list of all the separator operators found (or (nil)
+if none)."
   (let ((sub-terms (list t))
        (eshell-sep-terms (list t))
        subchains)
@@ -760,9 +773,8 @@ This macro calls itself recursively, with NOTFIRST non-nil."
     `(eshell-copy-handles
       (progn
        ,(when (cdr pipeline)
-          `(let (nextproc)
-              (setq nextproc
-                    (eshell-do-pipelines (quote ,(cdr pipeline)) t))
+          `(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
@@ -788,12 +800,11 @@ This macro calls itself recursively, with NOTFIRST non-nil."
 (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."
+This is used on systems where async subprocesses are not supported."
   (when (setq pipeline (cadr pipeline))
-    `(let (result)
+    `(progn
        ,(when (cdr pipeline)
-          `(let (output-marker)
-             (setq output-marker ,(point-marker))
+          `(let ((output-marker ,(point-marker)))
              (eshell-set-output-handle ,eshell-output-handle
                                        'append output-marker)
              (eshell-set-output-handle ,eshell-error-handle
@@ -813,13 +824,13 @@ This is used on systems where `start-process' is not supported."
             `(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)))
+       (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)
 
@@ -827,7 +838,7 @@ This is used on systems where `start-process' is not supported."
   "Execute the commands in PIPELINE, connecting each to one another."
   `(let ((eshell-in-pipeline-p t) tailproc)
      (progn
-       ,(if (fboundp 'start-process)
+       ,(if (fboundp 'make-process)
            `(eshell-do-pipelines ,pipeline)
          `(let ((tail-handles (eshell-create-handles
                                (car (aref eshell-current-handles
@@ -884,8 +895,7 @@ Returns a string comprising the output from the command."
         (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
@@ -908,7 +918,7 @@ at the moment are:
   "Completion for the `debug' command."
   (while (pcomplete-here '("errors" "commands"))))
 
-(defun eshell-invoke-directly (command input)
+(defun eshell-invoke-directly (command)
   (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))
@@ -989,14 +999,6 @@ at the moment are:
        ,@commands
        (eshell-debug-command ,(concat "done " (eval tag)) form))))
 
-(defsubst eshell-macrop (object)
-  "Return t if OBJECT is a macro or nil otherwise."
-  (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 SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
@@ -1012,10 +1014,10 @@ be finished later after the completion of an asynchronous subprocess."
       (setq form (cadr (cadr form))))
     ;; expand any macros directly into the form.  This is done so that
     ;; we can modify any `let' forms to evaluate only once.
-    (if (eshell-macrop (car form))
+    (if (macrop (car form))
        (let ((exp (eshell-copy-tree (macroexpand form))))
-         (eshell-manipulate (format "expanding macro `%s'"
-                                    (symbol-name (car form)))
+         (eshell-manipulate (format-message "expanding macro `%s'"
+                                            (symbol-name (car form)))
            (setcar form (car exp))
            (setcdr form (cdr exp)))))
     (let ((args (cdr form)))
@@ -1024,14 +1026,17 @@ be finished later after the completion of an asynchronous subprocess."
        ;; `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))))
@@ -1041,7 +1046,7 @@ be finished later after the completion of an asynchronous subprocess."
        ;; 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))))
@@ -1082,11 +1087,16 @@ be finished later after the completion of an asynchronous subprocess."
          (eshell-manipulate "handling special form"
            (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
-               (format "evaluating arguments to `%s'"
-                       (symbol-name (car form)))
+               (format-message "evaluating arguments to `%s'"
+                               (symbol-name (car form)))
              (while args
                (setcar args (eshell-do-eval (car args) synchronous-p))
                (setq args (cdr args)))))
@@ -1118,11 +1128,12 @@ be finished later after the completion of an asynchronous subprocess."
          ;; 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))
@@ -1190,7 +1201,7 @@ COMMAND may result in an alias being executed, or a plain command."
   (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
@@ -1205,13 +1216,12 @@ COMMAND may result in an alias being executed, or a plain command."
   (let* ((sym (intern-soft (concat "eshell/" name)))
         (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
+    ;; that's not currently enabled, don't report it as found.
     (if (and file
-            (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
+            (setq file (file-name-base file))
+            (string-match "\\`\\(em\\|esh\\)-\\([[:alnum:]]+\\)\\'" file))
        (let ((module-sym
-              (intern (file-name-sans-extension
-                       (file-name-nondirectory
-                        (concat "eshell-" (match-string 2 file)))))))
+              (intern (concat "eshell-" (match-string 2 file)))))
          (if (and (functionp sym)
                   (or (null module-sym)
                       (eshell-using-module module-sym)
@@ -1238,25 +1248,23 @@ or an external command."
 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.