cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 67c1dd4fe3cc9a08f73a69b538a0208b41bd34cd
parent d068d3963f29fa90475333fcffc92a641e70a0f1
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 12 Apr 2015 20:01:02 +0200

more allegro porting

Diffstat:
Mos.lisp | 27++++++++++++++++++++++++++-
1 file changed, 26 insertions(+), 1 deletion(-)

diff --git a/os.lisp b/os.lisp @@ -42,8 +42,33 @@ (when error-plist (or (cdr (assoc code error-plist)) "")) args))))) - #-(or ccl ecl sbcl cmu clisp) + #-(or allegro ccl ecl mkcl sbcl cmu clisp) (error "RW.OS:MAKE-PROGRAM not ported") + #+allegro + (multiple-value-bind (stream b p) + (excl:run-shell-command (format nil "~a ~{~a~^ ~}" cmd args) + :input input + :output output + :error-output nil + :show-window nil + :wait nil) + (declare (ignore b)) + (flet ((status (z) + (if (integerp z) :exited :running))) + (let ((status (status (sys:reap-os-subprocess :pid p :wait nil)))) + (if input + (assert (eq :running status)) + (assert (member status '(:running :exited))))) + (let (code) + (lambda (msg) + (ecase msg + (:fail (fail (or (sys:reap-os-subprocess :pid p :wait nil) code))) + (:status-and-code + (let ((z (or (sys:reap-os-subprocess :pid p :wait nil) code))) + (values (status z) z))) + (:streams (values (when input stream) (when output stream))) + (:wait (setq code (sys:reap-os-subprocess :pid p :wait t))) + (:close (when stream (close stream)))))))) #+ccl (let ((p (ccl:run-program cmd args