most cursor movement functionality works, but there are lots of weird quirks to iron out

human.ml

@@ -1383,10 +1383,13 @@ module Panel = struct
           braces
             (record ~sep:semi [field "n" Fun.id pp_node_n; any "..."]))
 
-      and pp_node ppf = _pp_node pp_node_n_record ppf
+      and pp_node ppf = _pp_node pp_node_n ppf
       and pp_dump_node ppf = _pp_node pp_dump_node ppf
 
-      let pp_t = _pp_t pp_node_n_record
+      let pp_t ppf = F.pf ppf "@[<hov>%a@]" (_pp_t pp_node_n_record)
+
+      let pp_n ppf n =
+        F.pf ppf "@[<h>%a: %a@]" pp_node_n n (_pp_t pp_node_n) n.t
 
       let rec pp_node_structure ppf v =
         F.(
@@ -1601,18 +1604,18 @@ module Panel = struct
         | `Hint _ -> empty_image
         | `Empty -> empty_image
 
-      and attr ?(style = Style.empty) (attr, node) : image =
+      and attr ?(style = Style.empty) (a, n) : image =
-        match attr with
+        match a with
-        | `Style s -> pane ~style:(Style.merge s style) node
+        | `Style s -> node ~style:(Style.merge s style) n
-        | `Pad p -> pad p (pane ~style node)
+        | `Pad p -> pad p (node ~style n)
-        | `Shift s -> shift s (pane ~style node)
+        | `Shift s -> shift s (node ~style n)
-        | _ -> pane ~style node
+        | _ -> node ~style n
 
       and join ?(style = Style.empty) (d, a, b) : image =
-        cat d (pane ~style a) (pane ~style b)
+        cat d (node ~style a) (node ~style b)
 
-      and pane ?(style = Style.empty) (node : node) : image =
+      and node ?(style = Style.empty) (n : node) : image =
-        match node.t with
+        match n.t with
         | `Atom a -> atom ~style a
         | `Attr a -> attr ~style a
         | `Join a -> join ~style a
@@ -1714,57 +1717,104 @@ module Panel = struct
       | Some {t= `Join _; _} -> assert false
     (* shouldn't happen *)
 
-    let rec search_forward (n : node) (f : node -> 'a option) :
+    let rec tree_iter f n i =
-        'a option =
+      if i <> 0 then tree_iter f (f n) (i - 1) else f n
-      match f n with
-      | None -> (
-        match tree_next n with
-        | Some n' -> search_forward n' f
-        | None -> None )
-      | x -> x
 
-    let rec search_backward (n : node) (f : node -> 'a option) :
+    let rec search_ next f n =
-        'a option =
+      F.epr "search_ " ;
-      match tree_prev n with
+      match next n with
-      | None -> None
+      | Some n' -> (
-      | Some p -> (
+          F.epr "%a@." pp_n n' ;
-        match f p with
+          match f n' with
-        | None -> search_backward p f
+          | Some a -> (n', Some a)
-        | Some x -> Some x )
+          | None -> search_ next f n' )
+      | None -> F.epr "None@." ; (n, None)
+
+    let search_forward f (n : node) = snd (search_ tree_next f n)
+    let search_backward f (n : node) = snd (search_ tree_prev f n)
+
+    let is_atom_uchar = function
+      | {t= `Atom (`Uchar _); _} as n -> Some n
+      | _ -> None
+
+    let tree_uchar_fwd n =
+      match is_atom_uchar n with
+      | Some a -> a
+      | None ->
+          Option.value (search_forward is_atom_uchar n) ~default:n
+
+    let tree_uchar_back n =
+      match is_atom_uchar n with
+      | Some a -> a
+      | None ->
+          Option.value (search_backward is_atom_uchar n) ~default:n
 
     let perform_action (a : Action.t) (c : cursor) : node option =
-      let r =
+      let mb ?(f = fun a -> a) b n =
-        match a with
+        match (b, n.t) with
-        | `Move (`Beginning `Char) -> None
+        | `Char, `Atom (`Uchar _)
-        | `Move (`Beginning `Word) ->
+         |`Word, `Atom (`Boundary `Word)
-            search_backward c.sel (fun n ->
+         |`Phrase, `Atom (`Boundary `Phrase)
-                match n.t with
+         |`Line, `Atom (`Boundary `Line)
-                | `Atom (`Boundary `Word) -> Some n
+         |`Page, `Atom (`Boundary `Page) ->
+            Some (f n)
+        | _ -> None in
+      match a with
+      | `Move (`Forward `Line) -> (
+          let i = ref 0 in
+          ignore
+            (search_backward
+               (function
+                 | {t= `Atom (`Boundary `Line); _} -> Some ()
+                 | {t= `Atom (`Uchar _); _} -> incr i ; None
+                 | _ -> None )
+               c.sel ) ;
+          match search_forward (mb `Line) c.sel with
+          | Some n' ->
+              Some
+                (tree_iter
+                   (fun nn ->
+                     Option.value
+                       (search_forward (mb `Char) nn)
+                       ~default:nn )
+                   n' !i )
+          | None -> None )
+      | `Move (`Backward `Line) -> (
+          let i = ref 0 in
+          match
+            search_backward
+              (function
+                | {t= `Atom (`Boundary `Line); _} as n' -> Some n'
+                | {t= `Atom (`Uchar _); _} -> incr i ; None
                 | _ -> None )
