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

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