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