commit 67c1dd4fe3cc9a08f73a69b538a0208b41bd34cd parent d068d3963f29fa90475333fcffc92a641e70a0f1 Author: Tomas Hlavaty <tom@logand.com> Date: Sun, 12 Apr 2015 20:01:02 +0200 more allegro porting Diffstat:
| M | os.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