broke focus, but rearranged for better save implementation

boot_js.ml

@@ -90,8 +90,8 @@ let _ =
   let gravity_crop = Gravity.make ~h:`Positive ~v:`Negative in
   let body = Lwd.var (Lwd.pure Ui.empty) in
   let wm = Widgets.window_manager (Lwd.join (Lwd.get body)) in
-  Nav.test_pull () >>= fun test_tree ->
-  Widgets.(tree_nav (test_tree, [])) >>= fun ui ->
+  Nav.test_pull () >>= fun test_store ->
+  Widgets.(tree_nav (test_store, [])) >>= fun ui ->
   let root =
     Lwd.set body
       (Lwd.map ~f:(Ui.resize ~pad:gravity_pad ~crop:gravity_crop) ui);

human.ml

@@ -439,6 +439,7 @@ module Nav = struct
   module Sync = Irmin.Sync.Make (S)
 
   type t = S.tree
+  type store = S.t
   type tree = t
   type step = S.step
   type path = step list
@@ -451,7 +452,7 @@ module Nav = struct
     >>= add [ "hello"; "daddy" ] "ily"
     >>= add [ "beep"; "beep" ] "motherfucker"
 
-  let test_pull () : t Lwt.t =
+  let test_pull () : store Lwt.t =
     (* test_populate ()*)
     S.Repo.v (Config.init "") >>= fun repo ->
     S.of_branch repo "current" >>= fun t ->
@@ -459,7 +460,7 @@ module Nav = struct
     let upstream =
       S.remote ~ctx "https://localhost:8080/console/rootstore.git"
     in
-    Sync.fetch_exn t upstream >>= fun _ -> S.tree t
+    Sync.fetch_exn t upstream >>= fun _ -> Lwt.return t
 end
 
 module Input = struct
@@ -2759,6 +2760,10 @@ module Widgets = struct
     let row = Lwd_table.append table in
     Lwd_table.set row (line_make ?focus str)
 
+  let string_of_line { state; _ } =
+    let str, _ = Lwd.peek state in
+    str
+
   let copy_line_cursor (x : line) (y : line) =
     let _, xi = Lwd.peek x.state in
     let ys, _ = Lwd.peek y.state in
@@ -2917,17 +2922,31 @@ module Widgets = struct
   (* TODO: view_metadata *)
 
   let rec node_edit_area ?(table = Lwd_table.make ())
-      ?(focus = Focus.make ()) ((tree, path) : Nav.tree * Nav.path) :
+      ?(focus = Focus.make ()) ((store, path) : Nav.S.t * Nav.path) :
       Ui.t Lwd.t Lwt.t =
     let cursor = Lwd.var @@ Lwd_table.first table in
     let open Lwt.Infix in
+    Nav.S.tree store >>= fun tree ->
     Nav.S.Tree.kind tree path >>= function
     | None ->
         lwt_lwd_string
           ("Nav.S.Tree.kind " ^ String.concat "/" path
          ^ " how'd you get here??")
-    | Some `Node -> tree_nav (tree, path)
+    | Some `Node -> tree_nav (store, path)
     | Some `Contents -> (
+        let save_stream, save_push = Lwt_stream.create () in
+        Lwt.async (fun () ->
+            Lwt_stream.iter_s
+              (fun contents ->
+                Nav.S.Tree.add tree path contents >>= fun tree' ->
+                Nav.S.set_tree
+                  ~info:(fun () ->
+                    Nav.S.Info.v ~message:"node_edit_area 'save'"
+                      (Int64.of_float
+                         ((new%js Js.date_now)##getTime /. 1000.)))
+                  store path tree'
+                >>= fun _ -> Lwt.return_unit)
+              save_stream);
         Nav.S.Tree.find_all tree path >>= function
         | None ->
             lwt_lwd_string
@@ -3013,12 +3032,22 @@ module Widgets = struct
                                            `Handled)
                                      else `Unhandled))
                          | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' ->
+                             `Handled
+                         | `Uchar u, [ `Ctrl ] when eq_uc_c u 'x' ->
+                             let b = Buffer.create 1024 in
+                             Lwd_table.iter
+                               (fun line ->
+                                 Buffer.add_string b
+                                 @@ string_of_line line)
+                               table;
+                             save_push (Some (Buffer.contents b));
+
                              `Handled
                          | _ -> `Unhandled))
                    (Focus.status focus)))
 
   and tree_nav ?(focus = Focus.make ())
-      ((tree, path) : Nav.tree * Nav.path) : Ui.t Lwd.t Lwt.t =
+      ((store, path) : Nav.S.t * Nav.path) : Ui.t Lwd.t Lwt.t =
     let table = Lwd_table.make () in
 
     let cursor_move cursor
@@ -3042,9 +3071,11 @@ module Widgets = struct
 
     (* Build view of tree *)
     let open Lwt.Infix in
+    Nav.S.tree store >>= fun tree ->
     Nav.S.Tree.list tree path >>= fun treelist ->
     List.iter
-      (fun te -> Lwd_table.append' table (Focus.make (), te))
+      (fun (step, _tree) ->
+        Lwd_table.append' table (Focus.make (), step))
       treelist;
     let cursor = Lwd.var @@ Lwd_table.first table in
     Option.iter
@@ -3069,19 +3100,11 @@ module Widgets = struct
       @@ Lwd.map (Lwd.get cursor) ~f:(function
            | Some cursor_row -> (
                match Lwd_table.get cursor_row with
-               | Some (_focus, (step, tree)) -> (
-                   Nav.S.Tree.kind tree [] >>= function
+               | Some (_focus, step) -> (
+                   Nav.S.Tree.kind tree (path @ [ step ]) >>= function
                    | Some `Node -> lwt_lwd_string "Sub-node??"
-                   | Some `Contents -> (
-                       Nav.S.Tree.find_all tree [] >>= function
-                       | Some (contents, _metadata) ->
-                           Lwt.return
-                             (edit_area
-                                ~table:(line_table_of_string contents)
-                                ())
-                       | None ->
-                           lwt_lwd_string
-                             ("could not find path: " ^ step))
+                   | Some `Contents ->
+                       node_edit_area (store, path @ [ step ])
                    | None ->
                        lwt_lwd_string
                          ("Nav.S.Tree.kind " ^ step ^ " -> None?"))
@@ -3100,7 +3123,7 @@ module Widgets = struct
     push_cv (Some ());
     Lwt.return
       (Lwd_table.map_reduce
-         (fun _ (f, (s, _)) ->
+         (fun _ (f, s) ->
            Lwd.map
              ~f:(fun focus_h ->
                if Focus.has_focus focus_h then string ~attr:A.cursor s