From ecd21c6793c9cc5631c3489746f230e2de93ab82 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Thu, 7 Jun 2012 21:14:26 -0400
Subject: [PATCH] Support :output :interactively as a hack on CCL and SBCL.

---
 run.lisp | 42 +++++++++++++++++++++++++++++-------------
 1 file changed, 29 insertions(+), 13 deletions(-)

diff --git a/run.lisp b/run.lisp
index efc92de..2b1c3a0 100644
--- a/run.lisp
+++ b/run.lisp
@@ -28,26 +28,42 @@
       spec
       `(ssh ,host ,(print-process-spec spec))))
 
+(deftype direct-command-spec ()
+  '(and command-spec (satisfies direct-command-spec-p)))
+
+(defun direct-command-spec-p (spec)
+  (and (typep spec 'command-spec)
+       (null (command-redirections spec))))
+
 (defun run-spec (spec &key ignore-error-status output)
-  (let ((command
-         (if (and (typep spec 'command-spec)
-                  (null (command-redirections spec)))
-             (command-arguments spec)
-             (print-process-spec spec))))
-    (if (eq output t)
-        (run-program/ command :ignore-error-status ignore-error-status)
-        (run-program/ command
-                      :ignore-error-status ignore-error-status
-                      :output output))))
+  (let* ((command
+          (if (consp spec)
+            (parse-process-spec spec)
+            spec))
+         (command
+          (etypecase command
+            (direct-command-spec
+             (command-arguments spec))
+            (process-spec
+             (print-process-spec spec))
+            (string
+             spec))))
+    (case output
+      ((t)
+       (run-program/ command :ignore-error-status ignore-error-status))
+      ((:interactively)
+       (run-program/interactively
+        command :ignore-error-status ignore-error-status))
+      (otherwise
+       (run-program/
+        command :ignore-error-status ignore-error-status :output output)))))
 
 (defun run-process-spec (spec &rest keys &key ignore-error-status output host backend)
   (etypecase host
     (null
      (etypecase spec
        (string
-        (if (eq output t)
-            (run-program/ spec :ignore-error-status ignore-error-status)
-            (apply 'run-program/ spec keys)))
+        (run-spec spec :ignore-error-status ignore-error-status :output output))
        (cons
         (apply 'run-process-spec (parse-process-spec spec) keys))
        (process-spec
-- 
GitLab