lisp/eshell/esh-io.el

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