From b3dba10b30dbf412de3a81f8743ce853b38cee54 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 11 Jul 2021 23:23:00 -0500 Subject: [PATCH] lol ctrl+enter --- bin/main.ml | 135 ++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 104 insertions(+), 31 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index 7478989..8bc6b6b 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -507,61 +507,134 @@ 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 = - match main p () with + let main p = + match main p () with | exception Exit -> () | () -> () *) 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 "@."); - 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 ();*) - ) +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 -> + 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 ->