* bug#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets
@ 2023-08-19 0:48 Jim Porter
2023-08-21 18:47 ` Jim Porter
0 siblings, 1 reply; 2+ messages in thread
From: Jim Porter @ 2023-08-19 0:48 UTC (permalink / raw)
To: 65374
[-- Attachment #1: Type: text/plain, Size: 559 bytes --]
The attached patches split up the Eshell I/O target code so that each
target type is its own method. Aside from fixing a couple tiny bugs,
this should be exactly the same as before, but will make it easier to
add new target types in the future (and for third-parties to be able to
do this!).
This won't have any major impact just yet, but it's a very helpful
precursor to a larger project I'm working on to pipe output in Eshell
into Lisp functions (currently, Lisp functions - including Eshell
builtins - can only be the first command in a pipeline).
[-- Attachment #2: 0001-Remove-unused-Eshell-target-type.patch --]
[-- Type: text/plain, Size: 1658 bytes --]
From c2ef3c2a231b55fd3427f37c8f922bae3f780372 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sat, 11 Mar 2023 15:37:38 -0800
Subject: [PATCH 1/3] ; Remove unused Eshell target type
Eshell creates all output targets in 'eshell-get-target', and that
function never returns a cons cell.
* lisp/eshell/esh-io.el (eshell-close-target)
(eshell-output-object-to-target): Remove 'consp' condition.
---
lisp/eshell/esh-io.el | 13 ++-----------
1 file changed, 2 insertions(+), 11 deletions(-)
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index cccdb49ce2a..1ec4f918282 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -466,13 +466,7 @@ eshell-close-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)))))
+ (funcall target status))))
(defun eshell-kill-append (string)
"Call `kill-append' with STRING, if it is indeed a string."
@@ -642,10 +636,7 @@ eshell-output-object-to-target
(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))))
+ (signal 'eshell-pipe-broken (list target)))))))
object)
(defun eshell-output-object (object &optional handle-index handles)
--
2.25.1
[-- Attachment #3: 0002-Use-generics-to-define-Eshell-output-targets.patch --]
[-- Type: text/plain, Size: 14619 bytes --]
From 9b6186973c0fd8317a80b4f1e776efdac2e3bac5 Mon Sep 17 00:00:00 2001
From: Jim Porter <jporterbugs@gmail.com>
Date: Sat, 11 Mar 2023 18:44:43 -0800
Subject: [PATCH 2/3] Use generics to define Eshell output targets
This is more flexible than before, since third-party code can add new
output target types without advising these functions. It also
resolves an issue where redirecting to a symbol that has a value in
its function slot doesn't work.
* lisp/eshell/esh-io.el (eshell-virtual-target): New struct.
(eshell-get-target, eshell-output-object-to-target): Reimplement via
'cl-defgeneric'.
(eshell-close-target): Reimplement via 'cl-defgeneric' and simplify
'process' method.
---
lisp/eshell/esh-io.el | 299 +++++++++++++++++--------------
test/lisp/eshell/esh-io-tests.el | 10 ++
2 files changed, 170 insertions(+), 139 deletions(-)
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 1ec4f918282..f9f50ea433a 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -423,51 +423,6 @@ eshell-set-all-output-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))))
-
(defun eshell-kill-append (string)
"Call `kill-append' with STRING, if it is indeed a string."
(if (stringp string)
@@ -479,56 +434,6 @@ eshell-clipboard-append
(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
@@ -593,52 +498,168 @@ eshell-printn
(eshell-print object)
(eshell-print "\n"))
-(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-interactive-print (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)))))))
+(cl-defstruct (eshell-virtual-target
+ (: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 raw 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 raw 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 raw process 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 (eq (process-status target) 'run)
+ (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-throw the signal.
+ (if (memq (process-status target)
+ '(run stop open closed))
+ (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'.
diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el
index ed350a9691c..ce80f3a8f08 100644
--- a/test/lisp/eshell/esh-io-tests.el
+++ b/test/lisp/eshell/esh-io-tests.el
@@ -31,6 +31,9 @@
(defvar eshell-test-value nil)
+(defvar eshell-test-value-with-fun nil)
+(defun eshell-test-value-with-fun ())
+
(defun eshell-test-file-string (file)
"Return the contents of FILE as a string."
(with-temp-buffer
@@ -117,6 +120,13 @@ esh-io-test/redirect-symbol/append
(eshell-insert-command "echo new >> #'eshell-test-value"))
(should (equal eshell-test-value "oldnew"))))
+(ert-deftest esh-io-test/redirect-symbol/with-function-slot ()
+ "Check that redirecting to a symbol with function slot set works."
+ (let ((eshell-test-value-with-fun))
+ (with-temp-eshell
+ (eshell-insert-command "echo hi > #'eshell-test-value-with-fun"))
+ (should (equal eshell-test-value-with-fun "hi"))))
+
(ert-deftest esh-io-test/redirect-marker ()
"Check that redirecting to a marker works."
(with-temp-buffer
--
2.25.1
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets
2023-08-19 0:48 bug#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets Jim Porter
@ 2023-08-21 18:47 ` Jim Porter
0 siblings, 0 replies; 2+ messages in thread
From: Jim Porter @ 2023-08-21 18:47 UTC (permalink / raw)
To: 65374-done
On 8/18/2023 5:48 PM, Jim Porter wrote:
> The attached patches split up the Eshell I/O target code so that each
> target type is its own method. Aside from fixing a couple tiny bugs,
> this should be exactly the same as before, but will make it easier to
> add new target types in the future (and for third-parties to be able to
> do this!).
Merged to master as dc0839de9b3 and closing this bug now.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2023-08-21 18:47 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-08-19 0:48 bug#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets Jim Porter
2023-08-21 18:47 ` Jim Porter
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).