code.delx.au - gnu-emacs/blob - lisp/eshell/esh-io.el

   1 ;;; esh-io --- I/O management
   2
   3 ;; Copyright (C) 1999, 2000 Free Software Foundation
   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-io)
  23
  24 (eval-when-compile (require 'esh-maint))
  25
  26 (defgroup eshell-io nil
  27   "Eshell's I/O management code provides a scheme for treating many
  28 different kinds of objects -- symbols, files, buffers, etc. -- as
  29 though they were files."
  30   :tag "I/O management"
  31   :group 'eshell)
  32
  33 ;;; Commentary:
  34
  35 ;; At the moment, only output redirection is supported in Eshell.  To
  36 ;; use input redirection, the following syntax will work, assuming
  37 ;; that the command after the pipe is always an external command:
  38 ;;
  39 ;;   cat <file> | <command>
  40 ;;
  41 ;; Otherwise, output redirection and piping are provided in a manner
  42 ;; consistent with most shells.  Therefore, only unique features are
  43 ;; mentioned here.
  44 ;;
  45 ;;;_* Insertion
  46 ;;
  47 ;; To insert at the location of point in a buffer, use '>>>':
  48 ;;
  49 ;;   echo alpha >>> #<buffer *scratch*>;
  50 ;;
  51 ;;;_* Pseudo-devices
  52 ;;
  53 ;; A few pseudo-devices are provided, since Emacs cannot write
  54 ;; directly to a UNIX device file:
  55 ;;
  56 ;;   echo alpha > /dev/null   ; the bit bucket
  57 ;;   echo alpha > /dev/kill   ; set the kill ring
  58 ;;   echo alpha >> /dev/clip  ; append to the clipboard
  59 ;;
  60 ;;;_* Multiple output targets
  61 ;;
  62 ;; Eshell can write to multiple output targets, including pipes.
  63 ;; Example:
  64 ;;
  65 ;;   (+ 1 2) > a > b > c   ; prints number to all three files
  66 ;;   (+ 1 2) > a | wc      ; prints to 'a', and pipes to 'wc'
  67
  68 ;;; User Variables:
  69
  70 (defcustom eshell-io-load-hook '(eshell-io-initialize)
  71   "*A hook that gets run when `eshell-io' is loaded."
  72   :type 'hook
  73   :group 'eshell-io)
  74
  75 (defcustom eshell-number-of-handles 3
  76   "*The number of file handles that eshell supports.
  77 Currently this is standard input, output and error.  But even all of
  78 these Emacs does not currently support with asynchronous processes
  79 \(which is what eshell uses so that you can continue doing work in
  80 other buffers) ."
  81   :type 'integer
  82   :group 'eshell-io)
  83
  84 (defcustom eshell-output-handle 1
  85   "*The index of the standard output handle."
  86   :type 'integer
  87   :group 'eshell-io)
  88
  89 (defcustom eshell-error-handle 2
  90   "*The index of the standard error handle."
  91   :type 'integer
  92   :group 'eshell-io)
  93
  94 (defcustom eshell-buffer-shorthand nil
  95   "*If non-nil, a symbol name can be used for a buffer in redirection.
  96 If nil, redirecting to a buffer requires buffer name syntax.  If this
  97 variable is set, redirection directly to Lisp symbols will be
  98 impossible.
  99
 100 Example:
 101
 102   echo hello > '*scratch*  ; works if `eshell-buffer-shorthand' is t
 103   echo hello > #<buffer *scratch*>  ; always works"
 104   :type 'boolean
 105   :group 'eshell-io)
 106
 107 (defcustom eshell-print-queue-size 5
 108   "*The size of the print queue, for doing buffered printing.
 109 This is basically a speed enhancement, to avoid blocking the Lisp code
 110 from executing while Emacs is redisplaying."
 111   :type 'integer
 112   :group 'eshell-io)
 113
 114 (defcustom eshell-virtual-targets
 115   '(("/dev/eshell" eshell-interactive-print nil)
 116     ("/dev/kill" (lambda (mode)
 117                    (if (eq mode 'overwrite)
 118                        (kill-new ""))
 119                    'eshell-kill-append) t)
 120     ("/dev/clip" (lambda (mode)
 121                    (if (eq mode 'overwrite)
 122                        (let ((x-select-enable-clipboard t))
 123                          (kill-new "")))
 124                    'eshell-clipboard-append) t))
 125   "*Map virtual devices name to Emacs Lisp functions.
 126 If the user specifies any of the filenames above as a redirection
 127 target, the function in the second element will be called.
 128
 129 If the third element is non-nil, the redirection mode is passed as an
 130 argument (which is the symbol `overwrite', `append' or `insert'), and
 131 the function is expected to return another function -- which is the
 132 output function.  Otherwise, the second element itself is the output
 133 function.
 134
 135 The output function is then called repeatedly with a single strings,
 136 with represents success pieces of the output of the command, until nil
 137 is passed, meaning EOF.
 138
 139 NOTE: /dev/null is handled specially as a virtual target, and should
 140 not be added to this variable."
 141   :type '(repeat
 142           (list (string :tag "Target")
 143                 function
 144                 (choice (const :tag "Func returns output-func" t)
 145                         (const :tag "Func is output-func" nil))))
 146   :group 'eshell-io)
 147
 148 (put 'eshell-virtual-targets 'risky-local-variable t)
 149
 150 ;;; Internal Variables:
 151
 152 (defvar eshell-current-handles nil)
 153
 154 (defvar eshell-last-command-status 0
 155   "The exit code from the last command.  0 if successful.")
 156
 157 (defvar eshell-last-command-result nil
 158   "The result of the last command.  Not related to success.")
 159
 160 (defvar eshell-output-file-buffer nil
 161   "If non-nil, the current buffer is a file output buffer.")
 162
 163 (defvar eshell-print-count)
 164 (defvar eshell-current-redirections)
 165
 166 ;;; Functions:
 167
 168 (defun eshell-io-initialize ()
 169   "Initialize the I/O subsystem code."
 170   (make-local-hook 'eshell-parse-argument-hook)
 171   (add-hook 'eshell-parse-argument-hook
 172             'eshell-parse-redirection nil t)
 173   (make-local-variable 'eshell-current-redirections)
 174   (make-local-hook 'eshell-pre-rewrite-command-hook)
 175   (add-hook 'eshell-pre-rewrite-command-hook
 176             'eshell-strip-redirections nil t)
 177   (make-local-hook 'eshell-post-rewrite-command-hook)
 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-int 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   (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    ((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'."
 330   (setq mode (or mode 'insert))
 331   (cond
 332    ((stringp target)
 333     (let ((redir (assoc target eshell-virtual-targets)))
 334      (if redir
 335          (if (nth 2 redir)
 336              (funcall (nth 1 redir) mode)
 337            (nth 1 redir))
 338        (let* ((exists (get-file-buffer target))
 339               (buf (find-file-noselect target t)))
 340          (with-current-buffer buf
 341            (if buffer-read-only
 342                (error "Cannot write to read-only file `%s'" target))
 343            (set (make-local-variable 'eshell-output-file-buffer)
 344                 (if (eq exists buf) 0 t))
 345            (cond ((eq mode 'overwrite)
 346                   (erase-buffer))
 347                  ((eq mode 'append)
 348                   (goto-char (point-max))))
 349            (point-marker))))))
 350    ((or (bufferp target)
 351         (and (boundp 'eshell-buffer-shorthand)
 352              (symbol-value 'eshell-buffer-shorthand)
 353              (symbolp target)))
 354     (let ((buf (if (bufferp target)
 355                    target
 356                  (get-buffer-create
 357                   (symbol-name target)))))
 358       (with-current-buffer buf
 359         (cond ((eq mode 'overwrite)
 360                (erase-buffer))
 361               ((eq mode 'append)
 362                (goto-char (point-max))))
 363         (point-marker))))
 364    ((functionp target)
 365     nil)
 366    ((symbolp target)
 367     (if (eq mode 'overwrite)
 368         (set target nil))
 369     target)
 370    ((or (processp target)
 371         (markerp target))
 372     target)
 373    (t
 374     (error "Illegal redirection target: %s"
 375            (eshell-stringify target)))))
 376
 377 (eval-when-compile
 378   (defvar grep-null-device))
 379
 380 (defun eshell-set-output-handle (index mode &optional target)
 381   "Set handle INDEX, using MODE, to point to TARGET."
 382   (when target
 383     (if (and (stringp target)
 384              (or (cond
 385                   ((boundp 'null-device)
 386                    (string= target null-device))
 387                   ((boundp 'grep-null-device)
 388                    (string= target grep-null-device))
 389                   (t nil))
 390                  (string= target "/dev/null")))
 391         (aset eshell-current-handles index nil)
 392       (let ((where (eshell-get-target target mode))
 393             (current (car (aref eshell-current-handles index))))
 394         (if (and (listp current)
 395                  (not (member where current)))
 396             (setq current (append current (list where)))
 397           (setq current (list where)))
 398         (if (not (aref eshell-current-handles index))
 399             (aset eshell-current-handles index (cons nil 1)))
 400         (setcar (aref eshell-current-handles index) current)))))
 401
 402 (defun eshell-interactive-output-p ()
 403   "Return non-nil if current handles are bound for interactive display."
 404   (and (eq (car (aref eshell-current-handles
 405                       eshell-output-handle)) t)
 406        (eq (car (aref eshell-current-handles
 407                       eshell-error-handle)) t)))
 408
 409 (defvar eshell-print-queue nil)
 410 (defvar eshell-print-queue-count -1)
 411
 412 (defun eshell-flush (&optional reset-p)
 413   "Flush out any lines that have been queued for printing.
 414 Must be called before printing begins with -1 as its argument, and
 415 after all printing is over with no argument."
 416   (ignore
 417    (if reset-p
 418        (setq eshell-print-queue nil
 419              eshell-print-queue-count reset-p)
 420      (if eshell-print-queue
 421          (eshell-print eshell-print-queue))
 422      (eshell-flush 0))))
 423
 424 (defun eshell-init-print-buffer ()
 425   "Initialize the buffered printing queue."
 426   (eshell-flush -1))
 427
 428 (defun eshell-buffered-print (&rest strings)
 429   "A buffered print -- *for strings only*."
 430   (if (< eshell-print-queue-count 0)
 431       (progn
 432         (eshell-print (apply 'concat strings))
 433         (setq eshell-print-queue-count 0))
 434     (if (= eshell-print-queue-count eshell-print-queue-size)
 435         (eshell-flush))
 436     (setq eshell-print-queue
 437           (concat eshell-print-queue (apply 'concat strings))
 438           eshell-print-queue-count (1+ eshell-print-queue-count))))
 439
 440 (defsubst eshell-print (object)
 441   "Output OBJECT to the error handle."
 442   (eshell-output-object object eshell-output-handle))
 443
 444 (defsubst eshell-error (object)
 445   "Output OBJECT to the error handle."
 446   (eshell-output-object object eshell-error-handle))
 447
 448 (defsubst eshell-errorn (object)
 449   "Output OBJECT to the error handle."
 450   (eshell-error object)
 451   (eshell-error "\n"))
 452
 453 (defsubst eshell-printn (object)
 454   "Output OBJECT to the error handle."
 455   (eshell-print object)
 456   (eshell-print "\n"))
 457
 458 (defun eshell-output-object-to-target (object target)
 459   "Insert OBJECT into TARGET.
 460 Returns what was actually sent, or nil if nothing was sent."
 461   (cond
 462    ((functionp target)
 463     (funcall target object))
 464
 465    ((symbolp target)
 466     (if (eq target t)                   ; means "print to display"
 467         (eshell-output-filter nil (eshell-stringify object))
 468       (if (not (symbol-value target))
 469           (set target object)
 470         (setq object (eshell-stringify object))
 471         (if (not (stringp (symbol-value target)))
 472             (set target (eshell-stringify
 473                          (symbol-value target))))
 474         (set target (concat (symbol-value target) object)))))
 475
 476    ((markerp target)
 477     (if (buffer-live-p (marker-buffer target))
 478         (with-current-buffer (marker-buffer target)
 479           (let ((moving (= (point) target)))
 480             (save-excursion
 481               (goto-char target)
 482               (setq object (eshell-stringify object))
 483               (insert-and-inherit object)
 484               (set-marker target (point-marker)))
 485             (if moving
 486                 (goto-char target))))))
 487
 488    ((processp target)
 489     (when (eq (process-status target) 'run)
 490       (setq object (eshell-stringify object))
 491       (process-send-string target object)))
 492
 493    ((consp target)
 494     (apply (car target) object (cdr target))))
 495   object)
 496
 497 (defun eshell-output-object (object &optional handle-index handles)
 498   "Insert OBJECT, using HANDLE-INDEX specifically)."
 499   (let ((target (car (aref (or handles eshell-current-handles)
 500                            (or handle-index eshell-output-handle)))))
 501     (if (and target (not (listp target)))
 502         (eshell-output-object-to-target object target)
 503       (while target
 504         (eshell-output-object-to-target object (car target))
 505         (setq target (cdr target))))))
 506
 507 ;;; Code:
 508
 509 ;;; esh-io.el ends here