suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix polling of text% input port

Browse Source 
svn: r1453
This commit is contained in:
Matthew Flatt 2005-12-01 03:46:57 +00:00
parent 7124e7f063
commit 23347d028a
1 changed files with 17 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/framework/private/text.ss
View File

@ -1857,20 +1857,23 @@ WARNING: printf is rebound in the body of the unit to always
(define (peek-proc bstr skip-count progress-evt) (define (peek-proc bstr skip-count progress-evt)
(poll-guard-evt (poll-guard-evt
(lambda (polling?) (lambda (polling?)
(let ([evt
(nack-guard-evt
(λ (nack)
(let ([chan (make-channel)])
(channel-put peek-chan (make-peeker bstr skip-count progress-evt chan nack polling?))
chan)))])
(if polling? (if polling?
(let ([answer (let ([v (sync evt)])
(sync (if (eq? v 0)
(nack-guard-evt ;; Don't return 0, because that means something is
(λ (nack) ;; probably ready. We want to indicate that nothing is
(let ([chan (make-channel)]) ;; ready.
(channel-put peek-chan (make-peeker bstr skip-count progress-evt chan nack #t)) never-evt
chan))))]) ;; Even on success, package it as an event, because
(wrap-evt always-evt (λ (_) answer))) ;; `read-bytes-proc' expects an event
(nack-guard-evt (wrap-evt always-evt (lambda (_) v))))
(λ (nack) evt)))))
(let ([chan (make-channel)])
(channel-put peek-chan (make-peeker bstr skip-count progress-evt chan nack #f))
chan)))))))
(define (progress-evt-proc) (define (progress-evt-proc)
(sync (sync