add 'current-read-interaction' parameter

svn: r18769

collects/drscheme/private/module-language.ss

@@ -334,6 +334,21 @@
         (cond [(thread-cell-ref repl-init-thunk)
                => (λ (t) (thread-cell-set! repl-init-thunk #f) (t))]))
       
+      (define/override (front-end/interaction port settings)
+        (λ ()
+           (let ([v (parameterize ([read-accept-reader #t])
+                      (with-stack-checkpoint
+                       ((current-read-interaction) 
+                        (object-name port)
+                        port)))])
+             (if (eof-object? v)
+                 v
+                 (let ([w (cons '#%top-interaction v)])
+                   (if (syntax? v)
+                       (namespace-syntax-introduce
+                        (datum->syntax #f w v))
+                       v))))))
+
       ;; printer settings are just ignored here.
       (define/override (create-executable setting parent program-filename)
         (let* ([executable-specs (drscheme:language:create-executable-gui

collects/racket/private/lang/reader.ss

@@ -2,4 +2,6 @@
 scheme/base
 
 #:info get-info
+#:module-info '#(racket/private/get-info get-info #f)
+
 (require racket/private/get-info)

collects/racket/private/runtime.ss

@@ -4,4 +4,7 @@
 (provide configure)
 
 (define (configure config)
+  (current-prompt-read  (lambda ()
+                          (printf "r> ")
+                          (read)))
   (print-as-quasiquote #t))

collects/readline/pread.ss

@@ -208,4 +208,6 @@
       ;; readline-prompt and using read-complete-syntax below should still
       ;; work fine)
       (display prompt) (flush-output))
-    (begin0 (read-syntax) (do-multiline-chunk))))
+    (begin0 (let ([in (current-input-port)])
+              ((current-read-interaction) (object-name in) in))
+            (do-multiline-chunk))))

collects/scribblings/reference/eval.scrbl

@@ -288,15 +288,34 @@ the @scheme[current-prompt-read], @scheme[current-eval], and
 
 @defparam[current-prompt-read proc (-> any)]{
 
-A parameter that determines a procedure that takes no arguments,
+A parameter that determines a @deftech{prompt read handler}, which is
-displays a prompt string, and returns a top-level form to
+a procedure that takes no arguments, displays a prompt string, and
-evaluate. This procedure is called by the read phase of
+returns a top-level form to evaluate. The prompt read handler is
-@scheme[read-eval-print-loop].  The default prompt read handler prints
+called by @scheme[read-eval-print-loop], and the handler typically
-@litchar{> } and returns the result of
+should call the @tech{read interaction handler} (as determined by the
+@scheme[current-read-interaction] parameter) after printing a prompt.
+
+The default prompt read handler prints @litchar{> } and returns the
+result of
 
 @schemeblock[
-(parameterize ((read-accept-reader #t))
+(let ([in (current-input-port)])
-  (read-syntax))
+  ((current-read-interaction) (object-name in) in))
+]}
+
+
+@defparam[current-read-interaction proc (any/c input-port? -> any)]{
+
+A parameter that determines the current @deftech{read interaction
+handler}, which is procedure that takes an arbitrary value and an
+input port and returns an expression read from the input port. 
+
+The default read interaction handler accepts @scheme[_src] and
+@scheme[_in] and returns
+
+@schemeblock[
+(parameterize ([read-accept-reader #t])
+  (read-syntax _src _in))
 ]}
 
 

src/mzscheme/include/scheme.h

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

src/mzscheme/src/fun.c

@@ -178,6 +178,7 @@ static Scheme_Object *call_with_values(int argc, Scheme_Object *argv[]);
 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 *write_compiled_closure(Scheme_Object *obj);
 static Scheme_Object *read_compiled_closure(Scheme_Object *obj);
@@ -546,6 +547,11 @@ scheme_init_fun (Scheme_Env *env)
 						       "current-prompt-read",
 						       MZCONFIG_PROMPT_READ_HANDLER),
 			     env);
+  scheme_add_global_constant("current-read-interaction",
+			     scheme_register_parameter(current_read,
+						       "current-read-interaction",
+						       MZCONFIG_READ_HANDLER),
+			     env);
 
   scheme_install_type_writer(scheme_unclosed_procedure_type,
 			     write_compiled_closure);
@@ -8859,6 +8865,15 @@ current_prompt_read(int argc, Scheme_Object **argv)
 			     0, NULL, NULL, 0);
 }
 
+static Scheme_Object *
+current_read(int argc, Scheme_Object **argv)
+{
+  return scheme_param_config("current-read-interaction",
+			     scheme_make_integer(MZCONFIG_READ_HANDLER),
+			     argc, argv,
+			     2, NULL, NULL, 0);
+}
+
 Scheme_Object *
 scheme_default_print_handler(int argc, Scheme_Object *argv[])
 {
@@ -8885,11 +8900,8 @@ Scheme_Object *
 scheme_default_prompt_read_handler(int argc, Scheme_Object *argv[])
 {
   Scheme_Config *config;
-  Scheme_Object *port;
+  Scheme_Object *port, *reader;
-  Scheme_Object *inport;
+  Scheme_Object *inport, *name, *a[2];
-  Scheme_Object *name;
-  Scheme_Object *stx;
-  Scheme_Cont_Frame_Data cframe;
 
   config = scheme_current_config();
   port = scheme_get_param(config, MZCONFIG_OUTPUT_PORT);
@@ -8898,11 +8910,36 @@ scheme_default_prompt_read_handler(int argc, Scheme_Object *argv[])
   scheme_write_byte_string("> ", 2, port);
   scheme_flush_output(port);
 
-  name = ((Scheme_Input_Port *)inport)->name;
-
   if (inport == scheme_orig_stdin_port)
     scheme_flush_orig_outputs();
 
+  name = (Scheme_Object *)scheme_port_record(inport);
+  name = ((Scheme_Input_Port *)name)->name;
+
+  reader = scheme_get_param(config, MZCONFIG_READ_HANDLER);
+
+  a[0] = name;
+  a[1] = inport;
+  return _scheme_apply(reader, 2, a);
+}
+  
+Scheme_Object *
+scheme_default_read_handler(int argc, Scheme_Object *argv[])
+{
+  Scheme_Config *config;
+  Scheme_Object *name = argv[0];
+  Scheme_Object *inport = argv[1];
+  Scheme_Object *stx;
+  Scheme_Cont_Frame_Data cframe;
+
+  if (!SCHEME_INPORTP(inport))
+    scheme_wrong_type("default-read-interaction-handler",
+                      "input port",
+                      1,
+                      argc,
+                      argv);
+
+  config = scheme_current_config();
   config = scheme_extend_config(config, MZCONFIG_CAN_READ_READER, scheme_true);
 
   scheme_push_continuation_frame(&cframe);

src/mzscheme/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 980
+#define EXPECTED_PRIM_COUNT 981
 #define EXPECTED_UNSAFE_COUNT 65
 #define EXPECTED_FLFXNUM_COUNT 53
 

src/mzscheme/src/schpriv.h

@@ -1930,6 +1930,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_handler(int argc, Scheme_Object *[]);
 
 extern Scheme_Object *scheme_default_global_print_handler;
 

src/mzscheme/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "4.2.5.6"
+#define MZSCHEME_VERSION "4.2.5.7"
 
 #define MZSCHEME_VERSION_X 4
 #define MZSCHEME_VERSION_Y 2
 #define MZSCHEME_VERSION_Z 5
-#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/mzscheme/src/thread.c

@@ -6699,17 +6699,22 @@ static void make_initial_config(Scheme_Thread *p)
   }
   
   {
-    Scheme_Object *ph, *prh;
+    Scheme_Object *ph;
 
     ph = scheme_make_prim_w_arity(scheme_default_print_handler,
 				  "default-print-handler",
 				  1, 1);
     init_param(cells, paramz, MZCONFIG_PRINT_HANDLER, ph);
 
-    prh = scheme_make_prim_w_arity(scheme_default_prompt_read_handler,
+    ph = scheme_make_prim_w_arity(scheme_default_prompt_read_handler,
                                   "default-prompt-read-handler",
                                   0, 0);
-    init_param(cells, paramz, MZCONFIG_PROMPT_READ_HANDLER, prh);
+    init_param(cells, paramz, MZCONFIG_PROMPT_READ_HANDLER, ph);
+
+    ph = scheme_make_prim_w_arity(scheme_default_read_handler,
+                                  "default-read-interaction-handler",
+                                  2, 2);
+    init_param(cells, paramz, MZCONFIG_READ_HANDLER, ph);
   }
   init_param(cells, paramz, MZCONFIG_PORT_COUNT_LINES, scheme_false);