hehe it's all inside the toplevel now

README

@@ -2,9 +2,4 @@
 
 - `console/rootstore` must exist at `../rootstore`
 
-$ dune exec ./main.exe
+$ dune exec ./boot.exe
-
-Type in:
-`#use "init.ml"`
-Ctrl-Enter runs the command
-

boot.ml

@@ -1,6 +1,2 @@
-
-
-
-
 let eval = (Topinf.init Format.std_formatter) Format.std_formatter in
-eval "#use \"init.ml\";;";
+eval "#use \"init.ml\";;" 

dune

@@ -19,18 +19,24 @@
   ocaml-compiler-libs.toplevel))
 
 (executable
- (name test)
+ (name boot)
  (modes byte)
- (modules test)
+ (modules boot)
  (link_flags (-linkall))
  (libraries
   topinf))
 
-
 (library
  (name topinf)
  (modes byte)
  (modules topinf)
  (libraries
    fmt
+  tsdl
+  tgls.tgles2
+  wall
+  zed
+  irmin-unix
+  ocaml-compiler-libs.common
+  ocaml-compiler-libs.bytecomp
   ocaml-compiler-libs.toplevel))

init.ml

@@ -1,6 +1,7 @@
 (* $Id$ -*- tuareg -*- *)
 
-#directory "/home/cqc/p/console/boot/_build/default/.topinf.objs/byte";;
+Sys.command "dune top | head -n -1 > .topenv";; (* `head -n -1` to remove the topinf.cma which fuck this shit all up *)
+#use ".topenv";;
 open Topinf;;
 let print_directives () = 
   Format.printf "directive_info_table:@.";
@@ -12,3 +13,4 @@ let print_modules () =
   Format.printf "Env.fold_modules !Topinf.toplevel_env :\n";
   Env.fold_modules (fun modname _ _ () -> Format.printf "\t%s@." modname) None !Topinf.toplevel_env ();;
 
+#use "main.ml";;

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;
+(*  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);
+    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 *)
+      (* 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);
+      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*)
+      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) ));
+               Store.Tree.add tree (t.histpath @ ["input"]) (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)))
     | _ -> ());
   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 *)

topinf.ml

@@ -44,6 +44,8 @@ let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty
 
 let ppf = ref Format.std_formatter
 
+let eval = ref None
+
 let getvalue name =
   try String.Map.find name !toplevel_value_bindings
   with Not_found -> fatal_error (name ^ " unbound at toplevel")
@@ -2328,7 +2330,7 @@ end
 
 type evalenv = Format.formatter -> string -> unit
 
-let eval lb ppf (text : string) =
+let eval_fun lb ppf (text : string) =
   Topdirs.std_out := ppf;
   (read_interactive_input :=
      fun buffer _ ->
@@ -2408,4 +2410,5 @@ let init ppf =
   Location.input_phrase_buffer := Some phrase_buffer;
   Sys.catch_break true;
   run_hooks After_setup;
-  eval lb
+  eval := Some (eval_fun lb);
+  eval_fun lb

topinf.mli

@@ -3,7 +3,7 @@
      (See module Translmod.) *)
 val getvalue : string -> Obj.t
 val setvalue : string -> Obj.t -> unit
-(* End accessors for table of toplevel value bindings that must be first in the module signature *)
+(* End of: accessors for table of toplevel value bindings that must be first in the module signature *)
 
 val print_toplevel_value_bindings : Format.formatter -> unit
 
@@ -22,6 +22,10 @@ type directive_fun =
 
 type directive_info = { section : string; doc : string }
 
+val add_directive : Misc.filepath -> directive_fun -> directive_info -> unit
+
 val directive_info_table : (string, directive_info) Hashtbl.t
 
 val ppf : Format.formatter ref
+
+val eval : evalenv option ref