diff --git a/collects/framework/private/main.ss b/collects/framework/private/main.ss index a08e4bf4..52285e90 100644 --- a/collects/framework/private/main.ss +++ b/collects/framework/private/main.ss @@ -138,7 +138,6 @@ (for-each (lambda (x) (hash-table-put! hash-table x 'define)) '(define defmacro define-macro - match-lambda match-lambda* define-syntax-set define-values define/public define/override define/private define/field @@ -149,8 +148,9 @@ define-schema define/contract)) (for-each (lambda (x) (hash-table-put! hash-table x 'begin)) - '(case-lambda case-lambda* - cond + '(case-lambda + match-lambda match-lambda* + cond begin begin0 delay unit compound-unit compound-unit/sig public private override diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss index d6572111..91f3e081 100644 --- a/collects/framework/private/text.ss +++ b/collects/framework/private/text.ss @@ -1024,10 +1024,6 @@ WARNING: printf is rebound in the body of the unit to always ;; send output to the editor (define write-chan (make-channel)) - ;; read-chan : (channel (union byte snip eof)) - ;; send input from the editor - (define read-chan (make-channel)) - ;; readers-chan : (channel (list (channel (union byte snip)) ;; (channel ...))) (define readers-chan (make-channel)) @@ -1182,6 +1178,10 @@ WARNING: printf is rebound in the body of the unit to always ;; input port sync code ;; + ;; read-chan : (channel (union byte snip eof)) + ;; send input from the editor + (define read-chan (make-channel)) + ;; progress-event-chan : (channel (cons (channel event) nack-evt))) (define progress-event-chan (make-channel)) @@ -1222,6 +1222,11 @@ WARNING: printf is rebound in the body of the unit to always new-peek-response-evts new-commit-response-evts)) (sync + (handle-evt + read-chan + (lambda (ent) + (set! data (enqueue ent data)) + (loop))) (handle-evt clear-input-chan (lambda (_) @@ -1286,6 +1291,7 @@ WARNING: printf is rebound in the body of the unit to always (apply choice-evt (map (lambda (resp-evt) (handle-evt + resp-evt (lambda (_) (set! response-evts (remq resp-evt response-evts)) (loop))))