console/boot
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

list-based key press handlers

Browse Source
This commit is contained in:
cqc
2023-02-05 15:47:00 -06:00
parent 6948a65a97
commit 0df5884a88
1 changed files with 90 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

161
human.ml
View File

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