From 2ec6426fe5817a118170637e3cc611d21a651867 Mon Sep 17 00:00:00 2001 From: cqc Date: Mon, 6 Feb 2023 09:36:14 -0600 Subject: [PATCH] key press display --- boot_js.ml | 2 +- human.ml | 73 ++++++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 55 insertions(+), 20 deletions(-) diff --git a/boot_js.ml b/boot_js.ml index e640810..0cf0556 100644 --- a/boot_js.ml +++ b/boot_js.ml @@ -119,4 +119,4 @@ let _ = buffered_loop (make_event Dom_html.Event.keydown) Dom_html.document (fun ev _ -> Lwt.return - @@ push_event (Some (`Key (Event_js.evt_of_jskey ev)))) + @@ push_event (Some (`Keys [ Event_js.evt_of_jskey ev ]))) diff --git a/human.ml b/human.ml index bcc4aa6..1f9ceab 100644 --- a/human.ml +++ b/human.ml @@ -514,12 +514,13 @@ module Input = struct let pp_code ppf v = F.pf ppf "%s" (string_of_code v) - type mods = [ `Super | `Meta | `Ctrl | `Shift ] list + type mods = [ `Super | `Meta | `Ctrl | `Shift | `Alt ] list let pp_mods = F.( list ~sep:F.sp (fun ppf -> function | `Super -> pf ppf "`Super" + | `Alt -> pf ppf "`Alt" | `Meta -> pf ppf "`Meta" | `Ctrl -> pf ppf "`Ctrl" | `Shift -> pf ppf "`Shift")) @@ -557,10 +558,10 @@ module Event_js = struct | Some s' -> `Uchar s' | None -> `Unknown s)) | None -> `Unknown "keypress .key is None?"), - (if Js.to_bool evt##.altKey then [ `Meta ] else []) + (if Js.to_bool evt##.altKey then [ `Alt ] else []) @ (if Js.to_bool evt##.shiftKey then [ `Shift ] else []) @ (if Js.to_bool evt##.ctrlKey then [ `Ctrl ] else []) - @ if Js.to_bool evt##.metaKey then [ `Super ] else [] ) + @ if Js.to_bool evt##.metaKey then [ `Meta ] else [] ) end open Gg @@ -1417,10 +1418,7 @@ module Nottui = struct type mouse = Input.mouse type event = - [ `Key of key - | `Key_list of key list - | `Mouse of mouse - | `Paste of Input.paste ] + [ `Keys of keys | `Mouse of mouse | `Paste of Input.paste ] type layout_spec = { w : float; @@ -1457,7 +1455,7 @@ module Nottui = struct | Pad of 'a * (float * float * float * float) | Shift_area of 'a * float * float | Event_filter of - 'a * ([ `Key of keys | `Mouse of mouse ] -> may_handle) + 'a * ([ `Keys of keys | `Mouse of mouse ] -> may_handle) | X of 'a * 'a | Y of 'a * 'a | Z of 'a * 'a @@ -2195,7 +2193,7 @@ module Nottui = struct | Resize (t, _, _, _) -> iter (t :: tl) | Event_filter (t, f) -> ( - match f (`Key keys) with + match f (`Keys keys) with | `Unhandled -> iter (t :: tl) | `Handled -> `Handled)) in @@ -2309,8 +2307,7 @@ module Nottui = struct | `Unhandled, _ -> `Unhandled let dispatch_event t = function - | `Key key -> dispatch_key t [ key ] - | `Key_list keys -> dispatch_key t keys + | `Keys keys -> dispatch_key t keys | `Mouse mouse -> dispatch_mouse t mouse | `Paste _ -> `Unhandled end @@ -2369,21 +2366,30 @@ module Nottui_lwt = struct push (Some (Renderer.image vg renderer)) in refresh (); + let key_list = ref [] in let process_event e = match e with - | `Key (`Uchar c, [ `Meta ]) as event + | `Keys [ (`Uchar c, [ `Meta ]) ] as event when Uchar.(equal c (of_char 'q')) -> ( match do_quit with | Some u -> Lwt.wakeup u () | None -> ignore (Renderer.dispatch_event renderer event)) + | `Keys [ (`Unknown _, _) ] -> () + | `Keys k -> ( + key_list := !key_list @ k; + match + Renderer.dispatch_event renderer (`Keys !key_list) + with + | `Handled -> key_list := [] + | `Unhandled -> ()) | #Ui.event as event -> ( match Renderer.dispatch_event renderer event with | `Handled -> () | `Unhandled -> - (* Log.warn (fun m -> + Log.warn (fun m -> m "Nottui_lwt.render process_event #Ui.event -> \ - `Unhandled") *) + `Unhandled"); ()) | `Resize size' -> size := size'; @@ -2419,6 +2425,7 @@ module Widgets = struct let float_ ?attr x = string ?attr (string_of_float x) let printf ?attr fmt = Printf.ksprintf (string ?attr) fmt let fmt ?attr fmt = Format.kasprintf (string ?attr) fmt + let eq_uc_c uc c = Uchar.(equal uc (of_char c)) let kprintf k ?attr fmt = Printf.ksprintf (fun str -> k (string ?attr str)) fmt @@ -2431,16 +2438,40 @@ module Widgets = struct view : ui Lwd.t; } + let display_keys (k : Ui.keys option Lwd.var) : Ui.t Lwd.t = + Lwd.map (Lwd.get k) ~f:(function + | Some k' -> string (F.str "%a" Ui.pp_keys k') + | None -> string "---") + let window_manager base = let overlays = Lwd_table.make () in let composition = Lwd.join (Lwd_table.reduce (Lwd_utils.lift_monoid Ui.pack_z) overlays) in + let keys = Lwd.var None in let view = Lwd.map2 base composition ~f:(fun base composite -> - Ui.join_z base - (Ui.resize_to (Ui.layout_spec base) composite)) + Ui.event_filter + (function + | `Keys k' -> + Log.debug (fun m -> + m "event_filter: window_manager `Keys %a" + Ui.pp_keys k'); + Lwd.set keys (Some k'); + if + List.mem + (`Uchar (Uchar.of_char 'g'), [ `Ctrl ]) + k' + then `Handled + else `Unhandled + | _ -> `Unhandled) + (Ui.join_z base + (Ui.resize_to (Ui.layout_spec base) composite))) + in + let view = + Lwd.map2 view (display_keys keys) ~f:(fun view extra -> + Ui.join_y view extra) in { overlays; view } @@ -2708,8 +2739,6 @@ module Widgets = struct in Lwd.map2 ~f:render (Lwd.get state_var) (Lwd.pair top bot) - let eq_uc_c uc c = Uchar.(equal uc (of_char c)) - let edit_field ?(focus = Focus.make ()) ?(on_change = Fun.id) state = let update focus_h focus (text, pos) = @@ -2740,6 +2769,12 @@ module Widgets = struct | [ (`Uchar c, [ `Ctrl ]) ] when Uchar.(equal c (of_char 'U')) -> on_change ("", 0) (* clear *) + | [ (`End, []) ] -> on_change (text, String.length text) + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'e' -> + on_change (text, String.length text) + | [ (`Home, []) ] -> on_change (text, 0) + | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'a' -> + on_change (text, String.length text) | [ (`Uchar u, [ `Ctrl ]) ] when eq_uc_c u 'k' -> (* TODO put killed text into kill-ring *) if pos < String.length text then @@ -2767,7 +2802,7 @@ module Widgets = struct else text ^ String.make 1 k in on_change (text, pos + 1) - | [ (`Escape, []) ] -> + | [ _; (`Escape, []) ] -> Focus.release focus_h; `Handled | [ (`Arrow `Left, []) ] ->