output to draw_pp's ppf

This commit is contained in:
cqc
2021-08-10 02:37:00 -05:00
parent 58975feee5
commit 73d9260b1f
4 changed files with 34 additions and 33 deletions

54
main.ml
View File

@ -529,22 +529,6 @@ type top = {
storeview : storeview;
}
let make_top storepath ?(branch = "current") () =
let t =
{
te = make_textedit ();
res = Format.make_symbolic_output_buffer ();
eval = None;
path = [ "init" ];
storeview = make_storeview storepath branch ();
}
in
let zctx = Zed_edit.context t.te.ze t.te.zc in
Zed_edit.insert zctx
(Zed_rope.of_string
(Zed_string.of_utf8 (Lwt_main.run (Store.get t.storeview.s t.path))));
t
let format_symbolic_output_buffer (ppf : Format.formatter) buf =
List.iter
Format.(
@ -568,28 +552,42 @@ let out_funs_of_sob sob =
out_spaces = (fun n -> add_symbolic_output_item sob (Output_spaces n));
}
let make_top storepath ?(branch = "current") () =
let t =
{
te = make_textedit ();
res = Format.make_symbolic_output_buffer ();
eval = None;
path = [ "init" ];
storeview = make_storeview storepath branch ();
}
in
Topinf.ppf := Format.formatter_of_symbolic_output_buffer t.res;
Format.pp_set_formatter_out_functions Format.std_formatter (out_funs_of_sob t.res);
let zctx = Zed_edit.context t.te.ze t.te.zc in
Zed_edit.insert zctx
(Zed_rope.of_string
(Zed_string.of_utf8 (Lwt_main.run (Store.get t.storeview.s t.path))));
t
let draw_top (t : top) height (s : Display.state) =
let ppf = Format.formatter_of_symbolic_output_buffer t.res in
Topinf.ppf := ppf;
let eval =
match t.eval with
| None ->
let e =
Topinf.init (Format.formatter_of_symbolic_output_buffer t.res)
in
t.eval <- Some e;
e
let e = Topinf.init ppf in
t.eval <- Some e;
e ppf "#use \"init.ml\";;";
e
| Some e -> e
in
(* HACK use Lazy.? *)
Display.handle_keyevents s.events (function
| `Key_up { char = '\r'; mods = [ Ctrl ]; _ } ->
format_symbolic_output_buffer F.stderr
(Format.flush_symbolic_output_buffer t.res);
(* HACK overwriting stdout formatter because fucking ocaml/toplevel/topdirs.ml hardcodes it *)
Format.pp_set_formatter_out_functions Format.std_formatter
(out_funs_of_sob t.res);
eval
(Format.formatter_of_symbolic_output_buffer t.res)
(str_of_textedit t.te ^ ";;");
Format.pp_set_formatter_out_functions Format.std_formatter (out_funs_of_sob t.res);
eval ppf (str_of_textedit t.te ^ ";;");
(*HACK to prevent getting stuck in parser*)
ignore
(Lwt_main.run