]> code.delx.au - gnu-emacs/blob - lisp/eshell/esh-cmd.el
70a9135d23915215b991edaa70351b433d6d0863
[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 after-change-functions)
360 (insert command)
361 (prog1
362 (eshell-parse-arguments here (point))
363 (delete-region here (point)))))
364 args))
365 (commands
366 (mapcar
367 (function
368 (lambda (cmd)
369 (if (or (not (car sep-terms))
370 (string= (car sep-terms) ";"))
371 (setq cmd
372 (eshell-parse-pipeline cmd (not (car sep-terms))))
373 (setq cmd
374 (list 'eshell-do-subjob
375 (list 'list (eshell-parse-pipeline cmd)))))
376 (setq sep-terms (cdr sep-terms))
377 (if eshell-in-pipeline-p
378 cmd
379 (list 'eshell-trap-errors cmd))))
380 (eshell-separate-commands terms "[&;]" nil 'sep-terms))))
381 (let ((cmd commands))
382 (while cmd
383 (if (cdr cmd)
384 (setcar cmd (list 'eshell-commands (car cmd))))
385 (setq cmd (cdr cmd))))
386 (setq commands
387 (append (list 'progn)
388 (if top-level
389 (list '(run-hooks 'eshell-pre-command-hook)))
390 (if (not top-level)
391 commands
392 (list
393 (list 'catch (quote 'top-level)
394 (append (list 'progn) commands))
395 '(run-hooks 'eshell-post-command-hook)))))
396 (if top-level
397 (list 'eshell-commands commands)
398 commands)))
399
400 (defun eshell-debug-command (tag subform)
401 "Output a debugging message to '*eshell last cmd*'."
402 (let ((buf (get-buffer-create "*eshell last cmd*"))
403 (text (eshell-stringify eshell-current-command)))
404 (with-current-buffer buf
405 (if (not tag)
406 (erase-buffer)
407 (insert "\n\C-l\n" tag "\n\n" text
408 (if subform
409 (concat "\n\n" (eshell-stringify subform)) ""))))))
410
411 (defun eshell-debug-show-parsed-args (terms)
412 "Display parsed arguments in the debug buffer."
413 (ignore
414 (if eshell-debug-command
415 (eshell-debug-command "parsed arguments" terms))))
416
417 (defun eshell-no-command-conversion (terms)
418 "Don't convert the command argument."
419 (ignore
420 (if (and (listp (car terms))
421 (eq (caar terms) 'eshell-convert))
422 (setcar terms (cadr (car terms))))))
423
424 (defun eshell-subcommand-arg-values (terms)
425 "Convert subcommand arguments {x} to ${x}, in order to take their values."
426 (setq terms (cdr terms)) ; skip command argument
427 (while terms
428 (if (and (listp (car terms))
429 (eq (caar terms) 'eshell-as-subcommand))
430 (setcar terms (list 'eshell-convert
431 (list 'eshell-command-to-value
432 (car terms)))))
433 (setq terms (cdr terms))))
434
435 (defun eshell-rewrite-sexp-command (terms)
436 "Rewrite a sexp in initial position, such as '(+ 1 2)'."
437 ;; this occurs when a Lisp expression is in first position
438 (if (and (listp (car terms))
439 (eq (caar terms) 'eshell-command-to-value))
440 (car (cdar terms))))
441
442 (eshell-deftest cmd lisp-command
443 "Evaluate Lisp command"
444 (eshell-command-result-p "(+ 1 2)" "3"))
445
446 (eshell-deftest cmd lisp-command-args
447 "Evaluate Lisp command (ignore args)"
448 (eshell-command-result-p "(+ 1 2) 3" "3"))
449
450 (defun eshell-rewrite-initial-subcommand (terms)
451 "Rewrite a subcommand in initial position, such as '{+ 1 2}'."
452 (if (and (listp (car terms))
453 (eq (caar terms) 'eshell-as-subcommand))
454 (car terms)))
455
456 (eshell-deftest cmd subcommand
457 "Run subcommand"
458 (eshell-command-result-p "{+ 1 2}" "3\n"))
459
460 (eshell-deftest cmd subcommand-args
461 "Run subcommand (ignore args)"
462 (eshell-command-result-p "{+ 1 2} 3" "3\n"))
463
464 (eshell-deftest cmd subcommand-lisp
465 "Run subcommand + Lisp form"
466 (eshell-command-result-p "{(+ 1 2)}" "3\n"))
467
468 (defun eshell-rewrite-named-command (terms)
469 "If no other rewriting rule transforms TERMS, assume a named command."
470 (let ((sym (if eshell-in-pipeline-p
471 'eshell-named-command*
472 'eshell-named-command))
473 (cmd (car terms))
474 (args (cdr terms)))
475 (if args
476 (list sym cmd (append (list 'list) (cdr terms)))
477 (list sym cmd))))
478
479 (eshell-deftest cmd named-command
480 "Execute named command"
481 (eshell-command-result-p "+ 1 2" "3\n"))
482
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 &optional notfirst)
823 "Execute the commands in PIPELINE, connecting each to one another.
824 This macro calls itself recursively, with NOTFIRST non-nil."
825 (when (setq pipeline (cadr pipeline))
826 `(eshell-copy-handles
827 (progn
828 ,(when (cdr pipeline)
829 `(let (nextproc)
830 (progn
831 (set 'nextproc
832 (eshell-do-pipelines (quote ,(cdr pipeline)) t))
833 (eshell-set-output-handle ,eshell-output-handle
834 'append nextproc)
835 (eshell-set-output-handle ,eshell-error-handle
836 'append nextproc)
837 (set 'tailproc (or tailproc nextproc)))))
838 ,(let ((head (car pipeline)))
839 (if (memq (car head) '(let progn))
840 (setq head (car (last head))))
841 (when (memq (car head) eshell-deferrable-commands)
842 (ignore
843 (setcar head
844 (intern-soft
845 (concat (symbol-name (car head)) "*"))))))
846 ;; First and last elements in a pipeline may need special treatment.
847 ;; (Currently only eshell-ls-files uses 'last.)
848 ;; Affects process-connection-type in eshell-gather-process-output.
849 (let ((eshell-in-pipeline-p
850 ,(cond ((not notfirst) (quote 'first))
851 ((cdr pipeline) t)
852 (t (quote 'last)))))
853 ,(car pipeline))))))
854
855 (defmacro eshell-do-pipelines-synchronously (pipeline)
856 "Execute the commands in PIPELINE in sequence synchronously.
857 Output of each command is passed as input to the next one in the pipeline.
858 This is used on systems where `start-process' is not supported."
859 (when (setq pipeline (cadr pipeline))
860 `(let (result)
861 (progn
862 ,(when (cdr pipeline)
863 `(let (output-marker)
864 (progn
865 (set 'output-marker ,(point-marker))
866 (eshell-set-output-handle ,eshell-output-handle
867 'append output-marker)
868 (eshell-set-output-handle ,eshell-error-handle
869 'append output-marker))))
870 ,(let ((head (car pipeline)))
871 (if (memq (car head) '(let progn))
872 (setq head (car (last head))))
873 ;;; FIXME: is deferrable significant here?
874 (when (memq (car head) eshell-deferrable-commands)
875 (ignore
876 (setcar head
877 (intern-soft
878 (concat (symbol-name (car head)) "*"))))))
879 ;; The last process in the pipe should get its handles
880 ;; redirected as we found them before running the pipe.
881 ,(if (null (cdr pipeline))
882 `(progn
883 (set 'eshell-current-handles tail-handles)
884 (set 'eshell-in-pipeline-p nil)))
885 (set 'result ,(car pipeline))
886 ;; tailproc gets the result of the last successful process in
887 ;; the pipeline.
888 (set 'tailproc (or result tailproc))
889 ,(if (cdr pipeline)
890 `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline))))
891 result))))
892
893 (defalias 'eshell-process-identity 'identity)
894
895 (defmacro eshell-execute-pipeline (pipeline)
896 "Execute the commands in PIPELINE, connecting each to one another."
897 `(let ((eshell-in-pipeline-p t) tailproc)
898 (progn
899 ,(if (fboundp 'start-process)
900 `(eshell-do-pipelines ,pipeline)
901 `(let ((tail-handles (eshell-create-handles
902 (car (aref eshell-current-handles
903 ,eshell-output-handle)) nil
904 (car (aref eshell-current-handles
905 ,eshell-error-handle)) nil)))
906 (eshell-do-pipelines-synchronously ,pipeline)))
907 (eshell-process-identity tailproc))))
908
909 (defmacro eshell-as-subcommand (command)
910 "Execute COMMAND using a temp buffer.
911 This is used so that certain Lisp commands, such as `cd', when
912 executed in a subshell, do not disturb the environment of the main
913 Eshell buffer."
914 `(let ,eshell-subcommand-bindings
915 ,command))
916
917 (defmacro eshell-do-command-to-value (object)
918 "Run a subcommand prepared by `eshell-command-to-value'.
919 This avoids the need to use `let*'."
920 `(let ((eshell-current-handles
921 (eshell-create-handles value 'overwrite)))
922 (progn
923 ,object
924 (symbol-value value))))
925
926 (defmacro eshell-command-to-value (object)
927 "Run OBJECT synchronously, returning its result as a string.
928 Returns a string comprising the output from the command."
929 `(let ((value (make-symbol "eshell-temp")))
930 (eshell-do-command-to-value ,object)))
931
932 ;;;_* Iterative evaluation
933 ;;
934 ;; Eshell runs all of its external commands asynchronously, so that
935 ;; Emacs is not blocked while the operation is being performed.
936 ;; However, this introduces certain synchronization difficulties,
937 ;; since the Lisp code, once it returns, will not "go back" to finish
938 ;; executing the commands which haven't yet been started.
939 ;;
940 ;; What Eshell does to work around this problem (basically, the lack
941 ;; of threads in Lisp), is that it evaluates the command sequence
942 ;; iteratively. Whenever an asynchronous process is begun, evaluation
943 ;; terminates and control is given back to Emacs. When that process
944 ;; finishes, it will resume the evaluation using the remainder of the
945 ;; command tree.
946
947 (defun eshell/eshell-debug (&rest args)
948 "A command for toggling certain debug variables."
949 (ignore
950 (cond
951 ((not args)
952 (if eshell-handle-errors
953 (eshell-print "errors\n"))
954 (if eshell-debug-command
955 (eshell-print "commands\n")))
956 ((or (string= (car args) "-h")
957 (string= (car args) "--help"))
958 (eshell-print "usage: eshell-debug [kinds]
959
960 This command is used to aid in debugging problems related to Eshell
961 itself. It is not useful for anything else. The recognized `kinds'
962 at the moment are:
963
964 errors stops Eshell from trapping errors
965 commands shows command execution progress in `*eshell last cmd*'
966 "))
967 (t
968 (while args
969 (cond
970 ((string= (car args) "errors")
971 (setq eshell-handle-errors (not eshell-handle-errors)))
972 ((string= (car args) "commands")
973 (setq eshell-debug-command (not eshell-debug-command))))
974 (setq args (cdr args)))))))
975
976 (defun pcomplete/eshell-mode/eshell-debug ()
977 "Completion for the `debug' command."
978 (while (pcomplete-here '("errors" "commands"))))
979
980 (defun eshell-invoke-directly (command input)
981 (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name)
982 (if (and (eq (car base) 'eshell-trap-errors)
983 (eq (car (cadr base)) 'eshell-named-command))
984 (setq name (cadr (cadr base))))
985 (and name (stringp name)
986 (not (member name eshell-complex-commands))
987 (catch 'simple
988 (progn
989 (eshell-for pred eshell-complex-commands
990 (if (and (functionp pred)
991 (funcall pred name))
992 (throw 'simple nil)))
993 t))
994 (fboundp (intern-soft (concat "eshell/" name))))))
995
996 (defun eshell-eval-command (command &optional input)
997 "Evaluate the given COMMAND iteratively."
998 (if eshell-current-command
999 ;; we can just stick the new command at the end of the current
1000 ;; one, and everything will happen as it should
1001 (setcdr (last (cdr eshell-current-command))
1002 (list (list 'let '((here (and (eobp) (point))))
1003 (and input
1004 (list 'insert-and-inherit
1005 (concat input "\n")))
1006 '(if here
1007 (eshell-update-markers here))
1008 (list 'eshell-do-eval
1009 (list 'quote command)))))
1010 (and eshell-debug-command
1011 (with-current-buffer (get-buffer-create "*eshell last cmd*")
1012 (erase-buffer)
1013 (insert "command: \"" input "\"\n")))
1014 (setq eshell-current-command command)
1015 (let ((delim (catch 'eshell-incomplete
1016 (eshell-resume-eval))))
1017 ;; On systems that don't support async subprocesses, eshell-resume
1018 ;; can return t. Don't treat that as an error.
1019 (if (listp delim)
1020 (setq delim (car delim)))
1021 (if (and delim (not (eq delim t)))
1022 (error "Unmatched delimiter: %c" delim)))))
1023
1024 (defun eshell-resume-command (proc status)
1025 "Resume the current command when a process ends."
1026 (when proc
1027 (unless (or (not (stringp status))
1028 (string= "stopped" status)
1029 (string-match eshell-reset-signals status))
1030 (if (eq proc (eshell-interactive-process))
1031 (eshell-resume-eval)))))
1032
1033 (defun eshell-resume-eval ()
1034 "Destructively evaluate a form which may need to be deferred."
1035 (eshell-condition-case err
1036 (progn
1037 (setq eshell-last-async-proc nil)
1038 (when eshell-current-command
1039 (let* (retval
1040 (proc (catch 'eshell-defer
1041 (ignore
1042 (setq retval
1043 (eshell-do-eval
1044 eshell-current-command))))))
1045 (if (eshell-processp proc)
1046 (ignore (setq eshell-last-async-proc proc))
1047 (cadr retval)))))
1048 (error
1049 (error (error-message-string err)))))
1050
1051 (defmacro eshell-manipulate (tag &rest commands)
1052 "Manipulate a COMMAND form, with TAG as a debug identifier."
1053 ;; Check `bound'ness since at compile time the code until here has not
1054 ;; executed yet.
1055 (if (not (and (boundp 'eshell-debug-command) eshell-debug-command))
1056 `(progn ,@commands)
1057 `(progn
1058 (eshell-debug-command ,(eval tag) form)
1059 ,@commands
1060 (eshell-debug-command ,(concat "done " (eval tag)) form))))
1061
1062 (put 'eshell-manipulate 'lisp-indent-function 1)
1063
1064 ;; eshell-lookup-function, eshell-functionp, and eshell-macrop taken
1065 ;; from edebug
1066
1067 (defsubst eshell-lookup-function (object)
1068 "Return the ultimate function definition of OBJECT."
1069 (while (and (symbolp object) (fboundp object))
1070 (setq object (symbol-function object)))
1071 object)
1072
1073 (defconst function-p-func
1074 (if (fboundp 'compiled-function-p)
1075 'compiled-function-p
1076 'byte-code-function-p))
1077
1078 (defsubst eshell-functionp (object)
1079 "Returns the function named by OBJECT, or nil if it is not a function."
1080 (setq object (eshell-lookup-function object))
1081 (if (or (subrp object)
1082 (funcall function-p-func object)
1083 (and (listp object)
1084 (eq (car object) 'lambda)
1085 (listp (car (cdr object)))))
1086 object))
1087
1088 (defsubst eshell-macrop (object)
1089 "Return t if OBJECT is a macro or nil otherwise."
1090 (setq object (eshell-lookup-function object))
1091 (if (and (listp object)
1092 (eq 'macro (car object))
1093 (eshell-functionp (cdr object)))
1094 t))
1095
1096 (defun eshell-do-eval (form &optional synchronous-p)
1097 "Evaluate form, simplifying it as we go.
1098 Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to
1099 be finished later after the completion of an asynchronous subprocess."
1100 (cond
1101 ((not (listp form))
1102 (list 'quote (eval form)))
1103 ((memq (car form) '(quote function))
1104 form)
1105 (t
1106 ;; skip past the call to `eshell-do-eval'
1107 (when (eq (car form) 'eshell-do-eval)
1108 (setq form (cadr (cadr form))))
1109 ;; expand any macros directly into the form. This is done so that
1110 ;; we can modify any `let' forms to evaluate only once.
1111 (if (eshell-macrop (car form))
1112 (let ((exp (eshell-copy-tree (macroexpand form))))
1113 (eshell-manipulate (format "expanding macro `%s'"
1114 (symbol-name (car form)))
1115 (setcar form (car exp))
1116 (setcdr form (cdr exp)))))
1117 (let ((args (cdr form)))
1118 (cond
1119 ((eq (car form) 'while)
1120 ;; `eshell-copy-tree' is needed here so that the test argument
1121 ;; doesn't get modified and thus always yield the same result.
1122 (when (car eshell-command-body)
1123 (assert (not synchronous-p))
1124 (eshell-do-eval (car eshell-command-body))
1125 (setcar eshell-command-body nil)
1126 (setcar eshell-test-body nil))
1127 (unless (car eshell-test-body)
1128 (setcar eshell-test-body (eshell-copy-tree (car args))))
1129 (while (cadr (eshell-do-eval (car eshell-test-body)))
1130 (setcar eshell-command-body (eshell-copy-tree (cadr args)))
1131 (eshell-do-eval (car eshell-command-body) synchronous-p)
1132 (setcar eshell-command-body nil)
1133 (setcar eshell-test-body (eshell-copy-tree (car args))))
1134 (setcar eshell-command-body nil))
1135 ((eq (car form) 'if)
1136 ;; `eshell-copy-tree' is needed here so that the test argument
1137 ;; doesn't get modified and thus always yield the same result.
1138 (if (car eshell-command-body)
1139 (progn
1140 (assert (not synchronous-p))
1141 (eshell-do-eval (car eshell-command-body)))
1142 (unless (car eshell-test-body)
1143 (setcar eshell-test-body (eshell-copy-tree (car args))))
1144 (if (cadr (eshell-do-eval (car eshell-test-body)))
1145 (setcar eshell-command-body (eshell-copy-tree (cadr args)))
1146 (setcar eshell-command-body (eshell-copy-tree (car (cddr args)))))
1147 (eshell-do-eval (car eshell-command-body) synchronous-p))
1148 (setcar eshell-command-body nil)
1149 (setcar eshell-test-body nil))
1150 ((eq (car form) 'setcar)
1151 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
1152 (eval form))
1153 ((eq (car form) 'setcdr)
1154 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p))
1155 (eval form))
1156 ((memq (car form) '(let catch condition-case unwind-protect))
1157 ;; `let', `condition-case' and `unwind-protect' have to be
1158 ;; handled specially, because we only want to call
1159 ;; `eshell-do-eval' on their first form.
1160 ;;
1161 ;; NOTE: This requires obedience by all forms which this
1162 ;; function might encounter, that they do not contain
1163 ;; other special forms.
1164 (if (and (eq (car form) 'let)
1165 (not (eq (car (cadr args)) 'eshell-do-eval)))
1166 (eshell-manipulate "evaluating let args"
1167 (eshell-for letarg (car args)
1168 (if (and (listp letarg)
1169 (not (eq (cadr letarg) 'quote)))
1170 (setcdr letarg
1171 (list (eshell-do-eval
1172 (cadr letarg) synchronous-p)))))))
1173 (unless (eq (car form) 'unwind-protect)
1174 (setq args (cdr args)))
1175 (unless (eq (caar args) 'eshell-do-eval)
1176 (eshell-manipulate "handling special form"
1177 (setcar args (list 'eshell-do-eval
1178 (list 'quote (car args))
1179 synchronous-p))))
1180 (eval form))
1181 (t
1182 (if (and args (not (memq (car form) '(run-hooks))))
1183 (eshell-manipulate
1184 (format "evaluating arguments to `%s'"
1185 (symbol-name (car form)))
1186 (while args
1187 (setcar args (eshell-do-eval (car args) synchronous-p))
1188 (setq args (cdr args)))))
1189 (cond
1190 ((eq (car form) 'progn)
1191 (car (last form)))
1192 ((eq (car form) 'prog1)
1193 (cadr form))
1194 (t
1195 ;; If a command desire to replace its execution form with
1196 ;; another command form, all it needs to do is throw the new
1197 ;; form using the exception tag `eshell-replace-command'.
1198 ;; For example, let's say that the form currently being
1199 ;; eval'd is:
1200 ;;
1201 ;; (eshell-named-command "hello")
1202 ;;
1203 ;; Now, let's assume the 'hello' command is an Eshell alias,
1204 ;; the definition of which yields the command:
1205 ;;
1206 ;; (eshell-named-command "echo" (list "Hello" "world"))
1207 ;;
1208 ;; What the alias code would like to do is simply substitute
1209 ;; the alias form for the original form. To accomplish
1210 ;; this, all it needs to do is to throw the substitution
1211 ;; form with the `eshell-replace-command' tag, and the form
1212 ;; will be replaced within the current command, and
1213 ;; execution will then resume (iteratively) as before.
1214 ;; Thus, aliases can even contain references to asynchronous
1215 ;; sub-commands, and things will still work out as they
1216 ;; should.
1217 (let (result new-form)
1218 (if (setq new-form
1219 (catch 'eshell-replace-command
1220 (ignore
1221 (setq result (eval form)))))
1222 (progn
1223 (eshell-manipulate "substituting replacement form"
1224 (setcar form (car new-form))
1225 (setcdr form (cdr new-form)))
1226 (eshell-do-eval form synchronous-p))
1227 (if (and (memq (car form) eshell-deferrable-commands)
1228 (not eshell-current-subjob-p)
1229 result
1230 (eshell-processp result))
1231 (if synchronous-p
1232 (eshell/wait result)
1233 (eshell-manipulate "inserting ignore form"
1234 (setcar form 'ignore)
1235 (setcdr form nil))
1236 (throw 'eshell-defer result))
1237 (list 'quote result))))))))))))
1238
1239 ;; command invocation
1240
1241 (defun eshell/which (command &rest names)
1242 "Identify the COMMAND, and where it is located."
1243 (eshell-for name (cons command names)
1244 (let (program alias direct)
1245 (if (eq (aref name 0) eshell-explicit-command-char)
1246 (setq name (substring name 1)
1247 direct t))
1248 (if (and (not direct)
1249 (eshell-using-module 'eshell-alias)
1250 (setq alias
1251 (funcall (symbol-function 'eshell-lookup-alias)
1252 name)))
1253 (setq program
1254 (concat name " is an alias, defined as \""
1255 (cadr alias) "\"")))
1256 (unless program
1257 (setq program (eshell-search-path name))
1258 (let* ((esym (eshell-find-alias-function name))
1259 (sym (or esym (intern-soft name))))
1260 (if (and (or esym (and sym (fboundp sym)))
1261 (or eshell-prefer-lisp-functions (not direct)))
1262 (let ((desc (let ((inhibit-redisplay t))
1263 (save-window-excursion
1264 (prog1
1265 (describe-function sym)
1266 (message nil))))))
1267 (setq desc (if desc (substring desc 0
1268 (1- (or (string-match "\n" desc)
1269 (length desc))))
1270 ;; This should not happen.
1271 (format "%s is defined, \
1272 but no documentation was found" name)))
1273 (if (buffer-live-p (get-buffer "*Help*"))
1274 (kill-buffer "*Help*"))
1275 (setq program (or desc name))))))
1276 (if (not program)
1277 (eshell-error (format "which: no %s in (%s)\n"
1278 name (getenv "PATH")))
1279 (eshell-printn program)))))
1280
1281 (put 'eshell/which 'eshell-no-numeric-conversions t)
1282
1283 (defun eshell-named-command (command &optional args)
1284 "Insert output from a plain COMMAND, using ARGS.
1285 COMMAND may result in an alias being executed, or a plain command."
1286 (setq eshell-last-arguments args
1287 eshell-last-command-name (eshell-stringify command))
1288 (run-hook-with-args 'eshell-prepare-command-hook)
1289 (assert (stringp eshell-last-command-name))
1290 (if eshell-last-command-name
1291 (or (run-hook-with-args-until-success
1292 'eshell-named-command-hook eshell-last-command-name
1293 eshell-last-arguments)
1294 (eshell-plain-command eshell-last-command-name
1295 eshell-last-arguments))))
1296
1297 (defalias 'eshell-named-command* 'eshell-named-command)
1298
1299 (defun eshell-find-alias-function (name)
1300 "Check whether a function called `eshell/NAME' exists."
1301 (let* ((sym (intern-soft (concat "eshell/" name)))
1302 (file (symbol-file sym 'defun)))
1303 ;; If the function exists, but is defined in an eshell module
1304 ;; that's not currently enabled, don't report it as found
1305 (if (and file
1306 (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file))
1307 (let ((module-sym
1308 (intern (file-name-sans-extension
1309 (file-name-nondirectory
1310 (concat "eshell-" (match-string 2 file)))))))
1311 (if (and (functionp sym)
1312 (or (null module-sym)
1313 (eshell-using-module module-sym)
1314 (memq module-sym (eshell-subgroups 'eshell))))
1315 sym))
1316 ;; Otherwise, if it's bound, return it.
1317 (if (functionp sym)
1318 sym))))
1319
1320 (defun eshell-plain-command (command args)
1321 "Insert output from a plain COMMAND, using ARGS.
1322 COMMAND may result in either a Lisp function being executed by name,
1323 or an external command."
1324 (let* ((esym (eshell-find-alias-function command))
1325 (sym (or esym (intern-soft command))))
1326 (if (and sym (fboundp sym)
1327 (or esym eshell-prefer-lisp-functions
1328 (not (eshell-search-path command))))
1329 (eshell-lisp-command sym args)
1330 (eshell-external-command command args))))
1331
1332 (defun eshell-exec-lisp (printer errprint func-or-form args form-p)
1333 "Execute a lisp FUNC-OR-FORM, maybe passing ARGS.
1334 PRINTER and ERRPRINT are functions to use for printing regular
1335 messages, and errors. FORM-P should be non-nil if FUNC-OR-FORM
1336 represent a lisp form; ARGS will be ignored in that case."
1337 (let (result)
1338 (eshell-condition-case err
1339 (progn
1340 (setq result
1341 (save-current-buffer
1342 (if form-p
1343 (eval func-or-form)
1344 (apply func-or-form args))))
1345 (and result (funcall printer result))
1346 result)
1347 (error
1348 (let ((msg (error-message-string err)))
1349 (if (and (not form-p)
1350 (string-match "^Wrong number of arguments" msg)
1351 (fboundp 'eldoc-get-fnsym-args-string))
1352 (let ((func-doc (eldoc-get-fnsym-args-string func-or-form)))
1353 (setq msg (format "usage: %s" func-doc))))
1354 (funcall errprint msg))
1355 nil))))
1356
1357 (defsubst eshell-apply* (printer errprint func args)
1358 "Call FUNC, with ARGS, trapping errors and return them as output.
1359 PRINTER and ERRPRINT are functions to use for printing regular
1360 messages, and errors."
1361 (eshell-exec-lisp printer errprint func args nil))
1362
1363 (defsubst eshell-funcall* (printer errprint func &rest args)
1364 "Call FUNC, with ARGS, trapping errors and return them as output."
1365 (eshell-apply* printer errprint func args))
1366
1367 (defsubst eshell-eval* (printer errprint form)
1368 "Evaluate FORM, trapping errors and returning them."
1369 (eshell-exec-lisp printer errprint form nil t))
1370
1371 (defsubst eshell-apply (func args)
1372 "Call FUNC, with ARGS, trapping errors and return them as output.
1373 PRINTER and ERRPRINT are functions to use for printing regular
1374 messages, and errors."
1375 (eshell-apply* 'eshell-print 'eshell-error func args))
1376
1377 (defsubst eshell-funcall (func &rest args)
1378 "Call FUNC, with ARGS, trapping errors and return them as output."
1379 (eshell-apply func args))
1380
1381 (defsubst eshell-eval (form)
1382 "Evaluate FORM, trapping errors and returning them."
1383 (eshell-eval* 'eshell-print 'eshell-error form))
1384
1385 (defsubst eshell-applyn (func args)
1386 "Call FUNC, with ARGS, trapping errors and return them as output.
1387 PRINTER and ERRPRINT are functions to use for printing regular
1388 messages, and errors."
1389 (eshell-apply* 'eshell-printn 'eshell-errorn func args))
1390
1391 (defsubst eshell-funcalln (func &rest args)
1392 "Call FUNC, with ARGS, trapping errors and return them as output."
1393 (eshell-applyn func args))
1394
1395 (defsubst eshell-evaln (form)
1396 "Evaluate FORM, trapping errors and returning them."
1397 (eshell-eval* 'eshell-printn 'eshell-errorn form))
1398
1399 (defun eshell-lisp-command (object &optional args)
1400 "Insert Lisp OBJECT, using ARGS if a function."
1401 (catch 'eshell-external ; deferred to an external command
1402 (let* ((eshell-ensure-newline-p (eshell-interactive-output-p))
1403 (result
1404 (if (functionp object)
1405 (progn
1406 (setq eshell-last-arguments args
1407 eshell-last-command-name
1408 (concat "#<function " (symbol-name object) ">"))
1409 ;; if any of the arguments are flagged as numbers
1410 ;; waiting for conversion, convert them now
1411 (unless (get object 'eshell-no-numeric-conversions)
1412 (while args
1413 (let ((arg (car args)))
1414 (if (and (stringp arg)
1415 (> (length arg) 0)
1416 (not (text-property-not-all
1417 0 (length arg) 'number t arg)))
1418 (setcar args (string-to-number arg))))
1419 (setq args (cdr args))))
1420 (eshell-apply object eshell-last-arguments))
1421 (setq eshell-last-arguments args
1422 eshell-last-command-name "#<Lisp object>")
1423 (eshell-eval object))))
1424 (if (and eshell-ensure-newline-p
1425 (save-excursion
1426 (goto-char eshell-last-output-end)
1427 (not (bolp))))
1428 (eshell-print "\n"))
1429 (eshell-close-handles 0 (list 'quote result)))))
1430
1431 (defalias 'eshell-lisp-command* 'eshell-lisp-command)
1432
1433 (provide 'esh-cmd)
1434
1435 ;; arch-tag: 8e4f3867-a0c5-441f-96ba-ddd142d94366
1436 ;;; esh-cmd.el ends here