text_area improvements

might require Focus.release, but may be incorrect use of Focus.request.

boot_js.ml

@@ -85,7 +85,6 @@ let _ =
   let webgl_ctx = webgl_initialize canvas in
   let vg = graphv_initialize webgl_ctx in
   let open Js_of_ocaml_lwt.Lwt_js_events in
-  let edit_me = Lwd.var ("edit me?", 0) in
   let open Nottui in
   let gravity_pad = Gravity.make ~h:`Negative ~v:`Negative in
   let gravity_crop = Gravity.make ~h:`Positive ~v:`Negative in
@@ -93,12 +92,20 @@ let _ =
   let wm = Nottui_widgets.window_manager (Lwd.join (Lwd.get body)) in
   let ui =
     Nottui_widgets.(
-      let string s = Lwd.pure @@ Nottui_widgets.string s in
+      edit_area
-      line_table_of_string
+        ~table:
-        "edit me?\n\
+          (multifield_of_string
-         derp derp derp\n\
+             "edit me?\n\
-         herp herp derp\n\
+              derp derp derp\n\
-         ding dong beep beep"
+              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;

human.ml

@@ -1,3 +1,5 @@
+(* why *)
+
 (*
 
 names?:
@@ -517,7 +519,7 @@ module Input = struct
 
   let pp_mods =
     F.(
-      list (fun ppf -> function
+      list ~sep:F.sp (fun ppf -> function
         | `Super -> pf ppf "`Super"
         | `Meta -> pf ppf "`Meta"
         | `Ctrl -> pf ppf "`Ctrl"
@@ -810,6 +812,14 @@ module Style = struct
     NVG.set_fill_color vg ~color:s.bg;
     NVG.set_stroke_color vg ~color:s.fg;
     Font.set vg s.font
+
+  let menu_main = bg Color.green ++ fg Color.black
+  let menu_sub = bg Color.lightgreen ++ fg Color.black
+
+  let clickable =
+    (bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5) ++ (fg @@ Color.light)
+
+  let cursor = (fg @@ Color.dark) ++ (bg @@ Color.yellow)
 end
 
 module Pad = struct
@@ -1220,6 +1230,8 @@ module Nottui = struct
     val status : handle -> status Lwd.t
     val has_focus : status -> bool
     val merge : status -> status -> status
+    val pp_var : Format.formatter -> var -> unit
+    val pp_status : Format.formatter -> status -> unit
   end = struct
     type var = int Lwd.var
     type status = Empty | Handle of int * var | Conflict of int
@@ -1240,6 +1252,8 @@ module Nottui = struct
 
     let request_var (v : var) =
       incr clock;
+      Log.debug (fun m ->
+          m "Focus.request_var v=%d clock=%d" (Lwd.peek v) !clock);
       Lwd.set v !clock
 
     let request ((v, _) : handle) = request_var v
@@ -1250,15 +1264,20 @@ module Nottui = struct
 
     let merge s1 s2 : status =
       match (s1, s2) with
-      | Empty, x | x, Empty -> x
+      | (Empty | Handle (0, _)), x | x, (Empty | Handle (0, _)) -> x
-      | _, Handle (0, _) -> s1
-      | Handle (0, _), _ -> s2
       | Handle (i1, _), Handle (i2, _) when i1 = i2 -> s1
       | (Handle (i1, _) | Conflict i1), Conflict i2 when i1 < i2 -> s2
       | (Handle (i1, _) | Conflict i1), Handle (i2, _) when i1 < i2 ->
           Conflict i2
       | Conflict _, (Handle (_, _) | Conflict _) -> s1
       | Handle (i1, _), (Handle (_, _) | Conflict _) -> Conflict i1
+
+    let pp_var ppf v = F.pf ppf "%d" (Lwd.peek v)
+
+    let pp_status ppf = function
+      | Empty -> F.pf ppf "Empty"
+      | Handle (i, v) -> F.pf ppf "Handle (%d, %a)" i pp_var v
+      | Conflict i -> F.pf ppf "Conflict %d" i
   end
 
   module Gravity : sig
@@ -1333,6 +1352,10 @@ module Nottui = struct
   module Ui = struct
     type may_handle = [ `Unhandled | `Handled ]
 
+    let may_handle (type a) (v : a option) (f : a -> may_handle) :
+        may_handle =
+      match v with Some v' -> f v' | None -> `Unhandled
+
     let pp_may_handle ppf = function
       | `Unhandled -> F.pf ppf "`Unhandled"
       | `Handled -> F.pf ppf "`Handled"
@@ -1361,7 +1384,7 @@ module Nottui = struct
 
     let pp_key =
       F.(
-        pair
+        pair ~sep:F.sp
           (fun ppf v ->
             match v with
             | `Copy -> pf ppf "`Copy"
@@ -1590,7 +1613,9 @@ module Nottui = struct
     let zcat xs = Lwd_utils.reduce pack_z xs
     let has_focus t = Focus.has_focus t.focus
 
-    let rec pp ppf t = Format.fprintf ppf "@[<hov>%a@]" pp_desc t.desc
+    let rec pp ppf t =
+      F.pf ppf "@[<hov>focus=%a %a@]" Focus.pp_status t.focus pp_desc
+        t.desc
 
     and pp_desc ppf = function
       | Atom a ->
@@ -1658,22 +1683,6 @@ module Nottui = struct
 
     let size t = t.size
 
-    let iter f (ui : ui) =
-      match ui.desc with
-      | Atom _ -> ()
-      | Size_sensor (u, _)
-      | Transient_sensor (u, _)
-      | Permanent_sensor (u, _)
-      | Resize (u, _, _, _)
-      | Mouse_handler (u, _)
-      | Focus_area (u, _)
-      | Shift_area (u, _, _)
-      | Event_filter (u, _) ->
-          f u
-      | X (u1, u2) | Y (u1, u2) | Z (u1, u2) ->
-          f u1;
-          f u2
-
     let solve_focus (ui : ui) i =
       let rec aux ui =
         match ui.focus with
@@ -1991,6 +2000,12 @@ module Nottui = struct
         let cache =
           match t.desc with
           | Atom image ->
+              let image =
+                if Focus.has_focus t.focus then (
+                  Log.debug (fun m -> m "render_node Atom has_focus");
+                  I.attr A.clickable image)
+                else image
+              in
               {
                 vx = Interval.make 0. sw;
                 vy = Interval.make 0. sh;
@@ -2094,7 +2109,7 @@ module Nottui = struct
 
     let image vg { size; view; _ } =
       let w, h = V2.to_tuple size in
-      (*Log.debug (fun m -> m "Renderer.image view=%a" Ui.pp view);*)
+      Log.debug (fun m -> m "Renderer.image view=%a " Ui.pp view);
       (render_node vg 0. 0. w h w h view).image
 
     let dispatch_raw_key st key =
@@ -2143,10 +2158,13 @@ module Nottui = struct
             raise Acquired_focus
         | Focus.Conflict _ -> iter aux ui
       in
+      Log.debug (fun m -> m "grab_focus");
       try
         aux ui;
         false
-      with Acquired_focus -> true
+      with Acquired_focus ->
+        Log.warn (fun m -> m "grab_focus Acquired_focus -> true");
+        true
 
     let rec dispatch_focus t dir =
       match t.desc with
@@ -2160,8 +2178,13 @@ module Nottui = struct
       | Event_filter (t, _) ->
           dispatch_focus t dir
       | Focus_area (t', _) ->
-          if Focus.has_focus t'.focus then
+          if Focus.has_focus t'.focus then (
-            dispatch_focus t' dir || grab_focus t
+            Log.debug (fun m ->
+                m
+                  "dispatch_focus Focus_area has_focus t'.focus = \
+                   true");
+
+            dispatch_focus t' dir || grab_focus t)
           else if Focus.has_focus t.focus then false
           else grab_focus t
       | X (a, b) -> (
@@ -2219,7 +2242,10 @@ module Nottui = struct
           let dir = if List.mem `Shift mods then `Prev else `Next in
           dispatch_key st (`Focus dir, mods)
       | `Unhandled, (`Focus dir, _) ->
-          if dispatch_focus st.view dir then `Handled else `Unhandled
+          let r = dispatch_focus st.view dir in
+          (if r then Log.debug else Log.warn) (fun m ->
+              m "Renderer.dispatch_focus key:%a -> %b" pp_key key r);
+          if r then `Handled else `Unhandled
       | `Unhandled, _ -> `Unhandled
 
     let dispatch_event t = function
@@ -2337,14 +2363,6 @@ module Nottui_widgets = struct
   let kfmt k ?attr fmt =
     Format.kasprintf (fun str -> k (string ?attr str)) fmt
 
-  let attr_menu_main = A.(bg Color.green ++ fg Color.black)
-  let attr_menu_sub = A.(bg Color.lightgreen ++ fg Color.black)
-
-  let attr_clickable =
-    A.((bg @@ Color.rgbf ~r:0.2 ~g:0.2 ~b:0.5) ++ (fg @@ Color.light))
-
-  let attr_cursor = A.((fg @@ Color.dark) ++ (bg @@ Color.yellow))
-
   type window_manager = {
     overlays : ui Lwd.t Lwd_table.t;
     view : ui Lwd.t;
@@ -2484,7 +2502,7 @@ module Nottui_widgets = struct
         |> Ui.keyboard_area focus_handler)
 
   let main_menu_item wm text f =
-    let text = string ~attr:attr_menu_main (" " ^ text ^ " ") in
+    let text = string ~attr:A.menu_main (" " ^ text ^ " ") in
     let refresh = Lwd.var () in
     let overlay = ref false in
     let on_click ~x:_ ~y:_ = function
@@ -2504,7 +2522,7 @@ module Nottui_widgets = struct
         else ui)
 
   let sub_menu_item wm text f =
-    let text = string ~attr:attr_menu_sub text in
+    let text = string ~attr:A.menu_sub text in
     let refresh = Lwd.var () in
     let overlay = ref false in
     let on_click ~x:_ ~y:_ = function
@@ -2524,7 +2542,7 @@ module Nottui_widgets = struct
         else ui)
 
   let sub_entry text f =
-    let text = string ~attr:attr_menu_sub text in
+    let text = string ~attr:A.menu_sub text in
     let on_click ~x:_ ~y:_ = function
       | `Left ->
           f ();
@@ -2625,51 +2643,44 @@ module Nottui_widgets = struct
     in
     Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot)
 
-  let sub' str p l =
+  let eq_uc_c uc c = Uchar.(equal uc (of_char c))
-    if p = 0 && l = String.length str then str else String.sub str p l
 
   let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id) state
       =
-    let on_change a = Lwd.set state (on_change a) in
     let update focus_h focus (text, pos) =
       let pos = min (max 0 pos) (String.length text) in
       let content =
         Ui.atom @@ I.hcat
         @@
         if Focus.has_focus focus then
-          let attr = attr_clickable in
+          let attr = A.clickable in
           let len = String.length text in
           if pos >= len then
-            [ I.string ~attr text; I.string ~attr:attr_cursor " " ]
+            [ I.string ~attr text; I.string ~attr:A.cursor " " ]
           else
             [
               I.string ~attr (String.sub text 0 pos);
-              I.string ~attr:attr_cursor (String.sub text pos 1);
+              I.string ~attr:A.cursor (String.sub text pos 1);
               I.string ~attr
                 (String.sub text (pos + 1) (len - pos - 1));
             ]
         else [ I.string (if text = "" then " " else text) ]
       in
       let handler k =
+        let on_change a =
+          Lwd.set state (on_change a);
+          `Handled
+        in
         (match k with
         | `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) ->
-            on_change ("", 0);
+            on_change ("", 0) (* clear *)
-            `Handled (* clear *)
+        | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' ->
-        | `Escape, [] ->
+            (* TODO put killed text into kill-ring *)
-            Focus.release focus_h;
+            if pos < String.length text then
-            `Handled
+              on_change (String.sub text 0 pos, pos)
-        | `Uchar k, _ ->
+            else `Unhandled (* kill *)
-            let k = Uchar.unsafe_to_char k in
-            let text =
-              if pos < String.length text then
-                String.sub text 0 pos ^ String.make 1 k
-                ^ String.sub text pos (String.length text - pos)
-              else text ^ String.make 1 k
-            in
-            on_change (text, pos + 1);
-            `Handled
         | `Backspace, [] ->
-            if pos > 0 then (
+            if pos > 0 then
               let text =
                 if pos < String.length text then
                   String.sub text 0 (pos - 1)
@@ -2679,23 +2690,28 @@ module Nottui_widgets = struct
                 else text
               in
               let pos = max 0 (pos - 1) in
-              on_change (text, pos);
+              on_change (text, pos)
-              `Handled)
             else `Unhandled
+        | `Uchar k, [] ->
+            let k = Uchar.unsafe_to_char k in
+            let text =
+              if pos < String.length text then
+                String.sub text 0 pos ^ String.make 1 k
+                ^ String.sub text pos (String.length text - pos)
+              else text ^ String.make 1 k
+            in
+            on_change (text, pos + 1)
+        | `Escape, [] ->
+            Focus.release focus_h;
+            `Handled
         (* | `Enter, _ ->
             on_submit (text, pos);
             `Handled *)
         | `Arrow `Left, [] ->
-            let pos = min (String.length text) pos in
+            if pos > 0 then on_change (text, pos - 1) else `Unhandled
-            if pos > 0 then (
-              on_change (text, pos - 1);
-              `Handled)
-            else `Unhandled
         | `Arrow `Right, [] ->
             let pos = pos + 1 in
-            if pos <= String.length text then (
+            if pos <= String.length text then on_change (text, pos)
-              on_change (text, pos);
-              `Handled)
             else `Unhandled
         | _ -> `Unhandled)
         |> fun r ->
@@ -2728,7 +2744,20 @@ module Nottui_widgets = struct
     ui : Ui.t Lwd.t;
   }
 
-  let eq_uc_c uc c = Uchar.(equal uc (of_char c))
+  type lines = line Lwd_table.t
+
+  let line_empty () =
+    let focus = Focus.make () in
+    let state = Lwd.var ("", 0) in
+    { focus; state; ui = edit_field ~focus state }
+
+  let line_make ?(focus = Focus.make ()) str =
+    let state = Lwd.var (str, 0) in
+    { focus; state; ui = edit_field ~focus state }
+
+  let line_append ?(table = Lwd_table.make ()) ?focus str =
+    let row = Lwd_table.append table in
+    Lwd_table.set row (line_make ?focus str)
 
   let copy_line_cursor (x : line) (y : line) =
     let _, xi = Lwd.peek x.state in
@@ -2736,48 +2765,80 @@ module Nottui_widgets = struct
     let yi = Int.max 0 (Int.min xi (String.length ys)) in
     Lwd.set y.state (ys, yi)
 
+  let row_of_cursor cursor f =
+    Ui.may_handle (Lwd.peek cursor) (fun row -> f row)
+
   let line_of_cursor cursor
       (f : line Lwd_table.row -> line -> Ui.may_handle) :
       Ui.may_handle =
-    match Lwd.peek cursor with
+    Ui.may_handle (Lwd.peek cursor) (fun row ->
-    | Some row -> (
+        Ui.may_handle (Lwd_table.get row) (fun line -> f row line))
-        match Lwd_table.get row with
-        | Some line -> f row line
-        | None -> `Unhandled)
-    | None -> `Unhandled
 
   let cursor_move cursor
       (f : line Lwd_table.row -> line Lwd_table.row option) =
     match Lwd.peek cursor with
-    | Some cursor_line -> (
+    | Some cursor_row -> (
-        match f cursor_line with
+        match f cursor_row with
-        | Some new_line ->
+        | Some new_row ->
-            (match Lwd_table.get new_line with
+            (match Lwd_table.get new_row with
-            | Some line' ->
+            | Some new_line ->
-                cursor_line |> Lwd_table.get
+                cursor_row |> Lwd_table.get
-                |> Option.iter (fun line ->
+                |> Option.iter (fun cursor_line ->
-                       copy_line_cursor line line');
+                       copy_line_cursor cursor_line new_line;
-                Focus.request line'.focus
+                       Focus.release cursor_line.focus);
+                Focus.request new_line.focus
             | None -> ());
-            Lwd.set cursor (Some new_line);
+            Lwd.set cursor (Some new_row);
             `Handled
         | None -> `Unhandled)
     | None -> `Unhandled
 
-  let line_make ?(focus = Focus.make ()) str =
+  let multifield_of_string ?(table = Lwd_table.make ()) (s : string) :
-    let state = Lwd.var (str, 0) in
+      line Lwd_table.t =
-    { focus; state; ui = edit_field ~focus state }
-
-  let line_append ?(table = Lwd_table.make ())
-      ?(focus = Focus.make ()) str =
-    let row = Lwd_table.append table in
-    Lwd_table.set row (line_make ~focus str)
-
-  let line_table_of_string ?(table = Lwd_table.make ())
-      ?(focus = Focus.make ()) (s : string) : Ui.t Lwd.t =
     (* Append lines from s to table *)
     List.iter (line_append ~table) (String.split_on_char '\n' s);
-    (* create the cursor var *)
+    table
+
+  let rec focus_compare focus : int =
+    Focus.(
+      match focus with
+      | Empty -> 0
+      | Handle (i, _) -> i
+      | Conflict i -> i)
+
+  let rec find_focus (ui : ui) : ui =
+    Focus.(
+      match (ui.focus, ui.desc) with
+      | 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
+          else find_focus a
+      | Conflict _, Atom _ -> Ui.empty
+      | ( Conflict _,
+          ( Size_sensor (t, _)
+          | Mouse_handler (t, _)
+          | Focus_area (t, _)
+          | Event_filter (t, _)
+          | Transient_sensor (t, _)
+          | Permanent_sensor (t, _)
+          | Resize (t, _, _, _)
+          | Shift_area (t, _, _) ) ) ->
+          find_focus t)
+
+  (* 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
+
+  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 ->
@@ -2818,6 +2879,7 @@ module Nottui_widgets = struct
                        in
                        Lwd.set old_line.state (o_str, 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));
@@ -2825,22 +2887,24 @@ module Nottui_widgets = struct
                | `Backspace, [] ->
                    line_of_cursor cursor (fun row line ->
                        let str, pos = Lwd.peek line.state in
-                       match Lwd_table.prev row with
+                       Ui.may_handle (Lwd_table.prev row)
-                       | Some row_prev when pos = 0 -> (
+                         (fun row_prev ->
-                           match Lwd_table.get row_prev with
+                           if pos = 0 then
-                           | Some line_prev ->
+                             Ui.may_handle (Lwd_table.get row_prev)
-                               let str_prev, _ =
+                               (fun line_prev ->
-                                 Lwd.peek line_prev.state
+                                 let str_prev, _ =
-                               in
+                                   Lwd.peek line_prev.state
-                               Lwd.set line_prev.state
+                                 in
-                                 ( str_prev ^ str,
+                                 Focus.release line.focus;
-                                   String.length str_prev );
+                                 Focus.request line_prev.focus;
-                               Focus.request line_prev.focus;
+                                 Lwd.set line_prev.state
-                               Lwd_table.remove row;
+                                   ( str_prev ^ str,
-                               Lwd.set cursor (Some row_prev);
+                                     String.length str_prev );
-                               `Handled
+                                 Lwd.set cursor (Some row_prev);
-                           | None -> `Unhandled)
+                                 Lwd_table.remove row;
-                       | _ -> `Unhandled)
+                                 `Handled)
+                           else `Unhandled))
+               | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled
                | _ -> `Unhandled))
          (Focus.status focus)
 
@@ -2894,58 +2958,59 @@ module Nottui_widgets = struct
                  box_render (Ui.join_x acc ui0) (i + w0) tl
          in
          box_render Ui.empty 0 l
-
-       (** Prints the summary, but calls [f()] to compute a sub-widget
-         when clicked on. Useful for displaying deep trees. *)
-       let unfoldable ?(folded_by_default = true) summary
-           (f : unit -> Ui.t Lwd.t) : Ui.t Lwd.t =
-         let open Lwd.Infix in
-         let opened = Lwd.var (not folded_by_default) in
-         let fold_content =
-           Lwd.get opened >>= function
-           | true ->
-               (* call [f] and pad a bit *)
-               f () |> Lwd.map ~f:(Ui.join_x (string " "))
-           | false -> empty_lwd
-         in
-         (* pad summary with a "> " when it's opened *)
-         let summary =
-           Lwd.get opened >>= fun op ->
-           summary >|= fun s ->
-           Ui.hcat
-             [
-               string ~attr:attr_clickable (if op then "v" else ">");
-               string " ";
-               s;
-             ]
-         in
-         let cursor ~x:_ ~y:_ = function
-           | `Left when Lwd.peek opened ->
-               Lwd.set opened false;
-               `Handled
-           | `Left ->
-               Lwd.set opened true;
-               `Handled
-           | _ -> `Unhandled
-         in
-         let mouse =
-           Lwd.map ~f:(fun m -> Ui.mouse_area cursor m) summary
-         in
-         Lwd.map2 mouse fold_content ~f:(fun summary fold ->
-             (* TODO: make this configurable/optional *)
-             (* newline if it's too big to fit on one line nicely *)
-             let spec_sum = Ui.layout_spec summary in
-             let spec_fold = Ui.layout_spec fold in
-             (* TODO: somehow, probe for available width here? *)
-             let too_big =
-               spec_fold.Ui.h > 1
-               || spec_fold.Ui.h > 0
-                  && spec_sum.Ui.w + spec_fold.Ui.w > 60
-             in
-             if too_big then
-               Ui.join_y summary (Ui.join_x (string " ") fold)
-             else Ui.join_x summary fold)
 *)
+
+  (** Prints the summary, but calls [f()] to compute a sub-widget
+         when clicked on. Useful for displaying deep trees. *)
+  let unfoldable ?(folded_by_default = true) summary
+      (f : unit -> Ui.t Lwd.t) : Ui.t Lwd.t =
+    let open Lwd.Infix in
+    let opened = Lwd.var (not folded_by_default) in
+    let fold_content =
+      Lwd.get opened >>= function
+      | true ->
+          (* call [f] and pad a bit *)
+          f () |> Lwd.map ~f:(Ui.join_x (string " "))
+      | false -> Lwd.return Ui.empty
+    in
+    (* pad summary with a "> " when it's opened *)
+    let summary =
+      Lwd.get opened >>= fun op ->
+      summary >|= fun s ->
+      Ui.hcat
+        [
+          string ~attr:A.clickable (if op then "v" else ">");
+          string " ";
+          s;
+        ]
+    in
+    let cursor ~x:_ ~y:_ = function
+      | `Left when Lwd.peek opened ->
+          Lwd.set opened false;
+          `Handled
+      | `Left ->
+          Lwd.set opened true;
+          `Handled
+      | _ -> `Unhandled
+    in
+    let mouse =
+      Lwd.map ~f:(fun m -> Ui.mouse_area cursor m) summary
+    in
+    Lwd.map2 mouse fold_content ~f:(fun summary fold ->
+        (* TODO: make this configurable/optional *)
+        (* newline if it's too big to fit on one line nicely *)
+        let spec_sum = Ui.layout_spec summary in
+        let spec_fold = Ui.layout_spec fold in
+        (* TODO: somehow, probe for available width here? *)
+        let too_big =
+          spec_fold.Ui.h > 20.
+          || spec_fold.Ui.h > 20.
+             && spec_sum.Ui.w +. spec_fold.Ui.w > 240.
+        in
+        if too_big then
+          Ui.join_y summary (Ui.join_x (string " ") fold)
+        else Ui.join_x summary fold)
+
   let hbox l = Lwd_utils.pack Ui.pack_x l
   let vbox l = Lwd_utils.pack Ui.pack_y l
   let zbox l = Lwd_utils.pack Ui.pack_z l
@@ -2953,7 +3018,7 @@ module Nottui_widgets = struct
   let vlist ?(bullet = "- ") (l : Ui.t Lwd.t list) : Ui.t Lwd.t =
     l
     |> List.map (fun ui -> Lwd.map ~f:(Ui.join_x (string bullet)) ui)
-    |> Lwd_utils.pack Ui.pack_y
+    |> vbox
 
   (** A list of items with a dynamic filter on the items *)
   let vlist_with ?(bullet = "- ")
@@ -2982,6 +3047,12 @@ module Nottui_widgets = struct
     in
     l_filter >>= Lwd_utils.pack Ui.pack_y
 
+  let vlist_of_text ?(focus = Focus.make ())
+      ?(key_handler = fun _ -> `Unhandled) =
+    Lwd.map2 (Focus.status focus) ~f:(fun focus s ->
+        Ui.vcat @@ List.map string @@ String.split_on_char '\n' s
+        |> Ui.keyboard_area ~focus key_handler)
+
   (* let rec iterate n f x = if n = 0 then x else iterate (n - 1) f (f x)
 
      (** A grid layout, with alignment in all rows/columns.
@@ -3058,92 +3129,100 @@ module Nottui_widgets = struct
        (* TODO: mouse and keyboard handling *)
        let ui = Lwd_utils.reduce pack_pad_y rows in
        Lwd.return ui
+  *)
 
-     (** Turn the given [ui] into a clickable button, calls [f] when clicked. *)
+  (** Turn the given [ui] into a clickable button, calls [f] when clicked. *)
-     let button_of ui f =
+  let button_of ui f =
-       Ui.mouse_area
+    Ui.keyboard_area
+      (function
+        | `Enter, _ ->
+            f ();
+            `Handled
+        | _ -> `Unhandled)
+      (* @@ Ui.mouse_area
          (fun ~x:_ ~y:_ _ ->
            f ();
-           `Handled)
+           `Handled) *)
-         ui
+      ui
 
-     (** A clickable button that calls [f] when clicked, labelled with a string. *)
+  (** A clickable button that calls [f] when clicked, labelled with a string. *)
-     let button ?(attr = attr_clickable) s f =
+  let button ?(attr = A.clickable) s f = button_of (string ~attr s) f
-       button_of (string ~attr s) f
 
-     (* file explorer for selecting a file *)
+  (* file explorer for selecting a file *)
-     let file_select ?(abs = false) ?filter ~(on_select : string -> unit)
+  let file_select ?(abs = false) ?filter ~(on_select : string -> unit)
-         () : Ui.t Lwd.t =
+      () : Ui.t Lwd.t =
-       let rec aux ~fold path =
+    let rec aux ~fold path =
-         try
+      try
-           let p_rel = if path = "" then "." else path in
+        let p_rel = if path = "" then "." else path in
-           if Sys.is_directory p_rel then
+        if Sys.is_directory p_rel then
-             let ui () =
+          let ui () =
-               let arr = Sys.readdir p_rel in
+            let arr = Sys.readdir p_rel in
-               let l =
+            let l =
-                 Array.to_list arr |> List.map (Filename.concat path)
+              Array.to_list arr |> List.map (Filename.concat path)
-               in
+            in
-               (* apply potential filter *)
+            (* apply potential filter *)
-               let l =
+            let l =
-                 match filter with
+              match filter with
-                 | None -> l
+              | None -> l
-                 | Some f -> List.filter f l
+              | Some f -> List.filter f l
-               in
+            in
-               let l = Lwd.return @@ List.sort String.compare l in
+            let l = Lwd.return @@ List.sort String.compare l in
-               vlist_with ~bullet:"" (aux ~fold:true) l
+            vlist_with ~bullet:"" (aux ~fold:true) l
-             in
+          in
-             if fold then
+          if fold then
-               unfoldable ~folded_by_default:true
+            unfoldable ~folded_by_default:true
-                 (Lwd.return @@ string @@ path ^ "/")
+              (Lwd.return @@ string @@ path ^ "/")
-                 ui
+              ui
-             else ui ()
+          else ui ()
-           else
+        else
-             Lwd.return
+          Lwd.return
-             @@ button
+          @@ button
-                  ~attr:A.(st underline)
+               ~attr:A.(font Font.underline)
-                  path
+               path
-                  (fun () -> on_select path)
+               (fun () -> on_select path)
-         with e ->
+      with e ->
-           Lwd.return
+        Lwd.return
-           @@ Ui.vcat
+        @@ Ui.vcat
-                [
+             [
-                  printf ~attr:A.(bg red) "cannot list directory %s" path;
+               printf
-                  string @@ Printexc.to_string e;
+                 ~attr:A.(bg Color.red)
-                ]
+                 "cannot list directory %s" path;
-       in
+               string @@ Printexc.to_string e;
-       let start = if abs then Sys.getcwd () else "" in
+             ]
-       aux ~fold:false start
+    in
+    let start = if abs then Sys.getcwd () else "" in
+    aux ~fold:false start
+
+  let toggle, toggle' =
+    let toggle_ st (lbl : string Lwd.t) (f : bool -> unit) :
+        Ui.t Lwd.t =
+      let mk_but st_v lbl_v =
+        let lbl =
+          Ui.hcat
+            [
+              printf "[%s|" lbl_v;
+              string ~attr:A.clickable (if st_v then "✔" else "×");
+              string "]";
+            ]
+        in
+        button_of lbl (fun () ->
+            let new_st = not st_v in
+            Lwd.set st new_st;
+            f new_st)
+      in
+      Lwd.map2 ~f:mk_but (Lwd.get st) lbl
+    in
+    (* Similar to {!toggle}, except it directly reflects the state of a variable. *)
+    let toggle' (lbl : string Lwd.t) (v : bool Lwd.var) : Ui.t Lwd.t =
+      toggle_ v lbl (Lwd.set v)
+    (* a toggle, with a true/false state *)
+    and toggle ?(init = false) (lbl : string Lwd.t) (f : bool -> unit)
+        : Ui.t Lwd.t =
+      let st = Lwd.var init in
+      toggle_ st lbl f
+    in
+    (toggle, toggle')
 
-     let toggle, toggle' =
-       let toggle_ st (lbl : string Lwd.t) (f : bool -> unit) :
-           Ui.t Lwd.t =
-         let mk_but st_v lbl_v =
-           let lbl =
-             Ui.hcat
-               [
-                 printf "[%s|" lbl_v;
-                 string ~attr:attr_clickable (if st_v then "✔" else "×");
-                 string "]";
-               ]
-           in
-           button_of lbl (fun () ->
-               let new_st = not st_v in
-               Lwd.set st new_st;
-               f new_st)
-         in
-         Lwd.map2 ~f:mk_but (Lwd.get st) lbl
-       in
-       (* Similar to {!toggle}, except it directly reflects the state of a variable. *)
-       let toggle' (lbl : string Lwd.t) (v : bool Lwd.var) : Ui.t Lwd.t =
-         toggle_ v lbl (Lwd.set v)
-       (* a toggle, with a true/false state *)
-       and toggle ?(init = false) (lbl : string Lwd.t) (f : bool -> unit)
-           : Ui.t Lwd.t =
-         let st = Lwd.var init in
-         toggle_ st lbl f
-       in
-       (toggle, toggle')
-  *)
   type scrollbox_state = {
     w : float;
     h : float;