Workaround Mes' non-parameter standard ports.
* gash/environment.scm (current-0-port): New procedure. (current-1-port): New procedure. (current-2-port): New procedure. (fd->current-port): Use them instead of the standard parameters. * gash/shell.scm (sh:with-redirects): Do not use 'parameterize' with the non-parameter ports. (plumb): Likewise.
This commit is contained in:
parent
4b1aa935de
commit
9b53a6b25b
|
@ -56,6 +56,9 @@
|
|||
sh:exit
|
||||
*fd-count*
|
||||
fd->current-port
|
||||
current-0-port
|
||||
current-1-port
|
||||
current-2-port
|
||||
get-last-job
|
||||
set-last-job!
|
||||
reap-child-processes!))
|
||||
|
@ -419,6 +422,21 @@ status. If not called from within @code{call-with-return}, return
|
|||
|
||||
(define *fd-count* 10)
|
||||
|
||||
(define current-0-port
|
||||
(case-lambda
|
||||
(() (current-input-port))
|
||||
((value) (set-current-input-port value))))
|
||||
|
||||
(define current-1-port
|
||||
(case-lambda
|
||||
(() (current-output-port))
|
||||
((value) (set-current-output-port value))))
|
||||
|
||||
(define current-2-port
|
||||
(case-lambda
|
||||
(() (current-error-port))
|
||||
((value) (set-current-error-port value))))
|
||||
|
||||
(define current-3-port (make-parameter #f))
|
||||
(define current-4-port (make-parameter #f))
|
||||
(define current-5-port (make-parameter #f))
|
||||
|
@ -428,9 +446,9 @@ status. If not called from within @code{call-with-return}, return
|
|||
(define current-9-port (make-parameter #f))
|
||||
|
||||
(define fd->current-port
|
||||
(let ((cps (vector current-input-port
|
||||
current-output-port
|
||||
current-error-port
|
||||
(let ((cps (vector current-0-port
|
||||
current-1-port
|
||||
current-2-port
|
||||
current-3-port
|
||||
current-4-port
|
||||
current-5-port
|
||||
|
|
|
@ -241,8 +241,15 @@ if it is our responsibility to close the port."
|
|||
(#f (set-status! 1)
|
||||
(errexit))
|
||||
((parameter port close?)
|
||||
(parameterize ((parameter port))
|
||||
(thunk))
|
||||
(cond
|
||||
((eq? parameter current-0-port)
|
||||
(with-input-from-port port thunk))
|
||||
((eq? parameter current-1-port)
|
||||
(with-output-to-port port thunk))
|
||||
((eq? parameter current-2-port)
|
||||
(with-error-to-port port thunk))
|
||||
(else
|
||||
(parameterize ((parameter port)) (thunk))))
|
||||
(cond
|
||||
(close? (close-port port))
|
||||
((output-port? port) (force-output port)))))))
|
||||
|
@ -311,9 +318,10 @@ be closed in the new process."
|
|||
(when close (close-port close))
|
||||
(let ((in (or in (current-input-port)))
|
||||
(out (or out (current-output-port))))
|
||||
(parameterize ((current-input-port in)
|
||||
(current-output-port out))
|
||||
(thunk)))))
|
||||
(with-input-from-port in
|
||||
(lambda ()
|
||||
(with-output-to-port out
|
||||
thunk))))))
|
||||
(pid (%subshell thunk*)))
|
||||
(when in (close-port in))
|
||||
(when out (close-port out))
|
||||
|
|
Loading…
Reference in New Issue