key press display

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 ])))

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
+      [ `Keys of keys | `Mouse of mouse | `Paste of Input.paste ]
-      | `Key_list of key list
-      | `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 ]
+      | `Keys keys -> dispatch_key t keys
-      | `Key_list 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.event_filter
-            (Ui.resize_to (Ui.layout_spec base) composite))
+            (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, []) ] ->