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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
|
diff --git a/_tags b/_tags
index 88318d9..b433ee8 100644
--- a/_tags
+++ b/_tags
@@ -7,9 +7,11 @@ true : package(sexplib astring)
<src/xconfig.ml>: package(otr ppx_sexp_conv)
<src/utils.ml>: package(uutf)
+<src/muc.ml>: package(uchar)
+<src/contact.mli>: package(uchar)
<src/persistency.ml>: package(lwt nocrypto)
<src/xjid.{ml,mli}>: package(ppx_sexp_conv erm_xmpp)
-<src/user.{ml,mli}>: package(ppx_sexp_conv otr hex ptime ptime.clock.os)
+<src/user.{ml,mli}>: package(uchar ppx_sexp_conv otr hex ptime ptime.clock.os)
<src/xmpp_callbacks.ml>: package(erm_xmpp lwt tls tls.lwt ptime)
<src/xmpp_connection.ml>: package(erm_xmpp lwt tls tls.lwt)
@@ -18,6 +20,6 @@ true : package(sexplib astring)
<cli/cli_input.ml>: package(notty lwt erm_xmpp otr)
<cli/cli_commands.ml>: package(lwt otr erm_xmpp)
<cli/cli_config.ml>: package(lwt nocrypto otr notty tls.lwt x509)
-<cli/cli_state.ml>: package(hex lwt nocrypto erm_xmpp tls.lwt x509)
+<cli/cli_state.ml>: package(uchar hex lwt nocrypto erm_xmpp tls.lwt x509)
<bin/jackline.{ml,byte,native}>: package(erm_xmpp hex lwt notty notty.lwt nocrypto otr sexplib tls tls.lwt ptime ptime.clock.os)
diff --git a/cli/cli_config.ml b/cli/cli_config.ml
index 618d655..dac6e68 100644
--- a/cli/cli_config.ml
+++ b/cli/cli_config.ml
@@ -34,7 +34,7 @@ let rewrap term above below (prefix, inp, inp2) (width, _) =
let height = if col mod width = 0 then succ h else h in
(succ (col mod width), height)
in
- Notty_lwt.Term.cursor term (Some (col, row))
+ Notty_lwt.Term.cursor term (Some (col - 1, row - 1))
let read_line ?(above = []) ?(prefix = "") ?default ?(below = []) term =
let rec go (pre, post) =
@@ -56,8 +56,8 @@ let read_line ?(above = []) ?(prefix = "") ?default ?(below = []) term =
| `Unhandled k ->
match k with
| `Key (`Enter, []) -> Lwt.return (char_list_to_str (pre @ post))
- | `Key (`Uchar 0x43, [`Ctrl]) -> Lwt.fail (Invalid_argument "Ctrl-c")
- | `Key (`Uchar 0x44, [`Ctrl]) -> Lwt.fail (Invalid_argument "Ctrl-d")
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x43 -> Lwt.fail (Invalid_argument "Ctrl-c")
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x44 -> Lwt.fail (Invalid_argument "Ctrl-d")
| _ -> go (pre, post)
in
let pre = Utils.option [] str_to_char_list default in
@@ -180,7 +180,7 @@ let configure term () =
let pw = "Password: " in
let chars = match password with
| None -> I.string A.empty "will be asked at startup"
- | Some _ -> I.uchar A.empty 0x2605 5 1
+ | Some _ -> I.uchar A.empty (Uchar.of_int 0x2605) 5 1
in
above @ [I.(string A.empty pw <|> chars)]
in
diff --git a/cli/cli_input.ml b/cli/cli_input.ml
index 34b4288..07488f2 100644
--- a/cli/cli_input.ml
+++ b/cli/cli_input.ml
@@ -314,19 +314,19 @@ let read_terminal term mvar input_mvar () =
| `Key (`Arrow `Up, []) -> p (fun s -> ok (history s Up)) >>= fun () -> loop ()
| `Key (`Arrow `Down, []) -> p (fun s -> ok (history s Down)) >>= fun () -> loop ()
- | `Key (`Uchar 0x44, [`Ctrl]) (* C-d *) -> p (fun s -> Lwt.return (`Quit s))
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x44 (* C-d *) -> p (fun s -> Lwt.return (`Quit s))
(* UI navigation and toggles *)
| `Key (`Page `Up, []) -> p (fun s -> ok (navigate_buddy_list s Up)) >>= fun () -> loop ()
| `Key (`Page `Down, []) -> p (fun s -> ok (navigate_buddy_list s Down)) >>= fun () -> loop ()
| `Key (`Page `Up, [`Ctrl]) -> p (fun s -> ok (navigate_message_buffer s Up)) >>= fun () -> loop ()
- | `Key (`Uchar 0x50, [`Ctrl]) (* C-p *) -> p (fun s -> ok (navigate_message_buffer s Up)) >>= fun () -> loop ()
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x50 (* C-p *) -> p (fun s -> ok (navigate_message_buffer s Up)) >>= fun () -> loop ()
| `Key (`Page `Down, [`Ctrl]) -> p (fun s -> ok (navigate_message_buffer s Down)) >>= fun () -> loop ()
- | `Key (`Uchar 0x4E, [`Ctrl]) (* C-n *) -> p (fun s -> ok (navigate_message_buffer s Down)) >>= fun () -> loop ()
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x4E (* C-n *) -> p (fun s -> ok (navigate_message_buffer s Down)) >>= fun () -> loop ()
- | `Key (`Uchar 0x58, [`Ctrl]) (* C-x *) -> p (fun s -> ok (activate_contact s s.last_active_contact)) >>= fun () -> loop ()
- | `Key (`Uchar 0x51, [`Ctrl]) (* C-q *) ->
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x58 (* C-x *) -> p (fun s -> ok (activate_contact s s.last_active_contact)) >>= fun () -> loop ()
+ | `Key (`Uchar u, [`Ctrl]) when Uchar.to_int u = 0x51 (* C-q *) ->
let handle s =
let s = match List.rev s.notifications with
| x::_ -> activate_contact s x
diff --git a/cli/cli_state.ml b/cli/cli_state.ml
index 5603cfe..ee320ce 100644
--- a/cli/cli_state.ml
+++ b/cli/cli_state.ml
@@ -24,7 +24,7 @@ type connect_v =
| Reconnect
| Presence of (User.presence * string option * int option)
-type input = int list * int list
+type input = Uchar.t list * Uchar.t list
type state = {
(* set only initially *)
diff --git a/cli/cli_support.ml b/cli/cli_support.ml
index 1c54df6..8275c38 100644
--- a/cli/cli_support.ml
+++ b/cli/cli_support.ml
@@ -4,17 +4,17 @@ open Notty
module Char = struct
let hdash a w =
if !Utils.unicode then
- I.uchar a 0x2500 w 1
+ I.uchar a (Uchar.of_int 0x2500) w 1
else
I.char a '-' w 1
and vdash a h =
if !Utils.unicode then
- I.uchar a 0x2502 1 h
+ I.uchar a (Uchar.of_int 0x2502) 1 h
else
I.char a '|' 1 h
and star a w =
if !Utils.unicode then
- I.uchar a 0x2605 w 1
+ I.uchar a (Uchar.of_int 0x2605) w 1
else
I.char a '*' w 1
end
@@ -186,8 +186,8 @@ let v_center left right width =
and rw = I.width right
in
match rw, lw >= width with
- | 0, true -> (I.hcrop (lw - width + 1) 0 left, width)
- | 0, false -> (left, succ lw)
+ | 0, true -> (I.hcrop (lw - width + 1) 0 left, width - 1)
+ | 0, false -> (left, lw)
| _, _ ->
if lw + rw >= width then
let leftw = min (max (width - rw) (width / 2)) lw in
@@ -195,11 +195,11 @@ let v_center left right width =
let l = I.hcrop (lw - leftw) 0 left
and r = I.hcrop 0 (rw - rightw) right
in
- (I.(l <|> r), succ leftw)
+ (I.(l <|> r), leftw)
else
- (I.(left <|> right), succ lw)
+ (I.(left <|> right), lw)
-let str_to_char_list str : int list =
+let str_to_char_list str : Uchar.t list =
let open Uutf in
List.rev (String.fold_utf_8 (fun acc _ -> function `Uchar i -> i :: acc | `Malformed _ -> acc) [] str)
@@ -236,22 +236,26 @@ let readline_input = function
| k -> `Unhandled k
let emacs_bindings = function
- | `Key (`Uchar 0x41, [`Ctrl]) (* C-a *) -> `Ok (fun (pre, post) -> ([], pre @ post))
- | `Key (`Uchar 0x45, [`Ctrl]) (* C-e *) -> `Ok (fun (pre, post) -> (pre @ post, []))
+ | `Key (`Uchar u, [`Ctrl]) as k ->
+ begin match Uchar.to_int u with
+ | 0x41 (* C-a *) -> `Ok (fun (pre, post) -> ([], pre @ post))
+ | 0x45 (* C-e *) -> `Ok (fun (pre, post) -> (pre @ post, []))
- | `Key (`Uchar 0x4b, [`Ctrl]) (* C-k *) -> `Ok (fun (pre, _) -> (pre, []))
- | `Key (`Uchar 0x55, [`Ctrl]) (* C-u *) -> `Ok (fun (_, post) -> ([], post))
+ | 0x4b (* C-k *) -> `Ok (fun (pre, _) -> (pre, []))
+ | 0x55 (* C-u *) -> `Ok (fun (_, post) -> ([], post))
- | `Key (`Uchar 0x46, [`Ctrl]) (* C-f *) ->
+ | 0x46 (* C-f *) ->
`Ok (fun (pre, post) ->
match post with
| [] -> (pre, post)
| hd::tl -> (pre @ [hd], tl))
- | `Key (`Uchar 0x42, [`Ctrl]) (* C-b *) ->
+ | 0x42 (* C-b *) ->
`Ok (fun (pre, post) ->
match List.rev pre with
| [] -> ([], post)
| hd::tl -> (List.rev tl, hd :: post))
+ | _ -> `Unhandled k
+ end
| `Key (`Arrow `Left, [`Ctrl]) ->
`Ok (fun (pre, post) ->
diff --git a/src/contact.mli b/src/contact.mli
index 6926296..d6c795b 100644
--- a/src/contact.mli
+++ b/src/contact.mli
@@ -8,7 +8,7 @@ val bare : contact -> Xjid.bare_jid
val preserve_messages : contact -> bool
val expanded : contact -> bool
val messages : contact -> User.message list
-val input_buffer : contact -> (int list * int list)
+val input_buffer : contact -> (Uchar.t list * Uchar.t list)
val readline_history : contact -> string list
val add_readline_history : contact -> string -> contact
@@ -18,7 +18,7 @@ val set_history_position : contact -> int -> contact
val received : contact -> string -> contact
val expand : contact -> contact
-val set_input_buffer : contact -> (int list * int list) -> contact
+val set_input_buffer : contact -> (Uchar.t list * Uchar.t list) -> contact
val set_preserve_messages : contact -> bool -> contact
val reset : contact -> contact
diff --git a/src/muc.ml b/src/muc.ml
index 1c98037..3293541 100644
--- a/src/muc.ml
+++ b/src/muc.ml
@@ -132,7 +132,7 @@ type groupchat = {
expand : bool ;
preserve_messages : bool ;
message_history : User.message list ; (* persistent if preserve_messages *)
- input_buffer : (int list * int list) ;
+ input_buffer : (Uchar.t list * Uchar.t list) ;
readline_history : string list ;
history_position : int ;
autojoin : bool ;
diff --git a/src/user.ml b/src/user.ml
index d039278..42a8c47 100644
--- a/src/user.ml
+++ b/src/user.ml
@@ -229,7 +229,7 @@ type user = {
properties : property list ;
preserve_messages : bool ;
message_history : message list ; (* persistent if preserve_messages is true *)
- input_buffer: (int list * int list) ; (* not persistent *)
+ input_buffer: (Uchar.t list * Uchar.t list) ; (* not persistent *)
readline_history : string list ; (* not persistent *)
history_position : int ; (* not persistent *)
otr_fingerprints : fingerprint list ;
diff --git a/src/user.mli b/src/user.mli
index 52b503d..5ce41be 100644
--- a/src/user.mli
+++ b/src/user.mli
@@ -118,7 +118,7 @@ type user = {
properties : property list ;
preserve_messages : bool ;
message_history : message list ; (* persistent if preserve_messages is true *)
- input_buffer: (int list * int list) ; (* not persistent *)
+ input_buffer: (Uchar.t list * Uchar.t list) ; (* not persistent *)
readline_history : string list ; (* not persistent *)
history_position : int ;
otr_fingerprints : fingerprint list ;
diff --git a/src/utils.ml b/src/utils.ml
index 0b4a3a7..cd9cb10 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -30,31 +30,33 @@ let validate_utf8 txt =
let rec loop d buf = match Uutf.decode d with
| `Await -> Buffer.contents buf
| `End -> Buffer.contents buf
- | `Malformed _ -> if !unicode then Uutf.Buffer.add_utf_8 buf 0xFFFD; loop d buf
- | `Uchar 0x000A -> (* newline *) Uutf.Buffer.add_utf_8 buf 0x000A ; loop d buf
- | `Uchar 0x0009 -> (* tab -> 4 spaces *) Uutf.Buffer.add_utf_8 buf 0x0020 ; Uutf.Buffer.add_utf_8 buf 0x0020 ; Uutf.Buffer.add_utf_8 buf 0x0020 ; Uutf.Buffer.add_utf_8 buf 0x0020 ; loop d buf
- | `Uchar 0x007F (* DEL *)
+ | `Malformed _ -> if !unicode then Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0xFFFD); loop d buf
+ | `Uchar u ->
+ match Uchar.to_int u with
+ | 0x000A -> (* newline *) Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0x000A) ; loop d buf
+ | 0x0009 -> (* tab -> 4 spaces *) Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0x0020) ; Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0x0020) ; Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0x0020) ; Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0x0020) ; loop d buf
+ | 0x007F (* DEL *)
(* See https://en.wikipedia.org/wiki/Unicode_control_characters / https://en.wikipedia.org/wiki/Bi-directional_text *)
- | `Uchar 0x200E | `Uchar 0x200F (* left-to-right / right-to-left *)
- | `Uchar 0x202A | `Uchar 0x202D (* left-to-right embedding / override *)
- | `Uchar 0x202B | `Uchar 0x202E (* right-to-left embedding / override *)
- | `Uchar 0x202C (* pop directional format *)
- | `Uchar 0x2066 | `Uchar 0x2067 (* l-t-r isolate r-t-l isolate *)
- | `Uchar 0x2068 | `Uchar 0x2069 (* first strong isolate / pop directional isolate *)
- | `Uchar 0x2028 | `Uchar 0x2029 (* line separator / page separator *) ->
- if !unicode then Uutf.Buffer.add_utf_8 buf 0xFFFD ; loop d buf
- | `Uchar x when x < 0x20 ->
+ | 0x200E | 0x200F (* left-to-right / right-to-left *)
+ | 0x202A | 0x202D (* left-to-right embedding / override *)
+ | 0x202B | 0x202E (* right-to-left embedding / override *)
+ | 0x202C (* pop directional format *)
+ | 0x2066 | 0x2067 (* l-t-r isolate r-t-l isolate *)
+ | 0x2068 | 0x2069 (* first strong isolate / pop directional isolate *)
+ | 0x2028 | 0x2029 (* line separator / page separator *) ->
+ if !unicode then Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0xFFFD) ; loop d buf
+ | x when x < 0x20 ->
(* other control characters *)
- if !unicode then Uutf.Buffer.add_utf_8 buf 0xFFFD ; loop d buf
- | `Uchar x when x >= 0x0080 && x <= 0x009F ->
+ if !unicode then Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0xFFFD) ; loop d buf
+ | x when x >= 0x0080 && x <= 0x009F ->
(* ctrl chars used in conjunction with ISO 8859 character sets (C0/C1) *)
- if !unicode then Uutf.Buffer.add_utf_8 buf 0xFFFD ; loop d buf
+ if !unicode then Uutf.Buffer.add_utf_8 buf (Uchar.of_int 0xFFFD) ; loop d buf
- | `Uchar x ->
+ | x ->
let c = if !unicode then x else if x > 0xff then 0x3f else x in
- Uutf.Buffer.add_utf_8 buf c ; loop d buf
+ Uutf.Buffer.add_utf_8 buf (Uchar.of_int c) ; loop d buf
in
- let nln = `Readline 0x000A in
+ let nln = `Readline (Uchar.of_int 0x000A) in
loop (Uutf.decoder ~nln ~encoding:`UTF_8 (`String txt)) (Buffer.create (String.length txt))
let version = "%%VERSION_NUM%%"
|