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

   1 ;;; esh-io.el --- I/O management  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 1999-2015 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 ((gui-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-function :filter-return (local 'eshell-post-rewrite-command-function)
 183                 #'eshell--apply-redirections))
 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 (cmd)
 227   "Apply any redirection which were specified for COMMAND."
 228   (if eshell-current-redirections
 229       `(progn
 230          ,@eshell-current-redirections
 231          ,cmd)
 232     cmd))
 233
 234 (defun eshell-create-handles
 235   (stdout output-mode &optional stderr 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 STDOUT and STDERR, 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 stdout output-mode))
 243         (error-target (eshell-get-target stderr error-mode)))
 244     (aset handles eshell-output-handle (cons output-target 1))
 245     (aset handles eshell-error-handle
 246           (cons (if stderr error-target output-target) 1))
 247     handles))
 248
 249 (defun eshell-protect-handles (handles)
 250   "Protect the handles in HANDLES from a being closed."
 251   (let ((idx 0))
 252     (while (< idx eshell-number-of-handles)
 253       (if (aref handles idx)
 254           (setcdr (aref handles idx)
 255                   (1+ (cdr (aref handles idx)))))
 256       (setq idx (1+ idx))))
 257   handles)
 258
 259 (defun eshell-close-target (target status)
 260   "Close an output TARGET, passing STATUS as the result.
 261 STATUS should be non-nil on successful termination of the output."
 262   (cond
 263    ((symbolp target) nil)
 264
 265    ;; If we were redirecting to a file, save the file and close the
 266    ;; buffer.
 267    ((markerp target)
 268     (let ((buf (marker-buffer target)))
 269       (when buf                         ; somebody's already killed it!
 270         (save-current-buffer
 271           (set-buffer buf)
 272           (when eshell-output-file-buffer
 273             (save-buffer)
 274             (when (eq eshell-output-file-buffer t)
 275               (or status (set-buffer-modified-p nil))
 276               (kill-buffer buf)))))))
 277
 278    ;; If we're redirecting to a process (via a pipe, or process
 279    ;; redirection), send it EOF so that it knows we're finished.
 280    ((eshell-processp target)
 281     (if (eq (process-status target) 'run)
 282         (process-send-eof target)))
 283
 284    ;; A plain function redirection needs no additional arguments
 285    ;; passed.
 286    ((functionp target)
 287     (funcall target status))
 288
 289    ;; But a more complicated function redirection (which can only
 290    ;; happen with aliases at the moment) has arguments that need to be
 291    ;; passed along with it.
 292    ((consp target)
 293     (apply (car target) status (cdr target)))))
 294
 295 (defun eshell-close-handles (exit-code &optional result handles)
 296   "Close all of the current handles, taking refcounts into account.
 297 EXIT-CODE is the process exit code; mainly, it is zero, if the command
 298 completed successfully.  RESULT is the quoted value of the last
 299 command.  If nil, then the meta variables for keeping track of the
 300 last execution result should not be changed."
 301   (let ((idx 0))
 302     (cl-assert (or (not result) (eq (car result) 'quote)))
 303     (setq eshell-last-command-status exit-code
 304           eshell-last-command-result (cadr result))
 305     (while (< idx eshell-number-of-handles)
 306       (let ((handles (or handles eshell-current-handles)))
 307         (when (aref handles idx)
 308           (setcdr (aref handles idx)
 309                   (1- (cdr (aref handles idx))))
 310           (when (= (cdr (aref handles idx)) 0)
 311             (let ((target (car (aref handles idx))))
 312               (if (not (listp target))
 313                   (eshell-close-target target (= exit-code 0))
 314                 (while target
 315                   (eshell-close-target (car target) (= exit-code 0))
 316                   (setq target (cdr target)))))
 317             (setcar (aref handles idx) nil))))
 318       (setq idx (1+ idx)))
 319     nil))
 320
 321 (defun eshell-kill-append (string)
 322   "Call `kill-append' with STRING, if it is indeed a string."
 323   (if (stringp string)
 324       (kill-append string nil)))
 325
 326 (defun eshell-clipboard-append (string)
 327   "Call `kill-append' with STRING, if it is indeed a string."
 328   (if (stringp string)
 329       (let ((gui-select-enable-clipboard t))
 330         (kill-append string nil))))
 331
 332 (defun eshell-get-target (target &optional mode)
 333   "Convert TARGET, which is a raw argument, into a valid output target.
 334 MODE is either `overwrite', `append' or `insert'; if it is omitted or nil,
 335 it defaults to `insert'."
 336   (setq mode (or mode 'insert))
 337   (cond
 338    ((stringp target)
 339     (let ((redir (assoc target eshell-virtual-targets)))
 340       (if redir
 341           (if (nth 2 redir)
 342               (funcall (nth 1 redir) mode)
 343             (nth 1 redir))
 344         (let* ((exists (get-file-buffer target))
 345                (buf (find-file-noselect target t)))
 346           (with-current-buffer buf
 347             (if buffer-file-read-only
 348                 (error "Cannot write to read-only file `%s'" target))
 349             (setq buffer-read-only nil)
 350             (set (make-local-variable 'eshell-output-file-buffer)
 351                  (if (eq exists buf) 0 t))
 352             (cond ((eq mode 'overwrite)
 353                    (erase-buffer))
 354                   ((eq mode 'append)
 355                    (goto-char (point-max))))
 356             (point-marker))))))
 357
 358    ((or (bufferp target)
 359         (and (boundp 'eshell-buffer-shorthand)
 360              (symbol-value 'eshell-buffer-shorthand)
 361              (symbolp target)
 362              (not (memq target '(t nil)))))
 363     (let ((buf (if (bufferp target)
 364                    target
 365                  (get-buffer-create
 366                   (symbol-name target)))))
 367       (with-current-buffer buf
 368         (cond ((eq mode 'overwrite)
 369                (erase-buffer))
 370               ((eq mode 'append)
 371                (goto-char (point-max))))
 372         (point-marker))))
 373
 374    ((functionp target) nil)
 375
 376    ((symbolp target)
 377     (if (eq mode 'overwrite)
 378         (set target nil))
 379     target)
 380
 381    ((or (eshell-processp target)
 382         (markerp target))
 383     target)
 384
 385    (t
 386     (error "Invalid redirection target: %s"
 387            (eshell-stringify target)))))
 388
 389 (defvar grep-null-device)
 390
 391 (defun eshell-set-output-handle (index mode &optional target)
 392   "Set handle INDEX, using MODE, to point to TARGET."
 393   (when target
 394     (if (and (stringp target)
 395              (or (cond
 396                   ((boundp 'null-device)
 397                    (string= target null-device))
 398                   ((boundp 'grep-null-device)
 399                    (string= target grep-null-device))
 400                   (t nil))
 401                  (string= target "/dev/null")))
 402         (aset eshell-current-handles index nil)
 403       (let ((where (eshell-get-target target mode))
 404             (current (car (aref eshell-current-handles index))))
 405         (if (and (listp current)
 406                  (not (member where current)))
 407             (setq current (append current (list where)))
 408           (setq current (list where)))
 409         (if (not (aref eshell-current-handles index))
 410             (aset eshell-current-handles index (cons nil 1)))
 411         (setcar (aref eshell-current-handles index) current)))))
 412
 413 (defun eshell-interactive-output-p ()
 414   "Return non-nil if current handles are bound for interactive display."
 415   (and (eq (car (aref eshell-current-handles
 416                       eshell-output-handle)) t)
 417        (eq (car (aref eshell-current-handles
 418                       eshell-error-handle)) t)))
 419
 420 (defvar eshell-print-queue nil)
 421 (defvar eshell-print-queue-count -1)
 422
 423 (defsubst eshell-print (object)
 424   "Output OBJECT to the standard output handle."
 425   (eshell-output-object object eshell-output-handle))
 426
 427 (defun eshell-flush (&optional reset-p)
 428   "Flush out any lines that have been queued for printing.
 429 Must be called before printing begins with -1 as its argument, and
 430 after all printing is over with no argument."
 431   (ignore
 432    (if reset-p
 433        (setq eshell-print-queue nil
 434              eshell-print-queue-count reset-p)
 435      (if eshell-print-queue
 436          (eshell-print eshell-print-queue))
 437      (eshell-flush 0))))
 438
 439 (defun eshell-init-print-buffer ()
 440   "Initialize the buffered printing queue."
 441   (eshell-flush -1))
 442
 443 (defun eshell-buffered-print (&rest strings)
 444   "A buffered print -- *for strings only*."
 445   (if (< eshell-print-queue-count 0)
 446       (progn
 447         (eshell-print (apply 'concat strings))
 448         (setq eshell-print-queue-count 0))
 449     (if (= eshell-print-queue-count eshell-print-queue-size)
 450         (eshell-flush))
 451     (setq eshell-print-queue
 452           (concat eshell-print-queue (apply 'concat strings))
 453           eshell-print-queue-count (1+ eshell-print-queue-count))))
 454
 455 (defsubst eshell-error (object)
 456   "Output OBJECT to the standard error handle."
 457   (eshell-output-object object eshell-error-handle))
 458
 459 (defsubst eshell-errorn (object)
 460   "Output OBJECT followed by a newline to the standard error handle."
 461   (eshell-error object)
 462   (eshell-error "\n"))
 463
 464 (defsubst eshell-printn (object)
 465   "Output OBJECT followed by a newline to the standard output handle."
 466   (eshell-print object)
 467   (eshell-print "\n"))
 468
 469 (autoload 'eshell-output-filter "esh-mode")
 470
 471 (defun eshell-output-object-to-target (object target)
 472   "Insert OBJECT into TARGET.
 473 Returns what was actually sent, or nil if nothing was sent."
 474   (cond
 475    ((functionp target)
 476     (funcall target object))
 477
 478    ((symbolp target)
 479     (if (eq target t)                   ; means "print to display"
 480         (eshell-output-filter nil (eshell-stringify object))
 481       (if (not (symbol-value target))
 482           (set target object)
 483         (setq object (eshell-stringify object))
 484         (if (not (stringp (symbol-value target)))
 485             (set target (eshell-stringify
 486                          (symbol-value target))))
 487         (set target (concat (symbol-value target) object)))))
 488
 489    ((markerp target)
 490     (if (buffer-live-p (marker-buffer target))
 491         (with-current-buffer (marker-buffer target)
 492           (let ((moving (= (point) target)))
 493             (save-excursion
 494               (goto-char target)
 495               (unless (stringp object)
 496                 (setq object (eshell-stringify object)))
 497               (insert-and-inherit object)
 498               (set-marker target (point-marker)))
 499             (if moving
 500                 (goto-char target))))))
 501
 502    ((eshell-processp target)
 503     (when (eq (process-status target) 'run)
 504       (unless (stringp object)
 505         (setq object (eshell-stringify object)))
 506       (process-send-string target object)))
 507
 508    ((consp target)
 509     (apply (car target) object (cdr target))))
 510   object)
 511
 512 (defun eshell-output-object (object &optional handle-index handles)
 513   "Insert OBJECT, using HANDLE-INDEX specifically)."
 514   (let ((target (car (aref (or handles eshell-current-handles)
 515                            (or handle-index eshell-output-handle)))))
 516     (if (and target (not (listp target)))
 517         (eshell-output-object-to-target object target)
 518       (while target
 519         (eshell-output-object-to-target object (car target))
 520         (setq target (cdr target))))))
 521
 522 ;;; esh-io.el ends here