lisp/eshell/esh-io.el

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