Subject: bug#65374: closed (Re: bug#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets)

From: [email-masked] (GNU bug Tracking System)
Date: Mon, 21 Aug 2023 18:48:02 +0000

Your bug report

#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
65374: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=65374
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#65374: 30.0.50 [PATCH]; Allow extending Eshell output targets
From: Jim Porter <[email-masked]>
To: [email-masked]
Date: Mon, 21 Aug 2023 11:47:46 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

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.

Subject: 30.0.50 [PATCH]; Allow extending Eshell output targets
From: Jim Porter <[email-masked]>
To: [email-masked]
Date: Fri, 18 Aug 2023 17:48:55 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

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).

From c2ef3c2a231b55fd3427f37c8f922bae3f780372 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
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

From 9b6186973c0fd8317a80b4f1e776efdac2e3bac5 Mon Sep 17 00:00:00 2001
From: Jim Porter <[email-masked]>
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