padding

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 ->
+  let ui = Widgets.(h_node_area (test_store, [ [] ])) in
   let root =
     Lwd.set body
       (Lwd.map ~f:(Ui.resize ~pad:gravity_pad ~crop:gravity_crop) ui);

human.ml

@@ -96,6 +96,10 @@ let _ =
   Logs.set_level (Some Debug)
 
 module Log = Logs
+
+let when_some (f : 'b -> 'a -> 'a) (o : 'b option) (v : 'a) : 'a =
+  match o with Some a -> f a v | None -> v
+
 module Cohttp_backend = Cohttp_lwt_jsoo
 
 module Git_af = struct
@@ -439,6 +443,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 +456,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 +464,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
@@ -1148,7 +1153,7 @@ module I = struct
           sz
 
     and node vg attr p n : p2 =
-      (* returns the *size* of the drawn area not the max coordinates anymore *)
+      (* returns the *size* of the drawn area not the max coordinates *)
       let b' =
         match n with
         | Empty | Void _ -> p
@@ -1178,7 +1183,12 @@ module I = struct
         | Hcrop (i, left, right) ->
             let p0 = size vg p i in
             NVG.save vg;
-            NVG.Scissor.scissor vg ~x:(V2.x p) ~y:(V2.y p)
+            (* NVG.Scissor.scissor:
+               - w, h are positive only
+            *)
+            NVG.Scissor.scissor vg
+              ~x:(V2.(x p) +. left)
+              ~y:(V2.y p)
               ~w:(V2.x p0 -. right)
               ~h:(V2.y p0);
             let p1 = node vg attr V2.(p - v left 0.) i in
@@ -1187,18 +1197,19 @@ module I = struct
         | Vcrop (i, top, bottom) ->
             let p0 = size vg p i in
             NVG.save vg;
-            NVG.Scissor.scissor vg ~x:(V2.x p) ~y:(V2.y p)
-              ~w:(V2.x p0)
+            NVG.Scissor.scissor vg
+              ~x:(V2.(x p) +. top)
+              ~y:(V2.y p) ~w:(V2.x p0)
               ~h:(V2.y p0 -. bottom);
             let p1 = node vg attr V2.(p - v 0. top) i in
             NVG.restore vg;
             V2.(p1 - v 0. (top +. bottom))
       in
 
-      (* ignore
-         (path_box vg.vg
+      ignore
+        (path_box vg
            (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2)
-            (Box2.of_pts b b')); *)
+           (Box2.v p b'));
       b'
   end
 end
@@ -1429,12 +1440,14 @@ module Nottui = struct
 
     type 'a desc =
       | Atom of image
+      | Attr of 'a * Style.t
       | Size_sensor of 'a * size_sensor
       | Transient_sensor of 'a * frame_sensor
       | Permanent_sensor of 'a * frame_sensor
       | Resize of 'a * float option * float option * Gravity.t2
       | Mouse_handler of 'a * mouse_handler
       | Focus_area of 'a * (key -> may_handle)
+      | Pad of 'a * (float * float * float * float)
       | Shift_area of 'a * float * float
       | Event_filter of
           'a * ([ `Key of key | `Mouse of mouse ] -> may_handle)
@@ -1496,18 +1509,7 @@ module Nottui = struct
         cache;
       }
 
-    (* let space_1_0 = atom (I.void 1 0)
-       let space_0_1 = atom (I.void 0 1)
-       let space_1_1 = atom (I.void 1 1)
-
-       let space x y =
-         match (x, y) with
-         | 0, 0 -> empty
-         | 1, 0 -> space_1_0
-         | 0, 1 -> space_0_1
-         | 1, 1 -> space_1_1
-          | _ -> atom (I.void x y) *)
-
+    let attr a t = { t with desc = Attr (t, a) }
     let space x y = atom (I.void x y)
     let mouse_area f t : t = { t with desc = Mouse_handler (t, f) }
 
@@ -1521,6 +1523,9 @@ module Nottui = struct
 
     let shift_area x y t : t = { t with desc = Shift_area (t, x, y) }
 
+    let pad ?a ?(l = 0.) ?(r = 0.) ?(t = 0.) ?(b = 0.) tt =
+      when_some attr a { tt with desc = Pad (tt, (l, r, t, b)) }
+
     let size_sensor handler t : t =
       { t with desc = Size_sensor (t, handler) }
 
@@ -1612,13 +1617,16 @@ module Nottui = struct
     let has_focus t = Focus.has_focus t.focus
 
     let rec pp ppf t =
-      F.pf ppf "@[<hov>focus=%a %a@]" Focus.pp_status t.focus pp_desc
+      if has_focus t then
+        F.pf ppf "@[<hov>%a %a@]" Focus.pp_status t.focus pp_desc
           t.desc
+      else F.pf ppf "@[<hov> %a@]" pp_desc t.desc
 
     and pp_desc ppf = function
       | Atom a ->
           Format.fprintf ppf "Atom @[<hov>(%a)@]"
             (I.Draw.pp ?attr:None) a
+      | Attr (desc, a) -> F.pf ppf "Attr (%a, %a)" Style.pp a pp desc
       | Size_sensor (desc, _) ->
           Format.fprintf ppf "Size_sensor (%a, _)" pp desc
       | Transient_sensor (desc, _) ->
@@ -1634,6 +1642,8 @@ module Nottui = struct
       | Mouse_handler (n, _) ->
           Format.fprintf ppf "%a" (*"Mouse (%a,@ _)"*) pp n
       | Focus_area (n, _) -> Format.fprintf ppf "Focus (%a,@ _)" pp n
+      | Pad (n, (l, r, t, b)) ->
+          F.pf ppf "Pad (%.0f,%.0f,%.0f,%.0f,%a)" l r t b pp n
       | Shift_area (n, x, y) ->
           Format.fprintf ppf "Shift (%.0f,%.0f,%a)" x y pp n
       | Event_filter (n, _) ->
@@ -1645,12 +1655,14 @@ module Nottui = struct
     let iter f ui =
       match ui.desc with
       | Atom _ -> ()
+      | Attr (u, _)
       | Size_sensor (u, _)
       | Transient_sensor (u, _)
       | Permanent_sensor (u, _)
       | Resize (u, _, _, _)
       | Mouse_handler (u, _)
       | Focus_area (u, _)
+      | Pad (u, _)
       | Shift_area (u, _, _)
       | Event_filter (u, _) ->
           f u
@@ -1747,6 +1759,7 @@ module Nottui = struct
           ui.sensor_cache <- Some (ox, oy, sw, sh);
         match ui.desc with
         | Atom _ -> ()
+        | Attr (t, _)
         | Size_sensor (t, _)
         | Mouse_handler (t, _)
         | Focus_area (t, _)
@@ -1778,6 +1791,8 @@ module Nottui = struct
                 (v (p2 g))
             in
             update_sensors (ox +. dx) (oy +. dy) rw rh t
+        | Pad (tt, (l, r, t, b)) ->
+            update_sensors (ox +. l) (oy +. t) (sw +. r) (sh +. b) tt
         | Shift_area (t, sx, sy) ->
             update_sensors (ox -. sx) (oy -. sy) sw sh t
         | X (a, b) ->
@@ -1800,6 +1815,7 @@ module Nottui = struct
     let rec t_size_desc_of_t vg (size : box2) (ui : Ui.t desc) =
       match ui with
       | Atom _ as a -> a
+      | Attr (t, v) -> Attr (t_size_of_t vg size t, v)
       | Size_sensor (t, v) -> Size_sensor (t_size_of_t vg size t, v)
       | Mouse_handler (t, v) ->
           Mouse_handler (t_size_of_t vg size t, v)
@@ -1820,6 +1836,14 @@ module Nottui = struct
               w,
               h,
               g2 )
+      | Pad (tt, (l, r, t, b)) ->
+          Pad
+            ( t_size_of_t vg
+                (Box2.of_pts
+                   V2.(Box2.o size + of_tuple (l, t))
+                   V2.(Box2.max size + of_tuple (r, b)))
+                tt,
+              (l, r, t, b) )
       | Shift_area (t, sx, sy) ->
           Shift_area
             ( t_size_of_t vg
@@ -1856,6 +1880,7 @@ module Nottui = struct
       let w, h =
         match desc with
         | Atom i -> V2.to_tuple (I.size vg (Box2.o size) i)
+        | Attr (t, _)
         | Size_sensor (t, _)
         | Mouse_handler (t, _)
         | Focus_area (t, _)
@@ -1865,6 +1890,7 @@ module Nottui = struct
             (t.w, t.h)
         | Resize (t, w, h, _) ->
             (Option.value w ~default:t.w, Option.value h ~default:t.h)
+        | Pad (tt, (l, r, t, b)) -> (tt.w +. l +. r, tt.h +. t +. b)
         | Shift_area (t, x, y) -> (t.w +. x, t.h +. y)
         | X (a, b) -> (a.w +. b.w, max a.h b.h)
         | Y (a, b) -> (max a.w b.w, a.h +. b.h)
@@ -1911,11 +1937,14 @@ module Nottui = struct
             && y -. oy >= 0.
             && y -. oy <= rh)
             && (aux ox oy sw sh t || handle ox oy f)
+        | Attr (desc, _)
         | Size_sensor (desc, _)
         | Transient_sensor (desc, _)
         | Permanent_sensor (desc, _)
         | Focus_area (desc, _) ->
             aux ox oy sw sh desc
+        | Pad (desc, (l, r, t, b)) ->
+            aux (ox +. l) (oy +. t) (sw +. r) (sh +. b) desc
         | Shift_area (desc, sx, sy) ->
             aux (ox -. sx) (oy -. sy) sw sh desc
         | Resize (t, _, _, g) ->
@@ -2009,12 +2038,17 @@ module Nottui = struct
                 vy = Interval.make 0. sh;
                 image = resize_canvas vg sw sh image;
               }
+          | Attr (desc, attr) ->
+              let cache = render_node vg vx1 vy1 vx2 vy2 sw sh desc in
+              { cache with image = I.attr attr cache.image }
           | Size_sensor (desc, handler) ->
               handler ~w:sw ~h:sh;
               render_node vg vx1 vy1 vx2 vy2 sw sh desc
           | Transient_sensor (desc, _) | Permanent_sensor (desc, _) ->
               render_node vg vx1 vy1 vx2 vy2 sw sh desc
-          | Focus_area (desc, _) | Mouse_handler (desc, _) ->
+          | Focus_area (desc, _) ->
+              render_node vg vx1 vy1 vx2 vy2 sw sh desc
+          | Mouse_handler (desc, _) ->
               render_node vg vx1 vy1 vx2 vy2 sw sh desc
           | Shift_area (t', sx, sy) ->
               let cache =
@@ -2028,6 +2062,19 @@ module Nottui = struct
                   (I.crop ~l:sx ~t:sy cache.image)
               in
               { vx; vy; image }
+          | Pad (t', (l, r, t, b)) ->
+              let cache =
+                render_node vg (vx1 +. l) (vy1 +. t)
+                  (vx2 +. l +. r)
+                  (vy2 +. t +. b)
+                  (sw +. r) (sh +. b) t'
+              in
+              let vx = Interval.make vx1 vx2
+              and vy = Interval.make vy1 vy2 in
+              let image =
+                resize_canvas vg sw sh (I.pad ~l ~r ~t ~b cache.image)
+              in
+              { vx; vy; image }
           | X (a, b) ->
               let aw, bw = split ~a:a.w ~sa:a.sw ~b:b.w ~sb:b.sw sw in
               let ca = render_node vg vx1 vy1 vx2 vy2 aw sh a in
@@ -2131,10 +2178,12 @@ module Nottui = struct
                     match f key with
                     | `Handled -> `Handled
                     | `Unhandled -> iter tl))
+            | Attr (t, _)
             | Mouse_handler (t, _)
             | Size_sensor (t, _)
             | Transient_sensor (t, _)
             | Permanent_sensor (t, _)
+            | Pad (t, _)
             | Shift_area (t, _, _)
             | Resize (t, _, _, _) ->
                 iter (t :: tl)
@@ -2167,10 +2216,12 @@ module Nottui = struct
     let rec dispatch_focus t dir =
       match t.desc with
       | Atom _ -> false
+      | Attr (t, _)
       | Mouse_handler (t, _)
       | Size_sensor (t, _)
       | Transient_sensor (t, _)
       | Permanent_sensor (t, _)
+      | Pad (t, _)
       | Shift_area (t, _, _)
       | Resize (t, _, _, _)
       | Event_filter (t, _) ->
@@ -2482,15 +2533,6 @@ module Widgets = struct
       Lwd.set offset (s_x, s_y);
       `Handled
     in
-    let focus_handler = function
-      | `Arrow `Left, [] -> scroll (-.scroll_step) 0.
-      | `Arrow `Right, [] -> scroll (+.scroll_step) 0.
-      | `Arrow `Up, [] -> scroll 0. (-.scroll_step)
-      | `Arrow `Down, [] -> scroll 0. (+.scroll_step)
-      | `Page `Up, [] -> scroll 0. (-.scroll_step *. 8.)
-      | `Page `Down, [] -> scroll 0. (+.scroll_step *. 8.)
-      | _ -> `Unhandled
-    in
     (* let scroll_handler ~x:_ ~y:_ = function
          | `Scroll `Up -> scroll 0. (-.scroll_step)
          | `Scroll `Down -> scroll 0. (+.scroll_step)
@@ -2499,7 +2541,17 @@ module Widgets = struct
     Lwd.map2 t (Lwd.get offset) ~f:(fun t (s_x, s_y) ->
         t |> Ui.shift_area s_x s_y
         (*|> Ui.mouse_area scroll_handler*)
-        |> Ui.keyboard_area focus_handler)
+        |> Ui.keyboard_area (fun e ->
+               Log.debug (fun m ->
+                   m "keyboard_area: scroll_area focus_handler");
+               match e with
+               | `Arrow `Left, [] -> scroll (-.scroll_step) 0.
+               | `Arrow `Right, [] -> scroll (+.scroll_step) 0.
+               | `Arrow `Up, [] -> scroll 0. (-.scroll_step)
+               | `Arrow `Down, [] -> scroll 0. (+.scroll_step)
+               | `Page `Up, [] -> scroll 0. (-.scroll_step *. 8.)
+               | `Page `Down, [] -> scroll 0. (+.scroll_step *. 8.)
+               | _ -> `Unhandled))
 
   let main_menu_item wm text f =
     let text = string ~attr:A.menu_main (" " ^ text ^ " ") in
@@ -2704,9 +2756,6 @@ module Widgets = struct
         | `Escape, [] ->
             Focus.release focus_h;
             `Handled
-        (* | `Enter, _ ->
-            on_submit (text, pos);
-            `Handled *)
         | `Arrow `Left, [] ->
             if pos > 0 then on_change (text, pos - 1) else `Unhandled
         | `Arrow `Right, [] ->
@@ -2736,8 +2785,6 @@ module Widgets = struct
      Lwd.map2 state node ~f:(fun state content ->
          Ui.mouse_area (mouse_grab state) content *)
 
-  open Lwd.Infix
-
   type line = {
     focus : Focus.handle;
     state : (string * int) Lwd.var;
@@ -2759,6 +2806,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
@@ -2774,17 +2825,18 @@ module Widgets = struct
     Ui.may_handle (Lwd.peek cursor) (fun row ->
         Ui.may_handle (Lwd_table.get row) (fun line -> f row line))
 
-  let cursor_move cursor
-      (f : 'a Lwd_table.row -> 'a Lwd_table.row option) =
+  let cursor_move ?(update : 'a -> 'a -> unit = fun _ _ -> ())
+      (cursor : 'a Lwd_table.row option Lwd.var)
+      (new_row : 'a Lwd_table.row -> 'a Lwd_table.row option) =
     match Lwd.peek cursor with
     | Some cursor_row -> (
-        match f cursor_row with
+        match new_row cursor_row with
         | Some new_row ->
             (match Lwd_table.get new_row with
             | Some new_line ->
-                cursor_row |> Lwd_table.get
+                Lwd_table.get cursor_row
                 |> Option.iter (fun cursor_line ->
-                       copy_line_cursor cursor_line new_line;
+                       update cursor_line new_line;
                        Focus.release cursor_line.focus);
                 Focus.request new_line.focus
             | None -> ());
@@ -2793,7 +2845,7 @@ module Widgets = struct
         | None -> `Unhandled)
     | None -> `Unhandled
 
-  let edit_area_of_string ?(table = Lwd_table.make ()) (s : string) :
+  let line_table_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);
@@ -2816,13 +2868,15 @@ module Widgets = struct
           else find_focus a
       | Conflict _, Atom _ -> Ui.empty
       | ( Conflict _,
-          ( Size_sensor (t, _)
+          ( Attr (t, _)
+          | Size_sensor (t, _)
           | Mouse_handler (t, _)
           | Focus_area (t, _)
           | Event_filter (t, _)
           | Transient_sensor (t, _)
           | Permanent_sensor (t, _)
           | Resize (t, _, _, _)
+          | Pad (t, _)
           | Shift_area (t, _, _) ) ) ->
           find_focus t)
 
@@ -2839,14 +2893,16 @@ module Widgets = struct
       ((None, line_empty ()), focus_handle_compare)
       table
 
+  let to_lwt_lwd e = Lwt.return @@ Lwd.pure e
+  let lwt_lwd_string s = to_lwt_lwd @@ string s
+
   let edit_area ?(table = Lwd_table.make ()) ?(focus = Focus.make ())
       () : Ui.t Lwd.t =
     let cursor = Lwd.var @@ Lwd_table.first table in
-    Option.iter
-      (fun cursor ->
-        Option.iter (fun first -> Focus.request first.focus)
-        @@ Lwd_table.get cursor)
-      (Lwd.peek cursor);
+    Lwd.peek cursor
+    |> Option.iter (fun cursor ->
+           Lwd_table.get cursor
+           |> Option.iter (fun first -> Focus.request first.focus));
 
     (* Build view of table *)
     Lwd_table.map_reduce
@@ -2854,24 +2910,24 @@ module Widgets = struct
       (Lwd_utils.lift_monoid Ui.pack_y)
       table
     |> Lwd.join
-    |> Lwd.map2
-         ~f:(fun focus ->
+    |> Lwd.map2 (Focus.status focus) ~f:(fun focus ->
            Ui.keyboard_area ~focus (fun k ->
                Log.debug (fun m ->
-                   m "edit_area handler %a" Ui.pp_key k);
+                   m "keyboard_area: edit_area handler %a" Ui.pp_key k);
+               let cursor_move =
+                 cursor_move ~update:copy_line_cursor cursor
+               in
                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)
+                   cursor_move Lwd_table.next
+               | `Arrow `Down, _ -> cursor_move Lwd_table.next
                | `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)
+                   cursor_move Lwd_table.prev
+               | `Arrow `Up, _ -> cursor_move Lwd_table.prev
                | `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
-                   cursor_move cursor (fun _ -> Lwd_table.first table)
+                   cursor_move (fun _ -> Lwd_table.first table)
                | `Uchar u, [ `Meta ] when eq_uc_c u '>' ->
-                   cursor_move cursor (fun _ -> Lwd_table.last table)
+                   cursor_move (fun _ -> Lwd_table.last table)
                | `Enter, [] ->
                    line_of_cursor cursor (fun old_row old_line ->
                        let str, pos = Lwd.peek old_line.state in
@@ -2907,46 +2963,204 @@ module Widgets = struct
                            else `Unhandled))
                | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
                | _ -> `Unhandled))
-         (Focus.status focus)
 
-  let tree_nav ?(focus = Focus.make ()) tree path : Ui.t Lwd.t Lwt.t =
+  (* TODO: view_metadata *)
+
+  let node_edit_area ?(table = Lwd_table.make ())
+      ?(focus = Focus.make ()) ((store, path) : Nav.S.t * Nav.path) :
+      Ui.t Lwd.t Lwt.t =
+    let open Lwt.Infix in
+    Nav.S.tree store >>= fun tree ->
+    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 " ^ String.concat "/" path
+                   ^ " '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
+          ("Nav.S.Tree.find_all " ^ String.concat "/" path
+         ^ " -> None")
+    | Some (contents, _metadata) ->
+        line_table_of_string ~table contents |> ignore;
+        let cursor = Lwd.var (Lwd_table.first table) in
+        Lwd.peek cursor
+        |> Option.iter (fun r ->
+               Lwd_table.get r
+               |> Option.iter (fun l -> Focus.request l.focus));
+        (* Build view of table *)
+        Lwt.return
+          (Lwd_table.map_reduce
+             (fun _ { ui; _ } -> ui)
+             (Lwd_utils.lift_monoid Ui.pack_y)
+             table
+          |> Lwd.join
+          |> Lwd.map2 (Focus.status focus) ~f:(fun focus' ->
+                 if Focus.has_focus focus' then
+                   Lwd.peek cursor
+                   |> Option.iter (fun r ->
+                          Lwd_table.get r
+                          |> Option.iter (fun l ->
+                                 Focus.request l.focus));
+
+                 Ui.keyboard_area ~focus:focus' (fun k ->
+                     Log.debug (fun m ->
+                         m "node_edit_area handler %a" Ui.pp_key k);
+                     let cursor_move =
+                       cursor_move ~update:copy_line_cursor cursor
+                     in
+                     match k with
+                     | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
+                         cursor_move Lwd_table.next
+                     | `Arrow `Down, _ -> cursor_move Lwd_table.next
+                     | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
+                         cursor_move Lwd_table.prev
+                     | `Arrow `Up, _ -> cursor_move Lwd_table.prev
+                     | `Uchar u, [ `Meta ] when eq_uc_c u '<' ->
+                         cursor_move (fun _ -> Lwd_table.first table)
+                     | `Uchar u, [ `Meta ] when eq_uc_c u '>' ->
+                         cursor_move (fun _ -> Lwd_table.last table)
+                     | `Enter, [] ->
+                         line_of_cursor cursor
+                           (fun old_row old_line ->
+                             let str, pos = Lwd.peek old_line.state in
+                             let n_str =
+                               String.(sub str pos (length str - pos))
+                             in
+                             Lwd.set old_line.state
+                               (String.sub str 0 pos, pos);
+                             let new_line = line_make n_str in
+                             Focus.release old_line.focus;
+                             Focus.request new_line.focus;
+                             Lwd.set cursor
+                               (Some
+                                  (Lwd_table.after old_row
+                                     ~set:new_line));
+                             `Handled)
+                     | `Backspace, [] ->
+                         line_of_cursor cursor (fun row line ->
+                             let str, pos = Lwd.peek line.state in
+                             Ui.may_handle (Lwd_table.prev row)
+                               (fun row_prev ->
+                                 if pos = 0 then
+                                   Ui.may_handle
+                                     (Lwd_table.get row_prev)
+                                     (fun line_prev ->
+                                       let str_prev, _ =
+                                         Lwd.peek line_prev.state
+                                       in
+                                       Focus.release line.focus;
+                                       Focus.request line_prev.focus;
+                                       Lwd.set line_prev.state
+                                         ( str_prev ^ str,
+                                           String.length str_prev );
+                                       Lwd_table.remove row;
+                                       `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)))
+
+  module Cursor = struct
+    type 'a t = 'a Lwd_table.row option Lwd.var
+
+    let get t ~f =
+      Lwd.peek t
+      |> Option.iter (fun t_row ->
+             Option.iter (f t_row) (Lwd_table.get t_row))
+  end
+
+  let tree_nav ?(focus = Focus.make ()) ?(selection = Lwd.var @@ None)
+      ((store, path) : Nav.S.t * Nav.path) : Ui.t Lwd.t Lwt.t =
     let table = Lwd_table.make () in
