lol ctrl+enter

bin/main.ml

@@ -507,35 +507,97 @@ module Topmain = struct
     in
     Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
 
+  let first_line = ref true
+  let got_eof = ref false
+
+  let refill_lexbuf buffer len =
+    F.pr "refill_lexbuf: \n";
+    if !got_eof then (got_eof := false; 0) else begin
+        let prompt =
+          if !Clflags.noprompt then ""
+          else if !first_line then "# "
+          else if !Clflags.nopromptcont then ""
+          else if Lexer.in_comment () then "* "
+          else "  "
+        in
+        first_line := false;
+        let (len, eof) = !Toploop.read_interactive_input prompt buffer len in
+        if eof then begin
+            Location.echo_eof ();
+            if len > 0 then got_eof := true;
+            len
+          end else
+          len
+      end
+
+  exception PPerror
   (* Phase buffer that stores the last toplevel phrase (see
    [Location.input_phrase_buffer]). *)
   let phrase_buffer = Buffer.create 1024
-  let main ppf text () =
+  let loop ppf =
+    F.pr "Toploop.loop: \n";
+    Clflags.debug := true;
+    Location.formatter_for_warnings := ppf;
+    if not !Clflags.noversion then
+      F.pf ppf "        OCaml version %s@.@." Config.version;
+    begin
+      try Toploop.initialize_toplevel_env ()
+      with Env.Error _ | Typetexp.Error _ as exn ->
+                          Location.report_exception ppf exn; raise Exit
+    end;
+    let lb = Lexing.from_function refill_lexbuf in
+    Location.init lb "//toplevel//";
+    Location.input_name := "//toplevel//";
+    Location.input_lexbuf := Some lb;
+    Location.input_phrase_buffer := Some phrase_buffer;
+    Sys.catch_break true;
+    Toploop.run_hooks Toploop.After_setup;
+    (*Toploop.load_ocamlinit ppf;*)
+    let snap = Btype.snapshot () in
+    try
+      Lexing.flush_input lb;
+      (* Reset the phrase buffer when we flush the lexing buffer. *)
+      Buffer.reset phrase_buffer;
+      Location.reset();
+      Warnings.reset_fatal ();
+      first_line := true;
+      let phr = try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror in
+      let phr = Toploop.preprocess_phrase ppf phr  in
+      Env.reset_cache_toplevel ();
+      ignore(Toploop.execute_phrase true ppf phr)
+    with
+      | End_of_file -> raise Exit
+      | Sys.Break -> F.pf ppf "Interrupted.@."; Btype.backtrack snap
+      | PPerror -> ()
+      | x -> Location.report_exception ppf x; Btype.backtrack snap
+
+
+  let main ppf (text:string) () =
     Compenv.readenv ppf Before_args;
     Compenv.readenv ppf Before_link;
     Compmisc.read_clflags_from_env ();
     if not (prepare ppf) then raise Exit;
     Compmisc.init_path ();
-    Toploop.read_interactive_input := (fun prompt buffer len ->
+    
+    Toploop.read_interactive_input := (
+      fun prompt buffer len ->
       F.text ppf prompt; F.flush ppf ();
       let i = ref 0 in
       try
-        while true do
-          if !i >= len then raise Exit;
-          let c = input_char stdin in
-          Bytes.set buffer !i c;
-          (* Also populate the phrase buffer as new characters are added. *)
-          Buffer.add_char phrase_buffer c;
-          incr i;
-          if c = '\n' then raise Exit;
-        done;
-        (!i, false)
+        (*if !i >= len then raise Exit; *)
+        Bytes.blit_string text 0 buffer 0 (String.length text);
+        Buffer.add_string phrase_buffer text; (* Also populate the phrase buffer as new characters are added. *)
+        i := (String.length text);
+        (*if c = '\n' then raise Exit;*)
+        (!i, true)
       with
       | End_of_file ->
          (!i, true)
       | Exit ->
          (!i, false));
-    Toploop.loop ppf
+    loop ppf
+
+  
   
 (* how to handle an exception:
    let main p =
@@ -545,23 +607,34 @@ module Topmain = struct
  *)
 end
 
-let ze = Zed_edit.create ()
-let zc = Zed_edit.new_cursor ze
-
-let draw_top height (s:Display.state) =
-  let t = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text ze)) in
-  F.epr "draw_top: Topmain.inbuf=%s\n" t;
-
-  pane_vbox [draw_pp 30. (fun pp ->
-                 F.pf pp "> "; F.text pp t; F.pf pp "@.");
+type top_instance = {ze: unit Zed_edit.t;
+                     zc: Zed_cursor.t;
+                     res: Buffer.t}
+let mktop () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_cursor z; res = Buffer.create 1024}
+let draw_top (t:top_instance) height (s:Display.state) =
+  let kr = Display.handle_keyevents s.events t.ze t.zc in
+  pane_vbox [
       draw_pp 30. (fun pp ->
-                 match Display.handle_keyevents s.events ze zc with
-                 | `Execute -> Topmain.main pp (Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text ze))) ()
-                 | _ -> ();
-               (*Topmain.main ();*)
-               )
+          let text = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text t.ze)) in
+          F.pf pp "> "; F.text pp text; F.pf pp "@.@.";
+        );
+      draw_pp 30. (fun pp ->
+          let ztc = Zed_edit.new_cursor t.ze in
+          let ztx = Zed_edit.context t.ze ztc in
+          match kr with
+          | `Execute ->
+             let text = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text t.ze)) in
+             Buffer.clear t.res;
+             Topmain.main (Format.formatter_of_buffer t.res) text ();
+             F.pf pp "%s@." (Buffer.contents t.res);
+             F.flush pp ()
+          | _ -> ()
+        );
     ] s
 
+
+let top_1 = mktop ()
+
 let mouse_state = ref (0,0)
 let draw_komm (s:Display.state) =
   let node, state, box = ref I.empty, ref s, ref s.box in
@@ -572,7 +645,7 @@ let draw_komm (s:Display.state) =
   let mouse_x, mouse_y = !mouse_state in
   push @@ fill_box (Display.gray 0.125) s.box !state; (* gray bg *)
   push @@ pane_vbox [
-              draw_top 30.;
+              draw_top top_1 30.;
               (*draw_lumptree 50.;
                 draw_pp 30.
                 (fun pp ->