| 1 | ;;; esh-io.el --- I/O management |
| 2 | |
| 3 | ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: John Wiegley <johnw@gnu.org> |
| 6 | |
| 7 | ;; This file is part of GNU Emacs. |
| 8 | |
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 10 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation, either version 3 of the License, or |
| 12 | ;; (at your option) any later version. |
| 13 | |
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 21 | |
| 22 | ;;; Commentary: |
| 23 | |
| 24 | ;; At the moment, only output redirection is supported in Eshell. To |
| 25 | ;; use input redirection, the following syntax will work, assuming |
| 26 | ;; that the command after the pipe is always an external command: |
| 27 | ;; |
| 28 | ;; cat <file> | <command> |
| 29 | ;; |
| 30 | ;; Otherwise, output redirection and piping are provided in a manner |
| 31 | ;; consistent with most shells. Therefore, only unique features are |
| 32 | ;; mentioned here. |
| 33 | ;; |
| 34 | ;;;_* Insertion |
| 35 | ;; |
| 36 | ;; To insert at the location of point in a buffer, use '>>>': |
| 37 | ;; |
| 38 | ;; echo alpha >>> #<buffer *scratch*>; |
| 39 | ;; |
| 40 | ;;;_* Pseudo-devices |
| 41 | ;; |
| 42 | ;; A few pseudo-devices are provided, since Emacs cannot write |
| 43 | ;; directly to a UNIX device file: |
| 44 | ;; |
| 45 | ;; echo alpha > /dev/null ; the bit bucket |
| 46 | ;; echo alpha > /dev/kill ; set the kill ring |
| 47 | ;; echo alpha >> /dev/clip ; append to the clipboard |
| 48 | ;; |
| 49 | ;;;_* Multiple output targets |
| 50 | ;; |
| 51 | ;; Eshell can write to multiple output targets, including pipes. |
| 52 | ;; Example: |
| 53 | ;; |
| 54 | ;; (+ 1 2) > a > b > c ; prints number to all three files |
| 55 | ;; (+ 1 2) > a | wc ; prints to 'a', and pipes to 'wc' |
| 56 | |
| 57 | ;;; Code: |
| 58 | |
| 59 | (provide 'esh-io) |
| 60 | |
| 61 | (eval-when-compile |
| 62 | (require 'cl) |
| 63 | (require 'eshell)) |
| 64 | |
| 65 | (defgroup eshell-io nil |
| 66 | "Eshell's I/O management code provides a scheme for treating many |
| 67 | different kinds of objects -- symbols, files, buffers, etc. -- as |
| 68 | though they were files." |
| 69 | :tag "I/O management" |
| 70 | :group 'eshell) |
| 71 | |
| 72 | ;;; User Variables: |
| 73 | |
| 74 | (defcustom eshell-io-load-hook nil |
| 75 | "A hook that gets run when `eshell-io' is loaded." |
| 76 | :version "24.1" ; removed eshell-io-initialize |
| 77 | :type 'hook |
| 78 | :group 'eshell-io) |
| 79 | |
| 80 | (defcustom eshell-number-of-handles 3 |
| 81 | "The number of file handles that eshell supports. |
| 82 | Currently this is standard input, output and error. But even all of |
| 83 | these Emacs does not currently support with asynchronous processes |
| 84 | \(which is what eshell uses so that you can continue doing work in |
| 85 | other buffers) ." |
| 86 | :type 'integer |
| 87 | :group 'eshell-io) |
| 88 | |
| 89 | (defcustom eshell-output-handle 1 |
| 90 | "The index of the standard output handle." |
| 91 | :type 'integer |
| 92 | :group 'eshell-io) |
| 93 | |
| 94 | (defcustom eshell-error-handle 2 |
| 95 | "The index of the standard error handle." |
| 96 | :type 'integer |
| 97 | :group 'eshell-io) |
| 98 | |
| 99 | (defcustom eshell-buffer-shorthand nil |
| 100 | "If non-nil, a symbol name can be used for a buffer in redirection. |
| 101 | If nil, redirecting to a buffer requires buffer name syntax. If this |
| 102 | variable is set, redirection directly to Lisp symbols will be |
| 103 | impossible. |
| 104 | |
| 105 | Example: |
| 106 | |
| 107 | echo hello > '*scratch* ; works if `eshell-buffer-shorthand' is t |
| 108 | echo hello > #<buffer *scratch*> ; always works" |
| 109 | :type 'boolean |
| 110 | :group 'eshell-io) |
| 111 | |
| 112 | (defcustom eshell-print-queue-size 5 |
| 113 | "The size of the print queue, for doing buffered printing. |
| 114 | This is basically a speed enhancement, to avoid blocking the Lisp code |
| 115 | from executing while Emacs is redisplaying." |
| 116 | :type 'integer |
| 117 | :group 'eshell-io) |
| 118 | |
| 119 | (defcustom eshell-virtual-targets |
| 120 | '(("/dev/eshell" eshell-interactive-print nil) |
| 121 | ("/dev/kill" (lambda (mode) |
| 122 | (if (eq mode 'overwrite) |
| 123 | (kill-new "")) |
| 124 | 'eshell-kill-append) t) |
| 125 | ("/dev/clip" (lambda (mode) |
| 126 | (if (eq mode 'overwrite) |
| 127 | (let ((x-select-enable-clipboard t)) |
| 128 | (kill-new ""))) |
| 129 | 'eshell-clipboard-append) t)) |
| 130 | "Map virtual devices name to Emacs Lisp functions. |
| 131 | If the user specifies any of the filenames above as a redirection |
| 132 | target, the function in the second element will be called. |
| 133 | |
| 134 | If the third element is non-nil, the redirection mode is passed as an |
| 135 | argument (which is the symbol `overwrite', `append' or `insert'), and |
| 136 | the function is expected to return another function -- which is the |
| 137 | output function. Otherwise, the second element itself is the output |
| 138 | function. |
| 139 | |
| 140 | The output function is then called repeatedly with single strings, |
| 141 | which represents successive pieces of the output of the command, until nil |
| 142 | is passed, meaning EOF. |
| 143 | |
| 144 | NOTE: /dev/null is handled specially as a virtual target, and should |
| 145 | not be added to this variable." |
| 146 | :type '(repeat |
| 147 | (list (string :tag "Target") |
| 148 | function |
| 149 | (choice (const :tag "Func returns output-func" t) |
| 150 | (const :tag "Func is output-func" nil)))) |
| 151 | :group 'eshell-io) |
| 152 | |
| 153 | (put 'eshell-virtual-targets 'risky-local-variable t) |
| 154 | |
| 155 | ;;; Internal Variables: |
| 156 | |
| 157 | (defvar eshell-current-handles nil) |
| 158 | |
| 159 | (defvar eshell-last-command-status 0 |
| 160 | "The exit code from the last command. 0 if successful.") |
| 161 | |
| 162 | (defvar eshell-last-command-result nil |
| 163 | "The result of the last command. Not related to success.") |
| 164 | |
| 165 | (defvar eshell-output-file-buffer nil |
| 166 | "If non-nil, the current buffer is a file output buffer.") |
| 167 | |
| 168 | (defvar eshell-print-count) |
| 169 | (defvar eshell-current-redirections) |
| 170 | |
| 171 | ;;; Functions: |
| 172 | |
| 173 | (defun eshell-io-initialize () |
| 174 | "Initialize the I/O subsystem code." |
| 175 | (add-hook 'eshell-parse-argument-hook |
| 176 | 'eshell-parse-redirection nil t) |
| 177 | (make-local-variable 'eshell-current-redirections) |
| 178 | (add-hook 'eshell-pre-rewrite-command-hook |
| 179 | 'eshell-strip-redirections nil t) |
| 180 | (add-hook 'eshell-post-rewrite-command-hook |
| 181 | 'eshell-apply-redirections nil t)) |
| 182 | |
| 183 | (defun eshell-parse-redirection () |
| 184 | "Parse an output redirection, such as '2>'." |
| 185 | (if (and (not eshell-current-quoted) |
| 186 | (looking-at "\\([0-9]\\)?\\(<\\|>+\\)&?\\([0-9]\\)?\\s-*")) |
| 187 | (if eshell-current-argument |
| 188 | (eshell-finish-arg) |
| 189 | (let ((sh (match-string 1)) |
| 190 | (oper (match-string 2)) |
| 191 | ; (th (match-string 3)) |
| 192 | ) |
| 193 | (if (string= oper "<") |
| 194 | (error "Eshell does not support input redirection")) |
| 195 | (eshell-finish-arg |
| 196 | (prog1 |
| 197 | (list 'eshell-set-output-handle |
| 198 | (or (and sh (string-to-number sh)) 1) |
| 199 | (list 'quote |
| 200 | (aref [overwrite append insert] |
| 201 | (1- (length oper))))) |
| 202 | (goto-char (match-end 0)))))))) |
| 203 | |
| 204 | (defun eshell-strip-redirections (terms) |
| 205 | "Rewrite any output redirections in TERMS." |
| 206 | (setq eshell-current-redirections (list t)) |
| 207 | (let ((tl terms) |
| 208 | (tt (cdr terms))) |
| 209 | (while tt |
| 210 | (if (not (and (consp (car tt)) |
| 211 | (eq (caar tt) 'eshell-set-output-handle))) |
| 212 | (setq tt (cdr tt) |
| 213 | tl (cdr tl)) |
| 214 | (unless (cdr tt) |
| 215 | (error "Missing redirection target")) |
| 216 | (nconc eshell-current-redirections |
| 217 | (list (list 'ignore |
| 218 | (append (car tt) (list (cadr tt)))))) |
| 219 | (setcdr tl (cddr tt)) |
| 220 | (setq tt (cddr tt)))) |
| 221 | (setq eshell-current-redirections |
| 222 | (cdr eshell-current-redirections)))) |
| 223 | |
| 224 | (defun eshell-apply-redirections (cmdsym) |
| 225 | "Apply any redirection which were specified for COMMAND." |
| 226 | (if eshell-current-redirections |
| 227 | (set cmdsym |
| 228 | (append (list 'progn) |
| 229 | eshell-current-redirections |
| 230 | (list (symbol-value cmdsym)))))) |
| 231 | |
| 232 | (defun eshell-create-handles |
| 233 | (standard-output output-mode &optional standard-error error-mode) |
| 234 | "Create a new set of file handles for a command. |
| 235 | The default location for standard output and standard error will go to |
| 236 | STANDARD-OUTPUT and STANDARD-ERROR, respectively. |
| 237 | OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert'; |
| 238 | a nil value of mode defaults to `insert'." |
| 239 | (let ((handles (make-vector eshell-number-of-handles nil)) |
| 240 | (output-target (eshell-get-target standard-output output-mode)) |
| 241 | (error-target (eshell-get-target standard-error error-mode))) |
| 242 | (aset handles eshell-output-handle (cons output-target 1)) |
| 243 | (if standard-error |
| 244 | (aset handles eshell-error-handle (cons error-target 1)) |
| 245 | (aset handles eshell-error-handle (cons output-target 1))) |
| 246 | handles)) |
| 247 | |
| 248 | (defun eshell-protect-handles (handles) |
| 249 | "Protect the handles in HANDLES from a being closed." |
| 250 | (let ((idx 0)) |
| 251 | (while (< idx eshell-number-of-handles) |
| 252 | (if (aref handles idx) |
| 253 | (setcdr (aref handles idx) |
| 254 | (1+ (cdr (aref handles idx))))) |
| 255 | (setq idx (1+ idx)))) |
| 256 | handles) |
| 257 | |
| 258 | (defun eshell-close-target (target status) |
| 259 | "Close an output TARGET, passing STATUS as the result. |
| 260 | STATUS should be non-nil on successful termination of the output." |
| 261 | (cond |
| 262 | ((symbolp target) nil) |
| 263 | |
| 264 | ;; If we were redirecting to a file, save the file and close the |
| 265 | ;; buffer. |
| 266 | ((markerp target) |
| 267 | (let ((buf (marker-buffer target))) |
| 268 | (when buf ; somebody's already killed it! |
| 269 | (save-current-buffer |
| 270 | (set-buffer buf) |
| 271 | (when eshell-output-file-buffer |
| 272 | (save-buffer) |
| 273 | (when (eq eshell-output-file-buffer t) |
| 274 | (or status (set-buffer-modified-p nil)) |
| 275 | (kill-buffer buf))))))) |
| 276 | |
| 277 | ;; If we're redirecting to a process (via a pipe, or process |
| 278 | ;; redirection), send it EOF so that it knows we're finished. |
| 279 | ((eshell-processp target) |
| 280 | (if (eq (process-status target) 'run) |
| 281 | (process-send-eof target))) |
| 282 | |
| 283 | ;; A plain function redirection needs no additional arguments |
| 284 | ;; passed. |
| 285 | ((functionp target) |
| 286 | (funcall target status)) |
| 287 | |
| 288 | ;; But a more complicated function redirection (which can only |
| 289 | ;; happen with aliases at the moment) has arguments that need to be |
| 290 | ;; passed along with it. |
| 291 | ((consp target) |
| 292 | (apply (car target) status (cdr target))))) |
| 293 | |
| 294 | (defun eshell-close-handles (exit-code &optional result handles) |
| 295 | "Close all of the current handles, taking refcounts into account. |
| 296 | EXIT-CODE is the process exit code; mainly, it is zero, if the command |
| 297 | completed successfully. RESULT is the quoted value of the last |
| 298 | command. If nil, then the meta variables for keeping track of the |
| 299 | last execution result should not be changed." |
| 300 | (let ((idx 0)) |
| 301 | (assert (or (not result) (eq (car result) 'quote))) |
| 302 | (setq eshell-last-command-status exit-code |
| 303 | eshell-last-command-result (cadr result)) |
| 304 | (while (< idx eshell-number-of-handles) |
| 305 | (let ((handles (or handles eshell-current-handles))) |
| 306 | (when (aref handles idx) |
| 307 | (setcdr (aref handles idx) |
| 308 | (1- (cdr (aref handles idx)))) |
| 309 | (when (= (cdr (aref handles idx)) 0) |
| 310 | (let ((target (car (aref handles idx)))) |
| 311 | (if (not (listp target)) |
| 312 | (eshell-close-target target (= exit-code 0)) |
| 313 | (while target |
| 314 | (eshell-close-target (car target) (= exit-code 0)) |
| 315 | (setq target (cdr target))))) |
| 316 | (setcar (aref handles idx) nil)))) |
| 317 | (setq idx (1+ idx))) |
| 318 | nil)) |
| 319 | |
| 320 | (defun eshell-kill-append (string) |
| 321 | "Call `kill-append' with STRING, if it is indeed a string." |
| 322 | (if (stringp string) |
| 323 | (kill-append string nil))) |
| 324 | |
| 325 | (defun eshell-clipboard-append (string) |
| 326 | "Call `kill-append' with STRING, if it is indeed a string." |
| 327 | (if (stringp string) |
| 328 | (let ((x-select-enable-clipboard t)) |
| 329 | (kill-append string nil)))) |
| 330 | |
| 331 | (defun eshell-get-target (target &optional mode) |
| 332 | "Convert TARGET, which is a raw argument, into a valid output target. |
| 333 | MODE is either `overwrite', `append' or `insert'; if it is omitted or nil, |
| 334 | it defaults to `insert'." |
| 335 | (setq mode (or mode 'insert)) |
| 336 | (cond |
| 337 | ((stringp target) |
| 338 | (let ((redir (assoc target eshell-virtual-targets))) |
| 339 | (if redir |
| 340 | (if (nth 2 redir) |
| 341 | (funcall (nth 1 redir) mode) |
| 342 | (nth 1 redir)) |
| 343 | (let* ((exists (get-file-buffer target)) |
| 344 | (buf (find-file-noselect target t))) |
| 345 | (with-current-buffer buf |
| 346 | (if buffer-file-read-only |
| 347 | (error "Cannot write to read-only file `%s'" target)) |
| 348 | (setq buffer-read-only nil) |
| 349 | (set (make-local-variable 'eshell-output-file-buffer) |
| 350 | (if (eq exists buf) 0 t)) |
| 351 | (cond ((eq mode 'overwrite) |
| 352 | (erase-buffer)) |
| 353 | ((eq mode 'append) |
| 354 | (goto-char (point-max)))) |
| 355 | (point-marker)))))) |
| 356 | |
| 357 | ((or (bufferp target) |
| 358 | (and (boundp 'eshell-buffer-shorthand) |
| 359 | (symbol-value 'eshell-buffer-shorthand) |
| 360 | (symbolp target) |
| 361 | (not (memq target '(t nil))))) |
| 362 | (let ((buf (if (bufferp target) |
| 363 | target |
| 364 | (get-buffer-create |
| 365 | (symbol-name target))))) |
| 366 | (with-current-buffer buf |
| 367 | (cond ((eq mode 'overwrite) |
| 368 | (erase-buffer)) |
| 369 | ((eq mode 'append) |
| 370 | (goto-char (point-max)))) |
| 371 | (point-marker)))) |
| 372 | |
| 373 | ((functionp target) nil) |
| 374 | |
| 375 | ((symbolp target) |
| 376 | (if (eq mode 'overwrite) |
| 377 | (set target nil)) |
| 378 | target) |
| 379 | |
| 380 | ((or (eshell-processp target) |
| 381 | (markerp target)) |
| 382 | target) |
| 383 | |
| 384 | (t |
| 385 | (error "Invalid redirection target: %s" |
| 386 | (eshell-stringify target))))) |
| 387 | |
| 388 | (defvar grep-null-device) |
| 389 | |
| 390 | (defun eshell-set-output-handle (index mode &optional target) |
| 391 | "Set handle INDEX, using MODE, to point to TARGET." |
| 392 | (when target |
| 393 | (if (and (stringp target) |
| 394 | (or (cond |
| 395 | ((boundp 'null-device) |
| 396 | (string= target null-device)) |
| 397 | ((boundp 'grep-null-device) |
| 398 | (string= target grep-null-device)) |
| 399 | (t nil)) |
| 400 | (string= target "/dev/null"))) |
| 401 | (aset eshell-current-handles index nil) |
| 402 | (let ((where (eshell-get-target target mode)) |
| 403 | (current (car (aref eshell-current-handles index)))) |
| 404 | (if (and (listp current) |
| 405 | (not (member where current))) |
| 406 | (setq current (append current (list where))) |
| 407 | (setq current (list where))) |
| 408 | (if (not (aref eshell-current-handles index)) |
| 409 | (aset eshell-current-handles index (cons nil 1))) |
| 410 | (setcar (aref eshell-current-handles index) current))))) |
| 411 | |
| 412 | (defun eshell-interactive-output-p () |
| 413 | "Return non-nil if current handles are bound for interactive display." |
| 414 | (and (eq (car (aref eshell-current-handles |
| 415 | eshell-output-handle)) t) |
| 416 | (eq (car (aref eshell-current-handles |
| 417 | eshell-error-handle)) t))) |
| 418 | |
| 419 | (defvar eshell-print-queue nil) |
| 420 | (defvar eshell-print-queue-count -1) |
| 421 | |
| 422 | (defsubst eshell-print (object) |
| 423 | "Output OBJECT to the standard output handle." |
| 424 | (eshell-output-object object eshell-output-handle)) |
| 425 | |
| 426 | (defun eshell-flush (&optional reset-p) |
| 427 | "Flush out any lines that have been queued for printing. |
| 428 | Must be called before printing begins with -1 as its argument, and |
| 429 | after all printing is over with no argument." |
| 430 | (ignore |
| 431 | (if reset-p |
| 432 | (setq eshell-print-queue nil |
| 433 | eshell-print-queue-count reset-p) |
| 434 | (if eshell-print-queue |
| 435 | (eshell-print eshell-print-queue)) |
| 436 | (eshell-flush 0)))) |
| 437 | |
| 438 | (defun eshell-init-print-buffer () |
| 439 | "Initialize the buffered printing queue." |
| 440 | (eshell-flush -1)) |
| 441 | |
| 442 | (defun eshell-buffered-print (&rest strings) |
| 443 | "A buffered print -- *for strings only*." |
| 444 | (if (< eshell-print-queue-count 0) |
| 445 | (progn |
| 446 | (eshell-print (apply 'concat strings)) |
| 447 | (setq eshell-print-queue-count 0)) |
| 448 | (if (= eshell-print-queue-count eshell-print-queue-size) |
| 449 | (eshell-flush)) |
| 450 | (setq eshell-print-queue |
| 451 | (concat eshell-print-queue (apply 'concat strings)) |
| 452 | eshell-print-queue-count (1+ eshell-print-queue-count)))) |
| 453 | |
| 454 | (defsubst eshell-error (object) |
| 455 | "Output OBJECT to the standard error handle." |
| 456 | (eshell-output-object object eshell-error-handle)) |
| 457 | |
| 458 | (defsubst eshell-errorn (object) |
| 459 | "Output OBJECT followed by a newline to the standard error handle." |
| 460 | (eshell-error object) |
| 461 | (eshell-error "\n")) |
| 462 | |
| 463 | (defsubst eshell-printn (object) |
| 464 | "Output OBJECT followed by a newline to the standard output handle." |
| 465 | (eshell-print object) |
| 466 | (eshell-print "\n")) |
| 467 | |
| 468 | (defun eshell-output-object-to-target (object target) |
| 469 | "Insert OBJECT into TARGET. |
| 470 | Returns what was actually sent, or nil if nothing was sent." |
| 471 | (cond |
| 472 | ((functionp target) |
| 473 | (funcall target object)) |
| 474 | |
| 475 | ((symbolp target) |
| 476 | (if (eq target t) ; means "print to display" |
| 477 | (eshell-output-filter nil (eshell-stringify object)) |
| 478 | (if (not (symbol-value target)) |
| 479 | (set target object) |
| 480 | (setq object (eshell-stringify object)) |
| 481 | (if (not (stringp (symbol-value target))) |
| 482 | (set target (eshell-stringify |
| 483 | (symbol-value target)))) |
| 484 | (set target (concat (symbol-value target) object))))) |
| 485 | |
| 486 | ((markerp target) |
| 487 | (if (buffer-live-p (marker-buffer target)) |
| 488 | (with-current-buffer (marker-buffer target) |
| 489 | (let ((moving (= (point) target))) |
| 490 | (save-excursion |
| 491 | (goto-char target) |
| 492 | (unless (stringp object) |
| 493 | (setq object (eshell-stringify object))) |
| 494 | (insert-and-inherit object) |
| 495 | (set-marker target (point-marker))) |
| 496 | (if moving |
| 497 | (goto-char target)))))) |
| 498 | |
| 499 | ((eshell-processp target) |
| 500 | (when (eq (process-status target) 'run) |
| 501 | (unless (stringp object) |
| 502 | (setq object (eshell-stringify object))) |
| 503 | (process-send-string target object))) |
| 504 | |
| 505 | ((consp target) |
| 506 | (apply (car target) object (cdr target)))) |
| 507 | object) |
| 508 | |
| 509 | (defun eshell-output-object (object &optional handle-index handles) |
| 510 | "Insert OBJECT, using HANDLE-INDEX specifically)." |
| 511 | (let ((target (car (aref (or handles eshell-current-handles) |
| 512 | (or handle-index eshell-output-handle))))) |
| 513 | (if (and target (not (listp target))) |
| 514 | (eshell-output-object-to-target object target) |
| 515 | (while target |
| 516 | (eshell-output-object-to-target object (car target)) |
| 517 | (setq target (cdr target)))))) |
| 518 | |
| 519 | ;;; esh-io.el ends here |