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

human.ml

@@ -2,6 +2,8 @@
 
 ALWAYS BREAK UP THE PROBLEM INTO SMALLER CHUNKS BITCH!!
 
+Times I would have solved it faster if i broke it up instead of trying to understand it all at once: 2
+
 a computation console
 
 - irmin store provides a tree of data objects
@@ -1242,6 +1244,8 @@ module Panel = struct
     (* Tree-like structure of Ui elements, from the entire display down to individual glyphs. *)
     (* i think this is gonna end up being a binary tree?? *)
 
+    (* TODO make sure this is LCRS: https://en.wikipedia.org/wiki/Left-child_right-sibling_binary_tree *)
+
     open Gg
     open Wall
 
@@ -1250,13 +1254,13 @@ module Panel = struct
       | `Attr of attr * node
       | `Join of dir * node * node ]
 
-    and node = {mutable parent: node option; mutable t: t}
+    and node = {mutable parent: node option; mutable t: t; n: int}
     and cursor = {root: node; mutable sel: node}
 
     and atom =
       [ `Image of image
       | `Uchar of Uchar.t
-      | `Boundary of [`Word | `Line | `Sentance]
+      | `Boundary of boundary
       | `Hint of [`Line | `Other]
       | `Empty ]
 
@@ -1264,14 +1268,14 @@ module Panel = struct
       [ `Style of style
       | `Pad of Pad.t
       | `Shift of dim
-      | `Cursor
       | `Handler of handler ]
 
+    and dir = [`X | `Y | `Z]
     and dim = Size2.t
     and image = Wall.image * dim
+    and boundary = [`Char | `Word | `Phrase | `Line | `Page | `Text]
     and style = Style.t
     and handler = node -> Event.t -> Event.t option Lwt.t
-    and dir = [`X | `Y | `Z]
 
     let set_parent_on_children n : node =
       ( match n.t with
@@ -1282,11 +1286,128 @@ module Panel = struct
           b.parent <- Some n ) ;
       n
 
