most cursor movement functionality works, but there are lots of weird quirks to iron out

.console

@@ -0,0 +1 @@
+it consoles you

.ocamlformat

@@ -0,0 +1 @@
+profile = compact

.ocamlformat-ignore

@@ -0,0 +1 @@
+init.ml

README

@@ -0,0 +1,5 @@
+# console/boot
+
+- `console/rootstore` must exist at `../rootstore`
+
+$ dune exec ./boot.exe

bin/dune

@@ -1,7 +0,0 @@
-(executables
- (names main)
- (modes byte)
- (link_flags (-linkall))
- (libraries komm tsdl tgls.tgles2 wall irmin-unix compiler-libs.common compiler-libs.bytecomp compiler-libs.toplevel ocaml-compiler-libs.common ocaml-compiler-libs.toplevel zed))
-
-

bin/main.ml

@@ -1,549 +0,0 @@
-(*[@@@ocaml.warning "-6-9-26-27"] *)
-open Lwt.Infix
-module F = Fmt
-
-module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
-(* Store.set_exn t ~info:(info "Adding a new entry") log_file logs) *)
-
-module Topmain = struct
-  open Ocaml_common
-  open Ocaml_toplevel
-  module Compenv = Ocaml_common.Compenv
-
-  let read_interactive_input = ref (fun _ _ -> 0)
-  let refill_lexbuf buffer len = !read_interactive_input buffer len
-  exception PPerror
-  (* Phase buffer that stores the last toplevel phrase (see [Location.input_phrase_buffer]). *)
-  let phrase_buffer = Buffer.create 1024
-  type evalenv = Format.formatter -> string -> unit
-  let eval lb ppf (text:string) =
-    F.epr "Topmain.eval: \n";
-    read_interactive_input := (fun buffer _ ->
-      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. *)
-      String.length text);
-    let snap = Btype.snapshot () in
-    try
-      F.epr "Topmain.eval: 1 reset@.";
-      Buffer.reset phrase_buffer; (* Reset the phrase buffer, then flush the lexing buffer. *)
-      Lexing.flush_input lb; (* calls read_interactive_input to fill buffer again *)
-      Location.reset ();
-      Warnings.reset_fatal ();
-      F.epr "Topmain.eval: 2 Toploop.parse_toplevel_phrase@.";
-      let phr = try !Toploop.parse_toplevel_phrase lb with Exit -> raise PPerror in
-      F.epr "Topmain.eval: 3 Toploop.preprocess_phrase@.";
-      let phr = Toploop.preprocess_phrase ppf phr  in
-      F.epr "Topmain.eval: 4 Env.reset_cache_toplevel@.";
-      Env.reset_cache_toplevel ();
-      F.epr "Topmain.eval: 5 Toploop.execute_phrase@.";
-      ignore(Toploop.execute_phrase true ppf phr);
-      F.epr "Topmain.eval: 6 handle exceptions@.";
-    with
-    | End_of_file -> F.epr "Topmain.eval End_of_file exception\n"; Btype.backtrack snap
-    | Sys.Break -> F.epr "Topmain.eval Sys.Break exception\n"; F.pf ppf "Interrupted.@."; Btype.backtrack snap
-    | PPerror -> F.epr "Topmain.eval PPerror exception\n"; ()
-    | x -> F.epr "Topmain.eval unknown exception\n"; Location.report_exception ppf x; Btype.backtrack snap
-
-  let preload_objects = ref ["komm.cma"]
-
-  let init ppf =
-    F.epr "Topmain.init: \n";
-    Compenv.readenv ppf Before_args;
-    Compenv.readenv ppf Before_link;
-    Compmisc.read_clflags_from_env ();
-    Toploop.set_paths ();
-    Load_path.add_dir "/home/cqc/.opam/default/lib/toplevel";
-    Load_path.add_dir "/home/cqc/p/pinephone/komm/komm/_build/default/lib/";
-    (try
-       F.epr "Load_path.get_paths: @."; List.iter (fun s -> F.epr "\t%s\n" s) (Load_path.get_paths ());
-       let res = List.for_all (fun name ->
-                     F.epr "Topdirs.load_file: ppf name=%s@." name;
-                     Topdirs.load_file ppf name) (List.rev !preload_objects @ !Compenv.first_objfiles) in
-      Toploop.run_hooks Toploop.Startup;
-      if not res then raise Exit
-    with Exit as x -> Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x));
-    Compmisc.init_path ();
-    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;
-    eval lb
-end
-
-module Display = struct
-  open Tgles2
-  open Tsdl
-  open Gg
-  open CamomileLibrary
-  let (>>=) x f = match x with
-    | Ok a -> f a
-    | Error _ as result -> result
-  
-  let get_result = function
-    | Ok x -> x
-    | Error (`Msg msg) -> failwith msg
-
-
-  type keymod = Shift | Ctrl | Meta | Fn
-  type key = {
-      char:char;
-      uchar:CamomileLibrary.UChar.t;
-      keycode:Sdl.keycode;
-      scancode:Sdl.scancode;
-      mods:keymod list}
-  
-  type mouse = (int * int)
-  type event = [ `Key_down of key
-               | `Key_up of key
-               | `Text_editing of string
-               | `Text_input of string
-               | `Mouse of mouse
-               | `Quit
-               | `Fullscreen of bool
-               | `None ]
-
-  let str_of_key k = Printf.sprintf "(char=%C;uchar=%C;keycode=%x;scancode=%x;name=%s;(%s%s%s%s))"
-                       k.char (CamomileLibrary.UChar.char_of k.uchar) k.keycode k.scancode
-                       (Sdl.get_key_name k.keycode) (if List.mem Shift k.mods then "shift" else "")
-                       (if List.mem Ctrl k.mods then "ctrl" else "") (if List.mem Meta k.mods then "meta" else "")
-                       (if List.mem Fn k.mods then " fn" else "")
-  
-  let event_of_sdlevent ev =
-    match Sdl.Event.enum (Sdl.Event.get ev Sdl.Event.typ) with
-    | `Text_editing -> F.epr "event_of_sdlevent: `Text_editing\n\twindow_id=%d\n\ttext=%s\n\tstart=%d\n\tlength=%d@."
-                              (Sdl.Event.get ev Sdl.Event.text_editing_window_id)
-                              (Sdl.Event.get ev Sdl.Event.text_editing_text)
-                              (Sdl.Event.get ev Sdl.Event.text_editing_start)
-                              (Sdl.Event.get ev Sdl.Event.text_editing_length); `None
-  
-    | `Text_input -> `Text_input (Sdl.Event.get ev Sdl.Event.text_input_text)
-    | `Key_down | `Key_up as w ->
-       let km = Sdl.Event.get ev Sdl.Event.keyboard_keymod in
-       let keycode = Sdl.Event.get ev Sdl.Event.keyboard_keycode in
-       let uchar = CamomileLibrary.UChar.of_int (if keycode land Sdl.K.scancode_mask > 0 then 0 else keycode) in
-       let mods = List.filter_map (fun (m, v) -> if (km land m)>0 then Some v else None)
-                    Sdl.Kmod.[(shift, Shift); (ctrl, Ctrl); (alt, Meta); (gui, Fn);] in
-       let k = { char=(UChar.char_of uchar); uchar; keycode;
-                 scancode=Sdl.Event.get ev Sdl.Event.keyboard_scancode; mods} in
-       (match w with `Key_down -> F.epr "key_down: " | `Key_up -> F.epr "key_up: ");
-       F.epr "%s@." (str_of_key k);
-       let repeat = (Sdl.Event.get ev Sdl.Event.keyboard_repeat) in
-       F.epr "\tkeyboard_repeat=%d\n" repeat ;
-       if repeat < 1 then (match w with `Key_down -> `Key_down k | `Key_up -> `Key_up k) else `None
-    | `Mouse_motion ->
-       let _, mouse_xy = Tsdl.Sdl.get_mouse_state () in `Mouse mouse_xy
-    | `Quit -> F.epr "Quit Event\n"; `Quit
-    | _ -> F.epr "Unknown Event@." ; `None
-  
-  let key_up : Sdl.keycode = 0x40000052
-  let key_down : Sdl.keycode = 0x40000051
-  let key_left : Sdl.keycode = 0x40000050
-  let key_right : Sdl.keycode = 0x4000004f
-
-  let handle_keyevents (el:event list) f = List.iter f el
-
-  (* current window state to be passed to window renderer *)
-  type state = { box: box2; (* This is cannonically box within which the next element should draw *)
-                 time: float;
-                 events: event list;
-                 wall: Wall.renderer; }
-
-  type image = (box2 * Wall.image) (* the box2 here is cannonically the place the returner drew 
-                                      (the Wall.image extents) *)
-  type pane = state -> (state * image)
-  
-  type frame = { sdl_win: Sdl.window;
-                 gl: Sdl.gl_context;
-                 wall: Wall.renderer;
-                 mutable quit: bool;
-                 mutable fullscreen: bool; }
-
-  let ticks () = (Int32.to_float (Sdl.get_ticks ())) /. 1000.
-  
-  let on_failure ~cleanup result = begin
-      match result with
-      | Ok _ -> ()
-      | Error _ -> cleanup ()
-    end; result
-
-  let video_initialized = lazy (Sdl.init Sdl.Init.video)
-
-  let make_frame ?(title="komm") ~w ~h () =
-    Lazy.force video_initialized >>= fun () ->
-    Sdl.create_window ~w ~h title
-      Sdl.Window.(opengl + allow_highdpi + resizable (*+ input_grabbed*))
-    >>= fun sdl_win ->
-    Sdl.set_window_title sdl_win title;
-    ignore (Sdl.gl_set_swap_interval (-1));
-    ignore (Sdl.gl_set_attribute Sdl.Gl.stencil_size 1);
-    on_failure (
-        Sdl.gl_create_context sdl_win >>= fun gl ->
-        let wall = Wall.Renderer.create ~antialias:true ~stencil_strokes:true () in
-        Ok { sdl_win; gl; wall; quit = false; fullscreen = false }
-      ) ~cleanup:(fun () -> Sdl.destroy_window sdl_win)
-  
-  let display_frame frame render =
-    (* create and fill event list *)
-    let tstart = ticks () in
-    let ev = Sdl.Event.create () in
-    let el = ref [`None] in
-    while Sdl.wait_event_timeout (Some ev) 50 (* HACK *) do
-      let e = event_of_sdlevent ev in
-      if e != `None then el := !el @ [e] (* HACK? *)
-    done;
-    (* Filter the events *)
-    el := List.filter_map
-            (function
-             | `Quit -> frame.quit <- true; None
-             | `Fullscreen a ->
-                if a then (
-                  frame.fullscreen <- not frame.fullscreen;
-                  ignore (Sdl.show_cursor (not frame.fullscreen) : _ result);
-                  ignore (Sdl.set_window_fullscreen frame.sdl_win
-                            (if frame.fullscreen
-                             then Sdl.Window.fullscreen_desktop
-                             else Sdl.Window.windowed)
-                          : _ result)); None
-             | `Key_up a -> Some (`Key_up a)
-             | `Key_down a -> Some (`Key_down a)
-             | `Mouse a -> Some (`Mouse a)
-             | a -> Some a
-            (*| a -> Some a*)) !el;
-    if (List.length !el) > 0 then begin
-        F.epr "Passing in %d events\n" (List.length !el);    
-        
-        let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
-        let _, (_, image) = render { box = (Box2.v (P2.v 0. 0.) (P2.v (float width) (float height)));
-                                             time = ticks (); events = !el; wall = frame.wall} in
-        Sdl.gl_make_current frame.sdl_win frame.gl >>= fun () ->
-        let width, height = Sdl.gl_get_drawable_size frame.sdl_win in
-        Gl.viewport 0 0 width height;
-        Gl.clear_color 0.0 0.0 0.0 1.0;
-        Gl.(clear (color_buffer_bit lor depth_buffer_bit lor stencil_buffer_bit));
-        Gl.enable Gl.blend;
-        Gl.blend_func_separate Gl.one Gl.src_alpha Gl.one Gl.one_minus_src_alpha;
-        Gl.enable Gl.cull_face_enum;
-        Gl.disable Gl.depth_test;
-        let width = float width and height = float height in
-        Wall.Renderer.render frame.wall ~width ~height image;
-        Sdl.gl_swap_window frame.sdl_win;
-        F.epr "event loop took %0.6f seconds\n" (ticks () -. tstart); Ok () end
-    else Ok ()
-  
-  let run frame render () =
-    let frame = get_result frame in
-    Sdl.show_window frame.sdl_win;
-    while not frame.quit do
-      ignore (display_frame frame render)
-    done;
-    print_endline "quit";
-    Sdl.hide_window frame.sdl_win; ()
-
-  let gray ?(a=1.0) v = Color.v v v v a
-end
-
-open Wall
-open Gg
-module I = Image
-module P = Path
-module Text = Wall_text
-
-let load_font name =
-  let ic = open_in_bin name in
-  let dim = in_channel_length ic in
-  let fd = Unix.descr_of_in_channel ic in
-  let buffer =
-    Unix.map_file fd Bigarray.int8_unsigned Bigarray.c_layout false [|dim|]
-    |> Bigarray.array1_of_genarray
-  in
-  let offset = List.hd (Stb_truetype.enum buffer) in
-  match Stb_truetype.init buffer offset with
-  | None -> assert false
-  | Some font -> font
-
-let font_icons = lazy (load_font "fonts/entypo.ttf")
-let font_sans = lazy (load_font "fonts/Roboto-Regular.ttf")
-let font_sans_bold = lazy (load_font "fonts/Roboto-Bold.ttf")
-let font_sans_light = lazy (load_font "fonts/Roboto-Light.ttf")
-let font_emoji = lazy (load_font "fonts/NotoEmoji-Regular.ttf")
-
-let str_of_box b = Printf.sprintf "(ox:%0.1f oy:%0.1f ex%0.1f ey%0.1f)" (Box2.ox b) (Box2.oy b) (Box2.maxx b) (Box2.maxy b)
-
-let draw_label text b =
-  let f = Text.Font.make ~size:(Box2.h b) (Lazy.force font_sans) in
-  ((Box2.v (Box2.o b) (P2.v (Text.Font.text_width f text) (Box2.h b))),
-   (I.paint (Paint.color (Display.gray ~a:0.5 1.0))
-      Text.(simple_text f ~valign:`BASELINE ~halign:`LEFT
-              ~x:(Box2.ox b) ~y:((Box2.oy b)+.(Box2.h b)*.0.75) text)))
-
-let fill_box c b (s:Display.state) =
-  (s, (b, I.paint (Paint.color c)
-            (I.fill_path @@ fun t -> P.rect t ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) ~h:(Box2.h b))))
-
-let path_box c b (s:Display.state) =
-  (s, (b, I.paint (Paint.color c)
-            (I.stroke_path
-               (Outline.make ()) @@ fun t -> P.rect t ~x:(Box2.ox b) ~y:(Box2.oy b) ~w:(Box2.w b) ~h:(Box2.h b))))
-
-let path_circle c b (s:Display.state) =
-  (s, (b, I.paint (Paint.color c)
-            (I.stroke_path
-               (Outline.make ()) @@ fun t -> P.circle t ~cx:(Box2.midx b) ~cy:(Box2.midy b) ~r:((Box2.w b) /. 2.))))
-
-(* draws the second item below if there's room *)
-let pane_vbox (subpanes:Display.pane list) (so:Display.state) = 
-  let sr, (br, ir) =
-    List.fold_left
-      (fun (sp, (_, ip)) (pane:Display.pane) ->
-        let sr, (br, ir) = pane sp in
-        let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in
-        ({sr with box = (Box2.of_pts (Box2.tl_pt br) (Box2.max sp.box))}, (br, Image.seq [ ip; sir; ir])))
-      (so, (so.box, Image.empty)) subpanes
-  in
-  let b = Box2.of_pts (Box2.o so.box) (Box2.max br) in 
-  let _,(_, i_redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) b sr in
-  (sr, (b, (Image.stack i_redbox ir)))
-
-(* draws second item to right if there's room *)
-let pane_hbox (subpanes:Display.pane list) (so:Display.state) = 
-  let sr, (br, ir) =
-    List.fold_left
-      (fun (sp, (_, ip)) (pane:Display.pane) ->
-        let sr, (br, ir) = pane sp in
-        let _, (_, sir) = path_box (Color.v 0.125 0.125 1.0 0.125) br sp in
-        ({sr with box = (Box2.of_pts (Box2.br_pt br) (Box2.max sp.box))},
-         (br, Image.seq [ ip; sir; ir])))
-      (so, (so.box, Image.empty)) subpanes
-  in
-  let b = Box2.of_pts (Box2.o so.box) (Box2.max br) in 
-  let _,(_, i_redbox) = path_box (Color.v 0.5 0.125 0.125 1.0) b sr in
-  (sr, (b, (Image.stack i_redbox ir)))
-
-
-
-let pane_label text height ~subpanes (s:Display.state) = 
-  let label_box, label_image = draw_label text (Box2.v (Box2.o s.box) (P2.v (Box2.w s.box) height)) in
-  Box2.pp Format.std_formatter label_box; 
-  (label_box, Image.seq [
-                  List.fold_left (fun image pane -> Image.seq [image; (pane s)]) Image.empty subpanes;
-                  I.paint (* red box *)
-                    (Paint.color (Color.v 0.5 0.125 0.125 1.0))
-                    (I.stroke_path (Outline.make ()) @@
-                       fun t -> P.rect t ~x:(Box2.ox s.box) ~y:(Box2.oy s.box) ~w:(Box2.w s.box) ~h:height);
-                  label_image; ])
-
-
-let simple_text f text (s:Display.state) =
-  let fm = Text.Font.font_metrics f in
-  let font_height = fm.ascent -. fm.descent +. fm.line_gap in
-  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.v 0.5 0.125 0.125 1.0) bextent s in
-  ({s with box = (Box2.of_pts (Box2.br_pt bextent) (Box2.max s.box))},
-   (bextent,
-    (I.stack redbox
-       (I.paint (Paint.color (Display.gray ~a:0.5 1.0))
-          Text.(simple_text f ~valign:`BASELINE ~halign:`LEFT
-                  ~x:(Box2.ox s.box) ~y:((Box2.oy s.box) +. fm.ascent) text)))))
-
-type Format.stag += Color_bg of Wall.color
-type Format.stag += Color_fg of Wall.color
-type Format.stag += Cursor of Wall.color
-let draw_pp height fpp (s:Display.state) =
-  let node, sc, box = ref I.empty, ref s, ref Box2.zero in
-  let push (s, (b, i)) = node := I.stack !node i; sc := s; box := b in
-  let f = Text.Font.make ~size:height (Lazy.force font_sans) in
-  let fm =  Text.Font.font_metrics f in
-  let font_height = fm.ascent -. fm.descent +. fm.line_gap in
-  let max_x = ref 0. in
-  let out_string text o l =
-    let text = String.sub text o l in
-    let sp = !sc in
-    push @@ simple_text f text !sc;
-    max_x := max !max_x (Box2.maxx !box);
-    sc := {!sc with box = (Box2.of_pts (P2.v (Box2.maxx !box) (Box2.oy sp.box)) (Box2.max sp.box))};
-  in
-  let out_flush () = () in
-  let out_newline () =
-    sc := {!sc with box = Box2.of_pts (P2.v (Box2.ox s.box) ((Box2.oy !sc.box) +. font_height)) (Box2.max s.box)}; 
-  in
-  let out_spaces n =
-    let wpx = Text.Font.text_width f " " in
-    if ((Box2.ox !sc.box) +. ((float n) *. wpx)) > (Box2.maxx !sc.box) then (* WRAP *)
-      begin F.epr "out_spaces: ===== WRAP =======@."; out_newline () end;
-    let so = !sc in
-    let bo = Box2.v (Box2.o !sc.box) (P2.v ((float n) *. wpx) height) in
-    let bsp = (Box2.v (Box2.br_pt !box) (P2.v wpx height)) in
-    push @@ pane_hbox (List.init n (fun _ -> path_circle (Color.v 0.125 1.0 0.125 0.125) bsp)) !sc;
-    box := bo;
-    sc := {!sc with box = Box2.of_pts (Box2.br_pt bo) (Box2.max so.box)};
-  in
-  let out_indent n =
-    let p = (min ((Box2.w !sc.box)-.1.) (height *. 2.0 *. (float n))) in
-    sc := {!sc with box = Box2.of_pts (P2.v ((Box2.ox !sc.box) +. p) (Box2.oy !sc.box))
-                            (Box2.max !sc.box)};
-  in
-  let pp = Format.formatter_of_out_functions {out_string; out_flush; out_newline; out_spaces; out_indent;} in
-  Format.pp_set_formatter_stag_functions pp {
-      mark_open_stag = (fun s ->
-        (match s with
-         | Cursor c -> push @@ fill_box c (Box2.v (Box2.o !sc.box) (P2.v (height *. 0.333) height)) !sc
-         | Color_bg c -> push @@ fill_box c !box !sc
-         | _ -> ()); "");
-      mark_close_stag = (function | _ -> (); "");
-      print_open_stag = (fun _ -> (*"<open_stag>"*) ()); (* TKTKTKTK XXX IT SHOULD BE USING THESE print ONES *)
-      print_close_stag = (fun _ -> (*"<close_stag>"*) ());
-    };
-  Format.pp_set_tags pp true;
-  let margin = int_of_float ((Box2.w s.box) /. (Text.Font.text_width f " ")) in
-  let max_indent = margin in
-  Format.pp_safe_set_geometry pp ~max_indent ~margin;
-  fpp pp;
-  Format.pp_force_newline pp ();
-  !sc, ((Box2.of_pts (Box2.o s.box) (P2.v !max_x (Box2.maxy !box))), !node)
-
-(*let draw_spp height fpp (s:Display.state) =
-  let node, sc, box = ref I.empty, ref s, ref Box2.zero in
-  let push (s, (b, i)) = node := I.stack !node i; sc := s; box := b in
-  let f = Text.Font.make ~size:height (Lazy.force font_sans) in
-  let fm =  Text.Font.font_metrics f in
-  let font_height = fm.ascent -. fm.descent +. fm.line_gap in
-
-  let sob = Format.make_symbolic_output_buffer () in
-  let pp = Format.formatter_of_symbolic_output_buffer sob in
-
-  Format.flush_symbolic_output_buffer sob;
-  fpp pp;
-  !sc, ((Box2.of_pts (Box2.o s.box) (Box2.max !sc.box)), !node)*)
-
-type textedit = {ze: unit Zed_edit.t; zc: Zed_cursor.t}
-let make_textedit () = let z = Zed_edit.create () in {ze = z; zc = Zed_edit.new_cursor z;}
-let draw_textedit (te:textedit) height (s:Display.state) =
-  let ctx = Zed_edit.context te.ze te.zc in
-  List.iter (function
-      | `Key_down (k:Display.key) ->
-         (match k with
-          | {keycode=kc;mods=[]; _} when kc = Display.key_up -> Zed_edit.prev_line ctx
-          | {keycode=kc;mods=[]; _} when kc = Display.key_down -> Zed_edit.next_line ctx
-          | {keycode=kc;mods=[]; _} when kc = Display.key_left -> Zed_edit.prev_char ctx
-          | {keycode=kc;mods=[]; _} when kc = Display.key_right-> Zed_edit.next_char ctx
-          | {char='\r'; mods=[]; _} -> Zed_edit.newline ctx
-          | {char='b';  mods=[Ctrl]; _} -> Zed_edit.prev_char ctx
-          | {char='f';  mods=[Ctrl]; _} -> Zed_edit.next_char ctx
-          | {char='a';  mods=[Ctrl]; _} -> Zed_edit.goto_bol ctx
-          | {char='e';  mods=[Ctrl]; _} -> Zed_edit.goto_eol ctx
-          | {char='d';  mods=[Ctrl]; _} -> Zed_edit.remove_next ctx 1
-          | {char='d';  mods=[Meta]; _} -> Zed_edit.kill_next_word ctx
-          | {char='\b'; mods=[];     _} -> Zed_edit.remove_prev ctx 1
-          | {char='\b'; mods=[Meta]; _} -> Zed_edit.kill_prev_word ctx
-          | {char='\t'; mods=[]; _} -> Zed_edit.insert_char ctx (CamomileLibrary.UChar.of_char '\t')
-          | {char='k';  mods=[Ctrl]; _} -> Zed_edit.kill_next_line ctx
-          | _ -> ())
-      | `Key_up _ -> ()
-      | `Text_input s -> F.epr "draw_textedit: `Text_input %s@." s;
-                         Zed_edit.insert ctx (Zed_rope.of_string (Zed_string.of_utf8 s)); ()
-      | _ -> ()) s.events;
-  draw_pp height (fun pp ->
-      let zrb, zra = Zed_rope.break (Zed_edit.text te.ze) (Zed_cursor.get_position te.zc) in
-      let before_cursor = Zed_string.to_utf8 (Zed_rope.to_string zrb) in
-      let after_cursor = Zed_string.to_utf8 (Zed_rope.to_string zra) in
-      Format.pp_open_hvbox pp 0;
-      F.text pp before_cursor;
-      Format.pp_open_stag pp (Cursor (Wall.Color.v 0.99 0.99 0.125 0.3));
-      F.pf pp "";
-      Format.pp_close_stag pp ();
-      F.text pp after_cursor;
-      F.pf pp "@.";
-      Format.pp_close_box pp ();
-    ) s
-let str_of_textedit (te:textedit) = Zed_string.to_utf8 (Zed_rope.to_string (Zed_edit.text te.ze))
-
-type storeview = {s:Store.t; path:string list}
-let make_storeview storepath branch ?(path=[]) () =
-  {s=Lwt_main.run (Store.of_branch (Lwt_main.run (Store.Repo.v (Irmin_git.config storepath))) branch) ;path}
-let draw_storeview (r:storeview) height (s:Display.state) =
-  let indent = ref 0 in
-  let rec draw_levels (tree:(string * Store.tree) list) pp =
-    indent := !indent + 1;
-    List.iter (fun (step, node) ->
-        Format.pp_open_vbox pp 0;
-        Format.pp_open_hbox pp ();
-        for _ = 0 to !indent do Format.pp_print_space pp () done;
-        Format.fprintf pp "%d-%s@." !indent step;
-        Format.pp_close_box pp ();
-        let subtree = Lwt_main.run (Store.Tree.list node []) in
-        draw_levels subtree pp;
-        Format.pp_close_box pp ()
-      ) tree;
-    indent := !indent - 1
-  in
-  let root = Lwt_main.run (Store.get_tree r.s r.path >>= (fun n -> Store.Tree.list n [])) in
-  draw_pp height (draw_levels root) s
-
-type top = {te: textedit; res: Buffer.t; mutable eval: Topmain.evalenv option; path: string list; storeview: storeview}
-let make_top storepath ?(branch="current") () =
-  let t = {te=make_textedit (); res=Buffer.create 1024;
-           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 draw_top (t:top) height (s:Display.state) =
-  let eval = match t.eval with
-      None -> let e = (Topmain.init (Format.formatter_of_buffer t.res)) in t.eval <- Some e; e
-    | Some e -> e in
-  Display.handle_keyevents s.events
-    (function 
-     | `Key_up {char='\r'; mods=[Ctrl]; _} -> 
-        Buffer.clear t.res;
-        eval (Format.formatter_of_buffer t.res)
-          ((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)))
-     | _ -> ());
-  pane_vbox [
-      draw_textedit t.te height;
-      draw_pp height (fun pp ->
-          Format.pp_open_hvbox pp 0;
-          F.text pp (Buffer.contents t.res);
-          F.pf pp "@.";
-          Format.pp_close_box pp ();
-          F.flush pp ()
-        );
-      draw_storeview t.storeview height;
-    ] s
-let top_1 = make_top "../../rootstore" ()
-
-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
-  let push (s, (b, i))  = node := I.stack !node i; state := s; box := b in
-(*  begin match List.find_opt (function `Mouse a -> true | _ -> false) s.events with
-    Some (`Mouse a) -> mouse_state := a
-  | _ -> (); end;*)
-  (*  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 top_1 25.;
-            ] {s with box = !state.box (*(Box2.v P2.o (Size2.v (float mouse_x) (float mouse_y)))*)};
-  (!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) ()

boot.ml

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

dune

@@ -0,0 +1,78 @@
+(env
+  (dev
+   (flags (:standard -warn-error -A))))
+
+(library
+ (name human)
+ (modes byte)
+ (modules human)
+ (libraries
+  topinf
+   lwt_ppx
+  tsdl
+  tgls.tgles2
+  wall
+  zed
+  lambda-term
+  irmin-unix
+  nottui
+  nottui-pretty
+  uuseg.string
+  uutf
+  uucp
+  ocaml-compiler-libs.common
+  ocaml-compiler-libs.bytecomp
+  ocaml-compiler-libs.toplevel))
+
+
+(executable
+ (name irc)
+ (modes byte)
+ (modules irc)
+ (libraries
+   human
+   lwt
+   fmt
+   topinf
+   lwt_ppx
+   irc-client
+   irc-client-lwt
+   irc-client-unix
+   irc-client-tls
+   nottui-lwt
+   nottui-pretty
+))
+
+(executable
+ (name boot)
+ (modes byte)
+ (modules boot)
+ (link_flags (-linkall))
+ (libraries
+   lwt_ppx
+   lambda-term
+   topinf))
+
+(library
+ (name topinf)
+ (modes byte)
+ (modules topinf)
+ (libraries
+   fmt
+  tsdl
+  tgls.tgles2
+  wall
+  zed
+  lambda-term
+  irmin-unix
+  nottui
+  nottui-pretty
+  nottui-lwt
+  uuseg
+  irc-client
+  irc-client-lwt
+  irc-client-unix
+  irc-client-tls
+  ocaml-compiler-libs.common
+  ocaml-compiler-libs.bytecomp
+  ocaml-compiler-libs.toplevel))

dune-project

@@ -1,2 +1,3 @@
 (lang dune 2.8)
 (name komm)
+(wrapped_executables false)

fonts/LICENSE.txt

@@ -0,0 +1,202 @@
+
+                                 Apache License
+                           Version 2.0, January 2004
+                        http://www.apache.org/licenses/
+
+   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
+
+   1. Definitions.
+
+      "License" shall mean the terms and conditions for use, reproduction,
+      and distribution as defined by Sections 1 through 9 of this document.
+
+      "Licensor" shall mean the copyright owner or entity authorized by
+      the copyright owner that is granting the License.
+
+      "Legal Entity" shall mean the union of the acting entity and all
+      other entities that control, are controlled by, or are under common
+      control with that entity. For the purposes of this definition,
+      "control" means (i) the power, direct or indirect, to cause the
+      direction or management of such entity, whether by contract or
+      otherwise, or (ii) ownership of fifty percent (50%) or more of the
+      outstanding shares, or (iii) beneficial ownership of such entity.
+
+      "You" (or "Your") shall mean an individual or Legal Entity
+      exercising permissions granted by this License.
+
+      "Source" form shall mean the preferred form for making modifications,
+      including but not limited to software source code, documentation
+      source, and configuration files.
+
+      "Object" form shall mean any form resulting from mechanical
+      transformation or translation of a Source form, including but
+      not limited to compiled object code, generated documentation,
+      and conversions to other media types.
+
+      "Work" shall mean the work of authorship, whether in Source or
+      Object form, made available under the License, as indicated by a
+      copyright notice that is included in or attached to the work
+      (an example is provided in the Appendix below).
+
+      "Derivative Works" shall mean any work, whether in Source or Object
+      form, that is based on (or derived from) the Work and for which the
+      editorial revisions, annotations, elaborations, or other modifications
+      represent, as a whole, an original work of authorship. For the purposes
+      of this License, Derivative Works shall not include works that remain
+      separable from, or merely link (or bind by name) to the interfaces of,
+      the Work and Derivative Works thereof.
+
+      "Contribution" shall mean any work of authorship, including
+      the original version of the Work and any modifications or additions
+      to that Work or Derivative Works thereof, that is intentionally
+      submitted to Licensor for inclusion in the Work by the copyright owner
+      or by an individual or Legal Entity authorized to submit on behalf of
+      the copyright owner. For the purposes of this definition, "submitted"
+      means any form of electronic, verbal, or written communication sent
+      to the Licensor or its representatives, including but not limited to
+      communication on electronic mailing lists, source code control systems,
+      and issue tracking systems that are managed by, or on behalf of, the
+      Licensor for the purpose of discussing and improving the Work, but
+      excluding communication that is conspicuously marked or otherwise
+      designated in writing by the copyright owner as "Not a Contribution."
+
+      "Contributor" shall mean Licensor and any individual or Legal Entity
+      on behalf of whom a Contribution has been received by Licensor and
+      subsequently incorporated within the Work.
+
+   2. Grant of Copyright License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      copyright license to reproduce, prepare Derivative Works of,
+      publicly display, publicly perform, sublicense, and distribute the
+      Work and such Derivative Works in Source or Object form.
+
+   3. Grant of Patent License. Subject to the terms and conditions of
+      this License, each Contributor hereby grants to You a perpetual,
+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable
+      (except as stated in this section) patent license to make, have made,
+      use, offer to sell, sell, import, and otherwise transfer the Work,
+      where such license applies only to those patent claims licensable
+      by such Contributor that are necessarily infringed by their
+      Contribution(s) alone or by combination of their Contribution(s)
+      with the Work to which such Contribution(s) was submitted. If You
+      institute patent litigation against any entity (including a
+      cross-claim or counterclaim in a lawsuit) alleging that the Work
+      or a Contribution incorporated within the Work constitutes direct
+      or contributory patent infringement, then any patent licenses
+      granted to You under this License for that Work shall terminate
+      as of the date such litigation is filed.
+
+   4. Redistribution. You may reproduce and distribute copies of the
+      Work or Derivative Works thereof in any medium, with or without
+      modifications, and in Source or Object form, provided that You
+      meet the following conditions:
+
+      (a) You must give any other recipients of the Work or
+          Derivative Works a copy of this License; and
+
+      (b) You must cause any modified files to carry prominent notices
+          stating that You changed the files; and
+
+      (c) You must retain, in the Source form of any Derivative Works
+          that You distribute, all copyright, patent, trademark, and
+          attribution notices from the Source form of the Work,
+          excluding those notices that do not pertain to any part of
+          the Derivative Works; and
+
+      (d) If the Work includes a "NOTICE" text file as part of its
+          distribution, then any Derivative Works that You distribute must
+          include a readable copy of the attribution notices contained
+          within such NOTICE file, excluding those notices that do not
+          pertain to any part of the Derivative Works, in at least one
+          of the following places: within a NOTICE text file distributed
+          as part of the Derivative Works; within the Source form or
+          documentation, if provided along with the Derivative Works; or,
+          within a display generated by the Derivative Works, if and
+          wherever such third-party notices normally appear. The contents
+          of the NOTICE file are for informational purposes only and
+          do not modify the License. You may add Your own attribution
+          notices within Derivative Works that You distribute, alongside
+          or as an addendum to the NOTICE text from the Work, provided
+          that such additional attribution notices cannot be construed
+          as modifying the License.
+
+      You may add Your own copyright statement to Your modifications and
+      may provide additional or different license terms and conditions
+      for use, reproduction, or distribution of Your modifications, or
+      for any such Derivative Works as a whole, provided Your use,
+      reproduction, and distribution of the Work otherwise complies with
+      the conditions stated in this License.
+
+   5. Submission of Contributions. Unless You explicitly state otherwise,
+      any Contribution intentionally submitted for inclusion in the Work
+      by You to the Licensor shall be under the terms and conditions of
+      this License, without any additional terms or conditions.
+      Notwithstanding the above, nothing herein shall supersede or modify
+      the terms of any separate license agreement you may have executed
+      with Licensor regarding such Contributions.
+
+   6. Trademarks. This License does not grant permission to use the trade
+      names, trademarks, service marks, or product names of the Licensor,
+      except as required for reasonable and customary use in describing the
+      origin of the Work and reproducing the content of the NOTICE file.
+
+   7. Disclaimer of Warranty. Unless required by applicable law or
+      agreed to in writing, Licensor provides the Work (and each
+      Contributor provides its Contributions) on an "AS IS" BASIS,
+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
+      implied, including, without limitation, any warranties or conditions
+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
+      PARTICULAR PURPOSE. You are solely responsible for determining the
+      appropriateness of using or redistributing the Work and assume any
+      risks associated with Your exercise of permissions under this License.
+
+   8. Limitation of Liability. In no event and under no legal theory,
+      whether in tort (including negligence), contract, or otherwise,
+      unless required by applicable law (such as deliberate and grossly
+      negligent acts) or agreed to in writing, shall any Contributor be
+      liable to You for damages, including any direct, indirect, special,
+      incidental, or consequential damages of any character arising as a
+      result of this License or out of the use or inability to use the
+      Work (including but not limited to damages for loss of goodwill,
+      work stoppage, computer failure or malfunction, or any and all
+      other commercial damages or losses), even if such Contributor
+      has been advised of the possibility of such damages.
+
+   9. Accepting Warranty or Additional Liability. While redistributing
+      the Work or Derivative Works thereof, You may choose to offer,
+      and charge a fee for, acceptance of support, warranty, indemnity,
+      or other liability obligations and/or rights consistent with this
+      License. However, in accepting such obligations, You may act only
+      on Your own behalf and on Your sole responsibility, not on behalf
+      of any other Contributor, and only if You agree to indemnify,
+      defend, and hold each Contributor harmless for any liability
+      incurred by, or claims asserted against, such Contributor by reason
+      of your accepting any such warranty or additional liability.
+
+   END OF TERMS AND CONDITIONS
+
+   APPENDIX: How to apply the Apache License to your work.
+
+      To apply the Apache License to your work, attach the following
+      boilerplate notice, with the fields enclosed by brackets "[]"
+      replaced with your own identifying information. (Don't include
+      the brackets!)  The text should be enclosed in the appropriate
+      comment syntax for the file format. We also recommend that a
+      file or class name and description of purpose be included on the
+      same "printed page" as the copyright notice for easier
+      identification within third-party archives.
+
+   Copyright [yyyy] [name of copyright owner]
+
+   Licensed under the Apache License, Version 2.0 (the "License");
+   you may not use this file except in compliance with the License.
+   You may obtain a copy of the License at
+
+       http://www.apache.org/licenses/LICENSE-2.0
+
+   Unless required by applicable law or agreed to in writing, software
+   distributed under the License is distributed on an "AS IS" BASIS,
+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+   See the License for the specific language governing permissions and
+   limitations under the License.

fonts/OFL.txt

@@ -0,0 +1,94 @@
+Copyright (c) 1994-2021, SIL International (http://www.sil.org/),
+with Reserved Font Names "Scheherazade" and "SIL".
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

fonts/README.txt

@@ -0,0 +1,77 @@
+Roboto Mono Variable Font
+=========================
+
+This download contains Roboto Mono as both variable fonts and static fonts.
+
+Roboto Mono is a variable font with this axis:
+  wght
+
+This means all the styles are contained in these files:
+  RobotoMono-VariableFont_wght.ttf
+  RobotoMono-Italic-VariableFont_wght.ttf
+
+If your app fully supports variable fonts, you can now pick intermediate styles
+that aren’t available as static fonts. Not all apps support variable fonts, and
+in those cases you can use the static font files for Roboto Mono:
+  static/RobotoMono-Thin.ttf
+  static/RobotoMono-ExtraLight.ttf
+  static/RobotoMono-Light.ttf
+  static/RobotoMono-Regular.ttf
+  static/RobotoMono-Medium.ttf
+  static/RobotoMono-SemiBold.ttf
+  static/RobotoMono-Bold.ttf
+  static/RobotoMono-ThinItalic.ttf
+  static/RobotoMono-ExtraLightItalic.ttf
+  static/RobotoMono-LightItalic.ttf
+  static/RobotoMono-Italic.ttf
+  static/RobotoMono-MediumItalic.ttf
+  static/RobotoMono-SemiBoldItalic.ttf
+  static/RobotoMono-BoldItalic.ttf
+
+Get started
+-----------
+
+1. Install the font files you want to use
+
+2. Use your app's font picker to view the font family and all the
+available styles
+
+Learn more about variable fonts
+-------------------------------
+
+  https://developers.google.com/web/fundamentals/design-and-ux/typography/variable-fonts
+  https://variablefonts.typenetwork.com
+  https://medium.com/variable-fonts
+
+In desktop apps
+
+  https://theblog.adobe.com/can-variable-fonts-illustrator-cc
+  https://helpx.adobe.com/nz/photoshop/using/fonts.html#variable_fonts
+
+Online
+
+  https://developers.google.com/fonts/docs/getting_started
+  https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_Fonts/Variable_Fonts_Guide
+  https://developer.microsoft.com/en-us/microsoft-edge/testdrive/demos/variable-fonts
+
+Installing fonts
+
+  MacOS: https://support.apple.com/en-us/HT201749
+  Linux: https://www.google.com/search?q=how+to+install+a+font+on+gnu%2Blinux
+  Windows: https://support.microsoft.com/en-us/help/314960/how-to-install-or-remove-a-font-in-windows
+
+Android Apps
+
+  https://developers.google.com/fonts/docs/android
+  https://developer.android.com/guide/topics/ui/look-and-feel/downloadable-fonts
+
+License
+-------
+Please read the full license text (LICENSE.txt) to understand the permissions,
+restrictions and requirements for usage, redistribution, and modification.
+
+You can use them freely in your products & projects - print or digital,
+commercial or otherwise.
+
+This isn't legal advice, please consider consulting a lawyer and see the full
+license for all details.

init.ml

@@ -0,0 +1,18 @@
+(* $Id$ -*- tuareg -*- *)
+
+#use_output "dune top | grep -v \"ocamltoplevel.cma\\|ocaml_toplevel.cma\\|topinf.cma\"";; (* grep to remove the topinf.cma which fuck this shit all up *)
+open Topinf;;
+let print_directives () = 
+  Format.printf "directive_info_table:@.";
+  Hashtbl.iter (fun n _ -> Format.printf "\t%s@." n) Topinf.directive_info_table;;
+
+(*#directory "+compiler-libs";; *)
+
+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 ();;
+(*print_modules ();;*)
+
+#use_silently "human.ml";;
+
+start ();;

irc.ml

@@ -0,0 +1,494 @@
+(*
+when all you can do is type, making things more complicated than a list is hard?
+we need to design this somehow before implementing it
+really the graphical drawing / window management funcitons i think at this point.
+
+features:
+ - message drafts? more like, if you send too many messages to someone all at once it will hold them so you can respond later and not flood people.......
+   - i mean really what you want is an editable stream, so you can stage messages for later
+   - because i mean, if this is a bicycle, and you can make it however you want, you can just fuck with the conversation thread with computer assistance instaed of just relying on your memory.
+*)
+
+open Lwt
+open Lwt_react
+module F = Fmt
+
+module Communicator = struct
+  let base_path = "communicator"
+  let topch = "top"
+
+  module Istore = struct
+    include Human.Store
+
+    let from_storeview (sv : storeview) = sv.store
+
+    include Human.Store.Istore
+  end
+
+  module Message = struct
+    type t = {time: string list; content: string}
+
+    let make ?(time = Unix.gettimeofday ()) content =
+      let tm = Unix.localtime time in
+      { time=
+          List.map string_of_int
+            [tm.tm_year + 1900; tm.tm_mon + 1; tm.tm_mday; tm.tm_hour]
+          @ [ string_of_float
+                ( float_of_int (tm.tm_min * tm.tm_sec)
+                +. fst (modf time) ) ]
+      ; content }
+  end
+
+  module Channel = struct
+    (* a channels step key may not be blank (i.e. "") *)
+    type t = {store: Istore.t; path: Istore.key}
+
+    let make (store : Istore.t) ~path ~(name : string) =
+      Lwt.return {store; path= path @ ["#" ^ name]}
+
+    let add_msg {store; path} (msg : Message.t) : unit Lwt.t =
+      F.epr "add_msg path=[" ;
+      F.list ~sep:F.semi F.string F.stderr (path @ msg.time) ;
+      F.epr "] content=%s @." msg.content ;
+      Istore.set_exn store ~info:Irmin.Info.none (path @ msg.time)
+        msg.content
+  end
+
+  module Tree = struct
+    open Message
+
+    type selection = Istore.Key.t
+    type t = {store: Istore.t; view: Istore.key}
+
+    let contents {store; view} (s : selection) :
+        Istore.Contents.t option Lwt.t =
+      Istore.find store (view @ s)
+
+    let make_top ?(view = [base_path]) gitpath branchname : t Lwt.t =
+      Istore.Repo.v (Irmin_git.config gitpath)
+      >>= fun repo ->
+      Istore.of_branch repo branchname
+      >>= fun store ->
+      let t = {store; view} in
+      Channel.make store ~path:view ~name:topch
+      >>= fun ch_top ->
+      Channel.add_msg ch_top
+        (Message.make "Communicator restarting...")
+      >>= fun () ->
+      Channel.add_msg ch_top
+        (Message.make "Currently only IRC is implemented")
+      >>= fun () -> Lwt.return t
+
+    let add {store; view} ~(name : string list) ~(config : Istore.tree)
+        : t Lwt.t =
+      Istore.get_tree store name
+      >>= fun tree ->
+      Istore.Tree.remove tree ["_config"]
+      >>= fun tree ->
+      Istore.Tree.add_tree tree [] config
+      >>= fun tree ->
+      Istore.set_tree_exn ~info:Irmin.Info.none store name tree
+      >>= fun () -> Lwt.return {store; view}
+  end
+
+  module Protocol = struct
+    type t = Irc | Email | Rss | Mublog | ActivityPub
+
+    let to_string = function
+      | Irc -> ("IRC", "Internet Relay Chat")
+      | Email -> ("E-mail", "Electronic Mail")
+      | Rss -> ("RSS", "Really Simple Subscriptions???")
+      | Mublog -> ("uBlog", "Microblogging (Twitter)")
+      | ActivityPub -> ("ActivityPub", "Mastodon, etc.")
+
+    let id t = fst (to_string t)
+    let desc t = snd (to_string t)
+  end
+
+  module Irc = struct
+    module C = Irc_client_tls
+    module M = Irc_message
+
+    module Config = struct
+      type t = Istore.tree
+
+      open Lwt.Infix
+
+      let path = "_config"
+
+      let make_connection Tree.{store; view} server port nick =
+        let name = F.str "%s@%s:%d" nick server port in
+        Istore.Tree.add Istore.Tree.empty ["server"] server
+        >>= fun t' ->
+        Istore.Tree.add t' ["port"] (string_of_int port)
+        >>= fun t' ->
+        Istore.Tree.add t' ["nick"] nick
+        >>= fun t' ->
+        Istore.Tree.add t' ["protocol"] (Protocol.id Irc)
+        >>= fun t' ->
+        F.epr "Creating connection config /%s/%s/@." name path ;
+        Istore.set_tree_exn ~info:Irmin.Info.none store
+          (view @ [name; path])
+          t'
+        >>= fun _ -> Lwt.return_unit
+
+      let server t : string Lwt.t = Istore.Tree.get t [path; "server"]
+
+      let port t : int Lwt.t =
+        Istore.Tree.get t [path; "port"] >|= fun p -> int_of_string p
+
+      let nick t : string Lwt.t = Istore.Tree.get t [path; "nick"]
+
+      let protocol t : string option Lwt.t =
+        Istore.Tree.find t [path; "protocol"]
+    end
+
+    let get_channels ~store ~path =
+      Istore.list store path
+      >>= fun c ->
+      let rec iter l =
+        Lwt_list.filter_map_p
+          (fun (s, _) ->
+            if String.length s > 1 && String.get s 0 = '#' then
+              Lwt.return (Some s)
+            else Lwt.return None )
+          l in
+      iter c
+
+    let connect ?(path = [base_path]) ({store; _} : Tree.t) :
+        unit Lwt.t =
+      (* search for all connections and start them *)
+      (* also need ot figure out how to preserve custom ordering of items like servers and channels
+         maybe just a _order file that has the ordering of files listed and hten gets  updated etc. *)
+      Channel.make store ~path ~name:topch
+      >>= fun top_channel ->
+      let _top_msg str =
+        Channel.add_msg top_channel (Message.make str) in
+      let channel_assoc = ref [] in
+      let make_channel store path (name : string) =
+        Channel.make store ~path ~name
+        >>= fun ch ->
+        channel_assoc := (name, ch) :: !channel_assoc ;
+        Channel.add_msg ch
+          (Message.make (F.str "channel %s created" name))
+        >>= fun () -> Lwt.return ch in
+      Istore.list store path
+      >>= fun servers ->
+      Lwt_list.filter_p
+        (fun (_, tree) ->
+          Config.protocol tree
+          >|= function Some p -> p = Protocol.id Irc | None -> false
+          )
+        servers
+      (* filter out non-irc protocols, TODO currently relying on this to filter out non-server folders too *)
+      >>= fun servers ->
+      F.epr "protocols filtered for irc@." ;
+      Lwt_list.iter_p
+        (fun (name, tree) ->
+          F.epr "Irc.connect server=%s @." name ;
+          Config.nick tree
+          >>= fun nick ->
+          Config.server tree
+          >>= fun server ->
+          Config.port tree
+          >>= fun port ->
+          Channel.make store ~path:(path @ [name]) ~name:topch
+          >>= fun server_channel ->
+          let add_msg s =
+            Channel.add_msg server_channel (Message.make s) in
+          C.reconnect_loop ~after:30
+            ~connect:(fun () ->
+              add_msg "Connecting..."
+              >>= fun () ->
+              C.connect_by_name ~server ~port ~nick ()
+              >>= fun c -> Lwt.return c )
+            ~f:(fun connection ->
+              F.epr "Irc.connect C.reconnect_loop ~f:(Connected...)@." ;
+              add_msg "Connected"
+              >>= fun () ->
+              get_channels ~store ~path:[name]
+              >>= fun chs ->
+              Lwt_list.iter_p
+                (fun chname ->
+                  C.send_join ~connection ~channel:chname
+                  >>= fun () ->
+                  ignore (make_channel store [name] chname) ;
+                  Lwt.return_unit )
+                chs )
+            ~callback:(fun _connection result ->
+              match result with
+              | Result.Ok ({M.command= M.Other _; _} as msg) ->
+                  add_msg (M.to_string msg)
+              | Result.Ok
+                  {M.command= M.PRIVMSG (target, data); prefix= user}
+                -> (
+                  let user =
+                    match user with
+                    | Some u -> List.hd (String.split_on_char '!' u)
+                    | None -> "unknown" in
+                  match List.assoc_opt target !channel_assoc with
+                  | Some ch ->
+                      Channel.add_msg ch
+                        (Message.make (F.str "<%s> %s" user data))
+                  | None ->
+                      make_channel store [server] target
+                      >>= fun ch ->
+                      Channel.add_msg ch
+                        (Message.make (F.str "<%s> %s" user data)) )
+              | Result.Ok msg ->
+                  add_msg (M.to_string msg)
+                  >>= fun () -> Lwt.return_unit
+              | Result.Error e -> Lwt_io.printl e )
+            () )
+        servers
+  end
+
+  module Panel = struct
+    open Panel
+    open Panel.Ui
+
+    type viewer =
+      { step: string
+      ; var: view Lwd.var
+      ; mutable parent: view
+      ; mutable node: viewer list }
+
+    and view = [`Empty | `View of viewer]
+
+    let add v node =
+      ( match v with
+      | `View v ->
+          v.node <- node :: v.node ;
+          Lwd.set v.var (`View v)
+      | `Empty -> () ) ;
+      node.parent <- v ;
+      Lwd.set node.var (`View node) ;
+      `View node
+
+    let make step parent node =
+      let v = {step; var= Lwd.var `Empty; parent; node} in
+      ( match parent with
+      | `View parent ->
+          parent.node <- v :: parent.node ;
+          Lwd.set parent.var (`View parent)
+      | `Empty -> () ) ;
+      let rec iter = function
+        | [] -> ()
+        | x :: xs ->
+            x.parent <- `View v ;
+            Lwd.set x.var (`View x) ;
+            iter xs in
+      iter node ;
+      Lwd.set v.var (`View v) ;
+      `View v
+
+    let rec last = function
+      | [] -> None
+      | [x] -> Some x
+      | _ :: xs -> last xs
+
+    let rec last_def = function
+      | [] -> "[]"
+      | [x] -> x
+      | _ :: xs -> last_def xs
+
+    let find_node ~step ~view =
+      match view with
+      | `Empty -> None
+      | `View v -> List.find_opt (fun v' -> v'.step = step) v.node
+
+    let string_of_path path =
+      "[" ^ F.str "%a" (F.list ~sep:F.semi F.string) path ^ "]"
+
+    let remove (v : viewer) =
+      Lwd.set v.var `Empty ;
+      `Empty
+
+    let storeview store path =
+      Istore.get_tree store path
+      >>= fun tree ->
+      let update d key (view : view) : view option Lwt.t =
+        F.epr "fold ~pre:update key=%s @." (string_of_path key) ;
+        Lwt.return
+          ( match
+              ( List.rev key
+              , find_node
+                  ~step:(Option.value (last key) ~default:"[]")
+                  ~view
+              , d )
+            with
+          | [], None, `Added | [], None, `Updated ->
+              Some (make "[]" view [])
+          | [], Some v, _ -> Some (`View v)
+          | [], None, `Removed -> None
+          | _ :: k :: _, _, _ when k.[0] == '#' -> None
+          | k :: _, None, `Added | k :: _, None, `Updated ->
+              Some (make k view [])
+          | _ :: _, None, `Removed -> None
+          | _ :: _, Some v, _ -> Some (`View v) ) in
+      (* if pre returns None, the children of that node are skipped. *)
+      let rec map ?(key = []) ~node tree (acc : view) : view Lwt.t =
+        let acc =
+          match acc with
+          | `Empty -> make (last_def key) acc []
+          | v -> v in
+        Istore.Tree.list tree []
+        >>= fun tree ->
+        Lwt_list.iter_s
+          (fun (s, t) ->
+            let k = key @ [s] in
+            node k acc
+            >|= function
+            | Some a ->
+                F.epr "storeview Fold step=%s @." s ;
+                ignore (map ~key:k ~node t a)
+            | None -> F.epr "storeview None step=%s @." s )
+          tree
+        >|= fun () -> acc in
+      map ~node:(update `Added) tree `Empty
+      >>= fun t ->
+      let root = Lwd.var t in
+      Istore.watch_key store path (fun diff ->
+          let d, tree =
+            match diff with
+            | `Added (_, tree) -> (`Added, tree)
+            | `Removed (_, tree) -> (`Removed, tree)
+            | `Updated (_, (_, tree)) -> (`Updated, tree) in
+          map ~node:(update d) tree t
+          >>= fun t' -> Lwd.set root t' ; Lwt.return_unit )
+      >>= fun watch -> Lwt.return (watch, root)
+
+    let channelview (store, path) =
+      storeview store path
+      >>= fun (_watch, root) ->
+      let ui =
+        Lwd.join
+          (Lwd.map (Lwd.get root) ~f:(function
+            | `Empty ->
+                failwith "channelview says root Lwd.var is `Empty"
+            | `View v ->
+                let rec iter ?(indent = 0) (v : viewer) =
+                  Lwd.bind (Lwd.get v.var) ~f:(function
+                    | `Empty -> Lwd.return Ui.empty
+                    | `View v' ->
+                        let sub =
+                          Lwd_utils.pack Ui.pack_y
+                            (List.map
+                               (iter ~indent:(indent + 1))
+                               v'.node ) in
+                        Lwd.map sub ~f:(fun sub ->
+                            Ui.join_y
+                              (Ui.string
+                                 ( String.make indent '>' ^ " "
+                                 ^ v'.step ) )
+                              sub ) ) in
+                iter v ) ) in
+      let chs, chs_push = Lwt_stream.create () in
+      Channel.make store ~path:[base_path] ~name:topch
+      >>= fun ch ->
+      chs_push (Some ch) ;
+      Lwt.return (chs, ui)
+
+    let messagelist ({store; path} : Channel.t) mlist :
+        Istore.watch Lwt.t =
+      let mlist' () =
+        Istore.get_tree store path
+        >>= fun tree ->
+        Istore.Tree.fold ~depth:(`Eq 5)
+          ~contents:(fun key contents view ->
+            match key with
+            | [y; m; d; h; s] ->
+                Lwt.return (((y, m, d, h, s), contents) :: view)
+            | _ ->
+                F.epr
+                  "ERROR: messagelist (fold ~depth:(`Eq 5)) got \
+                   wrong number of steps@." ;
+                Lwt.return view )
+          ~node:(fun _key _node view ->
+            F.epr
+              "ERROR: messagelist (fold ~depth:(`Eq 5)) found a \
+               node@." ;
+            Lwt.return view )
+          tree [] in
+      mlist' ()
+      >>= fun ml ->
+      Lwd.set mlist ml ;
+      Istore.watch_key store path (fun _ ->
+          mlist' ()
+          >>= fun mlist' -> Lwt.return (Lwd.set mlist mlist') )
+
+    let messageview ch =
+      let mlist = Lwd.var [(("", "", "", "", ""), "")] in
+      let rec update_messagelist watch () =
+        Lwt_stream.last_new ch
+        >>= fun ch ->
+        ( match watch with
+        | None -> Lwt.return_unit
+        | Some w -> Istore.unwatch w )
+        >>= fun () ->
+        messagelist ch mlist
+        >>= fun watch -> update_messagelist (Some watch) () in
+      Lwt.async (update_messagelist None) ;
+      Lwt.return
+        (Lwd.map (Lwd.get mlist) ~f:(fun mlist ->
+             scroll
+               (List.fold_left
+                  (fun doc ((year, month, day, hour, sec), content) ->
+                    F.epr
+                      "Communicator.Panel.messagelist ch.content=%s@."
+                      content ;
+                    doc
+                    ^/^ Ui.string
+                          (F.str "%s.%s.%s.%s.%s" year month day hour
+                             sec )
+                    ^^ Ui.string " | " ^^ string content )
+                  Ui.empty mlist ) ) )
+
+    let commview (store, path) =
+      channelview (store, List.rev (List.tl (List.rev path)))
+      >>= fun (ch, cv) ->
+      messageview ch
+      >>= fun mv ->
+      Lwt.return (Lwd.map2 cv mv ~f:(fun c m -> join_x c m))
+
+    let panel ({store; view} : Tree.t) : (Event.t -> atom Lwt.t) Lwt.t
+        =
+      commview (store, view) >>= fun cv -> Panel.Ui.panel cv
+  end
+end
+
+(**
+   program starts...
+   - spawn connections to servers
+   - these connections will populate the Channel.t in a Channel.tree
+       
+ **)
+let _ =
+  Lwt.async (fun () ->
+      Communicator.Tree.make_top "commstore" "current"
+      >>= fun comm ->
+      Communicator.Irc.Config.make_connection comm "irc.hackint.org"
+        6697 "cqcaml"
+      >>= fun () ->
+      Lwt.async (fun () -> Communicator.Irc.connect comm) ;
+      F.epr
+        "root_actor := std_actor (Communicator.Panel.panel comm)@." ;
+      Communicator.Panel.panel comm
+      >|= fun f ->
+      root_actor :=
+        std_actor
+          (Lwt.return
+             Panel.
+               { act=
+                   (fun _ events ->
+                     Lwt_list.fold_left_s
+                       (fun _ ev ->
+                         f ev
+                         >>= fun i ->
+                         Lwt.return (fun s ->
+                             ( s
+                             , ( Gg.Box2.of_pts Gg.V2.zero (snd i)
+                               , fst i ) ) ) )
+                       Display.pane_empty events )
+               ; subpanels= []
+               ; tag= "irc" } ) )

lib/dune

@@ -1,2 +0,0 @@
-(library
- (name komm))

opam-switch

@@ -0,0 +1,361 @@
+opam-version: "2.0"
+compiler: ["ocaml-system.4.13.1"]
+roots: [
+  "bogue.20210917"
+  "findlib_top.v0.11.0"
+  "glfw-ocaml.3.3.1-1"
+  "huffman.0.1.2"
+  "inuit.0.4.1"
+  "irc-client.0.7.0"
+  "irc-client-lwt.0.7.0"
+  "irc-client-tls.0.7.0"
+  "irc-client-unix.0.7.0"
+  "irmin.2.9.0"
+  "irmin-unix.2.9.0"
+  "lambda-term.3.1.0"
+  "lwd.0.1"
+  "lwt_ppx.2.0.3"
+  "merlin.4.4-413"
+  "note.0.0.1"
+  "nottui.0.1"
+  "nottui-lwt.0.1"
+  "nottui-pretty.0.1"
+  "ocaml-manual.4.13.0"
+  "ocaml-system.4.13.1"
+  "ocamlformat.0.20.1"
+  "odig.0.0.7"
+  "odoc.2.0.2"
+  "pp.1.1.2"
+  "pprint.20211129"
+  "tgls.0.8.5"
+  "tsdl.0.9.8"
+  "user-setup.0.7"
+  "wall.0.4.1"
+  "zed.3.1.0"
+]
+installed: [
+  "angstrom.0.15.0"
+  "arp.3.0.0"
+  "asn1-combinators.0.2.6"
+  "astring.0.8.5"
+  "awa.0.0.4"
+  "awa-mirage.0.0.4"
+  "b0.0.0.3"
+  "base.v0.14.2"
+  "base-bigarray.base"
+  "base-bytes.base"
+  "base-threads.base"
+  "base-unix.base"
+  "base64.3.5.0"
+  "bheap.2.0.0"
+  "bigarray-compat.1.0.0"
+  "bigstringaf.0.8.0"
+  "biniou.1.2.1"
+  "bogue.20210917"
+  "bos.0.2.0"
+  "ca-certs.0.2.2"
+  "ca-certs-nss.3.71"
+  "camomile.1.0.2"
+  "carton.0.4.3"
+  "carton-git.0.4.3"
+  "carton-lwt.0.4.3"
+  "cf.0.4"
+  "cf-lwt.0.4"
+  "charInfo_width.1.1.0"
+  "checkseum.0.3.2"
+  "cmdliner.1.0.4"
+  "cohttp.4.0.0"
+  "cohttp-lwt.4.0.0"
+  "cohttp-lwt-unix.4.0.0"
+  "conduit.4.0.2"
+  "conduit-lwt.4.0.2"
+  "conduit-lwt-unix.4.0.2"
+  "conf-cairo.1"
+  "conf-gles2.1"
+  "conf-glfw3.2"
+  "conf-gmp.3"
+  "conf-gmp-powm-sec.3"
+  "conf-libffi.2.0.0"
+  "conf-libX11.1"
+  "conf-m4.1"
+  "conf-pkg-config.2"
+  "conf-sdl2.1"
+  "conf-sdl2-image.1"
+  "conf-sdl2-ttf.1"
+  "cppo.1.6.8"
+  "crunch.3.2.0"
+  "csexp.1.5.1"
+  "cstruct.6.0.1"
+  "cstruct-lwt.6.0.1"
+  "cstruct-sexp.6.0.1"
+  "cstruct-unix.6.0.1"
+  "ctypes.0.20.0"
+  "ctypes-foreign.0.18.0"
+  "decompress.1.4.2"
+  "digestif.1.1.0"
+  "dispatch.0.5.0"
+  "domain-name.0.3.1"
+  "dot-merlin-reader.4.1"
+  "duff.0.4"
+  "dune.2.9.1"
+  "dune-build-info.2.9.1"
+  "dune-configurator.2.9.1"
+  "duration.0.2.0"
+  "easy-format.1.3.2"
+  "either.1.0.0"
+  "emile.1.1"
+  "encore.0.8"
+  "eqaf.0.8"
+  "ethernet.3.0.0"
+  "findlib_top.v0.11.0"
+  "fix.20211125"
+  "fmt.0.9.0"
+  "fpath.0.7.3"
+  "fsevents.0.3.0"
+  "fsevents-lwt.0.3.0"
+  "gg.0.9.3"
+  "git.3.6.0"
+  "git-cohttp.3.6.0"
+  "git-cohttp-unix.3.6.0"
+  "git-unix.3.6.0"
+  "glfw-ocaml.3.3.1-1"
+  "gmap.0.3.0"
+  "graphql.0.13.0"
+  "graphql-cohttp.0.13.0"
+  "graphql-lwt.0.13.0"
+  "graphql_parser.0.13.0"
+  "graphv_core.0.1.1"
+  "graphv_core_lib.0.1.1"
+  "graphv_font.0.1.1"
+  "graphv_font_js.0.1.1"
+  "graphv_gles2.0.1.1"
+  "graphv_gles2_native_impl.0.1.1"
+  "graphv_webgl.0.1.1"
+  "graphv_webgl_impl.0.1.1"
+  "grenier.0.13"
+  "hex.1.4.0"
+  "hkdf.1.0.4"
+  "huffman.0.1.2"
+  "hxd.0.3.1"
+  "index.1.5.0"
+  "inotify.2.3"
+  "integers.0.5.1"
+  "inuit.0.4.1"
+  "ipaddr.5.2.0"
+  "ipaddr-sexp.5.2.0"
+  "irc-client.0.7.0"
+  "irc-client-lwt.0.7.0"
+  "irc-client-tls.0.7.0"
+  "irc-client-unix.0.7.0"
+  "irmin.2.9.0"
+  "irmin-fs.2.9.0"
+  "irmin-git.2.9.0"
+  "irmin-graphql.2.9.0"
+  "irmin-http.2.9.0"
+  "irmin-layers.2.9.0"
+  "irmin-pack.2.9.0"
+  "irmin-unix.2.9.0"
+  "irmin-watcher.0.5.0"
+  "jbuilder.1.0+beta20.2"
+  "js_of_ocaml.3.11.0"
+  "js_of_ocaml-compiler.3.11.0"
+  "js_of_ocaml-ppx.3.11.0"
+  "jsonm.1.0.1"
+  "ke.0.4"
+  "lambda-term.3.1.0"
+  "logs.0.7.0"
+  "lru.0.3.0"
+  "lwd.0.1"
+  "lwt.5.5.0"
+  "lwt-dllist.1.0.1"
+  "lwt_log.1.1.1"
+  "lwt_ppx.2.0.3"
+  "lwt_react.1.1.5"
+  "macaddr.5.2.0"
+  "macaddr-cstruct.5.2.0"
+  "magic-mime.1.2.0"
+  "menhir.20211128"
+  "menhirLib.20211128"
+  "menhirSdk.20211128"
+  "merlin.4.4-413"
+  "metrics.0.3.0"
+  "mew.0.1.0"
+  "mew_vi.0.5.0"
+  "mimic.0.0.4"
+  "mirage-clock.4.0.0"
+  "mirage-clock-unix.4.0.0"
+  "mirage-crypto.0.10.5"
+  "mirage-crypto-ec.0.10.5"
+  "mirage-crypto-pk.0.10.5"
+  "mirage-crypto-rng.0.10.5"
+  "mirage-device.2.0.0"
+  "mirage-flow.3.0.0"
+  "mirage-kv.4.0.0"
+  "mirage-net.4.0.0"
+  "mirage-no-solo5.1"
+  "mirage-no-xen.1"
+  "mirage-profile.0.9.1"
+  "mirage-protocols.8.0.0"
+  "mirage-random.3.0.0"
+  "mirage-stack.4.0.0"
+  "mirage-time.3.0.0"
+  "mmap.1.1.0"
+  "mtime.1.3.0"
+  "note.0.0.1"
+  "nottui.0.1"
+  "nottui-lwt.0.1"
+  "nottui-pretty.0.1"
+  "notty.0.2.2"
+  "num.1.4"
+  "oasis.0.4.11"
+  "ocaml.4.13.1"
+  "ocaml-compiler-libs.v0.12.4"
+  "ocaml-config.2"
+  "ocaml-manual.4.13.0"
+  "ocaml-migrate-parsetree.2.3.0"
+  "ocaml-options-vanilla.1"
+  "ocaml-syntax-shims.1.0.0"
+  "ocaml-system.4.13.1"
+  "ocaml-version.3.4.0"
+  "ocamlbuild.0.14.0"
+  "ocamlfind.1.9.1"
+  "ocamlformat.0.20.1"
+  "ocamlgraph.2.0.0"
+  "ocamlify.0.0.1"
+  "ocamlmod.0.0.9"
+  "ocb-stubblr.0.1.1-1"
+  "ocp-indent.1.8.1"
+  "ocplib-endian.1.2"
+  "odig.0.0.7"
+  "odoc.2.0.2"
+  "odoc-parser.1.0.0"
+  "optint.0.1.0"
+  "parsexp.v0.14.1"
+  "pbkdf.1.2.0"
+  "pecu.0.6"
+  "pp.1.1.2"
+  "pprint.20211129"
+  "ppx_cstruct.6.0.1"
+  "ppx_derivers.1.2.1"
+  "ppx_deriving.5.2.1"
+  "ppx_irmin.2.9.0"
+  "ppx_repr.0.5.0"
+  "ppx_sexp_conv.v0.14.3"
+  "ppxlib.0.24.0"
+  "progress.0.2.1"
+  "psq.0.2.0"
+  "ptime.0.8.6"
+  "randomconv.0.1.3"
+  "re.1.10.3"
+  "react.1.2.1"
+  "repr.0.5.0"
+  "result.1.5"
+  "rresult.0.6.0"
+  "semaphore-compat.1.0.1"
+  "seq.base"
+  "sexplib.v0.14.0"
+  "sexplib0.v0.14.0"
+  "stb_image.0.5"
+  "stb_truetype.0.6"
+  "stdio.v0.14.0"
+  "stdlib-shims.0.3.0"
+  "stringext.1.6.0"
+  "tcpip.7.0.0"
+  "terminal.0.2.1"
+  "terminal_size.0.1.4"
+  "tgls.0.8.5"
+  "tls.0.14.1"
+  "tls-mirage.0.14.1"
+  "topkg.1.0.4"
+  "trie.1.0.0"
+  "tsdl.0.9.8"
+  "tsdl-image.0.3.2"
+  "tsdl-ttf.0.3.2"
+  "tyxml.4.5.0"
+  "uchar.0.0.2"
+  "uri.4.2.0"
+  "uri-sexp.4.2.0"
+  "user-setup.0.7"
+  "uucp.14.0.0"
+  "uuseg.14.0.0"
+  "uutf.1.0.2"
+  "vector.1.0.0"
+  "wall.0.4.1"
+  "webmachine.0.7.0"
+  "x509.0.14.1"
+  "yaml.3.0.0"
+  "yojson.1.7.0"
+  "zarith.1.12"
+  "zed.3.1.0"
+]
+pinned: ["lwd.0.1" "nottui.0.1"]
+package "lwd" {
+  opam-version: "2.0"
+  version: "0.1"
+  synopsis: "Lightweight reactive documents"
+  maintainer: "fred@tarides.com"
+  authors: "Frédéric Bour"
+  license: "MIT"
+  homepage: "https://github.com/let-def/lwd"
+  doc: "https://let-def.github.io/lwd/doc"
+  bug-reports: "https://github.com/let-def/lwd/issues"
+  depends: [
+    "dune" {>= "2.0"}
+    "seq"
+    "ocaml" {>= "4.03"}
+    "qtest" {with-test}
+    "qcheck" {with-test}
+  ]
+  build: [
+    ["dune" "subst"] {pinned}
+    [
+      "dune"
+      "build"
+      "-p"
+      name
+      "-j"
+      jobs
+      "@install"
+      "@runtest" {with-test}
+      "@doc" {with-doc}
+    ]
+  ]
+  dev-repo: "git+https://github.com/let-def/lwd.git"
+  url {
+    src: "git+file:///home/cqc/p/console/ref/lwd#master"
+  }
+}
+package "nottui" {
+  opam-version: "2.0"
+  version: "0.1"
+  synopsis: "UI toolkit for the terminal built on top of Notty and Lwd"
+  maintainer: "fred@tarides.com"
+  authors: "Frédéric Bour"
+  license: "MIT"
+  homepage: "https://github.com/let-def/lwd"
+  doc: "https://let-def.github.io/lwd/doc"
+  bug-reports: "https://github.com/let-def/lwd/issues"
+  depends: [
+    "dune" {>= "2.0"}
+    "lwd"
+    "notty"
+  ]
+  build: [
+    ["dune" "subst"] {pinned}
+    [
+      "dune"
+      "build"
+      "-p"
+      name
+      "-j"
+      jobs
+      "@install"
+      "@runtest" {with-test}
+      "@doc" {with-doc}
+    ]
+  ]
+  dev-repo: "git+https://github.com/let-def/lwd.git"
+  url {
+    src: "git+file:///home/cqc/p/console/ref/lwd#master"
+  }
+}

topinf.mli

@@ -0,0 +1,30 @@
+(* Accessors for the table of toplevel value bindings.  These functions
+     must appear as first and second exported functions in this module.
+     (See module Translmod.) *)
+val getvalue : string -> Obj.t
+val setvalue : string -> Obj.t -> unit
+(* 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
+val toplevel_env : Env.t ref
+
+type evalenv = Format.formatter -> string -> unit
+
+val init : Format.formatter -> evalenv
+
+type directive_fun =
+  | Directive_none of (unit -> unit)
+  | Directive_string of (string -> unit)
+  | Directive_int of (int -> unit)
+  | Directive_ident of (Longident.t -> unit)
+  | Directive_bool of (bool -> unit)
+
+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 ref
+val eval_value_path : Env.t -> Path.t -> Obj.t