-
-    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 ->
-              (match Lwd_table.get new_row with
-              | Some (new_line_focus, _) ->
-                  cursor_row |> Lwd_table.get
+    let cursor_move cursor f =
+      Ui.may_handle (Lwd.peek cursor) (fun cursor_row ->
+          Ui.may_handle (f cursor_row) (fun new_row ->
+              Lwd_table.get new_row
+              |> Option.iter (fun (new_line_focus, new_line_sel) ->
+                     Lwd.set selection (Some new_line_sel);
+                     Lwd_table.get cursor_row
                      |> Option.iter (fun (cursor_line_focus, _) ->
                             Focus.release cursor_line_focus);
-                  Focus.request new_line_focus
-              | None -> ());
+                     Focus.request new_line_focus);
               Lwd.set cursor (Some new_row);
-              `Handled
-          | None -> `Unhandled)
-      | None -> `Unhandled
+              `Handled))
     in
-
     (* Build view of tree *)
     let open Lwt.Infix in
-    Nav.S.Tree.list tree path >>= fun treelist ->
+    Nav.S.list store 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
-      (fun cursor ->
-        Option.iter (fun (f, _) -> Focus.request f)
-        @@ Lwd_table.get cursor)
-      (Lwd.peek cursor);
+    Lwd.peek cursor
+    |> Option.iter (fun cursor ->
+           Lwd_table.get cursor
+           |> Option.iter (fun (f, _) -> Focus.request f));
+    Lwt.return
+      (Lwd_table.map_reduce
+         (fun _ (f, s) ->
+           Lwd.map (Focus.status f) ~f:(fun focus_h ->
+               if Focus.has_focus focus_h then string ~attr:A.cursor s
+               else string s))
+         (Lwd_utils.lift_monoid Ui.pack_y)
+         table
+      |> Lwd.join
+      |> Lwd.map2 (Focus.status focus) ~f:(fun focus' ->
+             if Focus.has_focus focus' then
+               Lwd.peek cursor
+               |> Option.iter (fun cursor ->
+                      Lwd_table.get cursor
+                      |> Option.iter (fun (f, _) -> Focus.request f));
+             Ui.keyboard_area ~focus:focus' (fun k ->
+                 Log.debug (fun m ->
+                     m "keyboard_area: tree_nav %a" Ui.pp_key k);
+                 match k with
+                 | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' ->
+                     cursor_move cursor Lwd_table.next |> ignore;
+                     `Handled
+                 | `Arrow `Down, _ ->
+                     cursor_move cursor Lwd_table.next |> ignore;
+                     `Handled
+                 | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' ->
+                     cursor_move cursor Lwd_table.prev |> ignore;
+                     `Handled
+                 | `Arrow `Up, _ ->
+                     cursor_move cursor Lwd_table.prev |> ignore;
+                     `Handled
+                 | `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)
+                 | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
+                 | `Enter, [] -> `Unhandled
+                 | `Backspace, [] -> `Unhandled
+                 | _ -> `Unhandled)))
 
