hehe it's all inside the toplevel now
This commit is contained in:
43
main.ml
43
main.ml
@ -318,7 +318,7 @@ let simple_text f text (s : Display.state) =
|
||||
let tm = Text.Font.text_measure f text in
|
||||
let br_pt = P2.v (Box2.ox s.box +. tm.width) (Box2.oy s.box +. font_height) in
|
||||
let bextent = Box2.of_pts (Box2.o s.box) br_pt in
|
||||
let _, (_, redbox) = path_box Color.red bextent s in
|
||||
(* let _, (_, redbox) = path_box Color.red bextent s in*)
|
||||
( { s with box = Box2.of_pts (Box2.br_pt bextent) (Box2.max s.box) },
|
||||
( bextent,
|
||||
(* I.stack redbox *)
|
||||
@ -526,6 +526,7 @@ type top = {
|
||||
res : Format.symbolic_output_buffer;
|
||||
mutable eval : Topinf.evalenv option;
|
||||
path : string list;
|
||||
histpath : string list;
|
||||
storeview : storeview;
|
||||
}
|
||||
|
||||
@ -559,11 +560,12 @@ let make_top storepath ?(branch = "current") () =
|
||||
res = Format.make_symbolic_output_buffer ();
|
||||
eval = None;
|
||||
path = [ "init" ];
|
||||
histpath = [ "history" ];
|
||||
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);
|
||||
(* 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
|
||||
@ -576,28 +578,29 @@ let draw_top (t : top) height (s : Display.state) =
|
||||
let eval =
|
||||
match t.eval with
|
||||
| None ->
|
||||
let e = Topinf.init ppf in
|
||||
let e = match !Topinf.eval with | Some e -> e | None -> Topinf.init ppf in
|
||||
t.eval <- Some e;
|
||||
e ppf "#use \"init.ml\";;";
|
||||
(* 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 ]; _ } ->
|
||||
(* 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 ppf (str_of_textedit t.te ^ ";;");
|
||||
(*HACK to prevent getting stuck in parser*)
|
||||
(* 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);
|
||||
|
||||
let b = Buffer.create 69 in
|
||||
format_symbolic_output_buffer (Format.formatter_of_buffer b) (Format.flush_symbolic_output_buffer t.res);
|
||||
ignore (Lwt_main.run (Store.tree t.storeview.s >>= fun tree ->
|
||||
Store.Tree.add tree (t.histpath @ ["output"]) (Buffer.contents b)));
|
||||
ignore (Lwt_main.run (Store.set_exn t.storeview.s ~info:(Irmin_unix.info "history")
|
||||
t.path (str_of_textedit t.te)));
|
||||
eval ppf (str_of_textedit t.te ^ ";;"); (*HACK to prevent getting stuck in parser*)
|
||||
ignore
|
||||
(Lwt_main.run
|
||||
( Store.tree t.storeview.s >>= fun tree ->
|
||||
Store.Tree.add tree t.path (str_of_textedit t.te) ));
|
||||
ignore
|
||||
(Lwt_main.run
|
||||
(Store.set_exn t.storeview.s
|
||||
~info:(Irmin_unix.info "executed")
|
||||
t.path (str_of_textedit t.te)))
|
||||
Store.Tree.add tree (t.histpath @ ["input"]) (str_of_textedit t.te) ))
|
||||
| _ -> ());
|
||||
pane_vbox
|
||||
[
|
||||
@ -626,4 +629,12 @@ let draw_komm (s : Display.state) =
|
||||
push @@ draw_top top_1 30. { s with box = !state.box };
|
||||
(!state, (Box2.of_pts (Box2.o s.box) (Box2.max !box), !node))
|
||||
|
||||
let () = Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) ()
|
||||
let () = while true do
|
||||
Display.(run (make_frame ~title:"hi" ~w:1440 ~h:900 ()) draw_komm) ()
|
||||
done
|
||||
|
||||
|
||||
|
||||
(* Implement the "window management" as just toplevel defined functions that manipulate the window tree *)
|
||||
|
||||
(* also, i'm tired *)
|
||||
|
||||
Reference in New Issue
Block a user