commit d5a3cca46b06c4c0d22e805749f7bb43e70bfe20
parent affefbc60cb38d935cfbf9d27fbf602d6ce02865
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 20 Apr 2014 21:01:15 +0200
fix and improve call-with-program-output
Diffstat:
| M | os.lisp | | | 42 | ++++++++++++++++++++---------------------- |
1 file changed, 20 insertions(+), 22 deletions(-)
diff --git a/os.lisp b/os.lisp
@@ -35,7 +35,7 @@
(in-package :rw.os)
(defun make-program (input output cmd args)
- #-(or ccl ecl sbcl cmu clisp)
+ #-(or ccl ecl sbcl cmu #+nil clisp)
(error "RW.OS:MAKE-PROGRAM not ported")
#+ccl
(let ((p (ccl:run-program cmd
@@ -82,7 +82,7 @@
(:input-stream io)
(:output-stream io)
(:wait (ext:external-process-wait p))
- (close (when io (close io)))))) ;; TODO is this the right thing to close process?
+ (:close (when io (close io)))))) ;; TODO is this the right thing to close process?
#+sbcl
(let ((p (sb-ext:run-program cmd
args
@@ -101,7 +101,7 @@
(:input-stream (sb-ext:process-input p))
(:output-stream (sb-ext:process-output p))
(:wait (sb-ext:process-wait p))
- (close (sb-ext:process-close p)))))
+ (:close (sb-ext:process-close p)))))
#+cmu
(let ((p (ext:run-program cmd
args
@@ -119,8 +119,9 @@
(:input-stream (sb-ext:process-input p))
(:output-stream (sb-ext:process-output p))
(:wait (sb-ext:process-wait p))
- (close (ext:process-close p)))))
- #+clisp
+ (:close (ext:process-close p)))))
+ ;;#+clisp
+ #+nil
(let ((p (ext:run-program cmd
:arguments args
:input input
@@ -137,27 +138,24 @@
(:input-stream p)
(:output-stream p)
(:wait (ext:process-wait p)) ;; TODO
- (close (close p))))))
-
-(defun throw-error (cmd args code error-plist)
- (unless (eq t error-plist)
- (error (format nil "~a error ~d: ~a ~s" cmd code
- (when error-plist
- (or (cdr (assoc code error-plist)) ""))
- args))))
+ (:close (close p))))))
(defun call-with-program-output (output cmd args error-plist fn)
(let ((p (make-program nil output cmd args)))
- (unless output
- (funcall p :wait))
(unwind-protect
- (multiple-value-bind (status code) (funcall p :status-and-code)
- (assert (member status '(:running :exited)))
- (if (member code '(nil 0))
- (if (eq :stream output)
- (funcall fn (funcall p :output-stream))
- t)
- (throw-error cmd args code error-plist)))
+ (let ((z (if output
+ (funcall fn (funcall p :output-stream))
+ t)))
+ (funcall p :wait)
+ (multiple-value-bind (status code) (funcall p :status-and-code)
+ (assert (member status '(:running :exited)))
+ (if (member code '(nil 0))
+ z
+ (unless (eq t error-plist)
+ (error (format nil "~a error ~d: ~a ~s" cmd code
+ (when error-plist
+ (or (cdr (assoc code error-plist)) ""))
+ args))))))
(funcall p :close))))
(defun run-command (cmd &optional args error-plist)
