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