original commit: 8af871ee2c556ccd5a882f974bfe07543da5d747
This commit is contained in:
Matthew Flatt 2001-04-06 22:46:59 +00:00
parent b7bda087b1
commit ea7a01157c

View File

@ -22,7 +22,7 @@
(else (error "don't know what shell to use for ~e." (system-type))))) (else (error "don't know what shell to use for ~e." (system-type)))))
(define (if-stream-out p) (define (if-stream-out p)
(if (file-stream-port? p) (if (or (not p) (file-stream-port? p))
p p
(if (output-port? p) (if (output-port? p)
#f #f
@ -32,7 +32,7 @@
p)))) p))))
(define (if-stream-in p) (define (if-stream-in p)
(if (file-stream-port? p) (if (or (not p) (file-stream-port? p))
p p
(if (input-port? p) (if (input-port? p)
#f #f
@ -92,21 +92,28 @@
;; Note: these always use current ports ;; Note: these always use current ports
(define (system* exe . args) (define (system* exe . args)
(let ([cout (current-output-port)] (if (eq? (system-type) 'macos)
[cin (current-input-port)] (begin
[cerr (current-error-port)]) (unless (null? args)
(let-values ([(subp out in err pid) (raise-mismatch-error 'system* "command-line arguments not supported for MacOS" args))
(apply (subprocess #f #f #f exe))
subprocess (let ([cout (current-output-port)]
(if-stream-out cout) [cin (current-input-port)]
(if-stream-in cin) [cerr (current-error-port)])
(if-stream-out cerr) (let-values ([(subp out in err pid)
exe args)]) (apply
(streamify-out cout out) subprocess
(streamify-in cin in) (if-stream-out cout)
(streamify-out cerr err) (if-stream-in cin)
(subprocess-wait subp) (if-stream-out cerr)
(zero? (subprocess-status subp))))) exe args)])
(streamify-out cout out)
(streamify-in cin in)
(streamify-out cerr err)
(subprocess-wait subp)
(zero? (subprocess-status subp))))))
(define (system str) (define (system str)
(apply system* (append (shell-path/args) (list str))))) (if (eq? (system-type) 'macos)
(subprocess #f #f #f "by id" str)
(apply system* (append (shell-path/args) (list str))))))