lisp/eshell/esh-io.el

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