cursor movement by char works across lines (i.e. subnested joins)

human.ml

@@ -1295,7 +1295,7 @@ module Panel = struct
       set_parent_on_children {parent= None; t; n= node_n ()}
 
     let empty_image = (Image.empty, V2.zero)
-    let empty_node = node (`Atom `Empty)
+    let empty_node () = node (`Atom `Empty)
     let style (s : Style.t) (n : node) = node (`Attr (`Style s, n))
 
     let rec traverse_nodes ~(f : node -> node option) (n : node) :
@@ -1351,9 +1351,9 @@ module Panel = struct
     let join_x = join_ `X
     let join_y = join_ `Y
     let join_z = join_ `Z
-    let pack_x : node Lwd_utils.monoid = (empty_node, join_x)
-    let pack_y : node Lwd_utils.monoid = (empty_node, join_y)
-    let pack_z : node Lwd_utils.monoid = (empty_node, join_z)
+    let pack_x : node Lwd_utils.monoid = (empty_node (), join_x)
+    let pack_y : node Lwd_utils.monoid = (empty_node (), join_y)
+    let pack_z : node Lwd_utils.monoid = (empty_node (), join_z)
     let ( ^^ ) = join_x
     let ( ^/^ ) = join_y
     let ( ^*^ ) = join_z
@@ -1473,7 +1473,7 @@ module Panel = struct
               new_line
                 (append_y la (l (node (`Atom (`Boundary `Line)))))
           | l, `End -> l in
-        (new_line (fun n -> n)) empty_node
+        (new_line (fun n -> n)) (empty_node ())
 
       (* let segment ?(boundary = `Word) ?(label = `Word) (node : node) :
              node =
@@ -1562,15 +1562,15 @@ module Panel = struct
         let m = Wall_text.Font.text_measure f str in
         let v = Gg.Size2.v m.width (f.size +. f.line_height) in
         ( I.stack
-            (I.paint
-               (Wall.Paint.color style.fg)
-               (simple_text f ~valign:`TOP ~halign:`LEFT ~x:0. ~y:0.
-                  str ) )
             (I.paint
                (Wall.Paint.color style.bg)
                ( I.fill_path
                @@ fun t ->
                P.rect t ~x:0. ~y:0. ~w:(Size2.w v) ~h:(Size2.h v) ) )
+            (I.paint
+               (Wall.Paint.color style.fg)
+               (simple_text f ~valign:`TOP ~halign:`LEFT ~x:0. ~y:0.
+                  str ) )
         , v )
 
       let cat d (ai, av) (bi, bv) =
@@ -1702,15 +1702,21 @@ module Panel = struct
       | `Join (_, a, _) -> Some a
 
     let tree_prev (n : node) =
+      let rec prev_right n' =
+        match n'.t with
+        | `Attr (_, nn) -> prev_right nn
+        | `Join (_, _, b) -> prev_right b
+        | `Atom _ -> Some n' in
       match n.parent with
       | None -> None
-      | Some ({t; _} as p) -> (
-        match t with
-        | `Atom _ -> assert false (* shouldn't happen *)
-        | `Attr _ -> Some p
-        | `Join (_, a, _) when a == n -> Some p
-        | `Join (_, a, b) when b == n -> Some a
-        | `Join _ -> assert false (* shouldn't happen *) )
+      | Some {t= `Atom _; _} ->
+          assert false
+          (* shouldn't happen TODO is there no way to type constrain these? *)
+      | Some {t= `Attr _; _} -> n.parent
+      | Some {t= `Join (_, a, b); _} when b == n -> prev_right a
+      | Some {t= `Join (_, a, _); _} when a == n -> n.parent
+      | Some {t= `Join _; _} -> assert false
+    (* shouldn't happen *)
 
     let rec search_forward (n : node) (f : node -> 'a option) :
         'a option =
@@ -1798,19 +1804,19 @@ module Panel = struct
       search_forward n (fun v ->
           match v.t with `Join _ -> Some v | _ -> None )
 
-    let cursor_attr = `Style Style.(bg Color.(blend red green))
+    let cursor_attr = `Style Style.(bg Color.(v 1. 1. 0. 1.))
 
     let textedit_handler ?(bindings = textedit_bindings) (n : node) =
       let bind = Key.Bind.init bindings in
       let c =
         { root= n
         ; sel=
-            insert_attr
-              (`Style Style.(bg Color.(blend red green)))
+            insert_attr cursor_attr
               ( match join_search_forward n with
               | Some n -> n
               | None -> n ) } in
-      Format.pp_set_max_boxes F.stderr 99999 ;
+      Format.pp_set_max_boxes F.stderr 64 ;
+      Format.pp_set_margin F.stderr 120 ;
       Format.(
         F.epr
           "@[<hv>F.stderr margin: %d, max_indent: %d, max_boxes: %d \
@@ -1825,6 +1831,9 @@ module Panel = struct
                 match Key.Bind.resolve_events bind [e] with
                 | x :: _ ->
                     c.sel <- remove_attr c.sel ;
+                    F.epr
+                      "textedit_handler c.root=@.@[%a@]@.c.sel=%a@."
+                      pp_dump_node c.root pp_node c.sel ;
                     ( match perform_action x c with
                     | Some _ ->
                         F.epr
@@ -1879,15 +1888,15 @@ module Panel = struct
         (Lwd.pure
            (textedit_handler
               (style Style.dark
-                 (* (join_y
-                     (join_y
-                        (Text.of_string
-                           "-- welcome to my land of idiocy ---" )
-                        (join_x
-                           (Text.of_string "hello bitch")
-                           (Text.of_string "!\n sup daddy") ) )*)
-                 (Text.of_string "123") ) ) )
-    (* ) *)
+                 (join_y
+                    (* (join_y
+                       (Text.of_string
+                          "-- welcome to my land of idiocy ---" )
+                                          (join_x *)
+                    (Text.of_string "hello bitch")
+                    (*
+                          (Text.of_string "!\n sup daddy") ) ) *)
+                    (Text.of_string "123") ) ) ) )
   end
 end