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