OCaml port of Linenoise
Add ctrls and fixes
+329
-31
+9
-2
example/main.ml
+9
-2
example/main.ml
···
1
+
let h = ref []
2
+
3
+
let history prefix =
4
+
if prefix <> "" then List.filter (fun s -> String.starts_with ~prefix s) !h
5
+
else !h
6
+
1
7
let complete s =
2
8
match String.get s 0 with
3
9
| 'h' -> [ "hello"; "hello there" ]
···
10
16
if sys_break then "[\x1b[31m130\x1b[0m] \x1b[33m>>\x1b[0m "
11
17
else "\x1b[33m>>\x1b[0m "
12
18
in
13
-
match Bruit.bruit ~complete prompt with
19
+
match Bruit.bruit ~history ~complete prompt with
14
20
| String (Some s) ->
15
-
Fmt.pr "%s\n%!" s;
21
+
Fmt.pr "\n%s\n%!" s;
22
+
h := s :: !h;
16
23
loop false
17
24
| String None -> ()
18
25
| Ctrl_c -> loop true
+305
-27
src/bruit.ml
+305
-27
src/bruit.ml
···
1
1
(* See the end of the file for the original license of Linenoise. *)
2
-
2
+
let () = Fmt.set_style_renderer Format.str_formatter `Ansi_tty
3
3
let max_line = 2048
4
+
5
+
type hint = string -> (string * Fmt.style) option
4
6
5
7
type key =
6
8
| Enter
···
9
11
| Ctrl_c
10
12
| Ctrl_d
11
13
| Ctrl_e
14
+
| Ctrl_f
15
+
| Ctrl_r
16
+
| Ctrl_p
17
+
| Ctrl_g
12
18
| Backspace
13
19
| Escape_sequence
14
20
| Tab
···
21
27
| 3 -> Ctrl_c
22
28
| 4 -> Ctrl_d
23
29
| 5 -> Ctrl_e
30
+
| 6 -> Ctrl_f
31
+
| 7 -> Ctrl_g
32
+
| 16 -> Ctrl_p
33
+
| 18 -> Ctrl_r
24
34
| 9 -> Tab
25
35
| 13 -> Enter
26
36
| 27 -> Escape_sequence
···
45
55
old_rows : int;
46
56
old_row_pos : int;
47
57
history_index : int;
58
+
history : string list;
59
+
saved_buf : string;
48
60
read_buf : Bytes.t;
49
61
in_completion : bool;
50
62
completion_idx : int;
51
63
complete : completion option;
64
+
hint : hint;
52
65
}
66
+
67
+
let buf t = Bytes.sub t.buf 0 t.len
53
68
54
69
let make ?(in_completion = false) ?(completion_idx = 0) ?complete
55
-
?(old_pos = 0) ?(pos = 0) ?(len = 0) ?(ifd = Unix.stdin)
56
-
?(ofd = Unix.stdout) ~prompt buf =
70
+
?(old_pos = 0) ?(pos = 0) ?(len = 0) ?(history = [])
71
+
?(hint = fun _ -> None) ?(ifd = Unix.stdin) ?(ofd = Unix.stdout) ~prompt
72
+
buf =
57
73
{
58
74
in_completion;
59
75
ifd;
···
67
83
len;
68
84
cols = 0;
69
85
old_row_pos = 1;
86
+
history;
70
87
old_rows = 0;
71
-
history_index = 0;
88
+
history_index = -1;
89
+
saved_buf = "";
72
90
complete;
73
91
completion_idx;
74
-
read_buf = Bytes.create 1 (* For reading a character *);
92
+
read_buf = Bytes.make 1 '\000' (* For reading a character *);
93
+
hint;
75
94
}
76
95
77
96
let override ?in_completion ?completion_idx ?complete ?ifd ?ofd ?buf ?buf_len
78
97
?prompt ?plen ?old_pos ?pos ?len ?cols ?old_rows ?old_row_pos
79
-
?history_index (t : t) =
98
+
?history_index ?history ?saved_buf (t : t) =
99
+
let () =
100
+
match buf with
101
+
| None -> ()
102
+
| Some buf -> Bytes.blit buf 0 t.buf 0 (Bytes.length buf)
103
+
in
80
104
{
81
105
in_completion = Option.value ~default:t.in_completion in_completion;
82
106
ifd = Option.value ~default:t.ifd ifd;
83
107
ofd = Option.value ~default:t.ofd ofd;
84
-
buf = Option.value ~default:t.buf buf;
108
+
buf = t.buf;
85
109
buf_len = Option.value ~default:t.buf_len buf_len;
86
110
prompt = Option.value ~default:t.prompt prompt;
87
111
plen = Option.value ~default:t.plen plen;
···
95
119
complete = (match complete with Some f -> Some f | None -> t.complete);
96
120
read_buf = t.read_buf;
97
121
completion_idx = Option.value ~default:t.completion_idx completion_idx;
122
+
history = Option.value ~default:t.history history;
123
+
saved_buf = Option.value ~default:t.saved_buf saved_buf;
124
+
hint = t.hint;
98
125
}
99
126
end
100
127
···
120
147
c_vmin = 1;
121
148
}
122
149
in
123
-
Unix.tcsetattr state.ifd TCSAFLUSH tio;
150
+
Unix.tcsetattr state.ifd TCSADRAIN tio;
124
151
Fun.protect
125
152
~finally:(fun () -> Unix.tcsetattr state.ifd TCSADRAIN saved_tio)
126
153
fn
···
148
175
let edit_start ~stdin:_ ~stdout:_ state fn =
149
176
with_raw_mode state @@ fun () ->
150
177
let cols = get_columns () in
151
-
Bytes.set state.buf 0 '\000';
178
+
(* Bytes.set state.buf 0 '\000'; *)
152
179
let state = State.override ~cols ~buf_len:(state.buf_len - 1) state in
153
180
write_bytes state.ofd state.prompt;
154
181
fn state
···
174
201
175
202
type refresh_flag = Rewrite
176
203
177
-
let refresh_single_line ?(flags = []) (state : State.t) =
178
-
let pwidth = utf8_display_width state.prompt state.plen in
204
+
let refresh_with_hints ~pwidth ~ab (state : State.t) =
205
+
let buf_width = utf8_display_width state.buf state.len in
206
+
if pwidth + buf_width < state.cols then begin
207
+
match state.hint (State.buf state |> Bytes.to_string) with
208
+
| None -> ()
209
+
| Some (hint, style) ->
210
+
let () =
211
+
Format.fprintf Format.str_formatter "%a"
212
+
Fmt.(styled style string)
213
+
hint
214
+
in
215
+
Buffer.add_string ab (Format.flush_str_formatter ())
216
+
end
217
+
218
+
let refresh_single_line ?(flags = []) ?prompt (state : State.t) =
219
+
let prompt = match prompt with None -> state.prompt | Some p -> p in
220
+
let pwidth = utf8_display_width prompt state.plen in
179
221
let poscol = ref @@ utf8_display_width state.buf state.pos in
180
222
let lencol = ref @@ utf8_display_width state.buf state.len in
181
223
···
202
244
203
245
(* Add prompt *)
204
246
if List.mem Rewrite flags then begin
205
-
Buffer.add_bytes ab state.prompt;
247
+
Buffer.add_bytes ab prompt;
206
248
Buffer.add_bytes ab (Bytes.sub state.buf 0 state.len)
207
249
end;
250
+
251
+
refresh_with_hints ~pwidth:state.len ~ab state;
208
252
209
253
(* Erase to the right *)
210
254
Buffer.add_string ab "\x1b[0K";
···
248
292
< state.cols
249
293
then begin
250
294
write_uchar state.ofd c;
251
-
state
295
+
refresh_line state
252
296
end
253
297
else refresh_line state
254
298
end
255
299
else begin
256
-
assert false
300
+
Bytes.blit state.buf state.pos state.buf (state.pos + clen)
301
+
(state.len - state.pos);
302
+
let _ : int = Bytes.set_utf_8_uchar state.buf state.pos c in
303
+
let state =
304
+
State.override ~len:(state.len + clen) ~pos:(state.pos + clen) state
305
+
in
306
+
refresh_line state
257
307
end
258
308
259
309
let edit_backspace (state : State.t) =
···
271
321
refresh_line state
272
322
273
323
let complete_line (state : State.t) c cn =
274
-
match cn (String.of_bytes state.buf) with
324
+
match cn (String.of_bytes (State.buf state)) with
275
325
| [] -> (State.override ~in_completion:false state, `Char c)
276
326
| xs ->
277
327
let state, c =
···
305
355
(refresh_line state, c)
306
356
end
307
357
308
-
let edit_feed state =
358
+
let move_left (state : State.t) =
359
+
let s =
360
+
if state.pos > 0 then
361
+
State.override
362
+
~pos:(state.pos - utf8_prev_char_len state.buf state.pos)
363
+
state
364
+
else state
365
+
in
366
+
refresh_line s
367
+
368
+
let complete_with_hint (state : State.t) =
369
+
let buf = State.buf state |> Bytes.to_string in
370
+
match state.hint buf with
371
+
| None -> state
372
+
| Some (h, _) ->
373
+
let new_buf = buf ^ h in
374
+
let end_buf = String.length new_buf in
375
+
Bytes.blit_string new_buf 0 state.buf 0 end_buf;
376
+
State.override ~pos:end_buf ~len:end_buf state
377
+
378
+
let move_right (state : State.t) =
379
+
let s =
380
+
if state.pos < state.len then
381
+
State.override
382
+
~pos:(state.pos + utf8_next_char_len state.buf state.pos)
383
+
state
384
+
else if state.pos = state.len then complete_with_hint state
385
+
else state
386
+
in
387
+
refresh_line s
388
+
389
+
let move_right_next_word (state : State.t) =
390
+
let pos = ref state.pos in
391
+
while !pos < state.len && Bytes.get state.buf !pos = ' ' do
392
+
incr pos
393
+
done;
394
+
while !pos < state.len && Bytes.get state.buf !pos <> ' ' do
395
+
incr pos
396
+
done;
397
+
let s = State.override ~pos:!pos state in
398
+
refresh_line s
399
+
400
+
let move_left_next_word (state : State.t) =
401
+
let pos = ref state.pos in
402
+
while !pos > 0 && Bytes.get state.buf !pos = ' ' do
403
+
decr pos
404
+
done;
405
+
while !pos > 0 && Bytes.get state.buf !pos <> ' ' do
406
+
decr pos
407
+
done;
408
+
let s = State.override ~pos:!pos state in
409
+
refresh_line s
410
+
411
+
let reverse_incr_search ~history (state : State.t) =
412
+
let has_match = ref true in
413
+
let search_buf = Buffer.create 16 in
414
+
let search_pos = ref 0 in
415
+
let search_dir = ref (-1) in
416
+
let h = history "" in
417
+
let history_len = List.length h in
418
+
let saved_buf = Bytes.copy state.buf in
419
+
let exception Completed of State.t in
420
+
let rec loop state : State.t =
421
+
let prompt =
422
+
if !has_match then
423
+
Fmt.str "(reverse-i-search)`%s': " (Buffer.contents search_buf)
424
+
else
425
+
Fmt.str "(failed-reverse-i-search)`%s': " (Buffer.contents search_buf)
426
+
in
427
+
let new_char = ref false in
428
+
let state = State.override ~pos:0 state in
429
+
let state =
430
+
refresh_single_line ~flags:[ Rewrite ] ~prompt:(String.to_bytes prompt)
431
+
state
432
+
in
433
+
let state =
434
+
match read_char state with
435
+
| `Editing -> loop state
436
+
| `None -> loop state
437
+
| `Some c -> (
438
+
match key_of_char c with
439
+
| Backspace ->
440
+
if Buffer.length search_buf > 0 then begin
441
+
(* Pretty wasteful... *)
442
+
let s = Buffer.contents search_buf in
443
+
Buffer.clear search_buf;
444
+
Buffer.add_substring search_buf s 0 (String.length s - 1);
445
+
search_pos := 0
446
+
end;
447
+
state
448
+
| Ctrl_p ->
449
+
search_dir := -1;
450
+
if !search_pos >= history_len then search_pos := history_len - 1;
451
+
state
452
+
| Ctrl_r ->
453
+
search_dir := 1;
454
+
if !search_pos < 0 then search_pos := 0;
455
+
state
456
+
| Ctrl_g ->
457
+
let l = Bytes.length saved_buf in
458
+
Bytes.blit saved_buf 0 state.buf 0 l;
459
+
let state = refresh_line (State.override ~pos:l ~len:l state) in
460
+
raise (Completed state)
461
+
| Enter ->
462
+
let state = State.override ~pos:state.len state in
463
+
raise (Completed state)
464
+
| _ ->
465
+
if Char.compare c ' ' > 0 then begin
466
+
new_char := true;
467
+
Buffer.add_char search_buf c;
468
+
search_pos := 0;
469
+
state
470
+
end
471
+
else
472
+
State.override ~pos:state.len state |> refresh_line |> fun s ->
473
+
raise (Completed s))
474
+
in
475
+
has_match := false;
476
+
let state =
477
+
if Buffer.length search_buf > 0 then begin
478
+
let rec inner_loop () =
479
+
if !search_pos >= 0 && !search_pos < history_len then begin
480
+
let entry = List.nth h !search_pos in
481
+
match
482
+
( Astring.String.cut ~sep:(Buffer.contents search_buf) entry,
483
+
!new_char
484
+
|| not
485
+
@@ String.equal entry (Bytes.to_string (State.buf state)) )
486
+
with
487
+
| Some (_l, _r), true ->
488
+
has_match := true;
489
+
Bytes.blit_string entry 0 state.buf 0 (String.length entry);
490
+
let state = State.override ~len:(String.length entry) state in
491
+
state
492
+
| _ ->
493
+
search_pos := !search_pos + !search_dir;
494
+
inner_loop ()
495
+
end
496
+
else state
497
+
in
498
+
inner_loop ()
499
+
end
500
+
else state
501
+
in
502
+
loop state
503
+
in
504
+
try loop state with Completed state -> state
505
+
506
+
let edit_history dir fn (state : State.t) =
507
+
let saved_state = state in
508
+
let current_buf = Bytes.sub_string state.buf 0 state.len in
509
+
let state =
510
+
match (dir, state.history_index) with
511
+
| `Prev, -1 ->
512
+
State.override ~history:(fn current_buf) ~history_index:0
513
+
~saved_buf:current_buf state
514
+
| `Prev, m ->
515
+
let max_history = List.length state.history in
516
+
if m < max_history - 1 then
517
+
State.override ~history_index:(state.history_index + 1) state
518
+
else state
519
+
| `Next, m when m >= 0 ->
520
+
State.override ~history_index:(state.history_index - 1) state
521
+
| _ -> state
522
+
in
523
+
match (state.history, state.history_index) with
524
+
| [], _ -> saved_state
525
+
| _, -1 ->
526
+
let len = String.length state.saved_buf in
527
+
State.override ~buf:(Bytes.of_string state.saved_buf) ~pos:len ~len state
528
+
|> refresh_line
529
+
| _ ->
530
+
let max_history = List.length state.history in
531
+
let idx = min max_history state.history_index in
532
+
let s = List.nth state.history idx in
533
+
let s_len = String.length s in
534
+
State.override ~buf:(Bytes.of_string s) ~pos:s_len ~len:s_len state
535
+
|> refresh_line
536
+
537
+
let edit_feed ~history state =
309
538
match read_char state with
310
539
| `Editing -> Editing state
311
540
| `None -> Finished None
···
322
551
| `Edit_more -> Editing state
323
552
| `Char c -> (
324
553
match key_of_char c with
325
-
| Enter -> Finished (Some state.buf)
554
+
| Enter -> Finished (Some (Bytes.sub state.buf 0 state.len))
326
555
| Ctrl_d ->
327
-
if Int.equal state.len 0 then Finished None else assert false
556
+
if Int.equal state.len 0 then Finished None else Editing state
328
557
| Ctrl_c -> Ctrl_c
558
+
| Ctrl_b -> Editing (move_left state)
559
+
| Ctrl_f -> Editing (move_right state)
560
+
| Ctrl_r -> Editing (reverse_incr_search ~history state)
329
561
| Backspace -> Editing (edit_backspace state)
330
562
| Tab -> Editing state
331
-
| Unknown _ | _ ->
563
+
| Escape_sequence -> (
564
+
let c0 =
565
+
read_char state |> function `Some c -> c | _ -> assert false
566
+
in
567
+
match c0 with
568
+
| '[' ->
569
+
let c1 =
570
+
read_char state |> function
571
+
| `Some c -> c
572
+
| _ -> assert false
573
+
in
574
+
if Char.compare c1 '0' >= 0 && Char.compare c1 '9' <= 0 then
575
+
let c2 =
576
+
read_char state |> function
577
+
| `Some c -> c
578
+
| _ -> assert false
579
+
in
580
+
let c3 =
581
+
match read_char state with
582
+
| `Some c -> Some c
583
+
| (exception _) | _ -> None
584
+
in
585
+
let c4 =
586
+
match read_char state with
587
+
| `Some c -> Some c
588
+
| (exception _) | _ -> None
589
+
in
590
+
match (c2, c3) with
591
+
| ';', Some '5' -> (
592
+
match c4 with
593
+
| Some 'D' -> Editing (move_left_next_word state)
594
+
| Some 'C' -> Editing (move_right_next_word state)
595
+
| _ -> Editing state)
596
+
| _ -> Editing state
597
+
else begin
598
+
match c1 with
599
+
| 'A' -> Editing (edit_history `Prev history state)
600
+
| 'B' -> Editing (edit_history `Next history state)
601
+
| 'C' -> Editing (move_right state)
602
+
| 'D' -> Editing (move_left state)
603
+
| _ -> Editing state
604
+
end
605
+
| _ -> Editing state)
606
+
| _ ->
332
607
let state = edit_insert state uc in
333
608
Editing state))
334
609
335
610
type result = String of string option | Ctrl_c
336
611
337
-
let blocking_edit ?complete ~stdin ~stdout buf ~prompt =
338
-
let state = State.make ?complete ~prompt buf in
612
+
let blocking_edit ?complete ~history ~hint ~stdin ~stdout buf ~prompt =
613
+
let state = State.make ?complete ~hint ~prompt buf in
339
614
let res =
340
615
edit_start ~stdin ~stdout state @@ fun state ->
341
616
let rec loop = function
342
-
| Editing state -> loop (edit_feed state)
617
+
| Editing state -> loop (edit_feed ~history state)
343
618
| Finished s -> String (Option.map Bytes.to_string s)
344
619
| Ctrl_c -> Ctrl_c
345
620
in
346
-
loop (edit_feed state)
621
+
loop (edit_feed ~history state)
347
622
in
348
-
Format.printf "\n%!";
349
623
res
350
624
351
-
let bruit ?complete prompt =
625
+
type history = string -> string list
626
+
627
+
let bruit ?complete ?(history = fun _ -> []) ?(hint = fun _ -> None) prompt =
352
628
let prompt = Bytes.of_string prompt in
353
-
let buf = Bytes.create max_line in
629
+
let buf = Bytes.make max_line '\000' in
354
630
if not (Unix.isatty Unix.stdin) then failwith "Stdin is not a tty"
355
-
else blocking_edit ?complete ~stdin:Unix.stdin ~stdout:Unix.stdout buf ~prompt
631
+
else
632
+
blocking_edit ?complete ~history ~hint ~stdin:Unix.stdin ~stdout:Unix.stdout
633
+
buf ~prompt
356
634
357
635
(*
358
636
* Copyright (c) 2010-2023, Salvatore Sanfilippo <antirez at gmail dot com>
+14
-1
src/bruit.mli
+14
-1
src/bruit.mli
···
4
4
5
5
The main entry point to the library is {! bruit}. *)
6
6
7
+
type history = string -> string list
8
+
(** The history callback that provides the user with the current line and
9
+
expects a list of history items to scroll through using the arrow keys. *)
10
+
11
+
type hint = string -> (string * Fmt.style) option
12
+
(** The hint callback takes the current input and a user can return, optionally,
13
+
extra information to fill in on the current line. *)
14
+
7
15
type result = String of string option | Ctrl_c
8
16
9
-
val bruit : ?complete:(string -> string list) -> string -> result
17
+
val bruit :
18
+
?complete:(string -> string list) ->
19
+
?history:history ->
20
+
?hint:hint ->
21
+
string ->
22
+
result
10
23
(** [bruit ?complete prompt] reads from [stdin] and returns the read string if
11
24
any, and on [ctrl+c] returns {! Ctrl_c}.
12
25