master dc0839de9b3 3/3: Use generics to define Eshell output targets

[Jim Porter]

branch: master
commit dc0839de9b3654837ec8f5e66d187319b9eecd6f
Author: Jim Porter <jporterbugs@gmail.com>
Commit: Jim Porter <jporterbugs@gmail.com>

    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 @@ 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))))
-
 (defun eshell-kill-append (string)
   "Call `kill-append' with STRING, if it is indeed a string."
   (if (stringp string)
@@ -479,56 +434,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
@@ -593,52 +498,168 @@ after all printing is over with no argument."
   (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 @@
      (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