From 2e05bdd45e9d2d4ffcabaed1d0551c6a1b41788a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 11:18:57 -0500 Subject: [PATCH 01/17] add infix module in Lwd --- lib/lwd/lwd.ml | 6 ++++++ lib/lwd/lwd.mli | 6 ++++++ 2 files changed, 12 insertions(+) diff --git a/lib/lwd/lwd.ml b/lib/lwd/lwd.ml index bb24c7e..de57e2f 100644 --- a/lib/lwd/lwd.ml +++ b/lib/lwd/lwd.ml @@ -458,3 +458,9 @@ let set_on_invalidate x f = match x with | Pure _ | Impure _ | Operator _ -> assert false | Root t -> t.on_invalidate <- f + +module Infix = struct + let (>>=) = bind + let (>|=) = map' + let (<*>) = app +end diff --git a/lib/lwd/lwd.mli b/lib/lwd/lwd.mli index 1f91ebd..808a2ea 100644 --- a/lib/lwd/lwd.mli +++ b/lib/lwd/lwd.mli @@ -33,3 +33,9 @@ val set_on_invalidate : 'a root -> ('a -> unit) -> unit val sample : 'a root -> 'a val is_damaged : 'a root -> bool val release : 'a root -> unit + +module Infix : sig + val (>|=) : 'a t -> ('a -> 'b) -> 'b t + val (>>=) : 'a t -> ('a -> 'b t) -> 'b t + val (<*>) : ('a -> 'b) t -> 'a t -> 'b t +end From 9954d80c80dff77c385f5a14cd53f6d936151497 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 11:24:40 -0500 Subject: [PATCH 02/17] add a few widgets --- lib/nottui-widgets/nottui_widgets.ml | 36 ++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 6bb1058..d60e8f4 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -349,3 +349,39 @@ let edit_field state ~on_change ~on_submit = in Lwd.map2' state node @@ fun state content -> Ui.mouse_area (mouse_grab state) content + +(** Prints the summary, but calls [f()] to compute a sub-widget + when clicked on. Useful for displaying deep trees. *) +let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = + let opened = ref false in + let v = Lwd.var empty_lwd in + let cursor ~x:_ ~y:_ = function + | `Left when !opened -> + opened := false; + Lwd.set v empty_lwd; + `Handled + | `Left -> + opened := true; + (* call [f] and pad a bit *) + (* TODO: optionally, newline+indent of 2? or maybe only if the size + of [inner] is big, or if it's multiline *) + let inner = + f() |> Lwd.map (fun x -> Ui.join_x (string ~attr:A.(bg blue) "> ") x) + in + Lwd.set v @@ inner; + `Handled + | _ -> `Unhandled + in + let mouse = + Lwd.map (fun m -> Ui.mouse_area cursor m) summary + in + Lwd_utils.pack Ui.pack_x [mouse; Lwd.join @@ Lwd.get v] + +let vlist (l: Ui.t Lwd.t list) : Ui.t Lwd.t = + l + |> List.map (fun ui -> Lwd.map (Ui.join_x (string "- ")) ui) + |> Lwd_utils.pack Ui.pack_y + +let button ?attr s f = + Ui.mouse_area (fun ~x:_ ~y:_ _ -> f(); `Handled) (string ?attr s) + From c72df191b8bbae0c187ca64fa6808eea3b243540 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 11:32:01 -0500 Subject: [PATCH 03/17] feat(widget): make unfoldable optionnally multiline --- lib/nottui-widgets/nottui_widgets.ml | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index d60e8f4..08f1a5a 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -363,10 +363,12 @@ let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = | `Left -> opened := true; (* call [f] and pad a bit *) - (* TODO: optionally, newline+indent of 2? or maybe only if the size - of [inner] is big, or if it's multiline *) let inner = - f() |> Lwd.map (fun x -> Ui.join_x (string ~attr:A.(bg blue) "> ") x) + f() + |> Lwd.map + (fun x -> + let arrow = string ~attr:A.(bg blue) "> " in + Ui.join_x arrow x) in Lwd.set v @@ inner; `Handled @@ -375,7 +377,15 @@ let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = let mouse = Lwd.map (fun m -> Ui.mouse_area cursor m) summary in - Lwd_utils.pack Ui.pack_x [mouse; Lwd.join @@ Lwd.get v] + Lwd.map2 + (fun summary fold -> + (* optionally, newline+indent of 2? or maybe only if the size + of [inner] is big, or if it's multiline *) + let spec = Ui.layout_spec fold in + if spec.Ui.h > 1 || spec.Ui.w > 30 + then Ui.join_y summary (Ui.join_x (string " ") fold) + else Ui.join_x summary fold) + mouse (Lwd.join @@ Lwd.get v) let vlist (l: Ui.t Lwd.t list) : Ui.t Lwd.t = l From 3a207e12a72481a1d8c998809e4941e5fa3f2778 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 11:48:26 -0500 Subject: [PATCH 04/17] feat(widgets): better behavior for `unfoldable` --- lib/nottui-widgets/nottui_widgets.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 08f1a5a..0c1911c 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -379,10 +379,12 @@ let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = in Lwd.map2 (fun summary fold -> - (* optionally, newline+indent of 2? or maybe only if the size - of [inner] is big, or if it's multiline *) - let spec = Ui.layout_spec fold in - if spec.Ui.h > 1 || spec.Ui.w > 30 + (* 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? *) + if spec_fold.Ui.h > 1 || (spec_sum.Ui.w + spec_fold.Ui.w) > 60 then Ui.join_y summary (Ui.join_x (string " ") fold) else Ui.join_x summary fold) mouse (Lwd.join @@ Lwd.get v) From 8dfa43b8fd2ec504a346c46697b897fda8ac895d Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 11:50:43 -0500 Subject: [PATCH 05/17] in `Nottui.Ui_loop`, make sharing easier by making `quit` a variable --- lib/nottui/nottui.ml | 17 ++++++++--------- lib/nottui/nottui.mli | 2 +- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/lib/nottui/nottui.ml b/lib/nottui/nottui.ml index 427b25a..3c13ddd 100644 --- a/lib/nottui/nottui.ml +++ b/lib/nottui/nottui.ml @@ -759,7 +759,7 @@ struct ignore (Renderer.dispatch_event renderer event : [`Handled | `Unhandled]) let run_with_term term ?tick_period ?(tick=ignore) ~renderer quit t = - let quit = Lwd.observe quit in + let quit = Lwd.observe (Lwd.get quit) in let root = Lwd.observe t in let rec loop () = let quit = Lwd.sample quit in @@ -775,16 +775,15 @@ struct let run ?tick_period ?tick ?term ?(renderer=Renderer.make ()) ?quit t = - let quit, t = match quit with - | Some quit -> quit, t - | None -> - let quit = Lwd.var false in - let t = t |> Lwd.map (Ui.event_filter (function + let quit = match quit with + | Some quit -> quit + | None -> Lwd.var false + in + let t = + t |> Lwd.map (Ui.event_filter (function | `Key (`Escape, _) -> Lwd.set quit true; `Handled | _ -> `Unhandled - )) - in - Lwd.get quit, t + )) in match term with | Some term -> run_with_term term ?tick_period ?tick ~renderer quit t diff --git a/lib/nottui/nottui.mli b/lib/nottui/nottui.mli index 729798c..e93bf0c 100644 --- a/lib/nottui/nottui.mli +++ b/lib/nottui/nottui.mli @@ -115,5 +115,5 @@ sig val run : ?tick_period:float -> ?tick:(unit -> unit) -> ?term:Term.t -> ?renderer:Renderer.t -> - ?quit:bool Lwd.t -> ui Lwd.t -> unit + ?quit:bool Lwd.var -> ui Lwd.t -> unit end From ad11d37230c472b64be61c4ceb21a12495c550d5 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 11:57:03 -0500 Subject: [PATCH 06/17] wip --- lib/nottui-widgets/nottui_widgets.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 0c1911c..7b4e195 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -384,7 +384,11 @@ let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = let spec_sum = Ui.layout_spec summary in let spec_fold = Ui.layout_spec fold in (* TODO: somehow, probe for available width here? *) - if spec_fold.Ui.h > 1 || (spec_sum.Ui.w + spec_fold.Ui.w) > 60 + 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) mouse (Lwd.join @@ Lwd.get v) From 0b2ee5f53a41730e5933535760a3547955b3cbfd Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 12:52:29 -0500 Subject: [PATCH 07/17] add lifted boxes in widgets --- lib/nottui-widgets/nottui_widgets.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 7b4e195..2ae29ec 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -393,6 +393,10 @@ let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = else Ui.join_x summary fold) mouse (Lwd.join @@ Lwd.get v) +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 + let vlist (l: Ui.t Lwd.t list) : Ui.t Lwd.t = l |> List.map (fun ui -> Lwd.map (Ui.join_x (string "- ")) ui) From 10b072f774f443b0e11ab27597cc2fc0c7e8154b Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 13:02:21 -0500 Subject: [PATCH 08/17] widgets: allow `unfoldable` to be open by default, if necessary --- lib/nottui-widgets/nottui_widgets.ml | 32 ++++++++++++++++------------ 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 2ae29ec..39821a5 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -352,25 +352,29 @@ let edit_field state ~on_change ~on_submit = (** Prints the summary, but calls [f()] to compute a sub-widget when clicked on. Useful for displaying deep trees. *) -let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = - let opened = ref false in - let v = Lwd.var empty_lwd in +let unfoldable ?(folded_by_default=true) summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = + let fold_content = Lwd.var empty_lwd in + let compute_inner () = + (* call [f] and pad a bit *) + let inner = + f() + |> Lwd.map + (fun x -> + let arrow = string ~attr:A.(bg blue) "> " in + Ui.join_x arrow x) + in + Lwd.set fold_content inner + in + let opened = ref (not folded_by_default) in + if !opened then compute_inner(); let cursor ~x:_ ~y:_ = function | `Left when !opened -> opened := false; - Lwd.set v empty_lwd; + Lwd.set fold_content empty_lwd; `Handled | `Left -> opened := true; - (* call [f] and pad a bit *) - let inner = - f() - |> Lwd.map - (fun x -> - let arrow = string ~attr:A.(bg blue) "> " in - Ui.join_x arrow x) - in - Lwd.set v @@ inner; + compute_inner (); `Handled | _ -> `Unhandled in @@ -391,7 +395,7 @@ let unfoldable summary (f: unit -> Ui.t Lwd.t) : Ui.t Lwd.t = if too_big then Ui.join_y summary (Ui.join_x (string " ") fold) else Ui.join_x summary fold) - mouse (Lwd.join @@ Lwd.get v) + mouse (Lwd.join @@ Lwd.get fold_content) let hbox l = Lwd_utils.pack Ui.pack_x l let vbox l = Lwd_utils.pack Ui.pack_y l From 87000237e23a155194b2d1bc87fb7f09815c76b3 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 13:13:36 -0500 Subject: [PATCH 09/17] refactor unfoldable to move the blue arrow on the summary's left --- lib/nottui-widgets/nottui_widgets.ml | 43 ++++++++++++---------------- 1 file changed, 18 insertions(+), 25 deletions(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 39821a5..c513ca3 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -353,34 +353,27 @@ let edit_field state ~on_change ~on_submit = (** 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 fold_content = Lwd.var empty_lwd in - let compute_inner () = - (* call [f] and pad a bit *) - let inner = - f() - |> Lwd.map - (fun x -> - let arrow = string ~attr:A.(bg blue) "> " in - Ui.join_x arrow x) - in - Lwd.set fold_content inner + 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 (Ui.join_x (string " ")) + | false -> empty_lwd + in + (* pad summary with a "> " when it's opened *) + let summary = + Lwd.get opened >>= function + | true -> Lwd.map (Ui.join_x (string ~attr:A.(bg blue) "> ")) summary + | false -> summary in - let opened = ref (not folded_by_default) in - if !opened then compute_inner(); let cursor ~x:_ ~y:_ = function - | `Left when !opened -> - opened := false; - Lwd.set fold_content empty_lwd; - `Handled - | `Left -> - opened := true; - compute_inner (); - `Handled + | `Left when Lwd.peek opened -> Lwd.set opened false; `Handled + | `Left -> Lwd.set opened true; `Handled | _ -> `Unhandled in - let mouse = - Lwd.map (fun m -> Ui.mouse_area cursor m) summary - in + let mouse = Lwd.map (fun m -> Ui.mouse_area cursor m) summary in Lwd.map2 (fun summary fold -> (* TODO: make this configurable/optional *) @@ -395,7 +388,7 @@ let unfoldable ?(folded_by_default=true) summary (f: unit -> Ui.t Lwd.t) : Ui.t if too_big then Ui.join_y summary (Ui.join_x (string " ") fold) else Ui.join_x summary fold) - mouse (Lwd.join @@ Lwd.get fold_content) + mouse fold_content let hbox l = Lwd_utils.pack Ui.pack_x l let vbox l = Lwd_utils.pack Ui.pack_y l From 06d1146abcf80d2ac36e38add95af4c5673eaf9e Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 14:17:00 -0500 Subject: [PATCH 10/17] add `vlist_with` for a more powerful vertical list --- lib/nottui-widgets/nottui_widgets.ml | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index c513ca3..7190c82 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -399,6 +399,28 @@ let vlist (l: Ui.t Lwd.t list) : Ui.t Lwd.t = |> List.map (fun ui -> Lwd.map (Ui.join_x (string "- ")) ui) |> Lwd_utils.pack Ui.pack_y +(** A list of items with a dynamic filter on the items *) +let vlist_with + ?(filter=Lwd.return (fun _ -> true)) + (f:'a -> Ui.t Lwd.t) + (l:'a list Lwd.t) : Ui.t Lwd.t = + let open Lwd.Infix in + let rec filter_map_ acc f l = + match l with + | [] -> List.rev acc + | x::l' -> + let acc' = match f x with | None -> acc | Some y -> y::acc in + filter_map_ acc' f l' + in + let l = l >|= List.map (fun x -> x, Lwd.map (Ui.join_x (string "- ")) @@ f x) in + let l_filter : _ list Lwd.t = + filter >>= fun filter -> + l >|= + filter_map_ [] + (fun (x,ui) -> if filter x then Some ui else None) + in + l_filter >>= Lwd_utils.pack Ui.pack_y + let button ?attr s f = Ui.mouse_area (fun ~x:_ ~y:_ _ -> f(); `Handled) (string ?attr s) From d028e0d6a8fd059981f5addb3f71c9d5529e18e2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 14:37:24 -0500 Subject: [PATCH 11/17] wip --- lib/nottui-widgets/nottui_widgets.ml | 2 ++ lib/nottui/nottui.ml | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 7190c82..9c237d7 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -294,6 +294,8 @@ let edit_field state ~on_change ~on_submit = [I.string A.empty (if text = "" then " " else text)] in let handler = function + | `ASCII 'U', [`Ctrl] -> on_change ("", 0); `Handled (* clear *) + | `Escape, [] -> Focus.release focus; `Handled | `ASCII k, _ -> let text = if pos < String.length text then ( diff --git a/lib/nottui/nottui.ml b/lib/nottui/nottui.ml index 3c13ddd..42463dc 100644 --- a/lib/nottui/nottui.ml +++ b/lib/nottui/nottui.ml @@ -613,10 +613,10 @@ struct match t.desc with | Atom _ | Overlay _ -> acc | X (a, b) | Y (a, b) | Z (a, b) -> - (* Default to left/top-most branch if there is no focus *) + (* Try left/top most branch first *) if Focus.has_focus b.focus then dispatch_key_branch acc b - else dispatch_key_branch acc a + else dispatch_key_branch (dispatch_key_branch acc b) a | Focus_area (t, f) -> dispatch_key_branch (f :: acc) t | Mouse_handler (t, _) | Size_sensor (t, _) | Scroll_area (t, _, _) | Resize (t, _, _) -> From ebe5508a85ef84bb940c1fa923120cca43f35f26 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 14:58:23 -0500 Subject: [PATCH 12/17] binding to exit is now ctrl-q --- lib/nottui/nottui.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/nottui/nottui.ml b/lib/nottui/nottui.ml index 42463dc..de093f2 100644 --- a/lib/nottui/nottui.ml +++ b/lib/nottui/nottui.ml @@ -781,7 +781,7 @@ struct in let t = t |> Lwd.map (Ui.event_filter (function - | `Key (`Escape, _) -> Lwd.set quit true; `Handled + | `Key (`ASCII 'Q', [`Ctrl]) -> Lwd.set quit true; `Handled | _ -> `Unhandled )) in From 1535b619707d8e6a76dcc40c8859362dbee56af2 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 14:58:36 -0500 Subject: [PATCH 13/17] feat: be able to lose focus --- lib/nottui-widgets/nottui_widgets.ml | 6 +++--- lib/nottui/nottui.ml | 2 ++ lib/nottui/nottui.mli | 1 + 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index 9c237d7..dbb98a8 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -275,7 +275,7 @@ let sub' str p l = else String.sub str p l let edit_field state ~on_change ~on_submit = - let update focus (text, pos) = + let update focus_h focus (text, pos) = let pos = min (max 0 pos) (String.length text) in let content = Ui.atom @@ I.hcat @@ @@ -295,7 +295,7 @@ let edit_field state ~on_change ~on_submit = in let handler = function | `ASCII 'U', [`Ctrl] -> on_change ("", 0); `Handled (* clear *) - | `Escape, [] -> Focus.release focus; `Handled + | `Escape, [] -> Focus.release focus_h; `Handled | `ASCII k, _ -> let text = if pos < String.length text then ( @@ -340,7 +340,7 @@ let edit_field state ~on_change ~on_submit = in let focus = Focus.make () in let node = - Lwd.map2 update (Nottui.Focus.status focus) state + Lwd.map2 (update focus) (Focus.status focus) state in let mouse_grab (text, pos) ~x ~y:_ = function | `Left -> diff --git a/lib/nottui/nottui.ml b/lib/nottui/nottui.ml index de093f2..1b6fcdf 100644 --- a/lib/nottui/nottui.ml +++ b/lib/nottui/nottui.ml @@ -10,6 +10,7 @@ sig val make : unit -> handle val request : handle -> unit val request_var : var -> unit + val release : handle -> unit type status = | Empty @@ -51,6 +52,7 @@ end = struct Lwd.set v !clock let request (v, _ : handle) = request_var v + let release (v, _ : handle) = incr clock; Lwd.set v 0 let merge s1 s2 : status = match s1, s2 with | Empty, x | x, Empty -> x diff --git a/lib/nottui/nottui.mli b/lib/nottui/nottui.mli index e93bf0c..ca4aeba 100644 --- a/lib/nottui/nottui.mli +++ b/lib/nottui/nottui.mli @@ -5,6 +5,7 @@ sig type handle val make : unit -> handle val request : handle -> unit + val release : handle -> unit type status val empty : status From 8a6a229f18948b9339917ddff643e52e20a1c9dc Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 15:05:21 -0500 Subject: [PATCH 14/17] scroll area support page{up,down} --- lib/nottui-widgets/nottui_widgets.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lib/nottui-widgets/nottui_widgets.ml b/lib/nottui-widgets/nottui_widgets.ml index dbb98a8..b5e159e 100644 --- a/lib/nottui-widgets/nottui_widgets.ml +++ b/lib/nottui-widgets/nottui_widgets.ml @@ -77,6 +77,8 @@ let vscroll_area ~state ~change t = (*| `Arrow `Right, _ -> scroll (+scroll_step) 0*) | `Arrow `Up , [] -> scroll state (-scroll_step) | `Arrow `Down , [] -> scroll state (+scroll_step) + | `Page `Up, [] -> scroll state ((-scroll_step) * 8) + | `Page `Down, [] -> scroll state ((+scroll_step) * 8) | _ -> `Unhandled in let scroll_handler state ~x:_ ~y:_ = function @@ -120,6 +122,8 @@ let scroll_area ?(offset=0,0) t = | `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 From 20949e7cf375aa143ed665dbb19e4538ad549a7a Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 15:30:24 -0500 Subject: [PATCH 15/17] refactor(nottui): more efficient dispatch of keys (more lazy) --- lib/nottui/nottui.ml | 51 ++++++++++++++++++++++++-------------------- 1 file changed, 28 insertions(+), 23 deletions(-) diff --git a/lib/nottui/nottui.ml b/lib/nottui/nottui.ml index 1b6fcdf..a889cb3 100644 --- a/lib/nottui/nottui.ml +++ b/lib/nottui/nottui.ml @@ -611,32 +611,37 @@ struct let cache = render_node 0 0 w h w h st.view in process (cache.image, cache.overlays) - let rec dispatch_key_branch acc t = - match t.desc with - | Atom _ | Overlay _ -> acc - | X (a, b) | Y (a, b) | Z (a, b) -> - (* Try left/top most branch first *) - if Focus.has_focus b.focus - then dispatch_key_branch acc b - else dispatch_key_branch (dispatch_key_branch acc b) a - | Focus_area (t, f) -> dispatch_key_branch (f :: acc) t - | Mouse_handler (t, _) | Size_sensor (t, _) - | Scroll_area (t, _, _) | Resize (t, _, _) -> - dispatch_key_branch acc t - | Event_filter (t, f) -> - (fun key -> f (`Key key)) :: dispatch_key_branch acc t - let dispatch_raw_key st key = - let branch = dispatch_key_branch [] st.view in - let rec iter = function - | f :: fs -> - begin match f key with - | `Unhandled -> iter fs - | `Handled -> `Handled - end + let rec iter (st: ui list) : [> `Unhandled] = + match st with | [] -> `Unhandled + | ui :: tl -> + begin match ui.desc with + | Atom _ | Overlay _ -> iter tl + | X (a, b) | Y (a, b) | Z (a, b) -> + (* Try left/top most branch first *) + let st' = + if Focus.has_focus b.focus + then b :: tl + else a :: b :: tl + in + iter st' + | Focus_area (t, f) -> + begin match f key with + | `Handled -> `Handled + | `Unhandled -> iter (t :: tl) + end + | Mouse_handler (t, _) | Size_sensor (t, _) + | Scroll_area (t, _, _) | Resize (t, _, _) -> + iter (t :: tl) + | Event_filter (t, f) -> + begin match f (`Key key) with + | `Unhandled -> iter (t :: tl) + | `Handled -> `Handled + end + end in - iter branch + iter [st.view] exception Acquired_focus From 75d01c0b8fc10349f74ef7fd865cc2fffd545a33 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Wed, 11 Mar 2020 17:57:38 -0500 Subject: [PATCH 16/17] update cbor_explorer example --- examples/cbor/cbor_explorer.ml | 34 +++++----------------------------- 1 file changed, 5 insertions(+), 29 deletions(-) diff --git a/examples/cbor/cbor_explorer.ml b/examples/cbor/cbor_explorer.ml index 9ed6c0b..937201d 100644 --- a/examples/cbor/cbor_explorer.ml +++ b/examples/cbor/cbor_explorer.ml @@ -3,30 +3,6 @@ module W = Nottui_widgets module C = CBOR.Simple module A = Notty.A -let unfoldable summary (f: unit -> Ui.Ui.t Lwd.t) : Ui.Ui.t Lwd.t = - let opened = ref false in - let v = Lwd.var W.empty_lwd in - let cursor ~x:_ ~y:_ = function - | `Left when !opened -> - opened := false; - Lwd.set v W.empty_lwd; - `Handled - | `Left -> - opened := true; - (* call [f] and pad a bit *) - let inner = - f() - |> Lwd.map (fun x -> Ui.Ui.join_x (W.string "> ") x) - in - Lwd.set v @@ inner; - `Handled - | _ -> `Unhandled - in - let mouse = - Lwd.map (fun m -> Ui.Ui.mouse_area cursor m) summary - in - Lwd_utils.pack Ui.Ui.pack_x [mouse; Lwd.join @@ Lwd.get v] - let ui_of_cbor (c:C.t) = let quit = Lwd.var false in let w_q = W.main_menu_item "[quit]" (fun () -> Lwd.set quit true; W.empty_lwd) in @@ -44,7 +20,7 @@ let ui_of_cbor (c:C.t) = | `Array l -> if fold then ( let summary = Lwd.return @@ W.printf ~attr:A.(fg yellow) "" (List.length l) in - unfoldable summary + W.unfoldable summary (fun () -> let l = List.map (traverse ~fold:true) l in Lwd_utils.pack Ui.Ui.pack_y l) @@ -54,15 +30,15 @@ let ui_of_cbor (c:C.t) = ) | `Map [] -> Lwd.return (W.string "{}") | `Map [x,y] -> - unfoldable (traverse x) (fun () -> traverse ~fold:false y) + W.unfoldable (traverse x) (fun () -> traverse ~fold:false y) | `Map l -> let summary = Lwd.return @@ W.printf ~attr:A.(fg yellow) "" (List.length l) in - unfoldable summary + W.unfoldable summary (fun () -> let tbl = Lwd_table.make () in List.iter (fun (x,y) -> let row = Lwd_table.append tbl in - let kv = unfoldable (traverse x) (fun () -> traverse ~fold:false y) in + let kv = W.unfoldable (traverse x) (fun () -> traverse ~fold:false y) in Lwd_table.set row kv) l; Lwd.join @@ Lwd_table.reduce (Lwd_utils.lift_monoid Ui.Ui.pack_y) tbl) @@ -71,7 +47,7 @@ let ui_of_cbor (c:C.t) = Lwd.map2 Ui.Ui.join_y w_q (Nottui_widgets.scroll_area @@ traverse ~fold:true c) in - Lwd.get quit, w + quit, w let show_file f = let cbor = CCIO.with_in f (fun ic -> CCIO.read_all ic |> C.decode) in From c29e14ad1fe122d3a67306baed39f140df195b15 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sun, 15 Mar 2020 19:10:25 -0500 Subject: [PATCH 17/17] example/cbor_explorer: better display of nested content --- examples/cbor/cbor_explorer.ml | 16 ++++++++++++---- examples/cbor/cbor_of_fs.ml | 5 +---- 2 files changed, 13 insertions(+), 8 deletions(-) diff --git a/examples/cbor/cbor_explorer.ml b/examples/cbor/cbor_explorer.ml index 937201d..96a8596 100644 --- a/examples/cbor/cbor_explorer.ml +++ b/examples/cbor/cbor_explorer.ml @@ -19,7 +19,8 @@ let ui_of_cbor (c:C.t) = | `Array [] -> Lwd.return (W.string "[]") | `Array l -> if fold then ( - let summary = Lwd.return @@ W.printf ~attr:A.(fg yellow) "" (List.length l) in + let summary = + Lwd.return @@ W.printf ~attr:A.(fg yellow) "" (List.length l) in W.unfoldable summary (fun () -> let l = List.map (traverse ~fold:true) l in @@ -29,8 +30,7 @@ let ui_of_cbor (c:C.t) = Lwd_utils.pack Ui.Ui.pack_y l ) | `Map [] -> Lwd.return (W.string "{}") - | `Map [x,y] -> - W.unfoldable (traverse x) (fun () -> traverse ~fold:false y) + | `Map [x,y] -> mk_k_v x y | `Map l -> let summary = Lwd.return @@ W.printf ~attr:A.(fg yellow) "" (List.length l) in W.unfoldable summary @@ -38,10 +38,18 @@ let ui_of_cbor (c:C.t) = let tbl = Lwd_table.make () in List.iter (fun (x,y) -> let row = Lwd_table.append tbl in - let kv = W.unfoldable (traverse x) (fun () -> traverse ~fold:false y) in + let kv = mk_k_v x y in Lwd_table.set row kv) l; Lwd.join @@ Lwd_table.reduce (Lwd_utils.lift_monoid Ui.Ui.pack_y) tbl) + and mk_k_v x y = + let tr_x = traverse x in + let summary = match y with + | `Array _ | `Map _ -> + W.hbox [tr_x; Lwd.return (W.string ~attr:A.(bg @@ gray 15) "/")] + | _ -> tr_x + in + W.unfoldable summary (fun () -> traverse ~fold:false y) in let w = Lwd.map2 Ui.Ui.join_y w_q diff --git a/examples/cbor/cbor_of_fs.ml b/examples/cbor/cbor_of_fs.ml index 781ea6c..1403afe 100644 --- a/examples/cbor/cbor_of_fs.ml +++ b/examples/cbor/cbor_of_fs.ml @@ -21,10 +21,7 @@ let rec fs_to_cbor ~path (f:string) : C.t = with _e -> `Text "" in - `Map [ - `Text f, - `Array [content] - ] + `Map [ `Text f, content ] ) let () =