add current-get-interaction-input-port' and adjust racket/gui'

so that GUI events are dispatched while a REPL is blocked on input

collects/mred/private/wx/common/queue.rkt

@@ -3,6 +3,7 @@
          racket/draw/private/utils
          ffi/unsafe/atomic
          racket/class
+         racket/port
          "rbtree.rkt"
          "../../lock.rkt"
          "handlers.rkt"
@@ -358,6 +359,12 @@
 (define main-eventspace (make-eventspace* (current-thread)))
 (define current-eventspace (make-parameter main-eventspace))
 
+;; So we can get from a thread to the eventspace that
+;;  it handles (independent of the `current-eventspace'
+;;  parameter):
+(define handler-thread-of (make-thread-cell #f))
+(thread-cell-set! handler-thread-of main-eventspace)
+
 (define make-new-eventspace
   (let ([make-eventspace
          (lambda ()
@@ -367,8 +374,9 @@
                       (thread
                        (lambda ()
                          (sync pause)
-                         (parameterize ([current-eventspace es])
+                         (thread-cell-set! handler-thread-of es)
-                           (yield (make-semaphore))))))])
+                         (current-eventspace es)
+                         (yield (make-semaphore)))))])
              (semaphore-post pause)
              es))])
     make-eventspace))
@@ -578,3 +586,28 @@
    (lambda (v)
      (yield main-eventspace)
      (old-eyh v))))
+
+;; When using a REPL in a thread that has an eventspace,
+;; yield to events when the port would block.
+(current-get-interaction-input-port
+ (let ([orig (current-get-interaction-input-port)])
+   (lambda ()
+     (let ([e (thread-cell-ref handler-thread-of)])
+       (if e
+           (let ([filter (lambda (v)
+                           (cond
+                            [(eq? v 0) (yield) 0]
+                            [(evt? v)
+                             (parameterize ([current-eventspace e])
+                               (yield))
+                             (choice-evt v
+                                         (wrap-evt (eventspace-event-evt e)
+                                                   (lambda (_) 0)))]
+                            [else v]))])
+             (filter-read-input-port
+              (orig)
+              (lambda (str v)
+                (filter v))
+              (lambda (s skip evt v)
+                (filter v))))
+           (orig))))))

collects/scribblings/gui/gui.scrbl

@@ -49,6 +49,7 @@ Both parts of the toolbox rely extensively on the
 @include-section["wxme.scrbl"]
 @include-section["prefs.scrbl"]
 @include-section["dynamic.scrbl"]
+@include-section["startup.scrbl"]
 
 @;------------------------------------------------------------------------
 

collects/scribblings/gui/startup.scrbl

@@ -0,0 +1,37 @@
+#lang scribble/doc
+@(require "common.ss"
+          (for-label racket/gui/dynamic))
+
+@title{Startup Actions}
+
+The @racketmodname[racket/gui/base] module can be instantiated only
+once per operating-system process, because it sets hooks in the Racket
+run-time system to coordinate between Racket thread scheduling and GUI
+events. Attempting to instantiate it a second time results in an
+exception.
+
+Loading @racketmodname[racket/gui/base] sets two parameters:
+
+@itemlist[
+
+@item{@racket[executable-yield-handler] --- The executable yield
+      handler is set to evaluate @racket[(yield _initial-eventspace)]
+      before chaining to the previously installed handler. As a
+      result, the Racket process will normally wait until all
+      top-level windows are closed, all callbacks are invoked, and all
+      timers are stopped in the initial eventspace before the process
+      exits.}
+
+@item{@racket[current-get-interaction-input-port] --- The interaction
+      port handler is set to wrap the previously installed handler's
+      result to yield to GUI events when the input port blocks on
+      reading. This extension of the default handler's behavior is
+      triggered only when the current thread is the handler thread of
+      some eventspace, in which case @racket[current-eventspace] is
+      set to the eventspace before invoking @racket[yield]. As a
+      result, GUI events normally can be handled while
+      @racket[read-eval-print-loop] (such as run by the plain Racket
+      executable) is blocked on input.}
+
+]
+

collects/scribblings/reference/eval.scrbl

@@ -317,19 +317,36 @@ the @racket[current-prompt-read], @racket[current-eval], and
 A parameter that determines a @deftech{prompt read handler}, which is
 a procedure that takes no arguments, displays a prompt string, and
 returns a top-level form to evaluate. The prompt read handler is
-called by @racket[read-eval-print-loop], and the handler typically
+called by @racket[read-eval-print-loop], and after printing a prompt,
-should call the @tech{read interaction handler} (as determined by the
+the handler typically should call the @tech{read interaction handler}
-@racket[current-read-interaction] parameter) after printing a prompt.
+(as determined by the @racket[current-read-interaction] parameter)
+with the port produced by the @tech{interaction port handler}
+(as determined by the @racket[current-get-interaction-input-port] parameter).
 
 The default prompt read handler prints @litchar{> } and returns the
 result of
 
 @racketblock[
-(let ([in (current-input-port)])
+(let ([in ((current-get-interaction-input-port))])
   ((current-read-interaction) (object-name in) in))
 ]}
 
 
+@defparam[current-get-interaction-input-port proc (-> input-port?)]{
+
+A parameter that determines the @deftech{interaction port handler},
+which returns a port to use for @racket[read-eval-print-loop] inputs.
+
+The default interaction port handler returns the current input port.
+In addition, if that port is the initial current input port,
+the initial current output and error ports are flushed.
+
+The @racketmodname[racket/gui/base] library adjusts this parameter's
+value by extending the current value. The extension wraps the result
+port so that GUI events can be handled when reading from the port
+blocks.}
+
+
 @defparam[current-read-interaction proc (any/c input-port? -> any)]{
 
 A parameter that determines the current @deftech{read interaction

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,7 @@
+5.0.99.7
+add `current-get-interaction-input-port', which enables
+ `racket/gui' events to be dispatched while a REPL is blocked
+
 5.0.99.2
 proxy => impersonator
 equal? equates C pointers when they refer to the same address

src/racket/include/scheme.h

@@ -1191,6 +1191,7 @@ enum {
   MZCONFIG_PRINT_HANDLER,
   MZCONFIG_PROMPT_READ_HANDLER,
   MZCONFIG_READ_HANDLER,
+  MZCONFIG_READ_INPUT_PORT_HANDLER,
 
   MZCONFIG_READTABLE,
   MZCONFIG_READER_GUARD,

src/racket/src/fun.c

@@ -183,6 +183,7 @@ Scheme_Object *scheme_values(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_print(int argc, Scheme_Object **argv);
 static Scheme_Object *current_prompt_read(int, Scheme_Object **);
 static Scheme_Object *current_read(int, Scheme_Object **);
+static Scheme_Object *current_get_read_input_port(int, Scheme_Object **);
 
 static Scheme_Object *write_compiled_closure(Scheme_Object *obj);
 static Scheme_Object *read_compiled_closure(Scheme_Object *obj);
@@ -571,6 +572,11 @@ scheme_init_fun (Scheme_Env *env)
 						       "current-read-interaction",
 						       MZCONFIG_READ_HANDLER),
 			     env);
+  scheme_add_global_constant("current-get-interaction-input-port",
+			     scheme_register_parameter(current_get_read_input_port,
+						       "current-get-interaction-input-port",
+						       MZCONFIG_READ_INPUT_PORT_HANDLER),
+			     env);
 
   scheme_install_type_writer(scheme_unclosed_procedure_type,
 			     write_compiled_closure);
@@ -9601,6 +9607,15 @@ current_read(int argc, Scheme_Object **argv)
 			     2, NULL, NULL, 0);
 }
 
+static Scheme_Object *
+current_get_read_input_port(int argc, Scheme_Object **argv)
+{
+  return scheme_param_config("current-get-interaction-input-port",
+			     scheme_make_integer(MZCONFIG_READ_INPUT_PORT_HANDLER),
+			     argc, argv,
+			     0, NULL, NULL, 0);
+}
+
 Scheme_Object *
 scheme_default_print_handler(int argc, Scheme_Object *argv[])
 {
@@ -9623,22 +9638,37 @@ scheme_default_print_handler(int argc, Scheme_Object *argv[])
   return scheme_void;
 }
 
+Scheme_Object *
+scheme_default_read_input_port_handler(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *inport;
+  
+  inport = scheme_get_param(scheme_current_config(), MZCONFIG_INPUT_PORT);
+
+  if (inport == scheme_orig_stdin_port)
+    scheme_flush_orig_outputs();
+
+  return inport;
+}
+
 Scheme_Object *
 scheme_default_prompt_read_handler(int argc, Scheme_Object *argv[])
 {
   Scheme_Config *config;
-  Scheme_Object *port, *reader;
+  Scheme_Object *port, *reader, *getter;
   Scheme_Object *inport, *name, *a[2];
 
   config = scheme_current_config();
   port = scheme_get_param(config, MZCONFIG_OUTPUT_PORT);
-  inport = scheme_get_param(config, MZCONFIG_INPUT_PORT);
 
   scheme_write_byte_string("> ", 2, port);
   scheme_flush_output(port);
 
-  if (inport == scheme_orig_stdin_port)
+  getter = scheme_get_param(config, MZCONFIG_READ_INPUT_PORT_HANDLER);
-    scheme_flush_orig_outputs();
+  inport = _scheme_apply(getter, 0, NULL);
+
+  if (!SCHEME_INPORTP(inport))
+    scheme_wrong_type("default-prompt-read-hander", "input port", -1, -1, &inport);
 
   name = (Scheme_Object *)scheme_port_record(inport);
   name = ((Scheme_Input_Port *)name)->name;

src/racket/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1017
+#define EXPECTED_PRIM_COUNT 1018
 #define EXPECTED_UNSAFE_COUNT 76
 #define EXPECTED_FLFXNUM_COUNT 68
 #define EXPECTED_FUTURES_COUNT 5

src/racket/src/schpriv.h

@@ -1992,6 +1992,7 @@ Scheme_Object *scheme_default_eval_handler(int, Scheme_Object *[]);
 Scheme_Object *scheme_default_compile_handler(int, Scheme_Object *[]);
 Scheme_Object *scheme_default_print_handler(int, Scheme_Object *[]);
 Scheme_Object *scheme_default_prompt_read_handler(int, Scheme_Object *[]);
+Scheme_Object *scheme_default_read_input_port_handler(int argc, Scheme_Object *[]);
 Scheme_Object *scheme_default_read_handler(int argc, Scheme_Object *[]);
 
 extern Scheme_Object *scheme_default_global_print_handler;

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.0.99.6"
+#define MZSCHEME_VERSION "5.0.99.7"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 0
 #define MZSCHEME_VERSION_Z 99
-#define MZSCHEME_VERSION_W 6
+#define MZSCHEME_VERSION_W 7
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

src/racket/src/thread.c

@@ -6945,6 +6945,11 @@ static void make_initial_config(Scheme_Thread *p)
                                   0, 0);
     init_param(cells, paramz, MZCONFIG_PROMPT_READ_HANDLER, ph);
 
+    ph = scheme_make_prim_w_arity(scheme_default_read_input_port_handler,
+                                  "default-get-interaction-input-port",
+                                  0, 0);
+    init_param(cells, paramz, MZCONFIG_READ_INPUT_PORT_HANDLER, ph);
+
     ph = scheme_make_prim_w_arity(scheme_default_read_handler,
                                   "default-read-interaction-handler",
                                   2, 2);