-    (* Lwd.observe ~on_invalidate:(fun _ ->
-         Lwd.set cursorview (Lwd.quick_sample (root ()))); *)
-    let cursorview =
+  (* let cursorview =
        Lwd.var @@ Lwd.pure @@ string "initializing..."
      in
      let cv, push_cv = Lwt_stream.create () in
@@ -2960,82 +3174,118 @@ 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 `Node ->
-                       Lwt.return @@ Lwd.pure @@ string "Sub-node??"
-                   | Some `Contents -> (
-                       Nav.S.Tree.find_all tree [] >>= function
-                       | Some (contents, _metadata) ->
-                           Lwt.return
-                             (edit_area
-                                ~table:(edit_area_of_string contents)
-                                ())
+                | Some (focus, step) -> (
+                    let path' = path @ [ step ] in
+                    Nav.S.kind store path' >>= function
+                    | Some `Node -> lwt_lwd_string "Sub-node??"
+                    | Some `Contents -> node_edit_area (store, path')
                     | None ->
-                           Lwt.return @@ Lwd.pure
-                           @@ string ("could not find path: " ^ step))
-                   | None -> Lwt.return @@ Lwd.pure @@ string step)
+                        lwt_lwd_string
+                          ("Nav.S.kind " ^ String.concat "/" path'
+                         ^ " -> None?"))
                 | None ->
-                   Lwt.return @@ Lwd.pure
-                   @@ string "cursor table row doesn't exist")
-           | None ->
-               Lwt.return @@ Lwd.pure @@ string "cursor doesn't exist")
+                    lwt_lwd_string "cursor table row doesn't exist")
+            | None -> lwt_lwd_string "cursor doesn't exist")
      in
      Lwt.async (fun () ->
          Lwt_stream.iter_s
            (fun _ ->
              Lwd.quick_sample cvroot >>= fun cursorview'' ->
              Log.info (fun m ->
-                m
-                  "tree_nav cursorviewroot on_invalidate Lwt.async \
-                   (Lwd.set cursorview) triggered??");
+                 m "tree_nav Lwt.async (Lwd.set cursorview)");
              Lwt.return (Lwd.set cursorview cursorview''))
            cv);
