From aa1a56c3fd534b8f068697a518dd2d4f76b5a16d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 13 Apr 2008 17:09:18 +0000 Subject: [PATCH] mred -z and textual-read-eval-print-loop svn: r9285 --- collects/mred/mred.ss | 1 + collects/mred/private/repl.ss | 58 +++++++++++++++++++- collects/scribblings/gui/miscwin-funcs.scrbl | 23 +++++++- collects/scribblings/reference/startup.scrbl | 5 +- src/mred/mrmain.cxx | 4 +- 5 files changed, 84 insertions(+), 7 deletions(-) diff --git a/collects/mred/mred.ss b/collects/mred/mred.ss index 35514947fc..df3529b49f 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 d01f8bab0f..f5c9b7f2f7 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 cb2b4b9b96..4631d557bd 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?]{ diff --git a/collects/scribblings/reference/startup.scrbl b/collects/scribblings/reference/startup.scrbl index e16c988afc..7c98a646c3 100644 --- a/collects/scribblings/reference/startup.scrbl +++ b/collects/scribblings/reference/startup.scrbl @@ -171,8 +171,9 @@ flags: 'init-file)].} @item{@FlagFirst{z} or @DFlagFirst{text-repl} : MrEd only; like - @Flag{i}/@DFlag{repl}, but uses @scheme[read-eval-print-loop] - instead of @scheme[graphical-read-eval-print-loop].} + @Flag{i}/@DFlag{repl}, but uses + @scheme[textual-read-eval-print-loop] instead of + @scheme[graphical-read-eval-print-loop].} @item{@FlagFirst{n} or @DFlagFirst{no-lib} : Skips requiring the initialization library (i.e., @schememodname[scheme/init] or diff --git a/src/mred/mrmain.cxx b/src/mred/mrmain.cxx index 2d375b2ada..dec762b752 100644 --- a/src/mred/mrmain.cxx +++ b/src/mred/mrmain.cxx @@ -179,8 +179,8 @@ static void do_graph_repl(Scheme_Env *env) if (!scheme_setjmp(newbuf)) { if (xfa->a->alternate_rep) { - a[0] = scheme_intern_symbol("scheme/base"); - a[1] = scheme_intern_symbol("read-eval-print-loop"); + a[0] = scheme_intern_symbol("mred/mred"); + a[1] = scheme_intern_symbol("textual-read-eval-print-loop"); } else { a[0] = scheme_intern_symbol("mred/mred"); a[1] = scheme_intern_symbol("graphical-read-eval-print-loop");