diff options
Diffstat (limited to 'lisp/eshell/esh-io.el')
| -rw-r--r-- | lisp/eshell/esh-io.el | 494 |
1 files changed, 276 insertions, 218 deletions
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 1c3262aa49d..4487389bf26 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -74,6 +74,8 @@ (eval-when-compile (require 'cl-lib)) +(declare-function eshell-interactive-print "esh-mode" (string)) + (defgroup eshell-io nil "Eshell's I/O management code provides a scheme for treating many different kinds of objects -- symbols, files, buffers, etc. -- as @@ -116,16 +118,22 @@ from executing while Emacs is redisplaying." :group 'eshell-io) (defcustom eshell-virtual-targets - '(("/dev/eshell" eshell-interactive-print nil) + '(;; The literal string "/dev/null" is intentional here. It just + ;; provides compatibility so that users can redirect to + ;; "/dev/null" no matter the actual value of `null-device'. + ("/dev/null" (lambda (_mode) (throw 'eshell-null-device t)) t) + ("/dev/eshell" eshell-interactive-print nil) ("/dev/kill" (lambda (mode) - (if (eq mode 'overwrite) - (kill-new "")) - 'eshell-kill-append) t) + (when (eq mode 'overwrite) + (kill-new "")) + #'eshell-kill-append) + t) ("/dev/clip" (lambda (mode) - (if (eq mode 'overwrite) - (let ((select-enable-clipboard t)) - (kill-new ""))) - 'eshell-clipboard-append) t)) + (when (eq mode 'overwrite) + (let ((select-enable-clipboard t)) + (kill-new ""))) + #'eshell-clipboard-append) + t)) "Map virtual devices name to Emacs Lisp functions. If the user specifies any of the filenames above as a redirection target, the function in the second element will be called. @@ -138,10 +146,8 @@ function. The output function is then called repeatedly with single strings, which represents successive pieces of the output of the command, until nil -is passed, meaning EOF. - -NOTE: /dev/null is handled specially as a virtual target, and should -not be added to this variable." +is passed, meaning EOF." + :version "30.1" :type '(repeat (list (string :tag "Target") function @@ -164,7 +170,7 @@ describing the mode, e.g. for using with `eshell-get-target'.") (defvar eshell-current-handles nil) -(defvar eshell-last-command-status 0 +(defvar-local eshell-last-command-status 0 "The exit code from the last command. 0 if successful.") (defvar eshell-last-command-result nil @@ -190,7 +196,8 @@ describing the mode, e.g. for using with `eshell-get-target'.") (defun eshell-parse-redirection () "Parse an output redirection, such as `2>' or `>&'." - (when (not eshell-current-quoted) + (unless (or eshell-current-quoted + eshell-current-argument-plain) (cond ;; Copying a handle (e.g. `2>&1'). ((looking-at (rx (? (group digit)) @@ -291,25 +298,58 @@ describing the mode, e.g. for using with `eshell-get-target'.") (defun eshell-create-handles (stdout output-mode &optional stderr error-mode) "Create a new set of file handles for a command. -The default location for standard output and standard error will go to -STDOUT and STDERR, respectively. -OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert'; -a nil value of mode defaults to `insert'." +The default target for standard output and standard error will +go to STDOUT and STDERR, respectively. OUTPUT-MODE and +ERROR-MODE are either `overwrite', `append' or `insert'; a nil +value of mode defaults to `insert'. + +The result is a vector of file handles. Each handle is of the form: + + ((TARGETS . REF-COUNT) DEFAULT) + +TARGETS is a list of destinations for output. REF-COUNT is the +number of references to this handle (initially 1); see +`eshell-protect-handles' and `eshell-close-handles'. DEFAULT is +non-nil if handle has its initial default value (always t after +calling this function)." (let* ((handles (make-vector eshell-number-of-handles nil)) - (output-target (eshell-get-target stdout output-mode)) - (error-target (if stderr - (eshell-get-target stderr error-mode) - output-target))) - (aset handles eshell-output-handle (cons output-target 1)) - (aset handles eshell-error-handle (cons error-target 1)) + (output-target + (let ((target (eshell-get-target stdout output-mode))) + (cons (when target (list target)) 1))) + (error-target + (if stderr + (let ((target (eshell-get-target stderr error-mode))) + (cons (when target (list target)) 1)) + (cl-incf (cdr output-target)) + output-target))) + (aset handles eshell-output-handle (list output-target t)) + (aset handles eshell-error-handle (list error-target t)) handles)) +(defun eshell-duplicate-handles (handles &optional steal-p) + "Create a duplicate of the file handles in HANDLES. +This uses the targets of each handle in HANDLES, incrementing its +reference count by one (unless STEAL-P is non-nil). These +targets are shared between the original set of handles and the +new one, so the targets are only closed when the reference count +drops to 0 (see `eshell-close-handles'). + +This function also sets the DEFAULT field for each handle to +t (see `eshell-create-handles'). Unlike the targets, this value +is not shared with the original handles." + (let ((dup-handles (make-vector eshell-number-of-handles nil))) + (dotimes (idx eshell-number-of-handles) + (when-let ((handle (aref handles idx))) + (unless steal-p + (cl-incf (cdar handle))) + (aset dup-handles idx (list (car handle) t)))) + dup-handles)) + (defun eshell-protect-handles (handles) "Protect the handles in HANDLES from a being closed." (dotimes (idx eshell-number-of-handles) - (when (aref handles idx) - (setcdr (aref handles idx) - (1+ (cdr (aref handles idx)))))) + (when-let ((handle (aref handles idx))) + (cl-incf (cdar handle)))) handles) (defun eshell-close-handles (&optional exit-code result handles) @@ -327,46 +367,56 @@ the value already set in `eshell-last-command-result'." (when result (cl-assert (eq (car result) 'quote)) (setq eshell-last-command-result (cadr result))) - (let ((handles (or handles eshell-current-handles))) + (let ((handles (or handles eshell-current-handles)) + (succeeded (= eshell-last-command-status 0))) (dotimes (idx eshell-number-of-handles) - (when-let ((handle (aref handles idx))) - (setcdr handle (1- (cdr handle))) - (when (= (cdr handle) 0) - (dolist (target (ensure-list (car (aref handles idx)))) - (eshell-close-target target (= eshell-last-command-status 0))) - (setcar handle nil)))))) + (eshell-close-handle (aref handles idx) succeeded)))) + +(defun eshell-close-handle (handle status) + "Close a single HANDLE, taking refcounts into account. +This will pass STATUS to each target for the handle, which should +be a non-nil value on successful termination." + (when handle + (cl-assert (> (cdar handle) 0) + "Attempted to close a handle with 0 references") + (when (and (> (cdar handle) 0) + (= (cl-decf (cdar handle)) 0)) + (dolist (target (caar handle)) + (eshell-close-target target status)) + (setcar (car handle) nil)))) (defun eshell-set-output-handle (index mode &optional target handles) "Set handle INDEX for the current HANDLES to point to TARGET using MODE. -If HANDLES is nil, use `eshell-current-handles'." +If HANDLES is nil, use `eshell-current-handles'. + +If the handle is currently set to its default value (see +`eshell-create-handles'), this will overwrite the targets with +the new target. Otherwise, it will append the new target to the +current list of targets." (when target - (let ((handles (or handles eshell-current-handles))) - (if (and (stringp target) - ;; The literal string "/dev/null" is intentional here. - ;; It just provides compatibility so that users can - ;; redirect to "/dev/null" no matter the actual value - ;; of `null-device'. - (string= target "/dev/null")) - (aset handles index nil) - (let ((where (eshell-get-target target mode)) - (current (car (aref handles index)))) - (if (listp current) - (unless (member where current) - (setq current (append current (list where)))) - (setq current (list where))) - (if (not (aref handles index)) - (aset handles index (cons nil 1))) - (setcar (aref handles index) current)))))) + (let* ((handles (or handles eshell-current-handles)) + (handle (or (aref handles index) + (aset handles index (list (cons nil 1) nil)))) + (defaultp (cadr handle))) + (when defaultp + (cl-decf (cdar handle)) + (setcar handle (cons nil 1))) + (catch 'eshell-null-device + (let ((current (caar handle)) + (where (eshell-get-target target mode))) + (unless (member where current) + (setcar (car handle) (append current (list where)))))) + (setcar (cdr handle) nil)))) (defun eshell-copy-output-handle (index index-to-copy &optional handles) "Copy the handle INDEX-TO-COPY to INDEX for the current HANDLES. If HANDLES is nil, use `eshell-current-handles'." (let* ((handles (or handles eshell-current-handles)) (handle-to-copy (car (aref handles index-to-copy)))) - (setcar (aref handles index) - (if (listp handle-to-copy) - (copy-sequence handle-to-copy) - handle-to-copy)))) + (when handle-to-copy + (cl-incf (cdr handle-to-copy))) + (eshell-close-handle (aref handles index) nil) + (setcar (aref handles index) handle-to-copy))) (defun eshell-set-all-output-handles (mode &optional target handles) "Set output and error HANDLES to point to TARGET using MODE. @@ -374,57 +424,6 @@ If HANDLES is nil, use `eshell-current-handles'." (eshell-set-output-handle eshell-output-handle mode target handles) (eshell-copy-output-handle eshell-error-handle eshell-output-handle handles)) -(defun eshell-close-target (target status) - "Close an output TARGET, passing STATUS as the result. -STATUS should be non-nil on successful termination of the output." - (cond - ((symbolp target) nil) - - ;; If we were redirecting to a file, save the file and close the - ;; buffer. - ((markerp target) - (let ((buf (marker-buffer target))) - (when buf ; somebody's already killed it! - (save-current-buffer - (set-buffer buf) - (when eshell-output-file-buffer - (save-buffer) - (when (eq eshell-output-file-buffer t) - (or status (set-buffer-modified-p nil)) - (kill-buffer buf))))))) - - ;; If we're redirecting to a process (via a pipe, or process - ;; redirection), send it EOF so that it knows we're finished. - ((eshell-processp target) - ;; According to POSIX.1-2017, section 11.1.9, when communicating - ;; via terminal, sending EOF causes all bytes waiting to be read - ;; to be sent to the process immediately. Thus, if there are any - ;; bytes waiting, we need to send EOF twice: once to flush the - ;; buffer, and a second time to cause the next read() to return a - ;; size of 0, indicating end-of-file to the reading process. - ;; However, some platforms (e.g. Solaris) actually require sending - ;; a *third* EOF. Since sending extra EOFs while the process is - ;; running are a no-op, we'll just send the maximum we'd ever - ;; need. See bug#56025 for further details. - (let ((i 0) - ;; Only call `process-send-eof' once if communicating via a - ;; pipe (in truth, this just closes the pipe). - (max-attempts (if (process-tty-name target 'stdin) 3 1))) - (while (and (<= (cl-incf i) max-attempts) - (eq (process-status target) 'run)) - (process-send-eof target)))) - - ;; A plain function redirection needs no additional arguments - ;; passed. - ((functionp target) - (funcall target status)) - - ;; But a more complicated function redirection (which can only - ;; happen with aliases at the moment) has arguments that need to be - ;; passed along with it. - ((consp target) - (apply (car target) status (cdr target))))) - (defun eshell-kill-append (string) "Call `kill-append' with STRING, if it is indeed a string." (if (stringp string) @@ -436,56 +435,6 @@ STATUS should be non-nil on successful termination of the output." (let ((select-enable-clipboard t)) (kill-append string nil)))) -(defun eshell-get-target (target &optional mode) - "Convert TARGET, which is a raw argument, into a valid output target. -MODE is either `overwrite', `append' or `insert'; if it is omitted or nil, -it defaults to `insert'." - (setq mode (or mode 'insert)) - (cond - ((stringp target) - (let ((redir (assoc target eshell-virtual-targets))) - (if redir - (if (nth 2 redir) - (funcall (nth 1 redir) mode) - (nth 1 redir)) - (let* ((exists (get-file-buffer target)) - (buf (find-file-noselect target t))) - (with-current-buffer buf - (if buffer-file-read-only - (error "Cannot write to read-only file `%s'" target)) - (setq buffer-read-only nil) - (setq-local eshell-output-file-buffer - (if (eq exists buf) 0 t)) - (cond ((eq mode 'overwrite) - (erase-buffer)) - ((eq mode 'append) - (goto-char (point-max)))) - (point-marker)))))) - - - ((bufferp target) - (with-current-buffer target - (cond ((eq mode 'overwrite) - (erase-buffer)) - ((eq mode 'append) - (goto-char (point-max)))) - (point-marker))) - - ((functionp target) nil) - - ((symbolp target) - (if (eq mode 'overwrite) - (set target nil)) - target) - - ((or (eshell-processp target) - (markerp target)) - target) - - (t - (error "Invalid redirection target: %s" - (eshell-stringify target))))) - (defun eshell-interactive-output-p (&optional index handles) "Return non-nil if the specified handle is bound for interactive display. HANDLES is the set of handles to check; if nil, use @@ -497,9 +446,9 @@ INDEX is the handle index to check. If nil, check (let ((handles (or handles eshell-current-handles)) (index (or index eshell-output-handle))) (if (eq index 'all) - (and (eq (car (aref handles eshell-output-handle)) t) - (eq (car (aref handles eshell-error-handle)) t)) - (eq (car (aref handles index)) t)))) + (and (equal (caar (aref handles eshell-output-handle)) '(t)) + (equal (caar (aref handles eshell-error-handle)) '(t))) + (equal (caar (aref handles index)) '(t))))) (defvar eshell-print-queue nil) (defvar eshell-print-queue-count -1) @@ -550,71 +499,180 @@ after all printing is over with no argument." (eshell-print object) (eshell-print "\n")) -(autoload 'eshell-output-filter "esh-mode") - -(defun eshell-output-object-to-target (object target) - "Insert OBJECT into TARGET. -Returns what was actually sent, or nil if nothing was sent." - (cond - ((functionp target) - (funcall target object)) - - ((symbolp target) - (if (eq target t) ; means "print to display" - (eshell-output-filter nil (eshell-stringify object)) - (if (not (symbol-value target)) - (set target object) - (setq object (eshell-stringify object)) - (if (not (stringp (symbol-value target))) - (set target (eshell-stringify - (symbol-value target)))) - (set target (concat (symbol-value target) object))))) - - ((markerp target) - (if (buffer-live-p (marker-buffer target)) - (with-current-buffer (marker-buffer target) - (let ((moving (= (point) target))) - (save-excursion - (goto-char target) - (unless (stringp object) - (setq object (eshell-stringify object))) - (insert-and-inherit object) - (set-marker target (point-marker))) - (if moving - (goto-char target)))))) - - ((eshell-processp target) - (unless (stringp object) - (setq object (eshell-stringify object))) - (condition-case err - (process-send-string target object) - (error - ;; If `process-send-string' raises an error and the process has - ;; finished, treat it as a broken pipe. Otherwise, just - ;; re-throw the signal. - (if (memq (process-status target) - '(run stop open closed)) - (signal (car err) (cdr err)) - (signal 'eshell-pipe-broken (list target)))))) - - ((consp target) - (apply (car target) object (cdr target)))) +(cl-defstruct (eshell-virtual-target + (:constructor nil) + (:constructor eshell-virtual-target-create (output-function))) + "A virtual target (see `eshell-virtual-targets')." + output-function) + +(cl-defgeneric eshell-get-target (raw-target &optional _mode) + "Convert RAW-TARGET, which is a raw argument, into a valid output target. +MODE is either `overwrite', `append' or `insert'; if it is omitted or nil, +it defaults to `insert'." + (error "Invalid redirection target: %s" (eshell-stringify raw-target))) + +(cl-defmethod eshell-get-target ((raw-target string) &optional mode) + "Convert a string RAW-TARGET into a valid output target using MODE. +If TARGET is a virtual target (see `eshell-virtual-targets'), +return an `eshell-virtual-target' instance; otherwise, return a +marker for a file named TARGET." + (setq mode (or mode 'insert)) + (if-let ((redir (assoc raw-target eshell-virtual-targets))) + (eshell-virtual-target-create + (if (nth 2 redir) + (funcall (nth 1 redir) mode) + (nth 1 redir))) + (let ((exists (get-file-buffer raw-target)) + (buf (find-file-noselect raw-target t))) + (with-current-buffer buf + (when buffer-file-read-only + (error "Cannot write to read-only file `%s'" raw-target)) + (setq buffer-read-only nil) + (setq-local eshell-output-file-buffer + (if (eq exists buf) 0 t)) + (cond ((eq mode 'overwrite) + (erase-buffer)) + ((eq mode 'append) + (goto-char (point-max)))) + (point-marker))))) + +(cl-defmethod eshell-get-target ((raw-target buffer) &optional mode) + "Convert a buffer RAW-TARGET into a valid output target using MODE. +This returns a marker for that buffer." + (with-current-buffer raw-target + (cond ((eq mode 'overwrite) + (erase-buffer)) + ((eq mode 'append) + (goto-char (point-max)))) + (point-marker))) + +(cl-defmethod eshell-get-target ((raw-target symbol) &optional mode) + "Convert a symbol RAW-TARGET into a valid output target using MODE. +This returns RAW-TARGET, with its value initialized to nil if MODE is +`overwrite'." + (when (eq mode 'overwrite) + (set raw-target nil)) + raw-target) + +(cl-defmethod eshell-get-target ((raw-target process) &optional _mode) + "Convert a process RAW-TARGET into a valid output target. +This just returns RAW-TARGET." + raw-target) + +(cl-defmethod eshell-get-target ((raw-target marker) &optional _mode) + "Convert a marker RAW-TARGET into a valid output target. +This just returns RAW-TARGET." + raw-target) + +(cl-defgeneric eshell-close-target (target status) + "Close an output TARGET, passing STATUS as the result. +STATUS should be non-nil on successful termination of the output.") + +(cl-defmethod eshell-close-target ((_target symbol) _status) + "Close a symbol TARGET." + nil) + +(cl-defmethod eshell-close-target ((target marker) status) + "Close a marker TARGET. +If TARGET was created from a file name, save and kill the buffer. +If status is nil, prompt before killing." + (when (buffer-live-p (marker-buffer target)) + (with-current-buffer (marker-buffer target) + (when eshell-output-file-buffer + (save-buffer) + (when (eq eshell-output-file-buffer t) + (or status (set-buffer-modified-p nil)) + (kill-buffer)))))) + +(cl-defmethod eshell-close-target ((target process) _status) + "Close a process TARGET." + ;; According to POSIX.1-2017, section 11.1.9, when communicating via + ;; terminal, sending EOF causes all bytes waiting to be read to be + ;; sent to the process immediately. Thus, if there are any bytes + ;; waiting, we need to send EOF twice: once to flush the buffer, and + ;; a second time to cause the next read() to return a size of 0, + ;; indicating end-of-file to the reading process. However, some + ;; platforms (e.g. Solaris) actually require sending a *third* EOF. + ;; Since sending extra EOFs to a running process is a no-op, we'll + ;; just send the maximum we'd ever need. See bug#56025 for further + ;; details. + (catch 'done + (dotimes (_ (if (process-tty-name target 'stdin) 3 1)) + (unless (process-live-p target) + (throw 'done nil)) + (process-send-eof target)))) + +(cl-defmethod eshell-close-target ((_target eshell-virtual-target) _status) + "Close a virtual TARGET." + nil) + +(cl-defgeneric eshell-output-object-to-target (object target) + "Output OBJECT to TARGET. +Returns what was actually sent, or nil if nothing was sent.") + +(cl-defmethod eshell-output-object-to-target (object (_target (eql t))) + "Output OBJECT to the display." + (setq object (eshell-stringify object)) + (eshell-interactive-print object)) + +(cl-defmethod eshell-output-object-to-target (object (target symbol)) + "Output OBJECT to the value of the symbol TARGET." + (if (not (symbol-value target)) + (set target object) + (setq object (eshell-stringify object)) + (if (not (stringp (symbol-value target))) + (set target (eshell-stringify + (symbol-value target)))) + (set target (concat (symbol-value target) object))) + object) + +(cl-defmethod eshell-output-object-to-target (object (target marker)) + "Output OBJECT to the marker TARGET." + (when (buffer-live-p (marker-buffer target)) + (with-current-buffer (marker-buffer target) + (let ((moving (= (point) target))) + (save-excursion + (goto-char target) + (unless (stringp object) + (setq object (eshell-stringify object))) + (insert-and-inherit object) + (set-marker target (point-marker))) + (when moving + (goto-char target))))) object) +(cl-defmethod eshell-output-object-to-target (object (target process)) + "Output OBJECT to the process TARGET." + (unless (stringp object) + (setq object (eshell-stringify object))) + (condition-case err + (process-send-string target object) + (error + ;; If `process-send-string' raises an error and the process has + ;; finished, treat it as a broken pipe. Otherwise, just re-raise + ;; the signal. NOTE: When running Emacs in batch mode + ;; (e.g. during regression tests), Emacs can abort due to SIGPIPE + ;; here. Maybe `process-send-string' should handle SIGPIPE even + ;; in batch mode (bug#66186). + (if (process-live-p target) + (signal (car err) (cdr err)) + (signal 'eshell-pipe-broken (list target))))) + object) + +(cl-defmethod eshell-output-object-to-target (object + (target eshell-virtual-target)) + "Output OBJECT to the virtual TARGET." + (funcall (eshell-virtual-target-output-function target) object)) + (defun eshell-output-object (object &optional handle-index handles) "Insert OBJECT, using HANDLE-INDEX specifically. If HANDLE-INDEX is nil, output to `eshell-output-handle'. HANDLES is the set of file handles to use; if nil, use `eshell-current-handles'." - (let ((target (car (aref (or handles eshell-current-handles) - (or handle-index eshell-output-handle))))) - (if (listp target) - (while target - (eshell-output-object-to-target object (car target)) - (setq target (cdr target))) - (eshell-output-object-to-target object target) - ;; Explicitly return nil to match the list case above. - nil))) + (let ((targets (caar (aref (or handles eshell-current-handles) + (or handle-index eshell-output-handle))))) + (dolist (target targets) + (eshell-output-object-to-target object target)))) (provide 'esh-io) ;;; esh-io.el ends here |