-        | `Move (`Forward `Char) ->
+              c.sel
-            search_forward c.sel (fun n ->
+          with
-                match n.t with
+          | Some n' ->
-                | _ when n == c.sel -> None
+              Some
-                (* TODO proper detection of root | _ when n == c.root -> Some n *)
+                (tree_iter
-                | `Atom (`Uchar _) -> Some n
+                   (fun nn ->
-                | _ -> None )
+                     Option.value
-        | `Move (`Backward `Char) ->
+                       (search_forward (mb `Char) nn)
-            search_backward c.sel (fun n ->
+                       ~default:nn )
-                match n.t with
+                   (fst (search_ tree_prev (mb `Line) n'))
-                (* TODO proper detection of root | _ when n == c.root -> Some np *)
+                   !i )
-                | `Atom (`Uchar _) -> Some n
+          | None -> None )
-                | _ -> None )
+      | `Move (`Forward b) ->
-        | `Move _ -> None
+          search_forward (mb ~f:tree_uchar_back b) c.sel
-        | `Yank _s -> None
+      | `Move (`Backward b) ->
-        | `Kill _s -> None
+          search_backward (mb ~f:tree_uchar_fwd b) c.sel
-        | `Descend -> Some (sub c.sel)
+      | `Move (`Beginning b) ->
-        | `Ascend -> c.sel.parent
+          (* uses last searched node regardless of match *)
-        | `Custom _s -> None in
+          Some (tree_uchar_fwd (fst (search_ tree_prev (mb b) c.sel)))
-      match r with
+      | `Move (`End b) ->
-      | Some n ->
+          (* uses last searched node regardless of match *)
-          c.sel <- n ;
+          Some
-          Some n
+            (tree_uchar_back (fst (search_ tree_next (mb b) c.sel)))
-      | None -> None
+      | `Yank _s -> None
+      | `Kill _s -> None
+      | `Descend -> Some (sub c.sel)
+      | `Ascend -> c.sel.parent
+      | `Custom _s -> None
 
     type event_status = [`Handled | `Event of Event.t]
 
@@ -1794,28 +1844,21 @@ module Panel = struct
            [([Ctrl], C 'x'); ([], U `Backspace)]
            [`Kill (`Backward `Phrase)]
       |> add [([Ctrl], C 'q')] [`Ascend]
-      |> add [([Ctrl], C 'e')] [`Descend]
+      |> add [([Ctrl], C 'z')] [`Descend]
-
-    let join_search_forward n =
-      search_forward n (fun v ->
-          match v.t with `Join _ -> Some v | _ -> None )
 
     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 cursor_attr
-              ( match join_search_forward n with
-              | Some n -> n
-              | None -> n ) } in
       Format.pp_set_max_boxes F.stderr 64 ;
       (*full screen fynn  *)
       Format.pp_safe_set_geometry F.stderr ~max_indent:150 ~margin:230 ;
-      node
+      let bind = Key.Bind.init bindings in
-        (`Attr
+      let sel = insert_attr cursor_attr n in
+      let c =
+        {root= attr (`Handler (fun _ _ -> Lwt.return_none)) sel; sel}
+      in
+      c.root.t <-
+        `Attr
           ( `Handler
               (fun (_ : node) (e : Event.t) : Event.t option Lwt.t ->
                 match Key.Bind.resolve_events bind [e] with
@@ -1825,20 +1868,24 @@ module Panel = struct
                       "textedit_handler c.sel.n=%d@ c.root=@ @[%a@]@."
                       pp_node_n c.sel pp_node_structure c.root  ; *)
                     ( match perform_action x c with
-                    | Some _ ->
+                    | Some n' ->
                         F.epr "textedit action @[%a@] Success@."
-                          Action.pp_t x
+                          Action.pp_t x ;
+                        c.sel <- n'
                     | None ->
                         F.epr "textedit action @[%a@] Failure@."
                           Action.pp_t x ) ;
                     c.sel <- insert_attr cursor_attr c.sel ;
                     Lwt.return_none
                 | [] -> Lwt.return_some e )
-          , n ) )
+          , n ) ;
+      set_parent_on_children c.root
 
     let handler_of_node (n : node) : handler option =
-      search_forward n (fun n ->
+      let f n =
-          match n.t with `Attr (`Handler f, _) -> Some f | _ -> None )
+        match n.t with `Attr (`Handler f, _) -> Some f | _ -> None
+      in
+      match f n with Some a -> Some a | None -> search_forward f n
 
     let handle_event (n : node) (ev : Event.t) : event_status Lwt.t =
       match handler_of_node n with
@@ -1867,7 +1914,7 @@ module Panel = struct
                   () ) ;
               Lwt.return_unit )
             ev
-          >|= fun () -> Draw.pane r )
+          >|= fun () -> Draw.node r )
 
     let test =
       panel