lisp/eshell/esh-cmd.el

   1 ;;; esh-cmd.el --- command invocation
   2
   3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: John Wiegley <johnw@gnu.org>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;;_* Invoking external commands
  28 ;;
  29 ;; External commands cause processes to be created, by loading
  30 ;; external executables into memory.  This is what most normal shells
  31 ;; do, most of the time.  For more information, see [External commands].
  32 ;;
  33 ;;;_* Invoking Lisp functions
  34 ;;
  35 ;; A Lisp function can be invoked using Lisp syntax, or command shell
  36 ;; syntax.  For example, to run `dired' to edit the current directory:
  37 ;;
  38 ;;   /tmp $ (dired ".")
  39 ;;
  40 ;; Or:
  41 ;;
  42 ;;   /tmp $ dired .
  43 ;;
  44 ;; The latter form is preferable, but the former is more precise,
  45 ;; since it involves no translations.  See [Argument parsing], to
  46 ;; learn more about how arguments are transformed before passing them
  47 ;; to commands.
  48 ;;
  49 ;; Ordinarily, if 'dired' were also available as an external command,
  50 ;; the external version would be called in preference to any Lisp
  51 ;; function of the same name.  To change this behavior so that Lisp
  52 ;; functions always take precedence, set
  53 ;; `eshell-prefer-lisp-functions' to t.
  54
  55 ;;;_* Alias functions
  56 ;;
  57 ;; Whenever a command is specified using a simple name, such as 'ls',
  58 ;; Eshell will first look for a Lisp function of the name `eshell/ls'.
  59 ;; If it exists, it will be called in preference to any other command
  60 ;; which might have matched the name 'ls' (such as command aliases,
  61 ;; external commands, Lisp functions of that name, etc).
  62 ;;
  63 ;; This is the most flexible mechanism for creating new commands,
  64 ;; since it does not pollute the global namespace, yet allows you to
  65 ;; use all of Lisp's facilities to define that piece of functionality.
  66 ;; Most of Eshell's "builtin" commands are defined as alias functions.
  67 ;;
  68 ;;;_* Lisp arguments
  69 ;;
  70 ;; It is possible to invoke a Lisp form as an argument.  This can be
  71 ;; done either by specifying the form as you might in Lisp, or by
  72 ;; using the '$' character to introduce a value-interpolation:
  73 ;;
  74 ;;   echo (+ 1 2)
  75 ;;
  76 ;; Or
  77 ;;
  78 ;;   echo $(+ 1 2)
  79 ;;
  80 ;; The two forms are equivalent.  The second is required only if the
  81 ;; form being interpolated is within a string, or is a subexpression
  82 ;; of a larger argument:
  83 ;;
  84 ;;   echo x$(+ 1 2) "String $(+ 1 2)"
  85 ;;
  86 ;; To pass a Lisp symbol as a argument, use the alternate quoting
  87 ;; syntax, since the single quote character is far too overused in
  88 ;; shell syntax:
  89 ;;
  90 ;;   echo #'lisp-symbol
  91 ;;
  92 ;; Backquote can also be used:
  93 ;;
  94 ;;   echo `(list ,lisp-symbol)
  95 ;;
  96 ;; Lisp arguments are identified using the following regexp:
  97
  98 ;;;_* Command hooks
  99 ;;
 100 ;; There are several hooks involved with command execution, which can
 101 ;; be used either to change or augment Eshell's behavior.
 102
 103
 104 ;;; Code:
 105
 106 (require 'esh-util)
 107 (unless (featurep 'xemacs)
 108   (require 'eldoc))
 109 (require 'esh-arg)
 110 (require 'esh-proc)
 111 (require 'esh-ext)
 112
 113 (eval-when-compile
 114   (require 'pcomplete))
 115
 116
 117 (defgroup eshell-cmd nil
 118   "Executing an Eshell command is as simple as typing it in and
 119 pressing <RET>.  There are several different kinds of commands,
 120 however."
 121   :tag "Command invocation"
 122   ;; :link '(info-link "(eshell)Command invocation")
 123   :group 'eshell)
 124
 125 (defcustom eshell-prefer-lisp-functions nil
 126   "*If non-nil, prefer Lisp functions to external commands."
 127   :type 'boolean
 128   :group 'eshell-cmd)
 129
 130 (defcustom eshell-lisp-regexp "\\([(`]\\|#'\\)"
 131   "*A regexp which, if matched at beginning of an argument, means Lisp.
 132 Such arguments will be passed to `read', and then evaluated."
 133   :type 'regexp
 134   :group 'eshell-cmd)
 135
 136 (defcustom eshell-pre-command-hook nil
 137   "*A hook run before each interactive command is invoked."
 138   :type 'hook
 139   :group 'eshell-cmd)
 140
 141 (defcustom eshell-post-command-hook nil
 142   "*A hook run after each interactive command is invoked."
 143   :type 'hook
 144   :group 'eshell-cmd)
 145
 146 (defcustom eshell-prepare-command-hook nil
 147   "*A set of functions called to prepare a named command.
 148 The command name and its argument are in `eshell-last-command-name'
 149 and `eshell-last-arguments'.  The functions on this hook can change
 150 the value of these symbols if necessary.
 151
 152 To prevent a command from executing at all, set
 153 `eshell-last-command-name' to nil."
 154   :type 'hook
 155   :group 'eshell-cmd)
 156
 157 (defcustom eshell-named-command-hook nil
 158   "*A set of functions called before a named command is invoked.
 159 Each function will be passed the command name and arguments that were
 160 passed to `eshell-named-command'.
 161
 162 If any of the functions returns a non-nil value, the named command
 163 will not be invoked, and that value will be returned from
 164 `eshell-named-command'.
 165
 166 In order to substitute an alternate command form for execution, the
 167 hook function should throw it using the tag `eshell-replace-command'.
 168 For example:
 169
 170   (add-hook 'eshell-named-command-hook 'subst-with-cd)
 171   (defun subst-with-cd (command args)
 172     (throw 'eshell-replace-command
 173            (eshell-parse-command \"cd\" args)))
 174
 175 Although useless, the above code will cause any non-glob, non-Lisp
 176 command (i.e., 'ls' as opposed to '*ls' or '(ls)') to be replaced by a
 177 call to `cd' using the arguments that were passed to the function."
 178   :type 'hook
 179   :group 'eshell-cmd)
 180
 181 (defcustom eshell-pre-rewrite-command-hook
 182   '(eshell-no-command-conversion
 183     eshell-subcommand-arg-values)
 184   "*A hook run before command rewriting begins.
 185 The terms of the command to be rewritten is passed as arguments, and
 186 may be modified in place.  Any return value is ignored."
 187   :type 'hook
 188   :group 'eshell-cmd)
 189
 190 (defcustom eshell-rewrite-command-hook
 191   '(eshell-rewrite-for-command
 192     eshell-rewrite-while-command
 193     eshell-rewrite-if-command
 194     eshell-rewrite-sexp-command
 195     eshell-rewrite-initial-subcommand
 196     eshell-rewrite-named-command)
 197   "*A set of functions used to rewrite the command argument.
 198 Once parsing of a command line is completed, the next step is to
 199 rewrite the initial argument into something runnable.
 200
 201 A module may wish to associate special behavior with certain argument
 202 syntaxes at the beginning of a command line.  They are welcome to do
 203 so by adding a function to this hook.  The first function to return a
 204 substitute command form is the one used.  Each function is passed the
 205 command's full argument list, which is a list of sexps (typically
 206 forms or strings)."
 207   :type 'hook
 208   :group 'eshell-cmd)
 209
 210 (defcustom eshell-post-rewrite-command-hook nil
 211   "*A hook run after command rewriting is finished.
 212 Each function is passed the symbol containing the rewritten command,
 213 which may be modified directly.  Any return value is ignored."
 214   :type 'hook
 215   :group 'eshell-cmd)
 216
 217 (defcustom eshell-complex-commands '("ls")
 218   "*A list of commands names or functions, that determine complexity.
 219 That is, if a command is defined by a function named eshell/NAME,
 220 and NAME is part of this list, it is invoked as a complex command.
 221 Complex commands are always correct, but run much slower.  If a
 222 command works fine without being part of this list, then it doesn't
 223 need to be.
 224
 225 If an entry is a function, it will be called with the name, and should
 226 return non-nil if the command is complex."
 227   :type '(repeat :tag "Commands"
 228                  (choice (string :tag "Name")
 229                          (function :tag "Predicate")))
 230   :group 'eshell-cmd)
 231
 232 ;;; User Variables:
 233
 234 (defcustom eshell-cmd-load-hook '(eshell-cmd-initialize)
 235   "*A hook that gets run when `eshell-cmd' is loaded."
 236   :type 'hook
 237   :group 'eshell-cmd)
 238
 239 (defcustom eshell-debug-command nil
 240   "*If non-nil, enable debugging code.  SSLLOOWW.
 241 This option is only useful for reporting bugs.  If you enable it, you
 242 will have to visit the file 'eshell-cmd.el' and run the command
 243 \\[eval-buffer]."
 244   :type 'boolean
 245   :group 'eshell-cmd)
 246
 247 (defcustom eshell-deferrable-commands
 248   '(eshell-named-command
 249     eshell-lisp-command
 250     eshell-process-identity)
 251   "*A list of functions which might return an ansychronous process.
 252 If they return a process object, execution of the calling Eshell
 253 command will wait for completion (in the background) before finishing
 254 the command."
 255   :type '(repeat function)
 256   :group 'eshell-cmd)
 257
 258 (defcustom eshell-subcommand-bindings
 259   '((eshell-in-subcommand-p t)
 260     (default-directory default-directory)
 261     (process-environment (eshell-copy-environment)))
 262   "*A list of `let' bindings for subcommand environments."
 263   :type 'sexp
 264   :group 'eshell-cmd)
 265
 266 (put 'risky-local-variable 'eshell-subcommand-bindings t)
 267
 268 (defvar eshell-ensure-newline-p nil
 269   "If non-nil, ensure that a newline is emitted after a Lisp form.
 270 This can be changed by Lisp forms that are evaluated from the Eshell
 271 command line.")
 272
 273 ;;; Internal Variables:
 274
 275 (defvar eshell-current-command nil)
 276 (defvar eshell-command-name nil)
 277 (defvar eshell-command-arguments nil)
 278 (defvar eshell-in-pipeline-p nil)
 279 (defvar eshell-in-subcommand-p nil)
 280 (defvar eshell-last-arguments nil)
 281 (defvar eshell-last-command-name nil)
 282 (defvar eshell-last-async-proc nil
 283   "When this foreground process completes, resume command evaluation.")
 284
 285 ;;; Functions:
 286
 287 (defsubst eshell-interactive-process ()
 288   "Return currently running command process, if non-Lisp."
 289   eshell-last-async-proc)
 290
 291 (defun eshell-cmd-initialize ()
 292   "Initialize the Eshell command processing module."
 293   (set (make-local-variable 'eshell-current-command) nil)
 294   (set (make-local-variable 'eshell-command-name) nil)
 295   (set (make-local-variable 'eshell-command-arguments) nil)
 296   (set (make-local-variable 'eshell-last-arguments) nil)
 297   (set (make-local-variable 'eshell-last-command-name) nil)
 298   (set (make-local-variable 'eshell-last-async-proc) nil)
 299
 300   (add-hook 'eshell-kill-hook 'eshell-resume-command nil t)
 301
 302   ;; make sure that if a command is over, and no process is being
 303   ;; waited for, that `eshell-current-command' is set to nil.  This
 304   ;; situation can occur, for example, if a Lisp function results in
 305   ;; `debug' being called, and the user then types \\[top-level]
 306   (add-hook 'eshell-post-command-hook
 307             (function
 308              (lambda ()
 309                (setq eshell-current-command nil
 310                      eshell-last-async-proc nil))) nil t)
 311
 312   (add-hook 'eshell-parse-argument-hook
 313             'eshell-parse-subcommand-argument nil t)
 314   (add-hook 'eshell-parse-argument-hook
 315             'eshell-parse-lisp-argument nil t)
 316
 317   (when (eshell-using-module 'eshell-cmpl)
 318     (add-hook 'pcomplete-try-first-hook
 319               'eshell-complete-lisp-symbols nil t)))
 320
 321 (eshell-deftest var last-result-var
 322   "\"last result\" variable"
 323   (eshell-command-result-p "+ 1 2; + $$ 2" "3\n5\n"))
 324
 325 (eshell-deftest var last-result-var2
 326   "\"last result\" variable"
 327   (eshell-command-result-p "+ 1 2; + $$ $$" "3\n6\n"))
 328
 329 (eshell-deftest var last-arg-var
 330   "\"last arg\" variable"
 331   (eshell-command-result-p "+ 1 2; + $_ 4" "3\n6\n"))
 332
 333 (defun eshell-complete-lisp-symbols ()
 334   "If there is a user reference, complete it."
 335   (let ((arg (pcomplete-actual-arg)))
 336     (when (string-match (concat "\\`" eshell-lisp-regexp) arg)
 337       (setq pcomplete-stub (substring arg (match-end 0))
 338             pcomplete-last-completion-raw t)
 339       (throw 'pcomplete-completions
 340              (all-completions pcomplete-stub obarray 'boundp)))))
 341
 342 ;; Command parsing
 343
 344 (defun eshell-parse-command (command &optional args top-level)
 345   "Parse the COMMAND, adding ARGS if given.
 346 COMMAND can either be a string, or a cons cell demarcating a buffer
 347 region.  TOP-LEVEL, if non-nil, means that the outermost command (the
 348 user's input command) is being parsed, and that pre and post command
 349 hooks should be run before and after the command."
 350   (let* (sep-terms
 351          (terms
 352           (append
 353            (if (consp command)
 354                (eshell-parse-arguments (car command) (cdr command))
 355              (let ((here (point))
 356                    (inhibit-point-motion-hooks t)
 357                    after-change-functions)
 358                (insert command)
 359                (prog1
 360                    (eshell-parse-arguments here (point))
 361                  (delete-region here (point)))))
 362            args))
 363          (commands
 364           (mapcar
 365            (function
 366             (lambda (cmd)
 367               (if (or (not (car sep-terms))
 368                       (string= (car sep-terms) ";"))
 369                   (setq cmd
 370                         (eshell-parse-pipeline cmd (not (car sep-terms))))
 371                 (setq cmd
 372                       (list 'eshell-do-subjob
 373                             (list 'list (eshell-parse-pipeline cmd)))))
 374               (setq sep-terms (cdr sep-terms))
 375               (if eshell-in-pipeline-p
 376                   cmd
 377                 (list 'eshell-trap-errors cmd))))
 378            (eshell-separate-commands terms "[&;]" nil 'sep-terms))))
 379     (let ((cmd commands))
 380       (while cmd
 381         (if (cdr cmd)
 382             (setcar cmd (list 'eshell-commands (car cmd))))
 383         (setq cmd (cdr cmd))))
 384     (setq commands
 385           (append (list 'progn)
 386                   (if top-level
 387                       (list '(run-hooks 'eshell-pre-command-hook)))
 388                   (if (not top-level)
 389                       commands
 390                     (list
 391                      (list 'catch (quote 'top-level)
 392                            (append (list 'progn) commands))
 393                      '(run-hooks 'eshell-post-command-hook)))))
 394     (if top-level
 395         (list 'eshell-commands commands)
 396       commands)))
 397
 398 (defun eshell-debug-command (tag subform)
 399   "Output a debugging message to '*eshell last cmd*'."
 400   (let ((buf (get-buffer-create "*eshell last cmd*"))
 401         (text (eshell-stringify eshell-current-command)))
 402     (save-excursion
 403       (set-buffer buf)
 404       (if (not tag)
 405           (erase-buffer)
 406         (insert "\n\C-l\n" tag "\n\n" text
 407                 (if subform
 408                     (concat "\n\n" (eshell-stringify subform)) ""))))))
 409
 410 (defun eshell-debug-show-parsed-args (terms)
 411   "Display parsed arguments in the debug buffer."
 412   (ignore
 413    (if eshell-debug-command
 414        (eshell-debug-command "parsed arguments" terms))))
 415
 416 (defun eshell-no-command-conversion (terms)
 417   "Don't convert the command argument."
 418   (ignore
 419    (if (and (listp (car terms))
 420             (eq (caar terms) 'eshell-convert))
 421        (setcar terms (cadr (car terms))))))
 422
 423 (defun eshell-subcommand-arg-values (terms)
 424   "Convert subcommand arguments {x} to ${x}, in order to take their values."
 425   (setq terms (cdr terms))              ; skip command argument
 426   (while terms
 427     (if (and (listp (car terms))
 428              (eq (caar terms) 'eshell-as-subcommand))
 429         (setcar terms (list 'eshell-convert
 430                             (list 'eshell-command-to-value
 431                                   (car terms)))))
 432     (setq terms (cdr terms))))
 433
 434 (defun eshell-rewrite-sexp-command (terms)
 435   "Rewrite a sexp in initial position, such as '(+ 1 2)'."
 436   ;; this occurs when a Lisp expression is in first position
 437   (if (and (listp (car terms))
 438            (eq (caar terms) 'eshell-command-to-value))
 439       (car (cdar terms))))
 440
 441 (eshell-deftest cmd lisp-command
 442   "Evaluate Lisp command"
 443   (eshell-command-result-p "(+ 1 2)" "3"))
 444
 445 (eshell-deftest cmd lisp-command-args
 446   "Evaluate Lisp command (ignore args)"
 447   (eshell-command-result-p "(+ 1 2) 3" "3"))
 448
 449 (defun eshell-rewrite-initial-subcommand (terms)
 450   "Rewrite a subcommand in initial position, such as '{+ 1 2}'."
 451   (if (and (listp (car terms))
 452            (eq (caar terms) 'eshell-as-subcommand))
 453       (car terms)))
 454
 455 (eshell-deftest cmd subcommand
 456   "Run subcommand"
 457   (eshell-command-result-p "{+ 1 2}" "3\n"))
 458
 459 (eshell-deftest cmd subcommand-args
 460   "Run subcommand (ignore args)"
 461   (eshell-command-result-p "{+ 1 2} 3" "3\n"))
 462
 463 (eshell-deftest cmd subcommand-lisp
 464   "Run subcommand + Lisp form"
 465   (eshell-command-result-p "{(+ 1 2)}" "3\n"))
 466
 467 (defun eshell-rewrite-named-command (terms)
 468   "If no other rewriting rule transforms TERMS, assume a named command."
 469   (let ((sym (if eshell-in-pipeline-p
 470                  'eshell-named-command*
 471                'eshell-named-command))
 472         (cmd (car terms))
 473         (args (cdr terms)))
 474     (if args
 475         (list sym cmd (append (list 'list) (cdr terms)))
 476       (list sym cmd))))
 477
 478 (eshell-deftest cmd named-command
 479   "Execute named command"
 480   (eshell-command-result-p "+ 1 2" "3\n"))
 481
 482 (eval-when-compile
 483   (defvar eshell-command-body)
 484   (defvar eshell-test-body))
 485
 486 (defsubst eshell-invokify-arg (arg &optional share-output silent)
 487   "Change ARG so it can be invoked from a structured command.
 488
 489 SHARE-OUTPUT, if non-nil, means this invocation should share the
 490 current output stream, which is separately redirectable.  SILENT
 491 means the user and/or any redirections shouldn't see any output
 492 from this command.  If both SHARE-OUTPUT and SILENT are non-nil,
 493 the second is ignored."
 494   ;; something that begins with `eshell-convert' means that it
 495   ;; intends to return a Lisp value.  We want to get past this,
 496   ;; but if it's not _actually_ a value interpolation -- in which
 497   ;; we leave it alone.  In fact, the only time we muck with it
 498   ;; is in the case of a {subcommand} that has been turned into
 499   ;; the interpolation, ${subcommand}, by the parser because it
 500   ;; didn't know better.
 501   (if (and (listp arg)
 502            (eq (car arg) 'eshell-convert)
 503            (eq (car (cadr arg)) 'eshell-command-to-value))
 504       (if share-output
 505           (cadr (cadr arg))
 506         (list 'eshell-commands (cadr (cadr arg))
 507               silent))
 508     arg))
 509
 510 (defun eshell-rewrite-for-command (terms)
 511   "Rewrite a `for' command into its equivalent Eshell command form.
 512 Because the implementation of `for' relies upon conditional evaluation
 513 of its argument (i.e., use of a Lisp special form), it must be
 514 implemented via rewriting, rather than as a function."
 515   (if (and (stringp (car terms))
 516            (string= (car terms) "for")
 517            (stringp (nth 2 terms))
 518            (string= (nth 2 terms) "in"))
 519       (let ((body (car (last terms))))
 520         (setcdr (last terms 2) nil)
 521         (list
 522          'let (list (list 'for-items
 523                           (append
 524                            (list 'append)
 525                            (mapcar
 526                             (function
 527                              (lambda (elem)
 528                                (if (listp elem)
 529                                    elem
 530                                  (list 'list elem))))
 531                             (cdr (cddr terms)))))
 532                     (list 'eshell-command-body
 533                           (list 'quote (list nil)))
 534                     (list 'eshell-test-body
 535                           (list 'quote (list nil))))
 536          (list
 537           'progn
 538           (list
 539            'while (list 'car (list 'symbol-value
 540                                    (list 'quote 'for-items)))
 541            (list
 542             'progn
 543             (list 'let
 544                   (list (list (intern (cadr terms))
 545                               (list 'car
 546                                     (list 'symbol-value
 547                                           (list 'quote 'for-items)))))
 548                   (list 'eshell-protect
 549                         (eshell-invokify-arg body t)))
 550             (list 'setcar 'for-items
 551                   (list 'cadr
 552                         (list 'symbol-value
 553                               (list 'quote 'for-items))))
 554             (list 'setcdr 'for-items
 555                   (list 'cddr
 556                         (list 'symbol-value
 557                               (list 'quote 'for-items))))))
 558           (list 'eshell-close-handles
 559                 'eshell-last-command-status
 560                 (list 'list (quote 'quote)
 561                       'eshell-last-command-result)))))))
 562
 563 (defun eshell-structure-basic-command (func names keyword test body
 564                                             &optional else vocal-test)
 565   "With TERMS, KEYWORD, and two NAMES, structure a basic command.
 566 The first of NAMES should be the positive form, and the second the
 567 negative.  It's not likely that users should ever need to call this
 568 function.
 569
 570 If VOCAL-TEST is non-nil, it means output from the test should be
 571 shown, as well as output from the body."
 572   ;; If the test form begins with `eshell-convert', it means
 573   ;; something data-wise will be returned, and we should let
 574   ;; that determine the truth of the statement.
 575   (unless (eq (car test) 'eshell-convert)
 576     (setq test
 577           (list 'progn test
 578                 (list 'eshell-exit-success-p))))
 579
 580   ;; should we reverse the sense of the test?  This depends
 581   ;; on the `names' parameter.  If it's the symbol nil, yes.
 582   ;; Otherwise, it can be a pair of strings; if the keyword
 583   ;; we're using matches the second member of that pair (a
 584   ;; list), we should reverse it.
 585   (if (or (eq names nil)
 586           (and (listp names)
 587                (string= keyword (cadr names))))
 588       (setq test (list 'not test)))
 589
 590   ;; finally, create the form that represents this structured
 591   ;; command
 592   (list
 593    'let (list (list 'eshell-command-body
 594                     (list 'quote (list nil)))
 595               (list 'eshell-test-body
 596                     (list 'quote (list nil))))
 597    (list func test body else)
 598    (list 'eshell-close-handles
 599          'eshell-last-command-status
 600          (list 'list (quote 'quote)
 601                'eshell-last-command-result))))
 602
 603 (defun eshell-rewrite-while-command (terms)
 604   "Rewrite a `while' command into its equivalent Eshell command form.
 605 Because the implementation of `while' relies upon conditional
 606 evaluation of its argument (i.e., use of a Lisp special form), it
 607 must be implemented via rewriting, rather than as a function."
 608   (if (and (stringp (car terms))
 609            (member (car terms) '("while" "until")))
 610       (eshell-structure-basic-command
 611        'while '("while" "until") (car terms)
 612        (eshell-invokify-arg (cadr terms) nil t)
 613        (list 'eshell-protect
 614              (eshell-invokify-arg (car (last terms)) t)))))
 615
 616 (defun eshell-rewrite-if-command (terms)
 617   "Rewrite an `if' command into its equivalent Eshell command form.
 618 Because the implementation of `if' relies upon conditional
 619 evaluation of its argument (i.e., use of a Lisp special form), it
 620 must be implemented via rewriting, rather than as a function."
 621   (if (and (stringp (car terms))
 622            (member (car terms) '("if" "unless")))
 623       (eshell-structure-basic-command
 624        'if '("if" "unless") (car terms)
 625        (eshell-invokify-arg (cadr terms) nil t)
 626        (list 'eshell-protect
 627              (eshell-invokify-arg
 628               (if (= (length terms) 4)
 629                   (car (last terms 2))
 630                 (car (last terms))) t))
 631        (if (= (length terms) 4)
 632            (list 'eshell-protect
 633                  (eshell-invokify-arg
 634                   (car (last terms)))) t))))
 635
 636 (defun eshell-exit-success-p ()
 637   "Return non-nil if the last command was \"successful\".
 638 For a bit of Lisp code, this means a return value of non-nil.
 639 For an external command, it means an exit code of 0."
 640   (if (save-match-data
 641         (string-match "#<\\(Lisp object\\|function .*\\)>"
 642                       eshell-last-command-name))
 643       eshell-last-command-result
 644     (= eshell-last-command-status 0)))
 645
 646 (defun eshell-parse-pipeline (terms &optional final-p)
 647   "Parse a pipeline from TERMS, return the appropriate Lisp forms."
 648   (let* (sep-terms
 649          (bigpieces (eshell-separate-commands terms "\\(&&\\|||\\)"
 650                                               nil 'sep-terms))
 651          (bp bigpieces)
 652          (results (list t))
 653          final)
 654     (while bp
 655       (let ((subterms (car bp)))
 656         (let* ((pieces (eshell-separate-commands subterms "|"))
 657                (p pieces))
 658           (while p
 659             (let ((cmd (car p)))
 660               (run-hook-with-args 'eshell-pre-rewrite-command-hook cmd)
 661               (setq cmd (run-hook-with-args-until-success
 662                          'eshell-rewrite-command-hook cmd))
 663               (run-hook-with-args 'eshell-post-rewrite-command-hook 'cmd)
 664               (setcar p cmd))
 665             (setq p (cdr p)))
 666           (nconc results
 667                  (list
 668                   (if (<= (length pieces) 1)
 669                       (car pieces)
 670                     (assert (not eshell-in-pipeline-p))
 671                     (list 'eshell-execute-pipeline
 672                           (list 'quote pieces))))))
 673         (setq bp (cdr bp))))
 674     ;; `results' might be empty; this happens in the case of
 675     ;; multi-line input
 676     (setq results (cdr results)
 677           results (nreverse results)
 678           final (car results)
 679           results (cdr results)
 680           sep-terms (nreverse sep-terms))
 681     (while results
 682       (assert (car sep-terms))
 683       (setq final (eshell-structure-basic-command
 684                    'if (string= (car sep-terms) "&&") "if"
 685                    (list 'eshell-protect (car results))
 686                    (list 'eshell-protect final)
 687                    nil t)
 688             results (cdr results)
 689             sep-terms (cdr sep-terms)))
 690     final))
 691
 692 (defun eshell-parse-subcommand-argument ()
 693   "Parse a subcommand argument of the form '{command}'."
 694   (if (and (not eshell-current-argument)
 695            (not eshell-current-quoted)
 696            (eq (char-after) ?\{)
 697            (or (= (point-max) (1+ (point)))
 698                (not (eq (char-after (1+ (point))) ?\}))))
 699       (let ((end (eshell-find-delimiter ?\{ ?\})))
 700         (if (not end)
 701             (throw 'eshell-incomplete ?\{)
 702           (when (eshell-arg-delimiter (1+ end))
 703             (prog1
 704                 (list 'eshell-as-subcommand
 705                       (eshell-parse-command (cons (1+ (point)) end)))
 706               (goto-char (1+ end))))))))
 707
 708 (defun eshell-parse-lisp-argument ()
 709   "Parse a Lisp expression which is specified as an argument."
 710   (if (and (not eshell-current-argument)
 711            (not eshell-current-quoted)
 712            (looking-at eshell-lisp-regexp))
 713       (let* ((here (point))
 714              (obj
 715               (condition-case err
 716                   (read (current-buffer))
 717                 (end-of-file
 718                  (throw 'eshell-incomplete ?\()))))
 719         (if (eshell-arg-delimiter)
 720             (list 'eshell-command-to-value
 721                   (list 'eshell-lisp-command (list 'quote obj)))
 722           (ignore (goto-char here))))))
 723
 724 (defun eshell-separate-commands (terms separator &optional
 725                                        reversed last-terms-sym)
 726   "Separate TERMS using SEPARATOR.
 727 If REVERSED is non-nil, the list of separated term groups will be
 728 returned in reverse order.  If LAST-TERMS-SYM is a symbol, its value
 729 will be set to a list of all the separator operators found (or '(list
 730 nil)' if none)."
 731   (let ((sub-terms (list t))
 732         (eshell-sep-terms (list t))
 733         subchains)
 734     (while terms
 735       (if (and (consp (car terms))
 736                (eq (caar terms) 'eshell-operator)
 737                (string-match (concat "^" separator "$")
 738                              (nth 1 (car terms))))
 739           (progn
 740             (nconc eshell-sep-terms (list (nth 1 (car terms))))
 741             (setq subchains (cons (cdr sub-terms) subchains)
 742                   sub-terms (list t)))
 743         (nconc sub-terms (list (car terms))))
 744       (setq terms (cdr terms)))
 745     (if (> (length sub-terms) 1)
 746         (setq subchains (cons (cdr sub-terms) subchains)))
 747     (if reversed
 748         (progn
 749           (if last-terms-sym
 750               (set last-terms-sym (reverse (cdr eshell-sep-terms))))
 751           subchains)                    ; already reversed
 752       (if last-terms-sym
 753           (set last-terms-sym (cdr eshell-sep-terms)))
 754       (nreverse subchains))))
 755
 756 ;;_* Command evaluation macros
 757 ;;
 758 ;; The structure of the following macros is very important to
 759 ;; `eshell-do-eval' [Iterative evaluation]:
 760 ;;
 761 ;; @ Don't use forms that conditionally evaluate their arguments, such
 762 ;;   as `setq', `if', `while', `let*', etc.  The only special forms
 763 ;;   that can be used are `let', `condition-case' and
 764 ;;   `unwind-protect'.
 765 ;;
 766 ;; @ The main body of a `let' can contain only one form.  Use `progn'
 767 ;;   if necessary.
 768 ;;
 769 ;; @ The two `special' variables are `eshell-current-handles' and
 770 ;;   `eshell-current-subjob-p'.  Bind them locally with a `let' if you
 771 ;;   need to change them.  Change them directly only if your intention
 772 ;;   is to change the calling environment.
 773
 774 (defmacro eshell-do-subjob (object)
 775   "Evaluate a command OBJECT as a subjob.
 776 We indicate that the process was run in the background by returning it
 777 ensconced in a list."
 778   `(let ((eshell-current-subjob-p t))
 779      ,object))
 780
 781 (defmacro eshell-commands (object &optional silent)
 782   "Place a valid set of handles, and context, around command OBJECT."
 783   `(let ((eshell-current-handles
 784           (eshell-create-handles ,(not silent) 'append))
 785          eshell-current-subjob-p)
 786      ,object))
 787
 788 (defmacro eshell-trap-errors (object)
 789   "Trap any errors that occur, so they are not entirely fatal.
 790 Also, the variable `eshell-this-command-hook' is available for the
 791 duration of OBJECT's evaluation.  Note that functions should be added
 792 to this hook using `nconc', and *not* `add-hook'.
 793
 794 Someday, when Scheme will become the dominant Emacs language, all of
 795 this grossness will be made to disappear by using `call/cc'..."
 796   `(let ((eshell-this-command-hook (list 'ignore)))
 797      (eshell-condition-case err
 798          (prog1
 799              ,object
 800            (run-hooks 'eshell-this-command-hook))
 801        (error
 802         (run-hooks 'eshell-this-command-hook)
 803         (eshell-errorn (error-message-string err))
 804         (eshell-close-handles 1)))))
 805
 806 (defmacro eshell-copy-handles (object)
 807   "Duplicate current I/O handles, so OBJECT works with its own copy."
 808   `(let ((eshell-current-handles
 809           (eshell-create-handles
 810            (car (aref eshell-current-handles
 811                       eshell-output-handle)) nil
 812            (car (aref eshell-current-handles
 813                       eshell-error-handle)) nil)))
 814      ,object))
 815
 816 (defmacro eshell-protect (object)
 817   "Protect I/O handles, so they aren't get closed after eval'ing OBJECT."
 818   `(progn
 819      (eshell-protect-handles eshell-current-handles)
 820      ,object))
 821
 822 (defmacro eshell-do-pipelines (pipeline)
 823   "Execute the commands in PIPELINE, connecting each to one another."
 824   (when (setq pipeline (cadr pipeline))
 825     `(eshell-copy-handles
 826       (progn
 827         ,(when (cdr pipeline)
 828            `(let (nextproc)
 829               (progn
 830                 (set 'nextproc
 831                      (eshell-do-pipelines (quote ,(cdr pipeline))))
 832                 (eshell-set-output-handle ,eshell-output-handle
 833                                           'append nextproc)
 834                 (eshell-set-output-handle ,eshell-error-handle
 835                                           'append nextproc)
 836                 (set 'tailproc (or tailproc nextproc)))))
 837         ,(let ((head (car pipeline)))
 838            (if (memq (car head) '(let progn))
 839                (setq head (car (last head))))
 840            (when (memq (car head) eshell-deferrable-commands)
 841              (ignore
 842               (setcar head
 843                       (intern-soft
 844                        (concat (symbol-name (car head)) "*"))))))
 845         ,(car pipeline)))))
 846
 847 (defmacro eshell-do-pipelines-synchronously (pipeline)
 848   "Execute the commands in PIPELINE in sequence synchronously.
 849 Output of each command is passed as input to the next one in the pipeline.
 850 This is used on systems where `start-process' is not supported."
 851   (when (setq pipeline (cadr pipeline))
 852     `(let (result)
 853        (progn
 854          ,(when (cdr pipeline)
 855             `(let (output-marker)
 856                (progn
 857                  (set 'output-marker ,(point-marker))
 858                  (eshell-set-output-handle ,eshell-output-handle
 859                                            'append output-marker)
 860                  (eshell-set-output-handle ,eshell-error-handle
 861                                            'append output-marker))))
 862          ,(let ((head (car pipeline)))
 863             (if (memq (car head) '(let progn))
 864                 (setq head (car (last head))))
 865             ;;; FIXME: is deferrable significant here?
 866             (when (memq (car head) eshell-deferrable-commands)
 867               (ignore
 868                (setcar head
 869                        (intern-soft
 870                         (concat (symbol-name (car head)) "*"))))))
 871          ;; The last process in the pipe should get its handles
 872          ;; redirected as we found them before running the pipe.
 873          ,(if (null (cdr pipeline))
 874               `(progn
 875                  (set 'eshell-current-handles tail-handles)
 876                  (set 'eshell-in-pipeline-p nil)))
 877          (set 'result ,(car pipeline))
 878          ;; tailproc gets the result of the last successful process in
 879          ;; the pipeline.
 880          (set 'tailproc (or result tailproc))
 881          ,(if (cdr pipeline)
 882               `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
 883          result))))
 884
 885 (defalias 'eshell-process-identity 'identity)
 886
 887 (defmacro eshell-execute-pipeline (pipeline)
 888   "Execute the commands in PIPELINE, connecting each to one another."
 889   `(let ((eshell-in-pipeline-p t) tailproc)
 890      (progn
 891        ,(if (fboundp 'start-process)
 892             `(eshell-do-pipelines ,pipeline)
 893           `(let ((tail-handles (eshell-create-handles
 894                                 (car (aref eshell-current-handles
 895                                            ,eshell-output-handle)) nil
 896                                 (car (aref eshell-current-handles
 897                                            ,eshell-error-handle)) nil)))
 898              (eshell-do-pipelines-synchronously ,pipeline)))
 899        (eshell-process-identity tailproc))))
 900
 901 (defmacro eshell-as-subcommand (command)
 902   "Execute COMMAND using a temp buffer.
 903 This is used so that certain Lisp commands, such as `cd', when
 904 executed in a subshell, do not disturb the environment of the main
 905 Eshell buffer."
 906   `(let ,eshell-subcommand-bindings
 907      ,command))
 908
 909 (defmacro eshell-do-command-to-value (object)
 910   "Run a subcommand prepared by `eshell-command-to-value'.
 911 This avoids the need to use `let*'."
 912   `(let ((eshell-current-handles
 913           (eshell-create-handles value 'overwrite)))
 914      (progn
 915        ,object
 916        (symbol-value value))))
 917
 918 (defmacro eshell-command-to-value (object)
 919   "Run OBJECT synchronously, returning its result as a string.
 920 Returns a string comprising the output from the command."
 921   `(let ((value (make-symbol "eshell-temp")))
 922      (eshell-do-command-to-value ,object)))
 923
 924 ;;;_* Iterative evaluation
 925 ;;
 926 ;; Eshell runs all of its external commands asynchronously, so that
 927 ;; Emacs is not blocked while the operation is being performed.
 928 ;; However, this introduces certain synchronization difficulties,
 929 ;; since the Lisp code, once it returns, will not "go back" to finish
 930 ;; executing the commands which haven't yet been started.
 931 ;;
 932 ;; What Eshell does to work around this problem (basically, the lack
 933 ;; of threads in Lisp), is that it evaluates the command sequence
 934 ;; iteratively.  Whenever an asynchronous process is begun, evaluation
 935 ;; terminates and control is given back to Emacs.  When that process
 936 ;; finishes, it will resume the evaluation using the remainder of the
 937 ;; command tree.
 938
 939 (defun eshell/eshell-debug (&rest args)
 940   "A command for toggling certain debug variables."
 941   (ignore
 942    (cond
 943     ((not args)
 944      (if eshell-handle-errors
 945          (eshell-print "errors\n"))
 946      (if eshell-debug-command
 947          (eshell-print "commands\n")))
 948     ((or (string= (car args) "-h")
 949          (string= (car args) "--help"))
 950      (eshell-print "usage: eshell-debug [kinds]
 951
 952 This command is used to aid in debugging problems related to Eshell
 953 itself.  It is not useful for anything else.  The recognized `kinds'
 954 at the moment are:
 955
 956   errors       stops Eshell from trapping errors
 957   commands     shows command execution progress in `*eshell last cmd*'
 958 "))
 959     (t
 960      (while args
 961        (cond
 962         ((string= (car args) "errors")
 963          (setq eshell-handle-errors (not eshell-handle-errors)))
 964         ((string= (car args) "commands")
 965          (setq eshell-debug-command (not eshell-debug-command))))
 966        (setq args (cdr args)))))))
 967
 968 (defun pcomplete/eshell-mode/eshell-debug ()
 969   "Completion for the `debug' command."
 970   (while (pcomplete-here '("errors" "commands"))))
 971
 972 (defun eshell-invoke-directly (command input)
 973   (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name)
 974     (if (and (eq (car base) 'eshell-trap-errors)
 975              (eq (car (cadr base)) 'eshell-named-command))
 976         (setq name (cadr (cadr base))))
 977     (and name (stringp name)
 978          (not (member name eshell-complex-commands))
 979          (catch 'simple
 980            (progn
 981             (eshell-for pred eshell-complex-commands
 982               (if (and (functionp pred)
 983                        (funcall pred name))
 984                   (throw 'simple nil)))
 985             t))
 986          (fboundp (intern-soft (concat "eshell/" name))))))
 987
 988 (defun eshell-eval-command (command &optional input)
 989   "Evaluate the given COMMAND iteratively."
 990   (if eshell-current-command
 991       ;; we can just stick the new command at the end of the current
 992       ;; one, and everything will happen as it should
 993       (setcdr (last (cdr eshell-current-command))
 994               (list (list 'let '((here (and (eobp) (point))))
 995                           (and input
 996                                (list 'insert-and-inherit
 997                                      (concat input "\n")))
 998                           '(if here
 999                                (eshell-update-markers here))
1000                           (list 'eshell-do-eval
1001                                 (list 'quote command)))))
1002     (and eshell-debug-command
1003          (save-excursion
1004            (let ((buf (get-buffer-create "*eshell last cmd*")))
1005              (set-buffer buf)
1006              (erase-buffer)
1007              (insert "command: \"" input "\"\n"))))
1008     (setq eshell-current-command command)
1009     (let ((delim (catch 'eshell-incomplete
1010                    (eshell-resume-eval))))
1011       ;; On systems that don't support async subprocesses, eshell-resume
1012       ;; can return t.  Don't treat that as an error.
1013       (if (listp delim)
1014           (setq delim (car delim)))
1015       (if (and delim (not (eq delim t)))
1016           (error "Unmatched delimiter: %c" delim)))))
1017
1018 (defun eshell-resume-command (proc status)
1019   "Resume the current command when a process ends."
1020   (when proc
1021     (unless (or (not (stringp status))
1022                 (string= "stopped" status)
1023                 (string-match eshell-reset-signals status))
1024       (if (eq proc (eshell-interactive-process))
1025           (eshell-resume-eval)))))
1026
1027 (defun eshell-resume-eval ()
1028   "Destructively evaluate a form which may need to be deferred."
1029   (eshell-condition-case err
1030       (progn
1031         (setq eshell-last-async-proc nil)
1032         (when eshell-current-command
1033           (let* (retval
1034                  (proc (catch 'eshell-defer
1035                          (ignore
1036                           (setq retval
1037                                 (eshell-do-eval
1038                                  eshell-current-command))))))
1039             (if (eshell-processp proc)
1040                 (ignore (setq eshell-last-async-proc proc))
1041               (cadr retval)))))
1042     (error
1043      (error (error-message-string err)))))
1044
1045 (defmacro eshell-manipulate (tag &rest commands)
1046   "Manipulate a COMMAND form, with TAG as a debug identifier."
1047   (if (not eshell-debug-command)
1048       `(progn ,@commands)
1049     `(progn
1050        (eshell-debug-command ,(eval tag) form)
1051        ,@commands
1052        (eshell-debug-command ,(concat "done " (eval tag)) form))))
1053
1054 (put 'eshell-manipulate 'lisp-indent-function 1)
1055
1056 ;; eshell-lookup-function, eshell-functionp, and eshell-macrop taken
1057 ;; from edebug
1058
1059 (defsubst eshell-lookup-function (object)
1060   "Return the ultimate function definition of OBJECT."
1061   (while (and (symbolp object) (fboundp object))
1062     (setq object (symbol-function object)))
1063   object)
1064
1065 (defconst function-p-func
1066   (if (fboundp 'compiled-function-p)
1067       'compiled-function-p
1068     'byte-code-function-p))
1069
1070 (defsubst eshell-functionp (object)
1071   "Returns the function named by OBJECT, or nil if it is not a function."
1072   (setq object (eshell-lookup-function object))
1073   (if (or (subrp object)
1074           (funcall function-p-func object)
1075           (and (listp object)
1076                (eq (car object) 'lambda)
1077                (listp (car (cdr object)))))
1078       object))
1079
1080 (defsubst eshell-macrop (object)
1081   "Return t if OBJECT is a macro or nil otherwise."
1082   (setq object (eshell-lookup-function object))
1083   (if (and (listp object)
1084            (eq 'macro (car object))
1085            (eshell-functionp (cdr object)))
1086       t))
1087
1088 (defun eshell-do-eval (form &optional synchronous-p)
1089   "Evaluate form, simplifying it as we go.
1090 Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
1091 be finished later after the completion of an asynchronous subprocess."
1092   (cond
1093    ((not (listp form))
1094     (list 'quote (eval form)))
1095    ((memq (car form) '(quote function))
1096     form)
1097    (t
1098     ;; skip past the call to `eshell-do-eval'
1099     (when (eq (car form) 'eshell-do-eval)
1100       (setq form (cadr (cadr form))))
1101     ;; expand any macros directly into the form.  This is done so that
1102     ;; we can modify any `let' forms to evaluate only once.
1103     (if (eshell-macrop (car form))
1104         (let ((exp (eshell-copy-tree (macroexpand form))))
1105           (eshell-manipulate (format "expanding macro `%s'"
1106                                      (symbol-name (car form)))
1107             (setcar form (car exp))
1108             (setcdr form (cdr exp)))))
1109     (let ((args (cdr form)))
1110       (cond
1111        ((eq (car form) 'while)
1112         ;; `eshell-copy-tree' is needed here so that the test argument
1113         ;; doesn't get modified and thus always yield the same result.
1114         (when (car eshell-command-body)
1115           (assert (not synchronous-p))
1116           (eshell-do-eval (car eshell-command-body))
1117           (setcar eshell-command-body nil)
1118           (setcar eshell-test-body nil))
1119         (unless (car eshell-test-body)
1120           (setcar eshell-test-body (eshell-copy-tree (car args))))
1121         (while (cadr (eshell-do-eval (car eshell-test-body)))
1122           (setcar eshell-command-body (eshell-copy-tree (cadr args)))
1123           (eshell-do-eval (car eshell-command-body) synchronous-p)
1124           (setcar eshell-command-body nil)
1125           (setcar eshell-test-body (eshell-copy-tree (car args))))
1126         (setcar eshell-command-body nil))
1127        ((eq (car form) 'if)
1128         ;; `eshell-copy-tree' is needed here so that the test argument
1129         ;; doesn't get modified and thus always yield the same result.
1130         (if (car eshell-command-body)
1131             (progn
1132               (assert (not synchronous-p))
1133               (eshell-do-eval (car eshell-command-body)))
1134           (unless (car eshell-test-body)
1135             (setcar eshell-test-body (eshell-copy-tree (car args))))
1136           (if (cadr (eshell-do-eval (car eshell-test-body)))
1137               (setcar eshell-command-body (eshell-copy-tree (cadr args)))
1138             (setcar eshell-command-body (eshell-copy-tree (car (cddr args)))))
1139           (eshell-do-eval (car eshell-command-body) synchronous-p))
1140         (setcar eshell-command-body nil)
1141         (setcar eshell-test-body nil))
1142        ((eq (car form) 'setcar)
1143         (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
1144         (eval form))
1145        ((eq (car form) 'setcdr)
1146         (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
1147         (eval form))
1148        ((memq (car form) '(let catch condition-case unwind-protect))
1149         ;; `let', `condition-case' and `unwind-protect' have to be
1150         ;; handled specially, because we only want to call
1151         ;; `eshell-do-eval' on their first form.
1152         ;;
1153         ;; NOTE: This requires obedience by all forms which this
1154         ;; function might encounter, that they do not contain
1155         ;; other special forms.
1156         (if (and (eq (car form) 'let)
1157                  (not (eq (car (cadr args)) 'eshell-do-eval)))
1158             (eshell-manipulate "evaluating let args"
1159               (eshell-for letarg (car args)
1160                 (if (and (listp letarg)
1161                          (not (eq (cadr letarg) 'quote)))
1162                     (setcdr letarg
1163                             (list (eshell-do-eval
1164                                    (cadr letarg) synchronous-p)))))))
1165         (unless (eq (car form) 'unwind-protect)
1166           (setq args (cdr args)))
1167         (unless (eq (caar args) 'eshell-do-eval)
1168           (eshell-manipulate "handling special form"
1169             (setcar args (list 'eshell-do-eval
1170                                (list 'quote (car args))
1171                                synchronous-p))))
1172         (eval form))
1173        (t
1174         (if (and args (not (memq (car form) '(run-hooks))))
1175             (eshell-manipulate
1176                 (format "evaluating arguments to `%s'"
1177                         (symbol-name (car form)))
1178               (while args
1179                 (setcar args (eshell-do-eval (car args) synchronous-p))
1180                 (setq args (cdr args)))))
1181         (cond
1182          ((eq (car form) 'progn)
1183           (car (last form)))
1184          ((eq (car form) 'prog1)
1185           (cadr form))
1186          (t
1187           ;; If a command desire to replace its execution form with
1188           ;; another command form, all it needs to do is throw the new
1189           ;; form using the exception tag `eshell-replace-command'.
1190           ;; For example, let's say that the form currently being
1191           ;; eval'd is:
1192           ;;
1193           ;;   (eshell-named-command "hello")
1194           ;;
1195           ;; Now, let's assume the 'hello' command is an Eshell alias,
1196           ;; the definition of which yields the command:
1197           ;;
1198           ;;   (eshell-named-command "echo" (list "Hello" "world"))
1199           ;;
1200           ;; What the alias code would like to do is simply substitute
1201           ;; the alias form for the original form.  To accomplish
1202           ;; this, all it needs to do is to throw the substitution
1203           ;; form with the `eshell-replace-command' tag, and the form
1204           ;; will be replaced within the current command, and
1205           ;; execution will then resume (iteratively) as before.
1206           ;; Thus, aliases can even contain references to asynchronous
1207           ;; sub-commands, and things will still work out as they
1208           ;; should.
1209           (let (result new-form)
1210             (if (setq new-form
1211                       (catch 'eshell-replace-command
1212                         (ignore
1213                          (setq result (eval form)))))
1214                 (progn
1215                   (eshell-manipulate "substituting replacement form"
1216                     (setcar form (car new-form))
1217                     (setcdr form (cdr new-form)))
1218                   (eshell-do-eval form synchronous-p))
1219               (if (and (memq (car form) eshell-deferrable-commands)
1220                        (not eshell-current-subjob-p)
1221                        result
1222                        (eshell-processp result))
1223                   (if synchronous-p
1224                       (eshell/wait result)
1225                     (eshell-manipulate "inserting ignore form"
1226                       (setcar form 'ignore)
1227                       (setcdr form nil))
1228                     (throw 'eshell-defer result))
1229                 (list 'quote result))))))))))))
1230
1231 ;; command invocation
1232
1233 (defun eshell/which (command &rest names)
1234   "Identify the COMMAND, and where it is located."
1235   (eshell-for name (cons command names)
1236     (let (program alias direct)
1237       (if (eq (aref name 0) eshell-explicit-command-char)
1238           (setq name (substring name 1)
1239                 direct t))
1240       (if (and (not direct)
1241                (eshell-using-module 'eshell-alias)
1242                (setq alias
1243                      (funcall (symbol-function 'eshell-lookup-alias)
1244                               name)))
1245           (setq program
1246                 (concat name " is an alias, defined as \""
1247                         (cadr alias) "\"")))
1248       (unless program
1249         (setq program (eshell-search-path name))
1250         (let* ((esym (eshell-find-alias-function name))
1251                (sym (or esym (intern-soft name))))
1252           (if (and (or esym (and sym (fboundp sym)))
1253                    (or eshell-prefer-lisp-functions (not direct)))
1254               (let ((desc (let ((inhibit-redisplay t))
1255                             (save-window-excursion
1256                               (prog1
1257                                   (describe-function sym)
1258                                 (message nil))))))
1259                 (setq desc (substring desc 0
1260                                       (1- (or (string-match "\n" desc)
1261                                               (length desc)))))
1262                 (if (buffer-live-p (get-buffer "*Help*"))
1263                     (kill-buffer "*Help*"))
1264                 (setq program (or desc name))))))
1265       (if (not program)
1266           (eshell-error (format "which: no %s in (%s)\n"
1267                                 name (getenv "PATH")))
1268         (eshell-printn program)))))
1269
1270 (put 'eshell/which 'eshell-no-numeric-conversions t)
1271
1272 (defun eshell-named-command (command &optional args)
1273   "Insert output from a plain COMMAND, using ARGS.
1274 COMMAND may result in an alias being executed, or a plain command."
1275   (setq eshell-last-arguments args
1276         eshell-last-command-name (eshell-stringify command))
1277   (run-hook-with-args 'eshell-prepare-command-hook)
1278   (assert (stringp eshell-last-command-name))
1279   (if eshell-last-command-name
1280       (or (run-hook-with-args-until-success
1281            'eshell-named-command-hook eshell-last-command-name
1282            eshell-last-arguments)
1283           (eshell-plain-command eshell-last-command-name
1284                                 eshell-last-arguments))))
1285
1286 (defalias 'eshell-named-command* 'eshell-named-command)
1287
1288 (defun eshell-find-alias-function (name)
1289   "Check whether a function called `eshell/NAME' exists."
1290   (let* ((sym (intern-soft (concat "eshell/" name)))
1291          (file (symbol-file sym 'defun)))
1292     ;; If the function exists, but is defined in an eshell module
1293     ;; that's not currently enabled, don't report it as found
1294     (if (and file
1295              (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
1296         (let ((module-sym
1297                (intern (file-name-sans-extension
1298                         (file-name-nondirectory
1299                          (concat "eshell-" (match-string 2 file)))))))
1300           (if (and (functionp sym)
1301                    (or (null module-sym)
1302                        (eshell-using-module module-sym)
1303                        (memq module-sym (eshell-subgroups 'eshell))))
1304               sym))
1305       ;; Otherwise, if it's bound, return it.
1306       (if (functionp sym)
1307           sym))))
1308
1309 (defun eshell-plain-command (command args)
1310   "Insert output from a plain COMMAND, using ARGS.
1311 COMMAND may result in either a Lisp function being executed by name,
1312 or an external command."
1313   (let* ((esym (eshell-find-alias-function command))
1314          (sym (or esym (intern-soft command))))
1315     (if (and sym (fboundp sym)
1316              (or esym eshell-prefer-lisp-functions
1317                  (not (eshell-search-path command))))
1318         (eshell-lisp-command sym args)
1319       (eshell-external-command command args))))
1320
1321 (defun eshell-exec-lisp (printer errprint func-or-form args form-p)
1322   "Execute a lisp FUNC-OR-FORM, maybe passing ARGS.
1323 PRINTER and ERRPRINT are functions to use for printing regular
1324 messages, and errors.  FORM-P should be non-nil if FUNC-OR-FORM
1325 represent a lisp form; ARGS will be ignored in that case."
1326   (let (result)
1327     (eshell-condition-case err
1328         (progn
1329           (setq result
1330                 (save-current-buffer
1331                   (if form-p
1332                       (eval func-or-form)
1333                     (apply func-or-form args))))
1334           (and result (funcall printer result))
1335           result)
1336       (error
1337        (let ((msg (error-message-string err)))
1338          (if (and (not form-p)
1339                   (string-match "^Wrong number of arguments" msg)
1340                   (fboundp 'eldoc-get-fnsym-args-string))
1341              (let ((func-doc (eldoc-get-fnsym-args-string func-or-form)))
1342                (setq msg (format "usage: %s" func-doc))))
1343          (funcall errprint msg))
1344        nil))))
1345
1346 (defsubst eshell-apply* (printer errprint func args)
1347   "Call FUNC, with ARGS, trapping errors and return them as output.
1348 PRINTER and ERRPRINT are functions to use for printing regular
1349 messages, and errors."
1350   (eshell-exec-lisp printer errprint func args nil))
1351
1352 (defsubst eshell-funcall* (printer errprint func &rest args)
1353   "Call FUNC, with ARGS, trapping errors and return them as output."
1354   (eshell-apply* printer errprint func args))
1355
1356 (defsubst eshell-eval* (printer errprint form)
1357   "Evaluate FORM, trapping errors and returning them."
1358   (eshell-exec-lisp printer errprint form nil t))
1359
1360 (defsubst eshell-apply (func args)
1361   "Call FUNC, with ARGS, trapping errors and return them as output.
1362 PRINTER and ERRPRINT are functions to use for printing regular
1363 messages, and errors."
1364   (eshell-apply* 'eshell-print 'eshell-error func args))
1365
1366 (defsubst eshell-funcall (func &rest args)
1367   "Call FUNC, with ARGS, trapping errors and return them as output."
1368   (eshell-apply func args))
1369
1370 (defsubst eshell-eval (form)
1371   "Evaluate FORM, trapping errors and returning them."
1372   (eshell-eval* 'eshell-print 'eshell-error form))
1373
1374 (defsubst eshell-applyn (func args)
1375   "Call FUNC, with ARGS, trapping errors and return them as output.
1376 PRINTER and ERRPRINT are functions to use for printing regular
1377 messages, and errors."
1378   (eshell-apply* 'eshell-printn 'eshell-errorn func args))
1379
1380 (defsubst eshell-funcalln (func &rest args)
1381   "Call FUNC, with ARGS, trapping errors and return them as output."
1382   (eshell-applyn func args))
1383
1384 (defsubst eshell-evaln (form)
1385   "Evaluate FORM, trapping errors and returning them."
1386   (eshell-eval* 'eshell-printn 'eshell-errorn form))
1387
1388 (defun eshell-lisp-command (object &optional args)
1389   "Insert Lisp OBJECT, using ARGS if a function."
1390   (catch 'eshell-external               ; deferred to an external command
1391     (let* ((eshell-ensure-newline-p (eshell-interactive-output-p))
1392            (result
1393             (if (functionp object)
1394                 (progn
1395                   (setq eshell-last-arguments args
1396                         eshell-last-command-name
1397                         (concat "#<function " (symbol-name object) ">"))
1398                   ;; if any of the arguments are flagged as numbers
1399                   ;; waiting for conversion, convert them now
1400                   (unless (get object 'eshell-no-numeric-conversions)
1401                     (while args
1402                       (let ((arg (car args)))
1403                         (if (and (stringp arg)
1404                                  (> (length arg) 0)
1405                                  (not (text-property-not-all
1406                                        0 (length arg) 'number t arg)))
1407                             (setcar args (string-to-number arg))))
1408                       (setq args (cdr args))))
1409                   (eshell-apply object eshell-last-arguments))
1410               (setq eshell-last-arguments args
1411                     eshell-last-command-name "#<Lisp object>")
1412               (eshell-eval object))))
1413       (if (and eshell-ensure-newline-p
1414                (save-excursion
1415                  (goto-char eshell-last-output-end)
1416                  (not (bolp))))
1417           (eshell-print "\n"))
1418       (eshell-close-handles 0 (list 'quote result)))))
1419
1420 (defalias 'eshell-lisp-command* 'eshell-lisp-command)
1421
1422 (provide 'esh-cmd)
1423
1424 ;;; arch-tag: 8e4f3867-a0c5-441f-96ba-ddd142d94366
1425 ;;; esh-cmd.el ends here