add filter-read-input-port' to
racket/port'
original commit: ce2d6030c73e0a04a2a5661a035c0e0d86d9c999
This commit is contained in:
parent
7c4fa8d61b
commit
ef64dab201
|
@ -478,6 +478,35 @@
|
||||||
count-lines!-proc
|
count-lines!-proc
|
||||||
pos)))
|
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.
|
;; Not kill-safe.
|
||||||
(define make-pipe-with-specials
|
(define make-pipe-with-specials
|
||||||
;; This implementation of pipes is almost CML-style, with a manager thread
|
;; This implementation of pipes is almost CML-style, with a manager thread
|
||||||
|
@ -1732,6 +1761,7 @@
|
||||||
peeking-input-port
|
peeking-input-port
|
||||||
relocate-input-port
|
relocate-input-port
|
||||||
transplant-input-port
|
transplant-input-port
|
||||||
|
filter-read-input-port
|
||||||
special-filter-input-port
|
special-filter-input-port
|
||||||
relocate-output-port
|
relocate-output-port
|
||||||
transplant-output-port
|
transplant-output-port
|
||||||
|
|
Loading…
Reference in New Issue
Block a user