From f4bcff142a99675c4a0eb791cb1fb4ab76f37641 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Sun, 4 Mar 2012 14:29:45 -0500
Subject: [PATCH] Update wrt tweak in xcvb-driver's run-program/ API.

---
 README   |  1 +
 run.lisp | 42 +++++++++++++++++-------------------------
 2 files changed, 18 insertions(+), 25 deletions(-)

diff --git a/README b/README
index 585eef9..fd91fea 100644
--- a/README
+++ b/README
@@ -77,6 +77,7 @@ RUN CMD &KEY ON-ERROR TIME SHOW HOST OUTPUT
   on which to run the command using ssh if
   it's not an alias for localhost as recognized by CURRENT-HOST-NAME-P
   (be sure to have passphraseless  login using ssh-agent).
+  OUTPUT is one of
   On Windows, RUN will not succeed for pipes, only for simple commands.
   On Unix, simple commands on localhost are executed directly, but
   remote commands and pipes are executed by spawning a shell.
diff --git a/run.lisp b/run.lisp
index dd2d8de..57ba8a0 100644
--- a/run.lisp
+++ b/run.lisp
@@ -18,23 +18,6 @@
               command return-code))
     (zerop return-code)))
 
-(defun run-program/ (command &key ignore-error-status output)
-  (check-type command cons)
-  (funcall (ecase output
-             ((nil) 'run-program/for-side-effects)
-             ((string :string) 'run-program/read-output-string)
-             ((:lines) 'run-program/read-output-lines)
-             ((:interactive) 'run-program/interactively)
-             ((:form) 'run-program/read-output-form)
-             ((:forms) 'run-program/read-output-forms))
-           command
-           :ignore-error-status ignore-error-status))
-
-(defun run-shell-command (command &rest keys &key ignore-error-status output)
-  (declare (ignore ignore-error-status output))
-  (check-type command string)
-  (apply 'run-program/ (list "/bin/sh" "-c" command) keys))
-
 (defun on-host-spec (host spec)
   (if (current-host-name-p host)
       spec
@@ -46,16 +29,18 @@
     (null
      (etypecase spec
        (string
-        (apply 'run-shell-command spec keys))
+        (apply 'run-program/ spec keys))
        (cons
         (apply 'run-process-spec (parse-process-spec spec) keys))
        (process-spec
-        (let ((rkeys (list :ignore-error-status ignore-error-status
-                           :output output)))
-          (if (and (typep spec 'command-spec)
-                   (null (command-redirections spec)))
-              (apply 'run-program/ (command-arguments spec) rkeys)
-              (apply 'run-shell-command (print-process-spec spec) rkeys))))))
+        (let ((command
+               (if (and (typep spec 'command-spec)
+                        (null (command-redirections spec)))
+                   (command-arguments spec)
+                   (print-process-spec spec))))
+          (run-program/ command
+                        :ignore-error-status ignore-error-status
+                        :output output)))))
     (string
      (apply 'run-process-spec (on-host-spec host spec) :host nil keys))
     (function
@@ -83,7 +68,14 @@
   "Like run/s, but strips the line ending off the result string;
 very much like `cmd` or $(cmd) at the shell"
   (declare (ignore on-error time show host))
-  (stripln (apply 'run/s cmd keys)))
+  (apply 'run cmd :output :string/stripped keys))
+
+(defun slurp-stream-string/stripped (input-stream)
+  (stripln (slurp-stream-string input-stream)))
+
+(defmethod slurp-input-stream ((x (eql :string/stripped)) input-stream
+                               &key &allow-other-keys)
+  (slurp-stream-string/stripped input-stream))
 
 (defun run/lines (cmd &rest keys &key on-error time show host)
   "Like run/s, but return a list of lines rather than one string"
-- 
GitLab