Mercurial > emacs
annotate lisp/eshell/esh-cmd.el @ 112318:deae5bb3f0f6
Give a name FLOAT_TO_STRING_BUFSIZE to the constant 350.
* lisp.h (FLOAT_TO_STRING_BUFSIZE): New macro.
* data.c (Fnumber_to_string): Use it.
* print.c (float_to_string, print_object): Likewise.
author | Paul Eggert <eggert@cs.ucla.edu> |
---|---|
date | Sun, 09 Jan 2011 00:21:21 -0800 |
parents | e8049570c647 |
children | 417b1e4d63cd |
rev | line source |
---|---|
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
38007
diff
changeset
|
1 ;;; esh-cmd.el --- command invocation |
29873 | 2 |
95619
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
106815 | 4 ;; 2008, 2009, 2010 Free Software Foundation, Inc. |
29873 | 5 |
32526 | 6 ;; Author: John Wiegley <johnw@gnu.org> |
7 | |
29873 | 8 ;; This file is part of GNU Emacs. |
9 | |
94661
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
10 ;; GNU Emacs is free software: you can redistribute it and/or modify |
29873 | 11 ;; it under the terms of the GNU General Public License as published by |
94661
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
12 ;; the Free Software Foundation, either version 3 of the License, or |
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; (at your option) any later version. |
29873 | 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 | |
94661
b5b0801a7637
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
29873 | 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 | |
87079
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
96 ;;;_* Command hooks |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
97 ;; |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
98 ;; There are several hooks involved with command execution, which can |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
99 ;; be used either to change or augment Eshell's behavior. |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
100 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
101 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
102 ;;; Code: |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
103 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
104 (require 'esh-util) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
105 (unless (featurep 'xemacs) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
106 (require 'eldoc)) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
107 (require 'esh-arg) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
108 (require 'esh-proc) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
109 (require 'esh-ext) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
110 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
111 (eval-when-compile |
98564
f79ec7c34dc5
Sven Joachim <svenjoac at gmx.de>
Glenn Morris <rgm@gnu.org>
parents:
97483
diff
changeset
|
112 (require 'cl) |
87079
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
113 (require 'pcomplete)) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
114 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
115 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
116 (defgroup eshell-cmd nil |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
117 "Executing an Eshell command is as simple as typing it in and |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
118 pressing <RET>. There are several different kinds of commands, |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
119 however." |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
120 :tag "Command invocation" |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
121 ;; :link '(info-link "(eshell)Command invocation") |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
122 :group 'eshell) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
123 |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
124 (defcustom eshell-prefer-lisp-functions nil |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
125 "If non-nil, prefer Lisp functions to external commands." |
87079
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
126 :type 'boolean |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
127 :group 'eshell-cmd) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
128 |
29873 | 129 (defcustom eshell-lisp-regexp "\\([(`]\\|#'\\)" |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
130 "A regexp which, if matched at beginning of an argument, means Lisp. |
29873 | 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 | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
136 "A hook run before each interactive command is invoked." |
29873 | 137 :type 'hook |
138 :group 'eshell-cmd) | |
139 | |
140 (defcustom eshell-post-command-hook nil | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
141 "A hook run after each interactive command is invoked." |
29873 | 142 :type 'hook |
143 :group 'eshell-cmd) | |
144 | |
145 (defcustom eshell-prepare-command-hook nil | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
146 "A set of functions called to prepare a named command. |
29873 | 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 | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
157 "A set of functions called before a named command is invoked. |
29873 | 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) | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
183 "A hook run before command rewriting begins. |
29873 | 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) | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
196 "A set of functions used to rewrite the command argument. |
29873 | 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 | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
210 "A hook run after command rewriting is finished. |
29873 | 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 | |
79116
1af9837978fa
(eshell-complex-commands): Add "ls".
Chong Yidong <cyd@stupidchicken.com>
parents:
78220
diff
changeset
|
216 (defcustom eshell-complex-commands '("ls") |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
217 "A list of commands names or functions, that determine complexity. |
33020 | 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 | |
29873 | 231 ;;; User Variables: |
232 | |
233 (defcustom eshell-cmd-load-hook '(eshell-cmd-initialize) | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
234 "A hook that gets run when `eshell-cmd' is loaded." |
29873 | 235 :type 'hook |
236 :group 'eshell-cmd) | |
237 | |
238 (defcustom eshell-debug-command nil | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
239 "If non-nil, enable debugging code. SSLLOOWW. |
29873 | 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) | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
250 "A list of functions which might return an ansychronous process. |
29873 | 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))) | |
110580
f57f72bb4757
Cosmetic doc fixes for eshell.
Glenn Morris <rgm@gnu.org>
parents:
106815
diff
changeset
|
261 "A list of `let' bindings for subcommand environments." |
29873 | 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) | |
99824
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
277 (defvar eshell-in-pipeline-p nil |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
278 "Internal Eshell variable, non-nil inside a pipeline. |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
279 Has the value 'first, 'last for the first/last commands in the pipeline, |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
280 otherwise t.") |
29873 | 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)) | |
111686
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
358 (inhibit-point-motion-hooks t)) |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
359 (with-silent-modifications |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
360 ;; FIXME: Why not use a temporary buffer and avoid this |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
361 ;; "insert&delete" business? --Stef |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
362 (insert command) |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
363 (prog1 |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
364 (eshell-parse-arguments here (point)) |
e8049570c647
* lisp/eshell/: Use with-silent-modifications.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
110580
diff
changeset
|
365 (delete-region here (point)))))) |
29873 | 366 args)) |
367 (commands | |
368 (mapcar | |
369 (function | |
370 (lambda (cmd) | |
371 (if (or (not (car sep-terms)) | |
372 (string= (car sep-terms) ";")) | |
373 (setq cmd | |
374 (eshell-parse-pipeline cmd (not (car sep-terms)))) | |
375 (setq cmd | |
376 (list 'eshell-do-subjob | |
377 (list 'list (eshell-parse-pipeline cmd))))) | |
378 (setq sep-terms (cdr sep-terms)) | |
379 (if eshell-in-pipeline-p | |
380 cmd | |
381 (list 'eshell-trap-errors cmd)))) | |
382 (eshell-separate-commands terms "[&;]" nil 'sep-terms)))) | |
383 (let ((cmd commands)) | |
384 (while cmd | |
385 (if (cdr cmd) | |
386 (setcar cmd (list 'eshell-commands (car cmd)))) | |
387 (setq cmd (cdr cmd)))) | |
388 (setq commands | |
389 (append (list 'progn) | |
390 (if top-level | |
391 (list '(run-hooks 'eshell-pre-command-hook))) | |
392 (if (not top-level) | |
393 commands | |
394 (list | |
395 (list 'catch (quote 'top-level) | |
396 (append (list 'progn) commands)) | |
397 '(run-hooks 'eshell-post-command-hook))))) | |
398 (if top-level | |
399 (list 'eshell-commands commands) | |
400 commands))) | |
401 | |
87079
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
402 (defun eshell-debug-command (tag subform) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
403 "Output a debugging message to '*eshell last cmd*'." |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
404 (let ((buf (get-buffer-create "*eshell last cmd*")) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
405 (text (eshell-stringify eshell-current-command))) |
96274
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
406 (with-current-buffer buf |
87079
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
407 (if (not tag) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
408 (erase-buffer) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
409 (insert "\n\C-l\n" tag "\n\n" text |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
410 (if subform |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
411 (concat "\n\n" (eshell-stringify subform)) "")))))) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
412 |
29873 | 413 (defun eshell-debug-show-parsed-args (terms) |
414 "Display parsed arguments in the debug buffer." | |
415 (ignore | |
416 (if eshell-debug-command | |
417 (eshell-debug-command "parsed arguments" terms)))) | |
418 | |
419 (defun eshell-no-command-conversion (terms) | |
420 "Don't convert the command argument." | |
421 (ignore | |
422 (if (and (listp (car terms)) | |
423 (eq (caar terms) 'eshell-convert)) | |
424 (setcar terms (cadr (car terms)))))) | |
425 | |
426 (defun eshell-subcommand-arg-values (terms) | |
427 "Convert subcommand arguments {x} to ${x}, in order to take their values." | |
428 (setq terms (cdr terms)) ; skip command argument | |
429 (while terms | |
430 (if (and (listp (car terms)) | |
431 (eq (caar terms) 'eshell-as-subcommand)) | |
432 (setcar terms (list 'eshell-convert | |
433 (list 'eshell-command-to-value | |
434 (car terms))))) | |
435 (setq terms (cdr terms)))) | |
436 | |
437 (defun eshell-rewrite-sexp-command (terms) | |
438 "Rewrite a sexp in initial position, such as '(+ 1 2)'." | |
439 ;; this occurs when a Lisp expression is in first position | |
440 (if (and (listp (car terms)) | |
441 (eq (caar terms) 'eshell-command-to-value)) | |
442 (car (cdar terms)))) | |
443 | |
444 (eshell-deftest cmd lisp-command | |
445 "Evaluate Lisp command" | |
446 (eshell-command-result-p "(+ 1 2)" "3")) | |
447 | |
448 (eshell-deftest cmd lisp-command-args | |
449 "Evaluate Lisp command (ignore args)" | |
450 (eshell-command-result-p "(+ 1 2) 3" "3")) | |
451 | |
452 (defun eshell-rewrite-initial-subcommand (terms) | |
453 "Rewrite a subcommand in initial position, such as '{+ 1 2}'." | |
454 (if (and (listp (car terms)) | |
455 (eq (caar terms) 'eshell-as-subcommand)) | |
456 (car terms))) | |
457 | |
458 (eshell-deftest cmd subcommand | |
459 "Run subcommand" | |
460 (eshell-command-result-p "{+ 1 2}" "3\n")) | |
461 | |
462 (eshell-deftest cmd subcommand-args | |
463 "Run subcommand (ignore args)" | |
464 (eshell-command-result-p "{+ 1 2} 3" "3\n")) | |
465 | |
466 (eshell-deftest cmd subcommand-lisp | |
467 "Run subcommand + Lisp form" | |
468 (eshell-command-result-p "{(+ 1 2)}" "3\n")) | |
469 | |
470 (defun eshell-rewrite-named-command (terms) | |
471 "If no other rewriting rule transforms TERMS, assume a named command." | |
65167
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
472 (let ((sym (if eshell-in-pipeline-p |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
473 'eshell-named-command* |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
474 'eshell-named-command)) |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
475 (cmd (car terms)) |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
476 (args (cdr terms))) |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
477 (if args |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
478 (list sym cmd (append (list 'list) (cdr terms))) |
2980740e3f1c
(eshell-rewrite-named-command): Changed the code around a bit so that
John Wiegley <johnw@newartisans.com>
parents:
64701
diff
changeset
|
479 (list sym cmd)))) |
29873 | 480 |
481 (eshell-deftest cmd named-command | |
482 "Execute named command" | |
483 (eshell-command-result-p "+ 1 2" "3\n")) | |
484 | |
95619
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
485 (defvar eshell-command-body) |
45dbb3c749a6
Remove unnecessary eval-when-compiles and eval-and-compiles.
Glenn Morris <rgm@gnu.org>
parents:
94661
diff
changeset
|
486 (defvar eshell-test-body) |
29873 | 487 |
488 (defsubst eshell-invokify-arg (arg &optional share-output silent) | |
489 "Change ARG so it can be invoked from a structured command. | |
490 | |
491 SHARE-OUTPUT, if non-nil, means this invocation should share the | |
492 current output stream, which is separately redirectable. SILENT | |
493 means the user and/or any redirections shouldn't see any output | |
494 from this command. If both SHARE-OUTPUT and SILENT are non-nil, | |
495 the second is ignored." | |
496 ;; something that begins with `eshell-convert' means that it | |
497 ;; intends to return a Lisp value. We want to get past this, | |
498 ;; but if it's not _actually_ a value interpolation -- in which | |
499 ;; we leave it alone. In fact, the only time we muck with it | |
500 ;; is in the case of a {subcommand} that has been turned into | |
501 ;; the interpolation, ${subcommand}, by the parser because it | |
502 ;; didn't know better. | |
503 (if (and (listp arg) | |
504 (eq (car arg) 'eshell-convert) | |
505 (eq (car (cadr arg)) 'eshell-command-to-value)) | |
506 (if share-output | |
507 (cadr (cadr arg)) | |
508 (list 'eshell-commands (cadr (cadr arg)) | |
509 silent)) | |
510 arg)) | |
511 | |
512 (defun eshell-rewrite-for-command (terms) | |
513 "Rewrite a `for' command into its equivalent Eshell command form. | |
514 Because the implementation of `for' relies upon conditional evaluation | |
75512
aee02f0a570b
(eshell-rewrite-for-command): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
75346
diff
changeset
|
515 of its argument (i.e., use of a Lisp special form), it must be |
29873 | 516 implemented via rewriting, rather than as a function." |
517 (if (and (stringp (car terms)) | |
518 (string= (car terms) "for") | |
519 (stringp (nth 2 terms)) | |
520 (string= (nth 2 terms) "in")) | |
521 (let ((body (car (last terms)))) | |
522 (setcdr (last terms 2) nil) | |
523 (list | |
524 'let (list (list 'for-items | |
525 (append | |
526 (list 'append) | |
527 (mapcar | |
528 (function | |
529 (lambda (elem) | |
530 (if (listp elem) | |
531 elem | |
532 (list 'list elem)))) | |
29875
19baeeb660f1
(eshell-rewrite-for-command): Use cdr and
Gerd Moellmann <gerd@gnu.org>
parents:
29873
diff
changeset
|
533 (cdr (cddr terms))))) |
29873 | 534 (list 'eshell-command-body |
535 (list 'quote (list nil))) | |
536 (list 'eshell-test-body | |
537 (list 'quote (list nil)))) | |
538 (list | |
539 'progn | |
540 (list | |
541 'while (list 'car (list 'symbol-value | |
542 (list 'quote 'for-items))) | |
543 (list | |
544 'progn | |
545 (list 'let | |
546 (list (list (intern (cadr terms)) | |
547 (list 'car | |
548 (list 'symbol-value | |
549 (list 'quote 'for-items))))) | |
33020 | 550 (list 'eshell-protect |
551 (eshell-invokify-arg body t))) | |
29873 | 552 (list 'setcar 'for-items |
553 (list 'cadr | |
554 (list 'symbol-value | |
555 (list 'quote 'for-items)))) | |
556 (list 'setcdr 'for-items | |
557 (list 'cddr | |
558 (list 'symbol-value | |
559 (list 'quote 'for-items)))))) | |
560 (list 'eshell-close-handles | |
561 'eshell-last-command-status | |
562 (list 'list (quote 'quote) | |
563 'eshell-last-command-result))))))) | |
564 | |
565 (defun eshell-structure-basic-command (func names keyword test body | |
566 &optional else vocal-test) | |
567 "With TERMS, KEYWORD, and two NAMES, structure a basic command. | |
568 The first of NAMES should be the positive form, and the second the | |
569 negative. It's not likely that users should ever need to call this | |
570 function. | |
571 | |
572 If VOCAL-TEST is non-nil, it means output from the test should be | |
573 shown, as well as output from the body." | |
574 ;; If the test form begins with `eshell-convert', it means | |
575 ;; something data-wise will be returned, and we should let | |
576 ;; that determine the truth of the statement. | |
577 (unless (eq (car test) 'eshell-convert) | |
578 (setq test | |
579 (list 'progn test | |
580 (list 'eshell-exit-success-p)))) | |
581 | |
582 ;; should we reverse the sense of the test? This depends | |
583 ;; on the `names' parameter. If it's the symbol nil, yes. | |
584 ;; Otherwise, it can be a pair of strings; if the keyword | |
585 ;; we're using matches the second member of that pair (a | |
586 ;; list), we should reverse it. | |
587 (if (or (eq names nil) | |
588 (and (listp names) | |
589 (string= keyword (cadr names)))) | |
590 (setq test (list 'not test))) | |
591 | |
592 ;; finally, create the form that represents this structured | |
593 ;; command | |
594 (list | |
595 'let (list (list 'eshell-command-body | |
596 (list 'quote (list nil))) | |
597 (list 'eshell-test-body | |
598 (list 'quote (list nil)))) | |
599 (list func test body else) | |
600 (list 'eshell-close-handles | |
601 'eshell-last-command-status | |
602 (list 'list (quote 'quote) | |
603 'eshell-last-command-result)))) | |
604 | |
605 (defun eshell-rewrite-while-command (terms) | |
606 "Rewrite a `while' command into its equivalent Eshell command form. | |
607 Because the implementation of `while' relies upon conditional | |
608 evaluation of its argument (i.e., use of a Lisp special form), it | |
609 must be implemented via rewriting, rather than as a function." | |
610 (if (and (stringp (car terms)) | |
611 (member (car terms) '("while" "until"))) | |
612 (eshell-structure-basic-command | |
613 'while '("while" "until") (car terms) | |
614 (eshell-invokify-arg (cadr terms) nil t) | |
33020 | 615 (list 'eshell-protect |
29873 | 616 (eshell-invokify-arg (car (last terms)) t))))) |
617 | |
618 (defun eshell-rewrite-if-command (terms) | |
619 "Rewrite an `if' command into its equivalent Eshell command form. | |
620 Because the implementation of `if' relies upon conditional | |
621 evaluation of its argument (i.e., use of a Lisp special form), it | |
622 must be implemented via rewriting, rather than as a function." | |
623 (if (and (stringp (car terms)) | |
624 (member (car terms) '("if" "unless"))) | |
625 (eshell-structure-basic-command | |
626 'if '("if" "unless") (car terms) | |
627 (eshell-invokify-arg (cadr terms) nil t) | |
33020 | 628 (list 'eshell-protect |
629 (eshell-invokify-arg | |
38007
fa54203d014a
(eshell-exit-success-p): Use a string-match to test if the last
John Wiegley <johnw@newartisans.com>
parents:
37817
diff
changeset
|
630 (if (= (length terms) 4) |
fa54203d014a
(eshell-exit-success-p): Use a string-match to test if the last
John Wiegley <johnw@newartisans.com>
parents:
37817
diff
changeset
|
631 (car (last terms 2)) |
33020 | 632 (car (last terms))) t)) |
38007
fa54203d014a
(eshell-exit-success-p): Use a string-match to test if the last
John Wiegley <johnw@newartisans.com>
parents:
37817
diff
changeset
|
633 (if (= (length terms) 4) |
33020 | 634 (list 'eshell-protect |
635 (eshell-invokify-arg | |
636 (car (last terms)))) t)))) | |
29873 | 637 |
638 (defun eshell-exit-success-p () | |
639 "Return non-nil if the last command was \"successful\". | |
640 For a bit of Lisp code, this means a return value of non-nil. | |
641 For an external command, it means an exit code of 0." | |
38007
fa54203d014a
(eshell-exit-success-p): Use a string-match to test if the last
John Wiegley <johnw@newartisans.com>
parents:
37817
diff
changeset
|
642 (if (save-match-data |
fa54203d014a
(eshell-exit-success-p): Use a string-match to test if the last
John Wiegley <johnw@newartisans.com>
parents:
37817
diff
changeset
|
643 (string-match "#<\\(Lisp object\\|function .*\\)>" |
fa54203d014a
(eshell-exit-success-p): Use a string-match to test if the last
John Wiegley <johnw@newartisans.com>
parents:
37817
diff
changeset
|
644 eshell-last-command-name)) |
29873 | 645 eshell-last-command-result |
646 (= eshell-last-command-status 0))) | |
647 | |
648 (defun eshell-parse-pipeline (terms &optional final-p) | |
649 "Parse a pipeline from TERMS, return the appropriate Lisp forms." | |
650 (let* (sep-terms | |
651 (bigpieces (eshell-separate-commands terms "\\(&&\\|||\\)" | |
652 nil 'sep-terms)) | |
653 (bp bigpieces) | |
654 (results (list t)) | |
655 final) | |
656 (while bp | |
657 (let ((subterms (car bp))) | |
658 (let* ((pieces (eshell-separate-commands subterms "|")) | |
659 (p pieces)) | |
660 (while p | |
661 (let ((cmd (car p))) | |
662 (run-hook-with-args 'eshell-pre-rewrite-command-hook cmd) | |
663 (setq cmd (run-hook-with-args-until-success | |
664 'eshell-rewrite-command-hook cmd)) | |
665 (run-hook-with-args 'eshell-post-rewrite-command-hook 'cmd) | |
666 (setcar p cmd)) | |
667 (setq p (cdr p))) | |
668 (nconc results | |
669 (list | |
670 (if (<= (length pieces) 1) | |
671 (car pieces) | |
672 (assert (not eshell-in-pipeline-p)) | |
673 (list 'eshell-execute-pipeline | |
674 (list 'quote pieces)))))) | |
675 (setq bp (cdr bp)))) | |
676 ;; `results' might be empty; this happens in the case of | |
677 ;; multi-line input | |
678 (setq results (cdr results) | |
679 results (nreverse results) | |
680 final (car results) | |
681 results (cdr results) | |
682 sep-terms (nreverse sep-terms)) | |
683 (while results | |
684 (assert (car sep-terms)) | |
685 (setq final (eshell-structure-basic-command | |
686 'if (string= (car sep-terms) "&&") "if" | |
33020 | 687 (list 'eshell-protect (car results)) |
688 (list 'eshell-protect final) | |
29873 | 689 nil t) |
690 results (cdr results) | |
691 sep-terms (cdr sep-terms))) | |
692 final)) | |
693 | |
694 (defun eshell-parse-subcommand-argument () | |
695 "Parse a subcommand argument of the form '{command}'." | |
696 (if (and (not eshell-current-argument) | |
697 (not eshell-current-quoted) | |
698 (eq (char-after) ?\{) | |
699 (or (= (point-max) (1+ (point))) | |
700 (not (eq (char-after (1+ (point))) ?\})))) | |
701 (let ((end (eshell-find-delimiter ?\{ ?\}))) | |
702 (if (not end) | |
703 (throw 'eshell-incomplete ?\{) | |
704 (when (eshell-arg-delimiter (1+ end)) | |
705 (prog1 | |
706 (list 'eshell-as-subcommand | |
707 (eshell-parse-command (cons (1+ (point)) end))) | |
708 (goto-char (1+ end)))))))) | |
709 | |
710 (defun eshell-parse-lisp-argument () | |
711 "Parse a Lisp expression which is specified as an argument." | |
712 (if (and (not eshell-current-argument) | |
713 (not eshell-current-quoted) | |
714 (looking-at eshell-lisp-regexp)) | |
715 (let* ((here (point)) | |
716 (obj | |
717 (condition-case err | |
718 (read (current-buffer)) | |
719 (end-of-file | |
720 (throw 'eshell-incomplete ?\())))) | |
721 (if (eshell-arg-delimiter) | |
722 (list 'eshell-command-to-value | |
723 (list 'eshell-lisp-command (list 'quote obj))) | |
724 (ignore (goto-char here)))))) | |
725 | |
33020 | 726 (defun eshell-separate-commands (terms separator &optional |
727 reversed last-terms-sym) | |
29873 | 728 "Separate TERMS using SEPARATOR. |
729 If REVERSED is non-nil, the list of separated term groups will be | |
49477
ea69593b3b09
(eshell-separate-commands): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents:
48211
diff
changeset
|
730 returned in reverse order. If LAST-TERMS-SYM is a symbol, its value |
29873 | 731 will be set to a list of all the separator operators found (or '(list |
732 nil)' if none)." | |
733 (let ((sub-terms (list t)) | |
734 (eshell-sep-terms (list t)) | |
735 subchains) | |
736 (while terms | |
737 (if (and (consp (car terms)) | |
738 (eq (caar terms) 'eshell-operator) | |
739 (string-match (concat "^" separator "$") | |
740 (nth 1 (car terms)))) | |
741 (progn | |
742 (nconc eshell-sep-terms (list (nth 1 (car terms)))) | |
743 (setq subchains (cons (cdr sub-terms) subchains) | |
744 sub-terms (list t))) | |
745 (nconc sub-terms (list (car terms)))) | |
746 (setq terms (cdr terms))) | |
747 (if (> (length sub-terms) 1) | |
748 (setq subchains (cons (cdr sub-terms) subchains))) | |
749 (if reversed | |
750 (progn | |
751 (if last-terms-sym | |
752 (set last-terms-sym (reverse (cdr eshell-sep-terms)))) | |
753 subchains) ; already reversed | |
754 (if last-terms-sym | |
755 (set last-terms-sym (cdr eshell-sep-terms))) | |
756 (nreverse subchains)))) | |
757 | |
758 ;;_* Command evaluation macros | |
759 ;; | |
760 ;; The structure of the following macros is very important to | |
761 ;; `eshell-do-eval' [Iterative evaluation]: | |
762 ;; | |
763 ;; @ Don't use forms that conditionally evaluate their arguments, such | |
764 ;; as `setq', `if', `while', `let*', etc. The only special forms | |
765 ;; that can be used are `let', `condition-case' and | |
766 ;; `unwind-protect'. | |
767 ;; | |
768 ;; @ The main body of a `let' can contain only one form. Use `progn' | |
769 ;; if necessary. | |
770 ;; | |
771 ;; @ The two `special' variables are `eshell-current-handles' and | |
772 ;; `eshell-current-subjob-p'. Bind them locally with a `let' if you | |
773 ;; need to change them. Change them directly only if your intention | |
774 ;; is to change the calling environment. | |
775 | |
776 (defmacro eshell-do-subjob (object) | |
777 "Evaluate a command OBJECT as a subjob. | |
62789
74e26c83386f
(eshell-eval-command): If the return value of `eshell-resume-eval' is
John Wiegley <johnw@newartisans.com>
parents:
59121
diff
changeset
|
778 We indicate that the process was run in the background by returning it |
29873 | 779 ensconced in a list." |
780 `(let ((eshell-current-subjob-p t)) | |
781 ,object)) | |
782 | |
783 (defmacro eshell-commands (object &optional silent) | |
784 "Place a valid set of handles, and context, around command OBJECT." | |
785 `(let ((eshell-current-handles | |
786 (eshell-create-handles ,(not silent) 'append)) | |
787 eshell-current-subjob-p) | |
788 ,object)) | |
789 | |
790 (defmacro eshell-trap-errors (object) | |
791 "Trap any errors that occur, so they are not entirely fatal. | |
792 Also, the variable `eshell-this-command-hook' is available for the | |
793 duration of OBJECT's evaluation. Note that functions should be added | |
794 to this hook using `nconc', and *not* `add-hook'. | |
795 | |
796 Someday, when Scheme will become the dominant Emacs language, all of | |
797 this grossness will be made to disappear by using `call/cc'..." | |
798 `(let ((eshell-this-command-hook (list 'ignore))) | |
799 (eshell-condition-case err | |
800 (prog1 | |
801 ,object | |
802 (run-hooks 'eshell-this-command-hook)) | |
803 (error | |
804 (run-hooks 'eshell-this-command-hook) | |
805 (eshell-errorn (error-message-string err)) | |
806 (eshell-close-handles 1))))) | |
807 | |
31241 | 808 (defmacro eshell-copy-handles (object) |
809 "Duplicate current I/O handles, so OBJECT works with its own copy." | |
810 `(let ((eshell-current-handles | |
811 (eshell-create-handles | |
812 (car (aref eshell-current-handles | |
813 eshell-output-handle)) nil | |
814 (car (aref eshell-current-handles | |
815 eshell-error-handle)) nil))) | |
816 ,object)) | |
817 | |
29873 | 818 (defmacro eshell-protect (object) |
819 "Protect I/O handles, so they aren't get closed after eval'ing OBJECT." | |
820 `(progn | |
821 (eshell-protect-handles eshell-current-handles) | |
822 ,object)) | |
823 | |
99824
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
824 (defmacro eshell-do-pipelines (pipeline &optional notfirst) |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
825 "Execute the commands in PIPELINE, connecting each to one another. |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
826 This macro calls itself recursively, with NOTFIRST non-nil." |
29873 | 827 (when (setq pipeline (cadr pipeline)) |
31241 | 828 `(eshell-copy-handles |
829 (progn | |
830 ,(when (cdr pipeline) | |
831 `(let (nextproc) | |
832 (progn | |
833 (set 'nextproc | |
99824
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
834 (eshell-do-pipelines (quote ,(cdr pipeline)) t)) |
31241 | 835 (eshell-set-output-handle ,eshell-output-handle |
836 'append nextproc) | |
837 (eshell-set-output-handle ,eshell-error-handle | |
838 'append nextproc) | |
839 (set 'tailproc (or tailproc nextproc))))) | |
840 ,(let ((head (car pipeline))) | |
841 (if (memq (car head) '(let progn)) | |
842 (setq head (car (last head)))) | |
843 (when (memq (car head) eshell-deferrable-commands) | |
844 (ignore | |
845 (setcar head | |
846 (intern-soft | |
847 (concat (symbol-name (car head)) "*")))))) | |
99824
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
848 ;; First and last elements in a pipeline may need special treatment. |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
849 ;; (Currently only eshell-ls-files uses 'last.) |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
850 ;; Affects process-connection-type in eshell-gather-process-output. |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
851 (let ((eshell-in-pipeline-p |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
852 ,(cond ((not notfirst) (quote 'first)) |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
853 ((cdr pipeline) t) |
df01f003c105
(eshell-in-pipeline-p): Add doc-string.
Glenn Morris <rgm@gnu.org>
parents:
98564
diff
changeset
|
854 (t (quote 'last))))) |
97483
3c44de892298
(eshell-do-pipelines): Indicate the last command in a pipeline.
Glenn Morris <rgm@gnu.org>
parents:
97442
diff
changeset
|
855 ,(car pipeline)))))) |
31241 | 856 |
857 (defmacro eshell-do-pipelines-synchronously (pipeline) | |
858 "Execute the commands in PIPELINE in sequence synchronously. | |
859 Output of each command is passed as input to the next one in the pipeline. | |
860 This is used on systems where `start-process' is not supported." | |
861 (when (setq pipeline (cadr pipeline)) | |
862 `(let (result) | |
29873 | 863 (progn |
864 ,(when (cdr pipeline) | |
31241 | 865 `(let (output-marker) |
29873 | 866 (progn |
31241 | 867 (set 'output-marker ,(point-marker)) |
29873 | 868 (eshell-set-output-handle ,eshell-output-handle |
31241 | 869 'append output-marker) |
29873 | 870 (eshell-set-output-handle ,eshell-error-handle |
31241 | 871 'append output-marker)))) |
29873 | 872 ,(let ((head (car pipeline))) |
873 (if (memq (car head) '(let progn)) | |
874 (setq head (car (last head)))) | |
31241 | 875 ;;; FIXME: is deferrable significant here? |
29873 | 876 (when (memq (car head) eshell-deferrable-commands) |
877 (ignore | |
878 (setcar head | |
879 (intern-soft | |
880 (concat (symbol-name (car head)) "*")))))) | |
31241 | 881 ;; The last process in the pipe should get its handles |
882 ;; redirected as we found them before running the pipe. | |
883 ,(if (null (cdr pipeline)) | |
884 `(progn | |
885 (set 'eshell-current-handles tail-handles) | |
886 (set 'eshell-in-pipeline-p nil))) | |
887 (set 'result ,(car pipeline)) | |
888 ;; tailproc gets the result of the last successful process in | |
889 ;; the pipeline. | |
890 (set 'tailproc (or result tailproc)) | |
891 ,(if (cdr pipeline) | |
892 `(eshell-do-pipelines-synchronously (quote ,(cdr pipeline)))) | |
893 result)))) | |
29873 | 894 |
895 (defalias 'eshell-process-identity 'identity) | |
896 | |
897 (defmacro eshell-execute-pipeline (pipeline) | |
898 "Execute the commands in PIPELINE, connecting each to one another." | |
899 `(let ((eshell-in-pipeline-p t) tailproc) | |
900 (progn | |
31241 | 901 ,(if (fboundp 'start-process) |
902 `(eshell-do-pipelines ,pipeline) | |
903 `(let ((tail-handles (eshell-create-handles | |
904 (car (aref eshell-current-handles | |
905 ,eshell-output-handle)) nil | |
906 (car (aref eshell-current-handles | |
907 ,eshell-error-handle)) nil))) | |
908 (eshell-do-pipelines-synchronously ,pipeline))) | |
29873 | 909 (eshell-process-identity tailproc)))) |
910 | |
911 (defmacro eshell-as-subcommand (command) | |
912 "Execute COMMAND using a temp buffer. | |
913 This is used so that certain Lisp commands, such as `cd', when | |
914 executed in a subshell, do not disturb the environment of the main | |
915 Eshell buffer." | |
916 `(let ,eshell-subcommand-bindings | |
917 ,command)) | |
918 | |
919 (defmacro eshell-do-command-to-value (object) | |
920 "Run a subcommand prepared by `eshell-command-to-value'. | |
921 This avoids the need to use `let*'." | |
922 `(let ((eshell-current-handles | |
923 (eshell-create-handles value 'overwrite))) | |
924 (progn | |
925 ,object | |
926 (symbol-value value)))) | |
927 | |
928 (defmacro eshell-command-to-value (object) | |
929 "Run OBJECT synchronously, returning its result as a string. | |
930 Returns a string comprising the output from the command." | |
931 `(let ((value (make-symbol "eshell-temp"))) | |
932 (eshell-do-command-to-value ,object))) | |
933 | |
934 ;;;_* Iterative evaluation | |
935 ;; | |
936 ;; Eshell runs all of its external commands asynchronously, so that | |
937 ;; Emacs is not blocked while the operation is being performed. | |
938 ;; However, this introduces certain synchronization difficulties, | |
939 ;; since the Lisp code, once it returns, will not "go back" to finish | |
940 ;; executing the commands which haven't yet been started. | |
941 ;; | |
942 ;; What Eshell does to work around this problem (basically, the lack | |
943 ;; of threads in Lisp), is that it evaluates the command sequence | |
944 ;; iteratively. Whenever an asynchronous process is begun, evaluation | |
945 ;; terminates and control is given back to Emacs. When that process | |
946 ;; finishes, it will resume the evaluation using the remainder of the | |
947 ;; command tree. | |
948 | |
949 (defun eshell/eshell-debug (&rest args) | |
950 "A command for toggling certain debug variables." | |
951 (ignore | |
952 (cond | |
953 ((not args) | |
954 (if eshell-handle-errors | |
955 (eshell-print "errors\n")) | |
956 (if eshell-debug-command | |
957 (eshell-print "commands\n"))) | |
958 ((or (string= (car args) "-h") | |
959 (string= (car args) "--help")) | |
960 (eshell-print "usage: eshell-debug [kinds] | |
961 | |
962 This command is used to aid in debugging problems related to Eshell | |
963 itself. It is not useful for anything else. The recognized `kinds' | |
964 at the moment are: | |
965 | |
966 errors stops Eshell from trapping errors | |
967 commands shows command execution progress in `*eshell last cmd*' | |
968 ")) | |
969 (t | |
970 (while args | |
971 (cond | |
972 ((string= (car args) "errors") | |
973 (setq eshell-handle-errors (not eshell-handle-errors))) | |
974 ((string= (car args) "commands") | |
975 (setq eshell-debug-command (not eshell-debug-command)))) | |
976 (setq args (cdr args))))))) | |
977 | |
978 (defun pcomplete/eshell-mode/eshell-debug () | |
979 "Completion for the `debug' command." | |
980 (while (pcomplete-here '("errors" "commands")))) | |
981 | |
33020 | 982 (defun eshell-invoke-directly (command input) |
983 (let ((base (cadr (nth 2 (nth 2 (cadr command))))) name) | |
984 (if (and (eq (car base) 'eshell-trap-errors) | |
985 (eq (car (cadr base)) 'eshell-named-command)) | |
986 (setq name (cadr (cadr base)))) | |
987 (and name (stringp name) | |
988 (not (member name eshell-complex-commands)) | |
989 (catch 'simple | |
990 (progn | |
991 (eshell-for pred eshell-complex-commands | |
992 (if (and (functionp pred) | |
993 (funcall pred name)) | |
994 (throw 'simple nil))) | |
995 t)) | |
996 (fboundp (intern-soft (concat "eshell/" name)))))) | |
997 | |
29873 | 998 (defun eshell-eval-command (command &optional input) |
999 "Evaluate the given COMMAND iteratively." | |
1000 (if eshell-current-command | |
1001 ;; we can just stick the new command at the end of the current | |
1002 ;; one, and everything will happen as it should | |
1003 (setcdr (last (cdr eshell-current-command)) | |
1004 (list (list 'let '((here (and (eobp) (point)))) | |
1005 (and input | |
1006 (list 'insert-and-inherit | |
1007 (concat input "\n"))) | |
1008 '(if here | |
1009 (eshell-update-markers here)) | |
1010 (list 'eshell-do-eval | |
1011 (list 'quote command))))) | |
1012 (and eshell-debug-command | |
96274
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
1013 (with-current-buffer (get-buffer-create "*eshell last cmd*") |
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
1014 (erase-buffer) |
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
1015 (insert "command: \"" input "\"\n"))) |
29873 | 1016 (setq eshell-current-command command) |
31241 | 1017 (let ((delim (catch 'eshell-incomplete |
1018 (eshell-resume-eval)))) | |
42971
a4e7fd8ad209
(eshell-eval-command): If eshell-resume-eval
Eli Zaretskii <eliz@gnu.org>
parents:
38414
diff
changeset
|
1019 ;; On systems that don't support async subprocesses, eshell-resume |
a4e7fd8ad209
(eshell-eval-command): If eshell-resume-eval
Eli Zaretskii <eliz@gnu.org>
parents:
38414
diff
changeset
|
1020 ;; can return t. Don't treat that as an error. |
62789
74e26c83386f
(eshell-eval-command): If the return value of `eshell-resume-eval' is
John Wiegley <johnw@newartisans.com>
parents:
59121
diff
changeset
|
1021 (if (listp delim) |
74e26c83386f
(eshell-eval-command): If the return value of `eshell-resume-eval' is
John Wiegley <johnw@newartisans.com>
parents:
59121
diff
changeset
|
1022 (setq delim (car delim))) |
42971
a4e7fd8ad209
(eshell-eval-command): If eshell-resume-eval
Eli Zaretskii <eliz@gnu.org>
parents:
38414
diff
changeset
|
1023 (if (and delim (not (eq delim t))) |
62789
74e26c83386f
(eshell-eval-command): If the return value of `eshell-resume-eval' is
John Wiegley <johnw@newartisans.com>
parents:
59121
diff
changeset
|
1024 (error "Unmatched delimiter: %c" delim))))) |
29873 | 1025 |
1026 (defun eshell-resume-command (proc status) | |
1027 "Resume the current command when a process ends." | |
1028 (when proc | |
31241 | 1029 (unless (or (not (stringp status)) |
1030 (string= "stopped" status) | |
29873 | 1031 (string-match eshell-reset-signals status)) |
1032 (if (eq proc (eshell-interactive-process)) | |
1033 (eshell-resume-eval))))) | |
1034 | |
1035 (defun eshell-resume-eval () | |
1036 "Destructively evaluate a form which may need to be deferred." | |
1037 (eshell-condition-case err | |
1038 (progn | |
1039 (setq eshell-last-async-proc nil) | |
1040 (when eshell-current-command | |
1041 (let* (retval | |
1042 (proc (catch 'eshell-defer | |
1043 (ignore | |
1044 (setq retval | |
1045 (eshell-do-eval | |
1046 eshell-current-command)))))) | |
31241 | 1047 (if (eshell-processp proc) |
29873 | 1048 (ignore (setq eshell-last-async-proc proc)) |
1049 (cadr retval))))) | |
1050 (error | |
1051 (error (error-message-string err))))) | |
1052 | |
1053 (defmacro eshell-manipulate (tag &rest commands) | |
1054 "Manipulate a COMMAND form, with TAG as a debug identifier." | |
96274
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
1055 ;; Check `bound'ness since at compile time the code until here has not |
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
1056 ;; executed yet. |
b0ac9927a5c0
(eshell-manipulate): Check eshell-debug-command is bound before using it.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95619
diff
changeset
|
1057 (if (not (and (boundp 'eshell-debug-command) eshell-debug-command)) |
29873 | 1058 `(progn ,@commands) |
1059 `(progn | |
1060 (eshell-debug-command ,(eval tag) form) | |
1061 ,@commands | |
1062 (eshell-debug-command ,(concat "done " (eval tag)) form)))) | |
1063 | |
1064 (put 'eshell-manipulate 'lisp-indent-function 1) | |
1065 | |
1066 ;; eshell-lookup-function, eshell-functionp, and eshell-macrop taken | |
1067 ;; from edebug | |
1068 | |
1069 (defsubst eshell-lookup-function (object) | |
1070 "Return the ultimate function definition of OBJECT." | |
1071 (while (and (symbolp object) (fboundp object)) | |
1072 (setq object (symbol-function object))) | |
1073 object) | |
1074 | |
1075 (defconst function-p-func | |
48211
e23f9344f37d
(function-p-func): Avoid `xemacs-p'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43335
diff
changeset
|
1076 (if (fboundp 'compiled-function-p) |
29873 | 1077 'compiled-function-p |
1078 'byte-code-function-p)) | |
1079 | |
1080 (defsubst eshell-functionp (object) | |
1081 "Returns the function named by OBJECT, or nil if it is not a function." | |
1082 (setq object (eshell-lookup-function object)) | |
1083 (if (or (subrp object) | |
1084 (funcall function-p-func object) | |
1085 (and (listp object) | |
1086 (eq (car object) 'lambda) | |
1087 (listp (car (cdr object))))) | |
1088 object)) | |
1089 | |
1090 (defsubst eshell-macrop (object) | |
1091 "Return t if OBJECT is a macro or nil otherwise." | |
1092 (setq object (eshell-lookup-function object)) | |
1093 (if (and (listp object) | |
1094 (eq 'macro (car object)) | |
1095 (eshell-functionp (cdr object))) | |
1096 t)) | |
1097 | |
1098 (defun eshell-do-eval (form &optional synchronous-p) | |
1099 "Evaluate form, simplifying it as we go. | |
1100 Unless SYNCHRONOUS-P is non-nil, throws `eshell-defer' if it needs to | |
1101 be finished later after the completion of an asynchronous subprocess." | |
1102 (cond | |
1103 ((not (listp form)) | |
1104 (list 'quote (eval form))) | |
1105 ((memq (car form) '(quote function)) | |
1106 form) | |
1107 (t | |
1108 ;; skip past the call to `eshell-do-eval' | |
1109 (when (eq (car form) 'eshell-do-eval) | |
1110 (setq form (cadr (cadr form)))) | |
1111 ;; expand any macros directly into the form. This is done so that | |
1112 ;; we can modify any `let' forms to evaluate only once. | |
1113 (if (eshell-macrop (car form)) | |
1114 (let ((exp (eshell-copy-tree (macroexpand form)))) | |
1115 (eshell-manipulate (format "expanding macro `%s'" | |
1116 (symbol-name (car form))) | |
1117 (setcar form (car exp)) | |
1118 (setcdr form (cdr exp))))) | |
1119 (let ((args (cdr form))) | |
1120 (cond | |
1121 ((eq (car form) 'while) | |
1122 ;; `eshell-copy-tree' is needed here so that the test argument | |
1123 ;; doesn't get modified and thus always yield the same result. | |
1124 (when (car eshell-command-body) | |
1125 (assert (not synchronous-p)) | |
1126 (eshell-do-eval (car eshell-command-body)) | |
31241 | 1127 (setcar eshell-command-body nil) |
1128 (setcar eshell-test-body nil)) | |
29873 | 1129 (unless (car eshell-test-body) |
1130 (setcar eshell-test-body (eshell-copy-tree (car args)))) | |
31241 | 1131 (while (cadr (eshell-do-eval (car eshell-test-body))) |
1132 (setcar eshell-command-body (eshell-copy-tree (cadr args))) | |
1133 (eshell-do-eval (car eshell-command-body) synchronous-p) | |
1134 (setcar eshell-command-body nil) | |
1135 (setcar eshell-test-body (eshell-copy-tree (car args)))) | |
29873 | 1136 (setcar eshell-command-body nil)) |
1137 ((eq (car form) 'if) | |
1138 ;; `eshell-copy-tree' is needed here so that the test argument | |
1139 ;; doesn't get modified and thus always yield the same result. | |
31241 | 1140 (if (car eshell-command-body) |
1141 (progn | |
1142 (assert (not synchronous-p)) | |
1143 (eshell-do-eval (car eshell-command-body))) | |
1144 (unless (car eshell-test-body) | |
1145 (setcar eshell-test-body (eshell-copy-tree (car args)))) | |
1146 (if (cadr (eshell-do-eval (car eshell-test-body))) | |
1147 (setcar eshell-command-body (eshell-copy-tree (cadr args))) | |
1148 (setcar eshell-command-body (eshell-copy-tree (car (cddr args))))) | |
1149 (eshell-do-eval (car eshell-command-body) synchronous-p)) | |
1150 (setcar eshell-command-body nil) | |
1151 (setcar eshell-test-body nil)) | |
29873 | 1152 ((eq (car form) 'setcar) |
1153 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) | |
1154 (eval form)) | |
1155 ((eq (car form) 'setcdr) | |
1156 (setcar (cdr args) (eshell-do-eval (cadr args) synchronous-p)) | |
1157 (eval form)) | |
1158 ((memq (car form) '(let catch condition-case unwind-protect)) | |
1159 ;; `let', `condition-case' and `unwind-protect' have to be | |
1160 ;; handled specially, because we only want to call | |
1161 ;; `eshell-do-eval' on their first form. | |
1162 ;; | |
1163 ;; NOTE: This requires obedience by all forms which this | |
1164 ;; function might encounter, that they do not contain | |
1165 ;; other special forms. | |
1166 (if (and (eq (car form) 'let) | |
1167 (not (eq (car (cadr args)) 'eshell-do-eval))) | |
1168 (eshell-manipulate "evaluating let args" | |
1169 (eshell-for letarg (car args) | |
1170 (if (and (listp letarg) | |
1171 (not (eq (cadr letarg) 'quote))) | |
1172 (setcdr letarg | |
1173 (list (eshell-do-eval | |
1174 (cadr letarg) synchronous-p))))))) | |
1175 (unless (eq (car form) 'unwind-protect) | |
1176 (setq args (cdr args))) | |
1177 (unless (eq (caar args) 'eshell-do-eval) | |
1178 (eshell-manipulate "handling special form" | |
1179 (setcar args (list 'eshell-do-eval | |
1180 (list 'quote (car args)) | |
1181 synchronous-p)))) | |
1182 (eval form)) | |
1183 (t | |
1184 (if (and args (not (memq (car form) '(run-hooks)))) | |
1185 (eshell-manipulate | |
1186 (format "evaluating arguments to `%s'" | |
1187 (symbol-name (car form))) | |
1188 (while args | |
1189 (setcar args (eshell-do-eval (car args) synchronous-p)) | |
1190 (setq args (cdr args))))) | |
1191 (cond | |
1192 ((eq (car form) 'progn) | |
1193 (car (last form))) | |
1194 ((eq (car form) 'prog1) | |
1195 (cadr form)) | |
1196 (t | |
33020 | 1197 ;; If a command desire to replace its execution form with |
1198 ;; another command form, all it needs to do is throw the new | |
1199 ;; form using the exception tag `eshell-replace-command'. | |
1200 ;; For example, let's say that the form currently being | |
1201 ;; eval'd is: | |
1202 ;; | |
1203 ;; (eshell-named-command "hello") | |
1204 ;; | |
1205 ;; Now, let's assume the 'hello' command is an Eshell alias, | |
1206 ;; the definition of which yields the command: | |
1207 ;; | |
1208 ;; (eshell-named-command "echo" (list "Hello" "world")) | |
1209 ;; | |
1210 ;; What the alias code would like to do is simply substitute | |
1211 ;; the alias form for the original form. To accomplish | |
1212 ;; this, all it needs to do is to throw the substitution | |
1213 ;; form with the `eshell-replace-command' tag, and the form | |
1214 ;; will be replaced within the current command, and | |
1215 ;; execution will then resume (iteratively) as before. | |
1216 ;; Thus, aliases can even contain references to asynchronous | |
1217 ;; sub-commands, and things will still work out as they | |
1218 ;; should. | |
29873 | 1219 (let (result new-form) |
1220 (if (setq new-form | |
1221 (catch 'eshell-replace-command | |
1222 (ignore | |
1223 (setq result (eval form))))) | |
1224 (progn | |
1225 (eshell-manipulate "substituting replacement form" | |
1226 (setcar form (car new-form)) | |
1227 (setcdr form (cdr new-form))) | |
1228 (eshell-do-eval form synchronous-p)) | |
1229 (if (and (memq (car form) eshell-deferrable-commands) | |
1230 (not eshell-current-subjob-p) | |
1231 result | |
31241 | 1232 (eshell-processp result)) |
29873 | 1233 (if synchronous-p |
1234 (eshell/wait result) | |
1235 (eshell-manipulate "inserting ignore form" | |
1236 (setcar form 'ignore) | |
1237 (setcdr form nil)) | |
1238 (throw 'eshell-defer result)) | |
1239 (list 'quote result)))))))))))) | |
1240 | |
1241 ;; command invocation | |
1242 | |
1243 (defun eshell/which (command &rest names) | |
1244 "Identify the COMMAND, and where it is located." | |
1245 (eshell-for name (cons command names) | |
1246 (let (program alias direct) | |
37817
431f430082e9
(eshell/which): Use `eshell-explicit-command-char' instead of ?*.
John Wiegley <johnw@newartisans.com>
parents:
37665
diff
changeset
|
1247 (if (eq (aref name 0) eshell-explicit-command-char) |
29873 | 1248 (setq name (substring name 1) |
1249 direct t)) | |
1250 (if (and (not direct) | |
1251 (eshell-using-module 'eshell-alias) | |
1252 (setq alias | |
1253 (funcall (symbol-function 'eshell-lookup-alias) | |
1254 name))) | |
1255 (setq program | |
1256 (concat name " is an alias, defined as \"" | |
1257 (cadr alias) "\""))) | |
1258 (unless program | |
1259 (setq program (eshell-search-path name)) | |
1260 (let* ((esym (eshell-find-alias-function name)) | |
1261 (sym (or esym (intern-soft name)))) | |
55968
db23082093f5
2004-06-06 Emilio C. Lopes <eclig@gmx.net>
John Wiegley <johnw@newartisans.com>
parents:
54568
diff
changeset
|
1262 (if (and (or esym (and sym (fboundp sym))) |
db23082093f5
2004-06-06 Emilio C. Lopes <eclig@gmx.net>
John Wiegley <johnw@newartisans.com>
parents:
54568
diff
changeset
|
1263 (or eshell-prefer-lisp-functions (not direct))) |
29873 | 1264 (let ((desc (let ((inhibit-redisplay t)) |
1265 (save-window-excursion | |
1266 (prog1 | |
1267 (describe-function sym) | |
1268 (message nil)))))) | |
97442
5be4c494e1d5
(eshell/which): Handle the case where no description is found.
Glenn Morris <rgm@gnu.org>
parents:
96274
diff
changeset
|
1269 (setq desc (if desc (substring desc 0 |
5be4c494e1d5
(eshell/which): Handle the case where no description is found.
Glenn Morris <rgm@gnu.org>
parents:
96274
diff
changeset
|
1270 (1- (or (string-match "\n" desc) |
5be4c494e1d5
(eshell/which): Handle the case where no description is found.
Glenn Morris <rgm@gnu.org>
parents:
96274
diff
changeset
|
1271 (length desc)))) |
5be4c494e1d5
(eshell/which): Handle the case where no description is found.
Glenn Morris <rgm@gnu.org>
parents:
96274
diff
changeset
|
1272 ;; This should not happen. |
5be4c494e1d5
(eshell/which): Handle the case where no description is found.
Glenn Morris <rgm@gnu.org>
parents:
96274
diff
changeset
|
1273 (format "%s is defined, \ |
5be4c494e1d5
(eshell/which): Handle the case where no description is found.
Glenn Morris <rgm@gnu.org>
parents:
96274
diff
changeset
|
1274 but no documentation was found" name))) |
31241 | 1275 (if (buffer-live-p (get-buffer "*Help*")) |
1276 (kill-buffer "*Help*")) | |
29873 | 1277 (setq program (or desc name)))))) |
1278 (if (not program) | |
1279 (eshell-error (format "which: no %s in (%s)\n" | |
1280 name (getenv "PATH"))) | |
1281 (eshell-printn program))))) | |
1282 | |
37662
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1283 (put 'eshell/which 'eshell-no-numeric-conversions t) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1284 |
29873 | 1285 (defun eshell-named-command (command &optional args) |
1286 "Insert output from a plain COMMAND, using ARGS. | |
1287 COMMAND may result in an alias being executed, or a plain command." | |
1288 (setq eshell-last-arguments args | |
1289 eshell-last-command-name (eshell-stringify command)) | |
1290 (run-hook-with-args 'eshell-prepare-command-hook) | |
1291 (assert (stringp eshell-last-command-name)) | |
1292 (if eshell-last-command-name | |
1293 (or (run-hook-with-args-until-success | |
1294 'eshell-named-command-hook eshell-last-command-name | |
1295 eshell-last-arguments) | |
1296 (eshell-plain-command eshell-last-command-name | |
1297 eshell-last-arguments)))) | |
1298 | |
1299 (defalias 'eshell-named-command* 'eshell-named-command) | |
1300 | |
1301 (defun eshell-find-alias-function (name) | |
1302 "Check whether a function called `eshell/NAME' exists." | |
1303 (let* ((sym (intern-soft (concat "eshell/" name))) | |
59121
7b2031432b63
(eshell-find-alias-function): Call symbol-file with `defun'.
Richard M. Stallman <rms@gnu.org>
parents:
55968
diff
changeset
|
1304 (file (symbol-file sym 'defun))) |
37442
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1305 ;; If the function exists, but is defined in an eshell module |
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1306 ;; that's not currently enabled, don't report it as found |
29873 | 1307 (if (and file |
1308 (string-match "\\(em\\|esh\\)-\\(.*\\)\\(\\.el\\)?\\'" file)) | |
37442
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1309 (let ((module-sym |
29873 | 1310 (intern (file-name-sans-extension |
37442
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1311 (file-name-nondirectory |
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1312 (concat "eshell-" (match-string 2 file))))))) |
37450
b1c5785dbec5
(eshell-find-alias-function): Corrected the fix from last night, since
John Wiegley <johnw@newartisans.com>
parents:
37442
diff
changeset
|
1313 (if (and (functionp sym) |
b1c5785dbec5
(eshell-find-alias-function): Corrected the fix from last night, since
John Wiegley <johnw@newartisans.com>
parents:
37442
diff
changeset
|
1314 (or (null module-sym) |
b1c5785dbec5
(eshell-find-alias-function): Corrected the fix from last night, since
John Wiegley <johnw@newartisans.com>
parents:
37442
diff
changeset
|
1315 (eshell-using-module module-sym) |
b1c5785dbec5
(eshell-find-alias-function): Corrected the fix from last night, since
John Wiegley <johnw@newartisans.com>
parents:
37442
diff
changeset
|
1316 (memq module-sym (eshell-subgroups 'eshell)))) |
37442
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1317 sym)) |
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1318 ;; Otherwise, if it's bound, return it. |
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1319 (if (functionp sym) |
f4b209194d8c
(eshell-find-alias-function): Return t in the case where the function
John Wiegley <johnw@newartisans.com>
parents:
33020
diff
changeset
|
1320 sym)))) |
29873 | 1321 |
1322 (defun eshell-plain-command (command args) | |
1323 "Insert output from a plain COMMAND, using ARGS. | |
1324 COMMAND may result in either a Lisp function being executed by name, | |
1325 or an external command." | |
1326 (let* ((esym (eshell-find-alias-function command)) | |
1327 (sym (or esym (intern-soft command)))) | |
1328 (if (and sym (fboundp sym) | |
1329 (or esym eshell-prefer-lisp-functions | |
1330 (not (eshell-search-path command)))) | |
1331 (eshell-lisp-command sym args) | |
1332 (eshell-external-command command args)))) | |
1333 | |
1334 (defun eshell-exec-lisp (printer errprint func-or-form args form-p) | |
1335 "Execute a lisp FUNC-OR-FORM, maybe passing ARGS. | |
1336 PRINTER and ERRPRINT are functions to use for printing regular | |
1337 messages, and errors. FORM-P should be non-nil if FUNC-OR-FORM | |
1338 represent a lisp form; ARGS will be ignored in that case." | |
1339 (let (result) | |
1340 (eshell-condition-case err | |
1341 (progn | |
1342 (setq result | |
1343 (save-current-buffer | |
1344 (if form-p | |
1345 (eval func-or-form) | |
1346 (apply func-or-form args)))) | |
1347 (and result (funcall printer result)) | |
1348 result) | |
1349 (error | |
1350 (let ((msg (error-message-string err))) | |
1351 (if (and (not form-p) | |
1352 (string-match "^Wrong number of arguments" msg) | |
1353 (fboundp 'eldoc-get-fnsym-args-string)) | |
1354 (let ((func-doc (eldoc-get-fnsym-args-string func-or-form))) | |
1355 (setq msg (format "usage: %s" func-doc)))) | |
1356 (funcall errprint msg)) | |
1357 nil)))) | |
1358 | |
1359 (defsubst eshell-apply* (printer errprint func args) | |
1360 "Call FUNC, with ARGS, trapping errors and return them as output. | |
1361 PRINTER and ERRPRINT are functions to use for printing regular | |
1362 messages, and errors." | |
1363 (eshell-exec-lisp printer errprint func args nil)) | |
1364 | |
1365 (defsubst eshell-funcall* (printer errprint func &rest args) | |
1366 "Call FUNC, with ARGS, trapping errors and return them as output." | |
1367 (eshell-apply* printer errprint func args)) | |
1368 | |
1369 (defsubst eshell-eval* (printer errprint form) | |
1370 "Evaluate FORM, trapping errors and returning them." | |
1371 (eshell-exec-lisp printer errprint form nil t)) | |
1372 | |
1373 (defsubst eshell-apply (func args) | |
1374 "Call FUNC, with ARGS, trapping errors and return them as output. | |
1375 PRINTER and ERRPRINT are functions to use for printing regular | |
1376 messages, and errors." | |
1377 (eshell-apply* 'eshell-print 'eshell-error func args)) | |
1378 | |
1379 (defsubst eshell-funcall (func &rest args) | |
1380 "Call FUNC, with ARGS, trapping errors and return them as output." | |
1381 (eshell-apply func args)) | |
1382 | |
1383 (defsubst eshell-eval (form) | |
1384 "Evaluate FORM, trapping errors and returning them." | |
1385 (eshell-eval* 'eshell-print 'eshell-error form)) | |
1386 | |
1387 (defsubst eshell-applyn (func args) | |
1388 "Call FUNC, with ARGS, trapping errors and return them as output. | |
1389 PRINTER and ERRPRINT are functions to use for printing regular | |
1390 messages, and errors." | |
1391 (eshell-apply* 'eshell-printn 'eshell-errorn func args)) | |
1392 | |
1393 (defsubst eshell-funcalln (func &rest args) | |
1394 "Call FUNC, with ARGS, trapping errors and return them as output." | |
1395 (eshell-applyn func args)) | |
1396 | |
1397 (defsubst eshell-evaln (form) | |
1398 "Evaluate FORM, trapping errors and returning them." | |
1399 (eshell-eval* 'eshell-printn 'eshell-errorn form)) | |
1400 | |
1401 (defun eshell-lisp-command (object &optional args) | |
1402 "Insert Lisp OBJECT, using ARGS if a function." | |
1403 (catch 'eshell-external ; deferred to an external command | |
1404 (let* ((eshell-ensure-newline-p (eshell-interactive-output-p)) | |
1405 (result | |
1406 (if (functionp object) | |
37662
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1407 (progn |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1408 (setq eshell-last-arguments args |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1409 eshell-last-command-name |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1410 (concat "#<function " (symbol-name object) ">")) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1411 ;; if any of the arguments are flagged as numbers |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1412 ;; waiting for conversion, convert them now |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1413 (unless (get object 'eshell-no-numeric-conversions) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1414 (while args |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1415 (let ((arg (car args))) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1416 (if (and (stringp arg) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1417 (> (length arg) 0) |
53051
bf3ee9e2ceda
(eshell-lisp-command): Do not late-convert string arguments to numbers
John Wiegley <johnw@newartisans.com>
parents:
52401
diff
changeset
|
1418 (not (text-property-not-all |
bf3ee9e2ceda
(eshell-lisp-command): Do not late-convert string arguments to numbers
John Wiegley <johnw@newartisans.com>
parents:
52401
diff
changeset
|
1419 0 (length arg) 'number t arg))) |
37665
ebd292552bfe
Fixed reference to free variable.
John Wiegley <johnw@newartisans.com>
parents:
37662
diff
changeset
|
1420 (setcar args (string-to-number arg)))) |
37662
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1421 (setq args (cdr args)))) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1422 (eshell-apply object eshell-last-arguments)) |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1423 (setq eshell-last-arguments args |
cb20d33bef50
(eshell-lisp-command): Don't perform numeric conversions if a Lisp
John Wiegley <johnw@newartisans.com>
parents:
37657
diff
changeset
|
1424 eshell-last-command-name "#<Lisp object>") |
29873 | 1425 (eshell-eval object)))) |
1426 (if (and eshell-ensure-newline-p | |
1427 (save-excursion | |
1428 (goto-char eshell-last-output-end) | |
1429 (not (bolp)))) | |
1430 (eshell-print "\n")) | |
1431 (eshell-close-handles 0 (list 'quote result))))) | |
1432 | |
1433 (defalias 'eshell-lisp-command* 'eshell-lisp-command) | |
1434 | |
87079
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
1435 (provide 'esh-cmd) |
c1197dc2780b
Require individual files if needed when compiling, rather than
Glenn Morris <rgm@gnu.org>
parents:
86202
diff
changeset
|
1436 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
1437 ;; arch-tag: 8e4f3867-a0c5-441f-96ba-ddd142d94366 |
29873 | 1438 ;;; esh-cmd.el ends here |