dup-{in,out}put-port and sandbox-error-output default

svn: r9617

original commit: 1dd30ca031de14fda4a9858f974e1dd0bfeaf209
This commit is contained in:
Matthew Flatt 2008-05-03 04:47:14 +00:00
parent ebb1887166
commit dbebbf5676

View File

@ -1775,6 +1775,41 @@
;; Flush output ;; Flush output
(write-it #"" 0 0 #f #f)))]))))) (write-it #"" 0 0 #f #f)))])))))
;; ----------------------------------------
(define dup-output-port
(opt-lambda (p [close? #f])
(let ([new (transplant-output-port p
(lambda ()
(port-next-location p))
(let-values ([(line col pos)
(port-next-location p)])
(or pos
(file-position p)))
close?
(lambda ()
(port-count-lines! p)))])
(port-display-handler new (port-display-handler p))
(port-write-handler new (port-write-handler p))
new)))
(define dup-input-port
(opt-lambda (p [close? #f])
(let ([new (transplant-input-port p
(lambda ()
(port-next-location p))
(let-values ([(line col pos)
(port-next-location p)])
(or pos
(file-position p)))
close?
(lambda ()
(port-count-lines! p)))])
(port-read-handler new (port-read-handler p))
new)))
;; ----------------------------------------
(provide open-output-nowhere (provide open-output-nowhere
make-pipe-with-specials make-pipe-with-specials
make-input-port/read-to-peek make-input-port/read-to-peek
@ -1790,6 +1825,8 @@
make-limited-input-port make-limited-input-port
reencode-input-port reencode-input-port
reencode-output-port reencode-output-port
dup-input-port
dup-output-port
strip-shell-command-start) strip-shell-command-start)
(provide/contract (read-bytes-avail!-evt (mutable-bytes? input-port-with-progress-evts? (provide/contract (read-bytes-avail!-evt (mutable-bytes? input-port-with-progress-evts?