-    push_cv (Some ());
-    Lwt.return
-      (Lwd_table.map_reduce
-         (fun _ (f, (s, _)) ->
-           Lwd.map
-             ~f:(fun focus_h ->
-               if Focus.has_focus focus_h then string ~attr:A.cursor s
-               else string s)
-             (Focus.status f))
-         (Lwd_utils.lift_monoid Ui.pack_y)
+       push_cv (Some ()); *)
+  (*|> Lwd.map2
+       (Lwd.join @@ Lwd.get cursorview)
+       ~f:(fun cursorview' tree_view ->
+         Ui.join_x tree_view cursorview') *)
+
+  open Lwt.Infix
+
+  let rec node_ui ?(focus = Focus.make ()) store path
+      (f : Focus.handle * ui Lwd.t -> unit) : unit =
+    Lwt.async (fun () ->
+        Nav.S.tree store >>= fun tree ->
+        Nav.S.Tree.kind tree path >>= function
+        | None ->
+            f
+              ( focus,
+                Lwd.pure
+                @@ string
+                     ("Nav.S.Tree.kind " ^ String.concat "/" path
+                    ^ " how'd you get here??") );
+            Lwt.return_unit
+        | Some `Node ->
+            let selection = Lwd.var None in
+            tree_nav ~selection ~focus (store, path) >>= fun ui ->
+            f
+              ( focus,
+                Lwd.map2
+                  (Lwd.pair (Focus.status focus) (Lwd.get selection))
+                  ui
+                  ~f:(fun (focus', selection) ui ->
+                    Ui.keyboard_area ~focus:focus'
+                      (fun k ->
+                        Log.debug (fun m ->
+                            m "keyboard_area: node_ui %a" Ui.pp_key k);
+
+                        match k with
+                        | `Enter, [] -> (
+                            Focus.release focus;
+                            match selection with
+                            | Some sel ->
+                                Log.info (fun m ->
+                                    m "node_ui selecting '%s'" sel);
+                                node_ui store (path @ [ sel ]) f;
+                                Log.info (fun m ->
+                                    m "node_ui done selecting '%s'"
+                                      sel);
+
+                                `Handled
+                            | None -> `Unhandled)
+                        | _ -> `Unhandled)
+                      ui) );
+            Lwt.return_unit
+        | Some `Contents ->
+            node_edit_area ~focus (store, path) >>= fun ui ->
+            f (focus, ui);
+            Lwt.return_unit)
+
+  let h_node_area ?(table = Lwd_table.make ())
+      ?(focus = Focus.make ())
+      ((store, paths) : Nav.S.t * Nav.path list) : Ui.t Lwd.t =
+    List.iter
+      (fun path ->
+        node_ui store path (fun v -> Lwd_table.append' table v))
+      paths;
+    let _cursor = Lwd.var @@ Lwd_table.first table in
+    Lwd_table.map_reduce
+      (fun _row (focus, ui) ->
+        Lwd.map2 ui (Focus.status focus) ~f:(fun ui focus ->
+            Ui.pad
+              ?a:
+                (if Focus.has_focus focus then
+                 Some
+                   A.(bg (NVG.Color.rgbaf ~r:1. ~g:1. ~b:1. ~a:0.5))
+                else None)
+              ~l:5. ~r:10. ~t:15. ~b:20. ui))
+      (Lwd_utils.lift_monoid Ui.pack_x)
       table
     |> Lwd.join
-      |> Lwd.map2
-           ~f:(fun focus ->
-             Ui.keyboard_area ~focus (fun k ->
+    |> Lwd.map2 (Focus.status focus) ~f:(fun focus' ->
+           Ui.keyboard_area ~focus:focus' (fun k ->
                Log.debug (fun m ->
-                     m "edit_area handler %a" Ui.pp_key k);
+                   m "keyboard_area: h_node_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
+               | `Enter, [] -> `Unhandled
                | _ -> `Unhandled))
-           (Focus.status focus)
-      |> Lwd.map2
-           ~f:(fun cursorview' tree_view ->
-             Ui.join_x tree_view cursorview')
-           (Lwd.join @@ Lwd.get cursorview))
 
   (** 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
       =
+    let open Lwd.Infix in
     match tabs with
     | [] -> Lwd.return Ui.empty
     | _ ->

unicom.org

@@ -0,0 +1,37 @@
+UNICOM
+
+unifying tools for thought and commmunication
+
+At the top level is a kind of "trace" that connects all the tools together
+and records the exact use of all the tools in a session. Traces are the only
+kind of document in the system, and are basically written by a user when
+they interact with the system. Users can store, retrieve, view, and modify
+traces as a way of controlling system state, retrieving history, and sharing
+information?
+
+
+tools for thought:
+- todo lists
+- personal journal
+- calendar
+- calculator/spreadsheet
+- health, fitness, finance data tracking, analysis
+- Integrated Development Environment [for development/configuration of all these tools]
+
+
+tools for communication:
+- collaborative documents
+  video / .txt file
+- content discovery,display,labeling?
+  twitter / netflix / books
+- direct messages
+  sms / email
+- group messages
+  private (chat) / private (irc,twitter)
+- audio/music production
+  sound driver / DAW
+- cad
+  KiCad / OpenSCAD
+
+
+