Fix `at-exp' syntax colorer to handle non-text input
- added 'special-filter-input-port' to `racker/port' Merge to v5.0 original commit: e4aab3465684717eca0d6e7c6f70bc11e7a2ef8e
This commit is contained in:
parent
72c3254caf
commit
d86a6b48f5
|
@ -839,6 +839,43 @@
|
||||||
(when close-orig?
|
(when close-orig?
|
||||||
(close-input-port port)))))))
|
(close-input-port port)))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define special-filter-input-port
|
||||||
|
(lambda (p filter [close? #t])
|
||||||
|
(unless (input-port? p)
|
||||||
|
(raise-type-error 'special-filter-input-port "input port" p))
|
||||||
|
(unless (and (procedure? filter)
|
||||||
|
(procedure-arity-includes? filter 2))
|
||||||
|
(raise-type-error 'special-filter-input-port "procedure (arity 2)" filter))
|
||||||
|
(make-input-port
|
||||||
|
(object-name p)
|
||||||
|
(lambda (s)
|
||||||
|
(let ([v (read-bytes-avail!* s p)])
|
||||||
|
(cond
|
||||||
|
[(eq? v 0) (wrap-evt p (lambda (x) 0))]
|
||||||
|
[(procedure? v) (filter v s)]
|
||||||
|
[else v])))
|
||||||
|
(lambda (s skip evt)
|
||||||
|
(let ([v (peek-bytes-avail!* s skip evt p)])
|
||||||
|
(cond
|
||||||
|
[(eq? v 0)
|
||||||
|
(choice-evt
|
||||||
|
(wrap-evt p (lambda (x) 0))
|
||||||
|
(if evt (wrap-evt evt (lambda (x) #f)) never-evt))]
|
||||||
|
[(procedure? v) (filter v s)]
|
||||||
|
[else 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 ([(l c p) (port-next-location p)])
|
||||||
|
p))))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(define (poll-or-spawn go)
|
(define (poll-or-spawn go)
|
||||||
|
@ -1695,6 +1732,7 @@
|
||||||
peeking-input-port
|
peeking-input-port
|
||||||
relocate-input-port
|
relocate-input-port
|
||||||
transplant-input-port
|
transplant-input-port
|
||||||
|
special-filter-input-port
|
||||||
relocate-output-port
|
relocate-output-port
|
||||||
transplant-output-port
|
transplant-output-port
|
||||||
merge-input
|
merge-input
|
||||||
|
|
Loading…
Reference in New Issue
Block a user