diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss index 35514947..df3529b4 100644 --- a/collects/mred/mred.ss +++ b/collects/mred/mred.ss @@ -231,6 +231,7 @@ text% pasteboard% graphical-read-eval-print-loop + textual-read-eval-print-loop message-box message+check-box message-box/custom diff --git a/collects/mred/private/repl.ss b/collects/mred/private/repl.ss index d01f8bab..f5c9b7f2 100644 --- a/collects/mred/private/repl.ss +++ b/collects/mred/private/repl.ss @@ -9,7 +9,8 @@ "mrmenu.ss" "filedialog.ss") - (provide graphical-read-eval-print-loop) + (provide graphical-read-eval-print-loop + textual-read-eval-print-loop) (define (-graphical-read-eval-print-loop user-esp override-ports?) ;; The REPL buffer class @@ -180,4 +181,57 @@ [(esp override-ports?) (unless (or (not esp) (wx:eventspace? esp)) (raise-type-error 'graphical-read-eval-print-loop "eventspace or #f" esp)) - (-graphical-read-eval-print-loop esp override-ports?)]))) + (-graphical-read-eval-print-loop esp override-ports?)])) + + (define (textual-read-eval-print-loop) + (define user-custodian (make-custodian)) + (define user-eventspace + (parameterize ((current-custodian user-custodian)) + (wx:make-eventspace))) + (define ready-sema (make-semaphore)) + (define (evaluate expr) + (parameterize ((wx:current-eventspace user-eventspace)) + (wx:queue-callback + (lambda () + (dynamic-wind + void + (lambda () + (call-with-values + (lambda () (call-with-continuation-prompt + (lambda () (eval (cons + '#%top-interaction + expr))))) + (lambda results + (for-each + (lambda (v) + ((current-print) v)) + results)))) + (lambda () + (semaphore-post ready-sema))))))) + (parameterize-break + #f + (let loop () + (let ([e (let read-loop () + (call-with-continuation-prompt + ;; Enable break during reading: + (lambda () + (parameterize-break + #t + ((current-prompt-read)))) + (default-continuation-prompt-tag) + (lambda args (read-loop))))]) + (unless (eof-object? e) + (evaluate e) + ;; While waiting, redirect breaks: + (call-with-exception-handler + (lambda (exn) + (if (exn:break? exn) + (begin + (break-thread (eventspace-handler-thread user-eventspace)) + ((exn:break-continuation exn) (void))) + exn)) + (lambda () + (parameterize-break + #t + (semaphore-wait ready-sema)))) + (loop))))))) diff --git a/collects/scribblings/gui/miscwin-funcs.scrbl b/collects/scribblings/gui/miscwin-funcs.scrbl index cb2b4b9b..4631d557 100644 --- a/collects/scribblings/gui/miscwin-funcs.scrbl +++ b/collects/scribblings/gui/miscwin-funcs.scrbl @@ -200,7 +200,7 @@ See also @method[dc<%> get-text-extent]. [redirect-ports? any/c (not eval-eventspace)]) void?]{ -Similar to MzScheme's @scheme[read-eval-print-loop], except that none of +Similar to @scheme[read-eval-print-loop], except that none of @scheme[read-eval-print-loop]'s configuration parameters are used (such as @scheme[current-read]) and the interaction occurs in a GUI window instead of using the current input and output ports. @@ -236,6 +236,27 @@ The keymap for the read-eval-print loop's editor is initialized by } +@defproc[(textual-read-eval-print-loop) + void?]{ + +Similar to @scheme[read-eval-print-loop], except that evaluation uses + a newly created eventspace. + +The @scheme[current-prompt-read] parameter is used in the current + thread to read input. The result is queued for evaluation and + printing in the created eventspace's @tech{handler thread}, which + uses @scheme[current-eval] and @scheme[current-print]. After printing + completes for an interaction result, the next expression in read in + the original thread, and so on. + +If an @scheme[exn:break] exception is raised in the original thread +during reading, it aborts the current call to @scheme[(current-read)] +and a new one is started. If an @scheme[exn:break] exception is raised +in the original thread while waiting for an interaction to complete, a +break is sent (via @scheme[break-thread]) to the created eventspace's +@tech{handler thread}.} + + @defproc[(hide-cursor-until-moved) void?]{