mred -z and textual-read-eval-print-loop

svn: r9285

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

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)))))))

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?]{
 

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

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");