adjust the module browser so that when expansion does IO and that IO uses specials,

the specials are just ignored, instead of causing an error message
  closes PR 11854
This commit is contained in:
Robby Findler 2011-04-19 10:28:46 -05:00
parent 57b9bcfe38
commit 8f43c9ebdb

View File

@ -10,7 +10,8 @@
"drsig.rkt" "drsig.rkt"
racket/unit racket/unit
racket/async-channel racket/async-channel
setup/private/lib-roots) setup/private/lib-roots
racket/port)
(define-struct req (filename key)) (define-struct req (filename key))
;; type req = (make-req string[filename] (union symbol #f)) ;; type req = (make-req string[filename] (union symbol #f))
@ -22,6 +23,11 @@
(define adding-file (string-constant module-browser-adding-file)) (define adding-file (string-constant module-browser-adding-file))
(define unknown-module-name "? unknown module name") (define unknown-module-name "? unknown module name")
;; probably, at some point, the module browser should get its
;; own output ports or something instead of wrapping these ones
(define original-output-port (current-output-port))
(define original-error-port (current-error-port))
(define-unit module-overview@ (define-unit module-overview@
(import [prefix drracket:frame: drracket:frame^] (import [prefix drracket:frame: drracket:frame^]
[prefix drracket:eval: drracket:eval^] [prefix drracket:eval: drracket:eval^]
@ -870,6 +876,8 @@
(port-count-lines! prt) (port-count-lines! prt)
prt)) prt))
p)))) p))))
(current-output-port (swallow-specials original-output-port))
(current-error-port (swallow-specials original-error-port))
(current-load-relative-directory init-dir) (current-load-relative-directory init-dir)
(current-directory init-dir) (current-directory init-dir)
(error-display-handler (λ (str exn) (set! error-str str))) (error-display-handler (λ (str exn) (set! error-str str)))
@ -884,6 +892,24 @@
(error-escape-handler (error-escape-handler
(λ () (custodian-shutdown-all user-custodian))) (λ () (custodian-shutdown-all user-custodian)))
(semaphore-post init-complete)))) (semaphore-post init-complete))))
(define (swallow-specials port)
(define-values (in out) (make-pipe-with-specials))
(thread
(λ ()
(let loop ()
(define c (read-char-or-special in))
(cond
[(char? c)
(display c out)
(loop)]
[(eof-object? c)
(close-output-port out)
(close-input-port in)]
[else
(loop)]))))
out)
(define (kill-termination) (void)) (define (kill-termination) (void))
(define complete-program? #t) (define complete-program? #t)