andrius
/
gash
mirror of https://git.savannah.gnu.org/git/gash.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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:
Timothy Sample 2022-12-22 11:53:59 -06:00
parent 4b1aa935de
commit 9b53a6b25b
2 changed files with 34 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
gash/environment.scm
View File

@ -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

18
gash/shell.scm
View File

@ -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))