gazagnaire.org
Terminal styling and layout widgets for OCaml (tables, trees, panels, colors)
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Thomas Gazagnaire. All rights reserved.
3 SPDX-License-Identifier: MIT
4 ---------------------------------------------------------------------------*)
5
6(* ANSI escape sequence detection *)
7type ansi_state = Normal | Escape | Csi
8
9let char_width uchar =
10 match Uucp.Break.tty_width_hint uchar with
11 | -1 -> 0 (* Control characters *)
12 | n -> n
13
14let string_width str =
15 let len = String.length str in
16 let width = ref 0 in
17 let state = ref Normal in
18 let decoder = Uutf.decoder ~encoding:`UTF_8 (`String str) in
19 let rec loop () =
20 match Uutf.decode decoder with
21 | `Uchar u -> (
22 let c = Uchar.to_int u in
23 match !state with
24 | Normal ->
25 if c = 0x1b then state := Escape else width := !width + char_width u;
26 loop ()
27 | Escape ->
28 if c = 0x5b (* '[' *) then state := Csi else state := Normal;
29 loop ()
30 | Csi ->
31 (* CSI sequence ends with byte in range 0x40-0x7E *)
32 if c >= 0x40 && c <= 0x7e then state := Normal;
33 loop ())
34 | `End -> ()
35 | `Await -> assert false
36 | `Malformed _ -> loop ()
37 in
38 if len = 0 then 0
39 else (
40 loop ();
41 !width)
42
43let truncate target_width str =
44 if target_width <= 0 then ""
45 else
46 let buf = Buffer.create (String.length str) in
47 let width = ref 0 in
48 let state = ref Normal in
49 let decoder = Uutf.decoder ~encoding:`UTF_8 (`String str) in
50 let rec loop () =
51 match Uutf.decode decoder with
52 | `Uchar u -> (
53 let c = Uchar.to_int u in
54 match !state with
55 | Normal ->
56 if c = 0x1b then (
57 state := Escape;
58 Uutf.Buffer.add_utf_8 buf u;
59 loop ())
60 else
61 let w = char_width u in
62 if !width + w <= target_width then (
63 width := !width + w;
64 Uutf.Buffer.add_utf_8 buf u;
65 loop ())
66 else ()
67 | Escape ->
68 Uutf.Buffer.add_utf_8 buf u;
69 if c = 0x5b then state := Csi else state := Normal;
70 loop ()
71 | Csi ->
72 Uutf.Buffer.add_utf_8 buf u;
73 if c >= 0x40 && c <= 0x7e then state := Normal;
74 loop ())
75 | `End -> ()
76 | `Await -> assert false
77 | `Malformed _ -> loop ()
78 in
79 loop ();
80 Buffer.contents buf
81
82let pad_right target_width str =
83 let str_width = string_width str in
84 if str_width >= target_width then str
85 else str ^ String.make (target_width - str_width) ' '
86
87let pad_left target_width str =
88 let str_width = string_width str in
89 if str_width >= target_width then str
90 else String.make (target_width - str_width) ' ' ^ str
91
92let center target_width str =
93 let str_width = string_width str in
94 if str_width >= target_width then str
95 else
96 let total_pad = target_width - str_width in
97 let left_pad = total_pad / 2 in
98 let right_pad = total_pad - left_pad in
99 String.make left_pad ' ' ^ str ^ String.make right_pad ' '
100
101let wrap ?(indent = 0) width text =
102 let effective = width - indent in
103 if effective <= 0 then text
104 else
105 let prefix = String.make indent ' ' in
106 let normalized =
107 text |> String.split_on_char '\n' |> List.map String.trim
108 |> String.concat " "
109 in
110 let words = String.split_on_char ' ' normalized in
111 let rec build acc line len = function
112 | [] -> if line = "" then acc else line :: acc
113 | word :: rest ->
114 let wlen = String.length word in
115 let space = if line = "" then 0 else 1 in
116 if len + space + wlen <= effective then
117 let line = if line = "" then word else line ^ " " ^ word in
118 build acc line (len + space + wlen) rest
119 else if line = "" then
120 (* Word longer than width; accept it on its own line *)
121 build (word :: acc) "" 0 rest
122 else build (line :: acc) word wlen rest
123 in
124 let lines = List.rev (build [] "" 0 words) in
125 String.concat "\n" (List.map (fun l -> prefix ^ l) lines)
126
127(* Terminal queries *)
128
129let cached_terminal_width = ref None
130
131let terminal_width () =
132 match !cached_terminal_width with
133 | Some cached -> cached
134 | None ->
135 let width =
136 let from_env =
137 match Sys.getenv_opt "COLUMNS" with
138 | Some cols -> int_of_string_opt cols
139 | None -> None
140 in
141 let from_tput () =
142 try
143 let ic = Unix.open_process_in "tput cols 2>/dev/null" in
144 let result =
145 try input_line ic |> int_of_string_opt with End_of_file -> None
146 in
147 ignore (Unix.close_process_in ic);
148 result
149 with Unix.Unix_error _ -> None
150 in
151 (* Use env if valid (> 10), otherwise try tput, fallback to 80 *)
152 match from_env with
153 | Some w when w > 10 -> w
154 | _ -> ( match from_tput () with Some w when w > 10 -> w | _ -> 80)
155 in
156 cached_terminal_width := Some width;
157 width
158
159let is_tty () = Unix.isatty Unix.stdout