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 =
-    Nottui_widgets.(
-      edit_area
-        ~table:
-          (multifield_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
+  Nav.test_pull () >>= fun test_tree ->
+  Nottui_widgets.(tree_nav test_tree []) >>= fun ui ->
   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
@@ -1228,6 +1222,7 @@ module Nottui = struct
 
     (*val is_empty : status -> bool*)
     val status : handle -> status Lwd.t
+    val var : handle -> var
     val has_focus : status -> bool
     val merge : status -> status -> status
     val pp_var : Format.formatter -> var -> unit
@@ -1242,6 +1237,7 @@ module Nottui = struct
       (v, Lwd.map ~f:(fun i -> Handle (i, v)) (Lwd.get v))
 
     let empty : status = Empty
+    let var (h : handle) : var = fst h
     let status (h : handle) : status Lwd.t = snd h
 
     let has_focus = function
@@ -1259,6 +1255,8 @@ module Nottui = struct
     let request ((v, _) : handle) = request_var v
 
     let release ((v, _) : handle) =
+      Log.debug (fun m ->
+          m "Focus.release v=%d clock=%d" (Lwd.peek v) !clock);
       incr clock;
       Lwd.set v 0
 
@@ -2775,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
@@ -2793,13 +2791,13 @@ module Nottui_widgets = struct
         | None -> `Unhandled)
     | None -> `Unhandled
 
-  let multifield_of_string ?(table = Lwd_table.make ()) (s : string) :
+  let edit_area_of_string ?(table = Lwd_table.make ()) (s : string) :
       line Lwd_table.t =
     (* Append lines from s to table *)
     List.iter (line_append ~table) (String.split_on_char '\n' s);
     table
 
-  let rec focus_compare focus : int =
+  let focus_val focus : int =
     Focus.(
       match focus with
       | Empty -> 0
@@ -2812,8 +2810,7 @@ module Nottui_widgets = struct
       | Empty, _ -> Ui.empty
       | Handle (_, _), _ -> ui
       | Conflict _, (X (a, b) | Y (a, b) | Z (a, b)) ->
-          if focus_compare a.focus < focus_compare b.focus then
-            find_focus b
+          if focus_val a.focus < focus_val b.focus then find_focus b
           else find_focus a
       | Conflict _, Atom _ -> Ui.empty
       | ( Conflict _,
@@ -2827,18 +2824,21 @@ module Nottui_widgets = struct
           | Shift_area (t, _, _) ) ) ->
           find_focus t)
 
-  (* let focused_row_of_table (table : line Lwd_table.t) =
+  let focus_handle_compare a b =
+    if
+      Lwd.peek (Focus.var (snd a).focus)
+      < Lwd.peek (Focus.var (snd b).focus)
+    then b
+    else a
+
+  let focused_row_of_table (table : line Lwd_table.t) =
     Lwd_table.map_reduce
       (fun row (line : line) -> (Some row, line))
-       (  (None, line_empty ()),
-          (fun a b -> if focus_compare (Focus.status (snd a).focus) < focus_compare ).focus then b else a) )
-       table *)
-
-  let focus_move table f = `Unhandled
+      ((None, line_empty ()), focus_handle_compare)
+      table
 
   let edit_area ?(table = Lwd_table.make ()) ?(focus = Focus.make ())
       () : Ui.t Lwd.t =
-    (* create the cursor var and focus on first table row *)
     let cursor = Lwd.var @@ Lwd_table.first table in
     Option.iter
       (fun cursor ->
@@ -2856,7 +2856,7 @@ module Nottui_widgets = struct
          ~f:(fun focus ->
            Ui.keyboard_area ~focus (fun k ->
                Log.debug (fun m ->
-                   m "line_table handler %a" Ui.pp_key k);
+                   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)
@@ -2900,7 +2900,6 @@ module Nottui_widgets = struct
                                  Lwd.set line_prev.state
                                    ( str_prev ^ str,
                                      String.length str_prev );
-                                 Lwd.set cursor (Some row_prev);
                                  Lwd_table.remove row;
                                  `Handled)
                            else `Unhandled))
@@ -2908,6 +2907,64 @@ module Nottui_widgets = struct
                | _ -> `Unhandled))
          (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
       =