.
original commit: 8af871ee2c556ccd5a882f974bfe07543da5d747
This commit is contained in:
parent
b7bda087b1
commit
ea7a01157c
|
@ -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))))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user