1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
type 'a binding = {
key : Event.Key.t;
ctrl : bool option;
alt : bool option;
shift : bool option;
super : bool option;
hyper : bool option;
meta : bool option;
data : 'a;
}
type 'a t = 'a binding list
let empty = []
let add_binding map binding = binding :: map
let add ?ctrl ?alt ?shift ?super ?hyper ?meta map key data =
add_binding map { key; ctrl; alt; shift; super; hyper; meta; data }
let add_char ?(ctrl = false) ?(alt = false) ?(shift = false) ?(super = false)
?(hyper = false) ?(meta = false) map c data =
add_binding map
{
key = Char (Uchar.of_char c);
ctrl = Some ctrl;
alt = Some alt;
shift = Some shift;
super = Some super;
hyper = Some hyper;
meta = Some meta;
data;
}
let matches_modifier (cond : _ binding) (actual : Event.Key.modifier) =
let check_opt opt field =
match opt with None -> true | Some v -> v = field
in
check_opt cond.ctrl actual.ctrl
&& check_opt cond.alt actual.alt
&& check_opt cond.shift actual.shift
&& check_opt cond.super actual.super
&& check_opt cond.hyper actual.hyper
&& check_opt cond.meta actual.meta
let default_event_type_filter = function
| Event.Key.Press | Event.Key.Repeat -> true
| Event.Key.Release -> false
let find ?(event_type = default_event_type_filter) map = function
| Event.Key { key; modifier; event_type = et; _ } ->
if not (event_type et) then None
else
let rec loop = function
| [] -> None
| b :: rest ->
if Event.Key.equal key b.key && matches_modifier b modifier then
Some b.data
else loop rest
in
loop map
| _ -> None