From 51dc1e67119fee24b2d6db474d030b9a2ac4fa42 Mon Sep 17 00:00:00 2001
From: Akihide Nano <an74abc@gmail.com>
Date: Tue, 24 Apr 2018 10:51:09 +0900
Subject: [PATCH] modify run-program and added ccl

---
 repo.lisp | 52 ++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 38 insertions(+), 14 deletions(-)

diff --git a/repo.lisp b/repo.lisp
index e040dc6..1d7e46c 100644
--- a/repo.lisp
+++ b/repo.lisp
@@ -104,21 +104,45 @@
   (format t "~&$ ~A~{ ~A~}~%" cmd args)
   (let ((out (make-string-output-stream))
         (err (make-string-output-stream)))
-    (let* ((process (sb-ext:run-program cmd args
-                                        :output out
-                                        :error err
-                                        :external-format :utf-8))
-           (exit-code (sb-ext:process-exit-code process)))
+    (unwind-protect
+	 (let* ((process (sb-ext:run-program cmd args
+					     :output out
+					     :error err
+					     :external-format :utf-8))
+		(exit-code (sb-ext:process-exit-code process))
+		(out-str (get-output-stream-string out))
+		(err-str (get-output-stream-string err)))
+	   (format t "~&~A~&" out-str)
+	   (format t "~&~A~&" err-str)
+	   (unless (= 0 exit-code)
+	     (with-simple-restart (continue "Ignore command error")
+	       (error "~&$ ~A~{ ~A~}~%~A" cmd args err-str)))
+	   (values out-str err-str exit-code))
       (close out)
-      (close err)
-      (let ((out (get-output-stream-string out))
-            (err (get-output-stream-string err)))
-        (format t "~&~A~&" out)
-        (format t "~&~A~&" err)
-        (unless (= 0 exit-code)
-          (with-simple-restart (continue "Ignore command error")
-            (error "~&$ ~A~{ ~A~}~%~A" cmd args err)))
-        (values out err exit-code)))))
+      (close err))))
+
+#+ccl
+(defun run-program (cmd &rest args)
+  (format t "~&$ ~A~{ ~A~}~%" cmd args)
+  (let ((out (make-string-output-stream))
+	(err (make-string-output-stream)))
+    (unwind-protect
+	 (let* ((process (ccl:run-program cmd args
+					  :wait nil
+					  :output out
+					  :error err
+					  :external-format :utf-8))
+		(exit-code (ccl:external-process-status process))
+		(out-str (get-output-stream-string out))
+		(err-str (get-output-stream-string err)))
+	   (format t "~&~A~&" out-str)
+	   (format t "~&~A~&" err-str)
+	   (unless (eql :running exit-code)
+	     (with-simple-restart (continue "Ignore command error")
+	       (error "~&$ ~A~{ ~A~}~%~A" cmd args err-str)))
+	   (values out-str err-str exit-code))
+      (close out)
+      (close err))))
 
 #-windows
 (defun sh (&rest parts)