loads and displays teh git tree

boot_js.ml

@@ -90,40 +90,8 @@ let _ =
   let gravity_crop = Gravity.make ~h:`Positive ~v:`Negative in
   let body = Lwd.var (Lwd.pure Ui.empty) in
   let wm = Nottui_widgets.window_manager (Lwd.join (Lwd.get body)) in
-  let ui =
+  Nav.test_pull () >>= fun test_tree ->
-    Nottui_widgets.(
+  Nottui_widgets.(tree_nav test_tree []) >>= fun ui ->
-      edit_area
-        ~table:
-          (edit_area_of_string
-             "edit me?\n\
-              derp derp derp\n\
-              herp herp derp\n\
-              ding dong beep beep")
-        ()
-      (* vlist_of_text
-         @@ Lwd.pure
-              "navigate me?\n\
-               derp derp derp\n\
-               herp herp derp\n\
-               ding dong beep beep" *)
-      (* @@ Lwd_utils.pack Ui.pack_y
-            [
-              edit_field edit_me;
-              string "derp derp derp";
-              string "herp herp derp";
-              string "ding dong beep beep";
-              string "derp derp derp";
-              string "herp herp derp";
-              string "ding dong beep beep";
-              string "derp derp derp";
-              string "herp herp derp";
-              string "ding dong beep beep";
-              string "derp derp derp";
-              string "herp herp derp";
-              string "ding dong beep beep";
-              main_menu_item wm "Quit" (fun () -> exit 0);
-            ] *))
-  in
   let root =
     Lwd.set body
       (Lwd.map ~f:(Ui.resize ~pad:gravity_pad ~crop:gravity_crop) ui);

human.ml

@@ -453,19 +453,13 @@ module Nav = struct
 
   let test_pull () : t Lwt.t =
     (* test_populate ()*)
-    Firebug.console##log (Js.string "Nav.test_pull()\n");
     S.Repo.v (Config.init "") >>= fun repo ->
-    Firebug.console##log (Js.string "Nav.test_pull(2)\n");
     S.of_branch repo "current" >>= fun t ->
-    Firebug.console##log (Js.string "Nav.test_pull(3)\n");
     Git_console_http.connect Mimic.empty >>= fun ctx ->
-    Firebug.console##log (Js.string "Nav.test_pull(4)\n");
     let upstream =
       S.remote ~ctx "https://localhost:8080/console/rootstore.git"
     in
-    Firebug.console##log (Js.string "Nav.test_pull(5)\n");
     Sync.fetch_exn t upstream >>= fun _ -> S.tree t
-  (* irmin/src/irmin/sync.ml: calls S.Remote.Backend.fetch *)
 end
 
 module Input = struct
@@ -2779,7 +2773,7 @@ module Nottui_widgets = struct
         Ui.may_handle (Lwd_table.get row) (fun line -> f row line))
 
   let cursor_move cursor
-      (f : line Lwd_table.row -> line Lwd_table.row option) =
+      (f : 'a Lwd_table.row -> 'a Lwd_table.row option) =
     match Lwd.peek cursor with
     | Some cursor_row -> (
         match f cursor_row with
@@ -2859,7 +2853,7 @@ module Nottui_widgets = struct
       table
     |> Lwd.join
     |> Lwd.map2
-         ~f:(fun (focus, _) ->
+         ~f:(fun focus ->
            Ui.keyboard_area ~focus (fun k ->
                Log.debug (fun m ->
                    m "edit_area handler %a" Ui.pp_key k);
@@ -2911,7 +2905,65 @@ module Nottui_widgets = struct
                            else `Unhandled))
                | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
                | _ -> `Unhandled))
-         (Lwd.pair (Focus.status focus) (focused_row_of_table table))
+         (Focus.status focus)
+
+  let tree_nav ?(focus = Focus.make ()) tree path : Ui.t Lwd.t Lwt.t =
+    let table = Lwd_table.make () in
+
+    (*
+    Option.iter
+      (fun cursor ->
+        Option.iter (fun first -> Focus.request first.focus)
+        @@ Lwd_table.get cursor)
+      (Lwd.peek cursor); *)
+    let cursor_move cursor
+        (f : 'a Lwd_table.row -> 'a Lwd_table.row option) =
+      match Lwd.peek cursor with
+      | Some cursor_row -> (
+          match f cursor_row with
+          | Some new_row ->
+              Lwd.set cursor (Some new_row);
+              `Handled
+          | None -> `Unhandled)
+      | None -> `Unhandled
+    in
+
+    (* Build view of tree *)
+    let open Lwt.Infix in
+    Nav.S.Tree.list tree path >>= fun treelist ->
+    List.iter (fun te -> Lwd_table.append' table te) treelist;
+    let cursor = Lwd.var @@ Lwd_table.first table in
+    Lwt.return
+      (Lwd_table.map_reduce
+         (fun _ (s, _) -> Lwd.pure (string s))
+         (Lwd_utils.lift_monoid Ui.pack_y)
+         table
+      |> Lwd.join
+      |> Lwd.map2
+           ~f:(fun focus ->
+             Ui.keyboard_area ~focus (fun k ->
+                 Log.debug (fun m ->
+                     m "edit_area handler %a" Ui.pp_key k);
+                 match k with
+                 | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
+                     cursor_move cursor (fun c -> Lwd_table.next c)
+                 | `Arrow `Down, _ ->
+                     cursor_move cursor (fun c -> Lwd_table.next c)
+                 | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
+                     cursor_move cursor (fun c -> Lwd_table.prev c)
+                 | `Arrow `Up, _ ->
+                     cursor_move cursor (fun c -> Lwd_table.prev c)
+                 | `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
+                     cursor_move cursor (fun _ ->
+                         Lwd_table.first table)
+                 | `Uchar u, [ `Meta ] when eq_uc_c u '>' ->
+                     cursor_move cursor (fun _ ->
+                         Lwd_table.last table)
+                 | `Enter, [] -> `Handled
+                 | `Backspace, [] -> `Unhandled
+                 | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
+                 | _ -> `Unhandled))
+           (Focus.status focus))
 
   (** Tab view, where exactly one element of [l] is shown at a time. *)
   let tabs (tabs : (string * (unit -> Ui.t Lwd.t)) list) : Ui.t Lwd.t