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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
module String = struct
[@@@ocaml.warning "-3-32"]
let lowercase_ascii = StringLabels.lowercase
include String
end
type code =
| Char of Uchar.t
| Enter
| Escape
| Tab
| Up
| Down
| Left
| Right
| F1
| F2
| F3
| F4
| F5
| F6
| F7
| F8
| F9
| F10
| F11
| F12
| Next_page
| Prev_page
| Home
| End
| Insert
| Delete
| Backspace
type t = {
control : bool;
meta : bool;
shift : bool;
code : code;
}
let compare = compare
let control key = key.control
let meta key = key.meta
let code key = key.code
let string_of_code = function
| Char ch -> Printf.sprintf "Char 0x%02x" (Uchar.to_int ch)
| Enter -> "Enter"
| Escape -> "Escape"
| Tab -> "Tab"
| Up -> "Up"
| Down -> "Down"
| Left -> "Left"
| Right -> "Right"
| F1 -> "F1"
| F2 -> "F2"
| F3 -> "F3"
| F4 -> "F4"
| F5 -> "F5"
| F6 -> "F6"
| F7 -> "F7"
| F8 -> "F8"
| F9 -> "F9"
| F10 -> "F10"
| F11 -> "F11"
| F12 -> "F12"
| Next_page -> "Next_page"
| Prev_page -> "Prev_page"
| Home -> "Home"
| End -> "End"
| Insert -> "Insert"
| Delete -> "Delete"
| Backspace -> "Backspace"
let to_string key =
Printf.sprintf "{ control = %B; meta = %B; shift = %B; code = %s }" key.control key.meta key.shift (string_of_code key.code)
let to_string_compact key =
let buffer = Buffer.create 32 in
if key.control then Buffer.add_string buffer "C-";
if key.meta then Buffer.add_string buffer "M-";
if key.shift then Buffer.add_string buffer "S-";
(match key.code with
| Char ch ->
let code = Uchar.to_int ch in
if code <= 255 then
match Char.chr code with
| 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'
| '_' | '(' | ')' | '[' | ']' | '{' | '}'
| '#' | '~' | '&' | '$' | '*' | '%'
| '!' | '?' | ',' | ';' | ':' | '/' | '\\'
| '.' | '@' | '=' | '+' | '-' as ch ->
Buffer.add_char buffer ch
| ' ' ->
Buffer.add_string buffer "space"
| _ ->
Printf.bprintf buffer "U+%02x" code
else if code <= 0xffff then
Printf.bprintf buffer "U+%04x" code
else
Printf.bprintf buffer "U+%06x" code
| Next_page ->
Buffer.add_string buffer "next"
| Prev_page ->
Buffer.add_string buffer "prev"
| code ->
Buffer.add_string buffer (String.lowercase_ascii (string_of_code code)));
Buffer.contents buffer