-    let node (t : t) = set_parent_on_children {parent= None; t}
+    let node_count = ref 0
+
+    let node_n () =
+      node_count := !node_count + 1 ;
+      !node_count - 1
+
+    let node (t : t) =
+      set_parent_on_children {parent= None; t; n= node_n ()}
+
+    let atom (a : atom) = node (`Atom a)
+    let attr (a : attr) (child : node) = node (`Attr (a, child))
+    let join (d : dir) (a : node) (b : node) = node (`Join (d, a, b))
     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))
 
+    module Pp = struct
+      let pp_uchar ppf v =
+        if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
+        else Fmt.Dump.uchar ppf v
+
+      let pp_boundary ppf v =
+        F.any
+          ( match v with
+          | `Char -> "`Char"
+          | `Word -> "`Word"
+          | `Phrase -> "`Phrase"
+          | `Line -> "`Line"
+          | `Page -> "`Page"
+          | `Text ->
+              "`Text"
+              (* text is like a file (unicode calls it End Of Text) *)
+          )
+          ppf ()
+
+      let pp_atom ppf v =
+        let open Fmt in
+        ( match v with
+        | `Image _ -> any "`Image"
+        | `Uchar c -> any "`Uchar " ++ const pp_uchar c
+        | `Boundary b -> any "`Boundary " ++ const pp_boundary b
+        | `Hint h ->
+            any "`Hint "
+            ++ any
+                 (match h with `Line -> "`Line" | `Other -> "`Other")
+        | `Empty -> any "`Empty" )
+          ppf ()
+
+      let pp_attr ppf v =
+        let open Fmt in
+        (any
+           ( match v with
+           | `Style _ -> "`Style ..."
+           | `Pad _ -> "`Pad ..."
+           | `Shift _ -> "`Shift ..."
+           | `Cursor -> "`Cursor"
+           | `Handler _ -> "`Handler ..." ) )
+          ppf ()
+
+      let pp_dir ppf v =
+        F.pf ppf "%s"
+          (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
+
+      let pp_node_n ppf v = F.(pf ppf "%a" int v.n)
+
+      let rec _pp_t child ppf v =
+        let open Fmt in
+        match v with
+        | `Atom x -> pf ppf "`Atom %a" pp_atom x
+        | `Attr (a, n) ->
+            pf ppf "`Attr %a"
+              (parens (const pp_attr a ++ comma ++ const child n))
+              ()
+        | `Join (d, a, b) ->
+            pf ppf "`Join %a"
+              (parens
+                 ( const pp_dir d ++ comma ++ const child a ++ comma
+                 ++ const child b ) )
+              ()
+
+      and _pp_node child ppf v =
+        let open Fmt in
+        pf ppf "@[<hov>%a@]"
+          (braces
+             (record
+                [ field "n" (fun v -> v.n) int
+                ; field "t" (fun v -> v.t) (_pp_t child)
+                ; field "parent"
+                    (fun v -> v.parent)
+                    (option pp_node_n) ] ) )
+          v
+
+      and pp_node_n_record =
+        F.(
+          braces
+            (record ~sep:semi [field "n" Fun.id pp_node_n; any "..."]))
+
+      and pp_node ppf = _pp_node pp_node_n ppf
+      and pp_dump_node ppf = _pp_node pp_dump_node ppf
+
+      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.(
+          const int v.n
+          ++ parens
+               (concat ~sep:comma
+                  ( match v.t with
+                  | `Atom a -> [const pp_atom a]
+                  | `Attr (a, n) ->
+                      [const pp_attr a; const pp_node_structure n]
+                  | `Join (d, l, r) ->
+                      [ const pp_dir d; const pp_node_structure l
+                      ; const pp_node_structure r ] ) ))
+          ppf ()
+    end
+
+    open Pp
+
     let rec traverse_nodes ~(f : node -> node option) (n : node) :
         unit =
       match f n with
@@ -1321,7 +1442,8 @@ module Panel = struct
                 | `Attr (a, _) -> `Attr (a, n')
                 | `Join (d, a, b) when n == a -> `Join (d, n', b)
                 | `Join (d, a, b) when n == b -> `Join (d, a, n')
-                | _ -> assert false )
+                | _ -> assert false ) ;
+              ignore (set_parent_on_children p)
           | None -> () ) ;
           n'
       | _ -> assert false
@@ -1332,76 +1454,23 @@ module Panel = struct
       | `Attr (_, n) -> n
       | `Join (_, a, _) -> a
 
-    let join_ d (a : node) (b : node) =
+    let join_x = join `X
-      set_parent_on_children {parent= a.parent; t= `Join (d, a, b)}
+    let join_y = join `Y
-
+    let join_z = join `Z
-    let empty_join d = node (`Join (d, empty_node, empty_node))
+    let pack_x : node Lwd_utils.monoid = (empty_node (), join_x)
-    let join_x = join_ `X
+    let pack_y : node Lwd_utils.monoid = (empty_node (), join_y)
-    let join_y = join_ `Y
+    let pack_z : node Lwd_utils.monoid = (empty_node (), join_z)
-    let join_z = join_ `Z
-    let pack_x : node Lwd_utils.monoid = (empty_join `X, join_x)
-    let pack_y : node Lwd_utils.monoid = (empty_join `Y, join_y)
-    let pack_z : node Lwd_utils.monoid = (empty_join `Z, join_z)
     let ( ^^ ) = join_x
     let ( ^/^ ) = join_y
+    let ( ^*^ ) = join_z
 
-    let pp_uchar ppf v =
+    let append_ d (l : node -> node) (a : node) : node -> node =
-      if Uchar.is_char v then Fmt.pf ppf "'%c'" (Uchar.to_char v)
+     fun n -> l (join d a n)
-      else Fmt.Dump.uchar ppf v
 
-    let pp_atom ppf v =
+    let empty_append = Fun.id
-      let open Fmt in
+    let append_x = append_ `X
-      ( match v with
+    let append_y = append_ `Y
-      | `Image _ -> any "`Image"
+    let append_z = append_ `Z
-      | `Uchar c -> any "`Uchar " ++ const pp_uchar c
-      | `Boundary b -> (
-          any "`Boundary "
-          ++
-          match b with
-          | `Word -> any "`Word"
-          | `Line -> any "`Line"
-          | `Sentance -> any "`Sentance" )
-      | `Hint h ->
-          any "`Hint "
-          ++ any (match h with `Line -> "`Line" | `Other -> "`Other")
-      | `Empty -> any "`Empty" )
-        ppf ()
-
-    let tess v = F.epr "%a" pp_atom v
-
-    let pp_attr ppf v =
-      let open Fmt in
-      (any
-         ( match v with
-         | `Style _ -> "`Style ..."
-         | `Pad _ -> "`Pad ..."
-         | `Shift _ -> "`Shift ..."
-         | `Cursor -> "`Cursor"
-         | `Handler _ -> "`Handler ..." ) )
-        ppf ()
-
-    let pp_dir ppf v =
-      F.pf ppf "%s"
-        (match v with `X -> "`X" | `Y -> "`Y" | `Z -> "`Z")
-
-    let rec pp_node ppf v =
-      let open Fmt in
-      pf ppf "@[<hov>%a@]" pp_t v.t
-
-    and pp_t ppf v =
-      let open Fmt in
-      match v with
-      | `Join (d, a, b) ->
-          pf ppf "`Join %a"
-            (parens
-               ( const pp_dir d ++ comma ++ const pp_node a ++ comma
-               ++ const pp_node b ) )
-            ()
-      | `Attr (a, n) ->
-          pf ppf "`Attr %a"
-            (parens (const pp_attr a ++ comma ++ const pp_node n))
-            ()
-      | `Atom x -> pf ppf "`Atom %a" pp_atom x
 
     (* there's no difference between a node element and a node list what, tho an element is kinda like a node.t,
        so i guess we'll use that to kinda emulate append (vs. concat which is what join is)
@@ -1410,85 +1479,54 @@ module Panel = struct
        So i think what is really happening is that i'm defining the `list` for this node type that allows `append`.
        The main problem with this thought is that you can't do anything but append with the datastructure.
     *)
-    let new_append () = empty_node
-
-    let append (d : dir) (l : unit -> node) (n : node) : unit -> node
-        =
-     fun () ->
-      set_parent_on_children {parent= None; t= `Join (d, l (), n)}
 
     module Text = struct
-      let rec _of_string (la : unit -> node) (str : string) :
+      let rec decode dec (l : 'a) :
-          unit -> node =
+          'a * [< `Await | `End | `Uchar of Uchar.t] =
-        let uudec = Uutf.decoder (`String str) in
+        match Uutf.decode dec with
-        let rec dec (lx : unit -> node) : 'a * (unit -> node) =
+        | `Malformed b ->
-          match Uutf.decode uudec with
+            F.epr "Text.dec (Uutf.decode uudec)=`Malformed \"%s\"@."
-          | `Malformed b -> dec (_of_string lx (String.escaped b))
+              (String.escaped b) ;
-          | (`Await | `Uchar _ | `End) as x -> (x, lx) in
+            decode dec (append_x l (of_string (String.escaped b)))
-        let uuline = Uuseg.create `Line_break in
+        | (`Await | `End | `Uchar _) as s -> (l, s)
-        let rec new_line la' : unit -> node =
+
-          let rec char (x, lx) (ly : unit -> node) =
+      and _of_string dec l =
-            match Uuseg.add uuline x with
+        match decode dec l with
-            | `End as x -> (ly, x)
+        | l, `End -> l (atom (`Boundary `Text))
-            | `Boundary as x when Uuseg.mandatory uuline -> (ly, x)
+        | l, `Uchar c -> _of_string dec (append_x l (atom (`Uchar c)))
-            | `Await -> char (dec lx) ly
+        | l, _ -> _of_string dec l
+
+      and of_string str =
+        _of_string
+          (Uutf.decoder
+             ~nln:(`Readline (Uchar.of_int 0x000A))
+             (`String str) )
+          empty_append
+
+      and _lines u d ly (lx, s) =
+        match Uuseg.add u s with
+        | `Boundary when Uuseg.mandatory u ->
+            _lines u d
+              (append_y ly (lx (atom (`Boundary `Line))))
+              (empty_append, `Await)
         | `Boundary ->
-                char
+            _lines u d ly (append_x lx (atom (`Hint `Line)), `Await)
-                  (`Await, append `X lx (node (`Atom (`Hint `Line))))
+        | `End -> ly (lx (atom (`Boundary `Text)))
-                  ly
+        | `Await -> _lines u d ly (decode d lx)
         | `Uchar c ->
-                char
+            _lines u d ly (append_x lx (atom (`Uchar c)), `Await)
-                  (`Await, append `X lx (node (`Atom (`Uchar c))))
-                  ly in
-          match char (`Await, la') la' with
-          | l, `Boundary ->
-              new_line
-                (append `Y la'
-                   ((append `X l (node (`Atom (`Boundary `Line)))) ()) )
-          | l, `End -> l in
-        new_line la
 
-      let of_string str = _of_string new_append str ()
+      let lines str =
-
+        _lines
-      (* let segment ?(boundary = `Word) ?(label = `Word) (node : node) :
+          (Uuseg.create `Line_break)
-             node =
+          (Uutf.decoder
-           let uuseg = Uuseg.create boundary in
+             ~nln:(`Readline (Uchar.of_int 0x000A))
-           traverse_regions
+             (`String str) )
-             ~node:(fun node -> node)
+          empty_append
-             ~region:(fun ~parent (r, c) ~child ->
+          (empty_append, `Await)
-               match child.child with
-               | `Atom (`Uchar uc) ->
-                   let rec seg ((t : node Trope.t), (c : Region.cursor))
-                       e' =
-                     match Uuseg.add uuseg e' with
-                     | `Boundary ->
-                         seg
-                           ( Trope.put_right t c
-                               {parent; child= `Atom (`Boundary label)}
-                           , Trope.cursor_after c )
-                           `Await
-                     | `End | `Await -> (t, c)
-                     | `Uchar ch ->
-                         seg
-                           ( Trope.put_right t c
-                               {parent; child= `Atom (`Uchar ch)}
-                           , c )
-                           `Await in
-                   let r', c' = seg (r.t, c) (`Uchar uc) in
-                   ({r with t= r'}, c')
-               | _ -> (r, c) )
-             node
-
-          let words node : node =
-           segment ~boundary:`Word ~label:`Word node
-
-         let sentances node : node =
-           segment ~boundary:`Sentence ~label:`Sentance node
-
-         let text str : node = insert_string str |> sentances |> words *)
     end
 
-    let text = Text.of_string
+    let text = Text.lines
 
     module Draw = struct
       type d = [`X | `Y | `Z]
@@ -1537,15 +1575,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) =
@@ -1566,35 +1604,31 @@ 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)
-        | `Cursor -> cursor (pane ~style node)
+        | _ -> node ~style n
-        | _ -> pane ~style node
 
       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
     end
 
     module Action = struct
-      type segment_type =
-        [`Char | `Word | `Phrase | `Line | `Page | `Region]
-
       type segment =
-        [ `Beginning of segment_type
+        [ `Beginning of boundary
-        | `Back of segment_type
+        | `Forward of boundary
-        | `Forward of segment_type
+        | `Backward of boundary
-        | `End of segment_type ]
+        | `End of boundary ]
 
-      type t =
+      and t =
         [ `Move of segment
         | `Yank of segment
         | `Kill of segment
@@ -1602,7 +1636,7 @@ module Panel = struct
         | `Descend
         | `Custom of string * (node -> t Key.Bind.t -> unit Lwt.t) ]
 
-      type dir =
+      and dir =
         [ `Next
         | `Prev
         | `Up
@@ -1613,45 +1647,174 @@ module Panel = struct
         | `Enter
         | `In
         | `Out ]
+
+      open Fmt
+
+      let pp_dir ppf v =
+        any
+          ( match v with
+          | `Next -> "`Next"
+          | `Prev -> "`Prev"
+          | `Up -> "`Up"
+          | `Down -> "`Down"
+          | `Left -> "`Left"
+          | `Right -> "`Right"
+          | `Fwd -> "`Fwd"
+          | `Enter -> "`Enter"
+          | `In -> "`In"
+          | `Out -> "`Out" )
+          ppf ()
+
+      let pp_segment ppf v =
+        ( match v with
+        | `Beginning s -> any "`Beginning " ++ const pp_boundary s
+        | `Forward s -> any "`Forward " ++ const pp_boundary s
+        | `Backward s -> any "`Backward " ++ const pp_boundary s
+        | `End s -> any "`End " ++ const pp_boundary s )
+          ppf ()
+
+      let pp_t ppf v =
+        ( match v with
+        | `Move s -> any "`Move " ++ const pp_segment s
+        | `Yank s -> any "`Yank " ++ const pp_segment s
+        | `Kill s -> any "`Kill " ++ const pp_segment s
+        | `Ascend -> any "`Ascend"
+        | `Descend -> any "`Descend"
+        | `Custom (s, _) ->
+            fun ppf () -> pf ppf "`Custom \"%a\"" string s )
+          ppf ()
     end
 
-    let rec search_forward (n : node) (f : node -> 'a option) :
+    let tree_next (n : node) =
-        'a option =
+      let rec next_right n' =
-      match f n with
+        match n'.parent with
-      | None -> (
+        | None -> None
+        | Some ({t= `Attr _; _} as p) -> next_right p
+        | Some {t= `Join (_, a, b); _} when n' == a -> Some b
+        | Some ({t= `Join (_, _, b); _} as p) when n' == b ->
+            next_right p
+        | Some {t= `Join _; _} -> assert false
+        | Some {t= `Atom _; _} -> assert false in
       match n.t with
-        | `Atom _ -> None
+      | `Atom _ -> next_right n
-        | `Attr (_, n) -> search_forward n f
+      | `Attr (_, n') -> Some n'
-        | `Join (_, a, b) -> (
+      | `Join (_, a, _) -> Some a
-          match search_forward a f with
-          | Some n' -> Some n'
-          | None -> search_forward b f ) )
-      | Some a -> Some a
 
-    let rec search_backward (n : node) (f : node -> 'a option) :
+    let tree_prev (n : node) =
-        'a option =
+      let rec prev_right n' =
-      match f n with
+        match n'.t with
-      | None -> (
+        | `Attr (_, nn) -> prev_right nn
+        | `Join (_, _, b) -> prev_right b
+        | `Atom _ -> Some n' in
       match n.parent with
-        | None -> None (* at root and didn't find anything *)
+      | None -> None
-        | Some n -> search_backward n f )
+      | Some {t= `Atom _; _} ->
-      | Some n' -> Some n'
+          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 perform_action (a : Action.t) (c : node) : node =
+    let rec tree_iter f n i =
+      if i <> 0 then tree_iter f (f n) (i - 1) else f n
+
+    let rec search_ next f n =
+      F.epr "search_ " ;
+      match next n with
+      | Some n' -> (
+          F.epr "%a@." pp_n n' ;
+          match f n' with
+          | Some a -> (n', Some a)
+          | 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 mb ?(f = fun a -> a) b n =
+        match (b, n.t) with
+        | `Char, `Atom (`Uchar _)
+         |`Word, `Atom (`Boundary `Word)
+         |`Phrase, `Atom (`Boundary `Phrase)
+         |`Line, `Atom (`Boundary `Line)
+         |`Page, `Atom (`Boundary `Page) ->
+            Some (f n)
+        | _ -> None in
       match a with
-      | `Move (`Beginning `Char) -> c
+      | `Move (`Forward `Line) -> (
-      | `Move (`Beginning `Word) ->
+          let i = ref 0 in
-          Option.value ~default:c
+          ignore
-            (search_backward c (fun n ->
+            (search_backward
-                 match n.t with
+               (function
-                 | `Atom (`Boundary `Word) -> Some n
+                 | {t= `Atom (`Boundary `Line); _} -> Some ()
-                 | _ -> None ) )
+                 | {t= `Atom (`Uchar _); _} -> incr i ; None
-      | `Move _ -> c
+                 | _ -> None )
-      | `Yank _s -> c
+               c.sel ) ;
-      | `Kill _s -> c
+          match search_forward (mb `Line) c.sel with
-      | `Descend -> sub c
+          | Some n' ->
-      | `Ascend -> ( match c.parent with Some n -> n | None -> c )
+              Some
-      | `Custom _s -> c
+                (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 )
+              c.sel
+          with
+          | Some n' ->
+              Some
+                (tree_iter
+                   (fun nn ->
+                     Option.value
+                       (search_forward (mb `Char) nn)
+                       ~default:nn )
+                   (fst (search_ tree_prev (mb `Line) n'))
+                   !i )
+          | None -> None )
+      | `Move (`Forward b) ->
+          search_forward (mb ~f:tree_uchar_back b) c.sel
+      | `Move (`Backward b) ->
+          search_backward (mb ~f:tree_uchar_fwd b) c.sel
+      | `Move (`Beginning b) ->
+          (* uses last searched node regardless of match *)
+          Some (tree_uchar_fwd (fst (search_ tree_prev (mb b) c.sel)))
+      | `Move (`End b) ->
+          (* uses last searched node regardless of match *)
+          Some
+            (tree_uchar_back (fst (search_ tree_next (mb b) c.sel)))
+      | `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]
 
@@ -1659,57 +1822,70 @@ module Panel = struct
       let open Key.Bind in
       empty
       |> add [([Ctrl], C 'f')] [`Move (`Forward `Char)]
-      |> add [([Ctrl], C 'b')] [`Move (`Back `Char)]
+      |> add [([Ctrl], C 'b')] [`Move (`Backward `Char)]
-      |> add [([Ctrl], C 'f')] [`Move (`Forward `Word)]
+      |> add [([Meta], C 'f')] [`Move (`Forward `Word)]
-      |> add [([Meta], C 'b')] [`Move (`Back `Word)]
+      |> add [([Meta], C 'b')] [`Move (`Backward `Word)]
       |> add
            [([Ctrl], C 'c'); ([Ctrl], C 'n')]
            [`Move (`Forward `Phrase)]
-      |> add [([Ctrl], C 'c'); ([Ctrl], C 'p')] [`Move (`Back `Phrase)]
+      |> add
+           [([Ctrl], C 'c'); ([Ctrl], C 'p')]
+           [`Move (`Backward `Phrase)]
       |> add [([Ctrl], C 'n')] [`Move (`Forward `Line)]
-      |> add [([Ctrl], C 'p')] [`Move (`Back `Line)]
+      |> add [([Ctrl], C 'p')] [`Move (`Backward `Line)]
-      |> add [([Meta], C 'v')] [`Move (`Forward `Page)]
+      |> add [([Ctrl], C 'v')] [`Move (`Forward `Page)]
-      |> add [([Ctrl], C 'v')] [`Move (`Back `Page)]
+      |> add [([Meta], C 'v')] [`Move (`Backward `Page)]
       |> add [([Ctrl], C 'a')] [`Move (`Beginning `Line)]
       |> add [([Ctrl], C 'e')] [`Move (`End `Line)]
       |> add [([Ctrl], C 'k')] [`Kill (`End `Line)]
-      |> add [([Ctrl], U `Backspace)] [`Kill (`Back `Word)]
+      |> add [([Ctrl], U `Backspace)] [`Kill (`Backward `Word)]
-      |> add [([Meta], U `Backspace)] [`Kill (`Back `Word)]
+      |> add [([Meta], U `Backspace)] [`Kill (`Backward `Word)]
       |> add
            [([Ctrl], C 'x'); ([], U `Backspace)]
-           [`Kill (`Back `Phrase)]
+           [`Kill (`Backward `Phrase)]
       |> add [([Ctrl], C 'q')] [`Ascend]
-      |> add [([Ctrl], C 'e')] [`Descend]
+      |> add [([Ctrl], C 'z')] [`Descend]
+
+    let cursor_attr = `Style Style.(bg Color.(v 1. 1. 0. 1.))
 
     let textedit_handler ?(bindings = textedit_bindings) (n : node) =
+      Format.pp_set_max_boxes F.stderr 64 ;
+      (*full screen fynn  *)
+      Format.pp_safe_set_geometry F.stderr ~max_indent:150 ~margin:230 ;
       let bind = Key.Bind.init bindings in
-      let n' = insert_attr `Cursor n in
+      let sel = insert_attr cursor_attr n in
-      let c = ref n in
+      let c =
-      Format.(
+        {root= attr (`Handler (fun _ _ -> Lwt.return_none)) sel; sel}
-        F.epr
+      in
-          "@[<hv> F.stderr margin: %d, max_indent: %d, max_boxes: %d \
+      c.root.t <-
-           @]@."
+        `Attr
-          (pp_get_margin F.stderr ())
-          (pp_get_max_indent F.stderr ())
-          (pp_get_max_boxes F.stderr ())) ;
-      F.epr "@[<v>%a@]@." pp_node n' ;
-      node
-        (`Attr
           ( `Handler
               (fun (_ : node) (e : Event.t) : Event.t option Lwt.t ->
                 match Key.Bind.resolve_events bind [e] with
                 | x :: _ ->
-                    c :=
+                    c.sel <- remove_attr c.sel ;
-                      insert_attr `Cursor
+                    (*F.epr
-                        (perform_action x (remove_attr !c)) ;
+                      "textedit_handler c.sel.n=%d@ c.root=@ @[%a@]@."
-                    F.epr "%a@." pp_node !c ;
+                      pp_node_n c.sel pp_node_structure c.root  ; *)
+                    ( match perform_action x c with
+                    | Some n' ->
+                        F.epr "textedit action @[%a@] Success@."
+                          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
@@ -1738,23 +1914,23 @@ module Panel = struct
                   () ) ;
               Lwt.return_unit )
             ev
-          >|= fun () -> Draw.pane r )
+          >|= fun () -> Draw.node r )
 
     let test =
       panel
         (Lwd.pure
            (textedit_handler
               (style Style.dark
-                 (*(join_y
                  (join_y
-                       (Text.insert_string empty_node
+                    (join_y
+                       (Text.of_string
                           "-- welcome to my land of idiocy ---" )
-                       (join_x
+                       ( ( Text.of_string "hello bitch"
-                          (Text.insert_string empty_node "hello bitch")
+                         ^^ Text.of_string "!\n sup daddy" )
-                          (Text.insert_string empty_node
+                       ^/^ (text "hello bitch" ^^ text "!\n sup daddy")
-                             "!\n sup daddy" ) ) )*)
+                       ^/^ text "hello bitch" ^/^ text "!\n sup daddy"
-                 (Text.of_string "test 1 2 3") ) ) )
+                       ) )
-    (* ) *)
+                    (Text.of_string "123") ) ) ) )
   end
 end