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
open! Import
let malformed_string s =
Format.kasprintf invalid_arg "Terminal.Ansi: malformed UTF-8 string: %S" s
module Length_counter = struct
type t =
{ mutable acc : int
; mutable state :
[ `Normal
| `Parsing_ansi_sequence
| `Ansi_parameter_bytes ]
}
let empty () = { acc = 0; state = `Normal }
let is_initial_ansi_byte c = Char.equal c '\x1b'
let is_final_ansi_byte c =
let c = Char.code c in
c >= 0x40 && c <= 0x7e
let guess_printed_char_length c =
match Uucp.Break.tty_width_hint c with
| -1 -> 1
| n -> n
let add t c =
match Uchar.is_char c with
| false -> t.acc <- t.acc + guess_printed_char_length c
| true -> (
let c = Uchar.to_char c in
match t.state with
| `Normal ->
if is_initial_ansi_byte c then t.state <- `Parsing_ansi_sequence
else t.acc <- t.acc + 1
| `Parsing_ansi_sequence ->
if Char.equal c '[' then
t.state <- `Ansi_parameter_bytes
else t.state <- `Normal
| `Ansi_parameter_bytes ->
if is_final_ansi_byte c then t.state <- `Normal)
let count t = t.acc
end
let guess_printed_width s =
let count = Length_counter.empty () in
Uutf.String.fold_utf_8
(fun () _ -> function
| `Malformed _ -> malformed_string s
| `Uchar c -> Length_counter.add count c)
() s;
Length_counter.count count
let uchar_size u =
match Uchar.to_int u with
| u when u < 0 -> assert false
| u when u <= 0x007F -> 1
| u when u <= 0x07FF -> 2
| u when u <= 0xFFFF -> 3
| u when u <= 0x10FFFF -> 4
| _ -> assert false
exception Exit of int
let string_equal : string -> string -> bool = ( = )
let truncate_to_width width s =
if width < 0 then
Format.kasprintf invalid_arg
"Terminal.truncate_to_width: negative width %d requested" width;
let count = Length_counter.empty () in
try
Uutf.String.fold_utf_8
(fun () i -> function
| `Malformed _ -> malformed_string s
| `Uchar c ->
if Length_counter.count count = width then
let display_reset = "\027[0m" in
if
i + 4 <= String.length s
&& string_equal (String.sub s ~pos:i ~len:4) display_reset
then raise (Exit (i + 4))
else raise (Exit i)
else (
Length_counter.add count c;
let count = Length_counter.count count in
if count <= width then () else raise (Exit i)))
() s;
s
with Exit len -> String.sub s ~pos:0 ~len
let show_cursor = "\x1b[?25h"
let hide_cursor = "\x1b[?25l"
let erase_display_suffix = "\x1b[J"
let erase_line = "\x1b[K"
let move_up ppf = function 0 -> () | n -> Format.fprintf ppf "\x1b[%dA" n
let move_down ppf = function 0 -> () | n -> Format.fprintf ppf "\x1b[%dB" n