add filter-read-input-port' to racket/port'

original commit: ce2d6030c73e0a04a2a5661a035c0e0d86d9c999
This commit is contained in:
Matthew Flatt 2011-01-24 14:45:29 -07:00
parent 7c4fa8d61b
commit ef64dab201

View File

@ -478,6 +478,35 @@
count-lines!-proc
pos)))
(define filter-read-input-port
(lambda (p wrap-read wrap-peek [close? #t])
(make-input-port
(object-name p)
(lambda (s)
(let ([v (read-bytes-avail!* s p)])
(wrap-read
s
(if (eq? v 0) (wrap-evt p (lambda (x) 0)) v))))
(lambda (s skip evt)
(let ([v (peek-bytes-avail!* s skip evt p)])
(wrap-peek
s skip evt
(if (eq? v 0)
(choice-evt
(wrap-evt p (lambda (x) 0))
(if evt (wrap-evt evt (lambda (x) #f)) never-evt))
v))))
(lambda ()
(when close? (close-input-port p)))
(and (port-provides-progress-evts? p)
(lambda () (port-progress-evt p)))
(and (port-provides-progress-evts? p)
(lambda (n evt target-evt) (port-commit-peeked n evt target-evt p)))
(lambda () (port-next-location p))
(lambda () (port-count-lines! p))
(let-values ([(line col pos) (port-next-location p)])
(or pos (file-position p))))))
;; Not kill-safe.
(define make-pipe-with-specials
;; This implementation of pipes is almost CML-style, with a manager thread
@ -1732,6 +1761,7 @@
peeking-input-port
relocate-input-port
transplant-input-port
filter-read-input-port
special-filter-input-port
relocate-output-port
transplant-output-port