list-based key press handlers
This commit is contained in:
cqc
161
human.ml
161
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)
|
||||
|
||||
Reference in New Issue
Block a user