From 0df5884a88be7a7fe8f2833876b2707fd6e13d51 Mon Sep 17 00:00:00 2001 From: cqc Date: Sun, 5 Feb 2023 15:47:00 -0600 Subject: [PATCH] list-based key press handlers --- human.ml | 161 +++++++++++++++++++++++++++++++------------------------ 1 file changed, 90 insertions(+), 71 deletions(-) diff --git a/human.ml b/human.ml index 7e1663d..bcc4aa6 100644 --- a/human.ml +++ b/human.ml @@ -1206,10 +1206,10 @@ module I = struct V2.(p1 - v 0. (top +. bottom)) in - ignore - (path_box vg - (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) - (Box2.v p b')); + (* ignore + (path_box vg + (NVG.Color.rgbaf ~r:1. ~g:0. ~b:0. ~a:0.2) + (Box2.v p b')); *) b' end end @@ -1391,6 +1391,8 @@ module Nottui = struct [ Input.special | `Uchar of Uchar.t | semantic_key ] * Input.mods + type keys = key list + let pp_key = F.( pair ~sep:F.sp @@ -1410,10 +1412,15 @@ module Nottui = struct | a -> pf ppf "%a" Input.pp_code a) Input.pp_mods) + let pp_keys = F.(list ~sep:F.comma pp_key) + type mouse = Input.mouse type event = - [ `Key of key | `Mouse of mouse | `Paste of Input.paste ] + [ `Key of key + | `Key_list of key list + | `Mouse of mouse + | `Paste of Input.paste ] type layout_spec = { w : float; @@ -1446,11 +1453,11 @@ module Nottui = struct | Permanent_sensor of 'a * frame_sensor | Resize of 'a * float option * float option * Gravity.t2 | Mouse_handler of 'a * mouse_handler - | Focus_area of 'a * (key -> may_handle) + | Focus_area of 'a * (keys -> may_handle) | Pad of 'a * (float * float * float * float) | Shift_area of 'a * float * float | Event_filter of - 'a * ([ `Key of key | `Mouse of mouse ] -> may_handle) + 'a * ([ `Key of keys | `Mouse of mouse ] -> may_handle) | X of 'a * 'a | Y of 'a * 'a | Z of 'a * 'a @@ -2157,7 +2164,7 @@ module Nottui = struct 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 = + let dispatch_raw_key st keys = let rec iter (st : ui list) : [> `Unhandled ] = match st with | [] -> `Unhandled @@ -2175,7 +2182,7 @@ module Nottui = struct match iter [ t ] with | `Handled -> `Handled | `Unhandled -> ( - match f key with + match f keys with | `Handled -> `Handled | `Unhandled -> iter tl)) | Attr (t, _) @@ -2188,7 +2195,7 @@ module Nottui = struct | Resize (t, _, _, _) -> iter (t :: tl) | Event_filter (t, f) -> ( - match f (`Key key) with + match f (`Key keys) with | `Unhandled -> iter (t :: tl) | `Handled -> `Handled)) in @@ -2278,27 +2285,32 @@ module Nottui = struct if Focus.has_focus a.focus then dispatch_focus a dir else dispatch_focus b dir || dispatch_focus a dir - let rec dispatch_key st key = - match (dispatch_raw_key st key, key) with + let rec dispatch_key st (keys : Ui.keys) = + match (dispatch_raw_key st keys, keys) with | `Handled, _ -> `Handled - | `Unhandled, (`Arrow dir, []) -> + | `Unhandled, [ (`Arrow dir, []) ] -> let dir : [ `Down | `Left | `Right | `Up ] :> [ `Down | `Left | `Right | `Up | `Next | `Prev ] = dir in - dispatch_key st (`Focus dir, [ `Meta ]) - | `Unhandled, (`Tab, mods) -> - let dir = if List.mem `Shift mods then `Prev else `Next in - dispatch_key st (`Focus dir, mods) - | `Unhandled, (`Focus dir, _) -> + dispatch_key st [ (`Focus dir, [ `Meta ]) ] + | `Unhandled, [ (`Tab, mods) ] + when mods == [] || mods = [ `Shift ] -> + dispatch_key st + [ + ( `Focus (if List.mem `Shift mods then `Prev else `Next), + mods ); + ] + | `Unhandled, [ (`Focus dir, _) ] -> 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); + m "Renderer.dispatch_focus key:%a -> %b" pp_keys keys r); if r then `Handled else `Unhandled | `Unhandled, _ -> `Unhandled let dispatch_event t = function - | `Key key -> dispatch_key t key + | `Key key -> dispatch_key t [ key ] + | `Key_list keys -> dispatch_key t keys | `Mouse mouse -> dispatch_mouse t mouse | `Paste _ -> `Unhandled end @@ -2545,12 +2557,13 @@ module Widgets = struct Log.debug (fun m -> m "keyboard_area: scroll_area focus_handler"); match e with - | `Arrow `Left, [] -> scroll (-.scroll_step) 0. - | `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.) + | [ (`Arrow `Left, []) ] -> scroll (-.scroll_step) 0. + | [ (`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)) let main_menu_item wm text f = @@ -2724,14 +2737,15 @@ module Widgets = struct `Handled in (match k with - | `Uchar c, [ `Ctrl ] when Uchar.(equal c (of_char 'U')) -> + | [ (`Uchar c, [ `Ctrl ]) ] when Uchar.(equal c (of_char 'U')) + -> on_change ("", 0) (* clear *) - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'k' -> (* TODO put killed text into kill-ring *) if pos < String.length text then on_change (String.sub text 0 pos, pos) else `Unhandled (* kill *) - | `Backspace, [] -> + | [ (`Backspace, []) ] -> if pos > 0 then let text = if pos < String.length text then @@ -2744,7 +2758,7 @@ module Widgets = struct let pos = max 0 (pos - 1) in on_change (text, pos) else `Unhandled - | `Uchar k, [] -> + | [ (`Uchar k, []) ] -> let k = Uchar.unsafe_to_char k in let text = if pos < String.length text then @@ -2753,19 +2767,19 @@ module Widgets = struct else text ^ String.make 1 k in on_change (text, pos + 1) - | `Escape, [] -> + | [ (`Escape, []) ] -> Focus.release focus_h; `Handled - | `Arrow `Left, [] -> + | [ (`Arrow `Left, []) ] -> if pos > 0 then on_change (text, pos - 1) else `Unhandled - | `Arrow `Right, [] -> + | [ (`Arrow `Right, []) ] -> let pos = pos + 1 in if pos <= String.length text then on_change (text, pos) else `Unhandled | _ -> `Unhandled) |> fun r -> Log.debug (fun m -> - m "edit_field keyboard_area handler %a -> %a" Ui.pp_key k + m "edit_field keyboard_area handler %a -> %a" Ui.pp_keys k Ui.pp_may_handle r); r in @@ -2913,22 +2927,23 @@ module Widgets = struct |> Lwd.map2 (Focus.status focus) ~f:(fun focus -> Ui.keyboard_area ~focus (fun k -> Log.debug (fun m -> - m "keyboard_area: edit_area handler %a" Ui.pp_key k); + m "keyboard_area: edit_area handler %a" Ui.pp_keys + k); let cursor_move = cursor_move ~update:copy_line_cursor cursor in match k with - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'n' -> cursor_move Lwd_table.next - | `Arrow `Down, _ -> cursor_move Lwd_table.next - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' -> + | [ (`Arrow `Down, _) ] -> cursor_move Lwd_table.next + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'p' -> cursor_move Lwd_table.prev - | `Arrow `Up, _ -> cursor_move Lwd_table.prev - | `Uchar u, [ `Meta ] when eq_uc_c u '<' -> + | [ (`Arrow `Up, _) ] -> cursor_move Lwd_table.prev + | [ (`Uchar u, [ `Meta ]) ] when eq_uc_c u '<' -> cursor_move (fun _ -> Lwd_table.first table) - | `Uchar u, [ `Meta ] when eq_uc_c u '>' -> + | [ (`Uchar u, [ `Meta ]) ] when eq_uc_c u '>' -> cursor_move (fun _ -> Lwd_table.last table) - | `Enter, [] -> + | [ (`Enter, []) ] -> line_of_cursor cursor (fun old_row old_line -> let str, pos = Lwd.peek old_line.state in let o_str = String.sub str 0 pos in @@ -2942,7 +2957,7 @@ module Widgets = struct Lwd.set cursor (Some (Lwd_table.after old_row ~set:new_line)); `Handled) - | `Backspace, [] -> + | [ (`Backspace, []) ] -> line_of_cursor cursor (fun row line -> let str, pos = Lwd.peek line.state in Ui.may_handle (Lwd_table.prev row) @@ -2961,7 +2976,8 @@ module Widgets = struct Lwd_table.remove row; `Handled) else `Unhandled)) - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'k' -> + `Handled | _ -> `Unhandled)) (* TODO: view_metadata *) @@ -3016,22 +3032,24 @@ module Widgets = struct Ui.keyboard_area ~focus:focus' (fun k -> Log.debug (fun m -> - m "node_edit_area handler %a" Ui.pp_key k); + m "node_edit_area handler %a" Ui.pp_keys k); let cursor_move = cursor_move ~update:copy_line_cursor cursor in match k with - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'n' -> cursor_move Lwd_table.next - | `Arrow `Down, _ -> cursor_move Lwd_table.next - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' -> + | [ (`Arrow `Down, _) ] -> + cursor_move Lwd_table.next + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'p' -> cursor_move Lwd_table.prev - | `Arrow `Up, _ -> cursor_move Lwd_table.prev - | `Uchar u, [ `Meta ] when eq_uc_c u '<' -> + | [ (`Arrow `Up, _) ] -> + cursor_move Lwd_table.prev + | [ (`Uchar u, [ `Meta ]) ] when eq_uc_c u '<' -> cursor_move (fun _ -> Lwd_table.first table) - | `Uchar u, [ `Meta ] when eq_uc_c u '>' -> + | [ (`Uchar u, [ `Meta ]) ] when eq_uc_c u '>' -> cursor_move (fun _ -> Lwd_table.last table) - | `Enter, [] -> + | [ (`Enter, []) ] -> line_of_cursor cursor (fun old_row old_line -> let str, pos = Lwd.peek old_line.state in @@ -3048,7 +3066,7 @@ module Widgets = struct (Lwd_table.after old_row ~set:new_line)); `Handled) - | `Backspace, [] -> + | [ (`Backspace, []) ] -> line_of_cursor cursor (fun row line -> let str, pos = Lwd.peek line.state in Ui.may_handle (Lwd_table.prev row) @@ -3068,9 +3086,9 @@ module Widgets = struct Lwd_table.remove row; `Handled) else `Unhandled)) - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'k' -> `Handled - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'x' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'x' -> let b = Buffer.create 1024 in Lwd_table.iter (fun line -> @@ -3135,29 +3153,30 @@ module Widgets = struct |> Option.iter (fun (f, _) -> Focus.request f)); Ui.keyboard_area ~focus:focus' (fun k -> Log.debug (fun m -> - m "keyboard_area: tree_nav %a" Ui.pp_key k); + m "keyboard_area: tree_nav %a" Ui.pp_keys k); match k with - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'n' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'n' -> cursor_move cursor Lwd_table.next |> ignore; `Handled - | `Arrow `Down, _ -> + | [ (`Arrow `Down, _) ] -> cursor_move cursor Lwd_table.next |> ignore; `Handled - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'p' -> + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'p' -> cursor_move cursor Lwd_table.prev |> ignore; `Handled - | `Arrow `Up, _ -> + | [ (`Arrow `Up, _) ] -> cursor_move cursor Lwd_table.prev |> ignore; `Handled - | `Uchar u, [ `Meta ] when eq_uc_c u '<' -> + | [ (`Uchar u, [ `Meta ]) ] when eq_uc_c u '<' -> cursor_move cursor (fun _ -> Lwd_table.first table) - | `Uchar u, [ `Meta ] when eq_uc_c u '>' -> + | [ (`Uchar u, [ `Meta ]) ] when eq_uc_c u '>' -> cursor_move cursor (fun _ -> Lwd_table.last table) - | `Uchar u, [ `Ctrl ] when eq_uc_c u 'k' -> `Handled - | `Enter, [] -> `Unhandled - | `Backspace, [] -> `Unhandled + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'k' -> + `Handled + | [ (`Enter, []) ] -> `Unhandled + | [ (`Backspace, []) ] -> `Unhandled | _ -> `Unhandled))) (* let cursorview = @@ -3228,10 +3247,10 @@ module Widgets = struct Ui.keyboard_area ~focus:focus' (fun k -> Log.debug (fun m -> - m "keyboard_area: node_ui %a" Ui.pp_key k); + m "keyboard_area: node_ui %a" Ui.pp_keys k); match k with - | `Enter, [] -> ( + | [ (`Enter, []) ] -> ( Focus.release focus; match selection with | Some sel -> @@ -3276,10 +3295,10 @@ module Widgets = struct |> Lwd.map2 (Focus.status focus) ~f:(fun focus' -> Ui.keyboard_area ~focus:focus' (fun k -> Log.debug (fun m -> - m "keyboard_area: h_node_area_handler %a" Ui.pp_key - k); + m "keyboard_area: h_node_area_handler %a" + Ui.pp_keys k); match k with - | `Enter, [] -> `Unhandled + | [ (`Enter, []) ] -> `Unhandled | _ -> `Unhandled)) (** Tab view, where exactly one element of [l] is shown at a time. *) @@ -3510,7 +3529,7 @@ module Widgets = struct let button_of ui f = Ui.keyboard_area (function - | `Enter, _ -> + | [ (`Enter, _) ] -> f (); `Handled | _ -> `Unhandled)