anil.recoil.org
My agentic slop goes here. Not intended for anyone else!
sync
+1832
-2598
+1
stack/kitty_graphics/.gitignore
+1
stack/kitty_graphics/.gitignore
···
1
+
_build
+2
-2
stack/kitty_graphics/dune-project
+2
-2
stack/kitty_graphics/dune-project
···
1
1
(lang dune 3.20)
2
-
(name kitty_graphics)
2
+
(name kgp)
3
3
4
4
(package
5
-
(name kitty_graphics)
5
+
(name kgp)
6
6
(synopsis "OCaml implementation of the Kitty terminal graphics protocol")
7
7
(description
8
8
"A standalone library for rendering images in terminals that support the Kitty graphics protocol. Supports image transmission, display, animation, Unicode placeholders, and terminal capability detection.")
+97
stack/kitty_graphics/example/anim_test.ml
+97
stack/kitty_graphics/example/anim_test.ml
···
1
+
(* Minimal animation test - shows exact bytes sent *)
2
+
3
+
module K = Kgp
4
+
5
+
let solid_color_rgba ~width ~height ~r ~g ~b ~a =
6
+
let pixels = Bytes.create (width * height * 4) in
7
+
for i = 0 to (width * height) - 1 do
8
+
let idx = i * 4 in
9
+
Bytes.set pixels idx (Char.chr r);
10
+
Bytes.set pixels (idx + 1) (Char.chr g);
11
+
Bytes.set pixels (idx + 2) (Char.chr b);
12
+
Bytes.set pixels (idx + 3) (Char.chr a)
13
+
done;
14
+
Bytes.to_string pixels
15
+
16
+
let send cmd ~data =
17
+
print_string (K.Command.to_string cmd ~data);
18
+
flush stdout
19
+
20
+
let () =
21
+
let width, height = 40, 40 in (* Smaller for faster testing *)
22
+
let image_id = 500 in
23
+
24
+
(* Clear any existing image *)
25
+
send (K.Command.delete ~quiet:`Errors_only (`All_visible_and_free)) ~data:"";
26
+
27
+
(* Step 1: Transmit base frame (red) *)
28
+
let red_frame = solid_color_rgba ~width ~height ~r:255 ~g:0 ~b:0 ~a:255 in
29
+
send
30
+
(K.Command.transmit
31
+
~image_id
32
+
~format:`Rgba32
33
+
~width ~height
34
+
~quiet:`Errors_only
35
+
())
36
+
~data:red_frame;
37
+
38
+
(* Step 2: Add frame (blue) *)
39
+
let blue_frame = solid_color_rgba ~width ~height ~r:0 ~g:0 ~b:255 ~a:255 in
40
+
send
41
+
(K.Command.frame
42
+
~image_id
43
+
~format:`Rgba32
44
+
~width ~height
45
+
~frame:(K.Frame.make ~gap_ms:500 ~composition:`Overwrite ())
46
+
~quiet:`Errors_only
47
+
())
48
+
~data:blue_frame;
49
+
50
+
(* Step 3: Add frame (green) *)
51
+
let green_frame = solid_color_rgba ~width ~height ~r:0 ~g:255 ~b:0 ~a:255 in
52
+
send
53
+
(K.Command.frame
54
+
~image_id
55
+
~format:`Rgba32
56
+
~width ~height
57
+
~frame:(K.Frame.make ~gap_ms:500 ~composition:`Overwrite ())
58
+
~quiet:`Errors_only
59
+
())
60
+
~data:green_frame;
61
+
62
+
(* Step 4: Create placement *)
63
+
send
64
+
(K.Command.display
65
+
~image_id
66
+
~placement:(K.Placement.make
67
+
~placement_id:1
68
+
~cursor:`Static
69
+
())
70
+
~quiet:`Errors_only
71
+
())
72
+
~data:"";
73
+
74
+
(* Step 5: Set root frame gap - IMPORTANT: root frame has no gap by default *)
75
+
send
76
+
(K.Command.animate ~image_id (K.Animation.set_gap ~frame:1 ~gap_ms:500))
77
+
~data:"";
78
+
79
+
(* Step 6: Start animation *)
80
+
send
81
+
(K.Command.animate ~image_id (K.Animation.set_state ~loops:1 `Run))
82
+
~data:"";
83
+
84
+
print_endline "";
85
+
print_endline "Animation should be playing (red -> blue -> green).";
86
+
print_endline "Press Enter to stop...";
87
+
flush stdout;
88
+
let _ = read_line () in
89
+
90
+
(* Stop animation *)
91
+
send
92
+
(K.Command.animate ~image_id (K.Animation.set_state `Stop))
93
+
~data:"";
94
+
95
+
(* Clean up *)
96
+
send (K.Command.delete ~quiet:`Errors_only (`All_visible_and_free)) ~data:"";
97
+
print_endline "Done."
+94
stack/kitty_graphics/example/debug_anim.ml
+94
stack/kitty_graphics/example/debug_anim.ml
···
1
+
(* Debug: Output animation escape sequences for comparison with Go *)
2
+
3
+
module K = Kgp
4
+
5
+
let solid_color_rgba ~width ~height ~r ~g ~b ~a =
6
+
let pixels = Bytes.create (width * height * 4) in
7
+
for i = 0 to (width * height) - 1 do
8
+
let idx = i * 4 in
9
+
Bytes.set pixels idx (Char.chr r);
10
+
Bytes.set pixels (idx + 1) (Char.chr g);
11
+
Bytes.set pixels (idx + 2) (Char.chr b);
12
+
Bytes.set pixels (idx + 3) (Char.chr a)
13
+
done;
14
+
Bytes.to_string pixels
15
+
16
+
let send cmd ~data =
17
+
let s = K.Command.to_string cmd ~data in
18
+
(* Print escaped version for debugging *)
19
+
String.iter (fun c ->
20
+
let code = Char.code c in
21
+
if code = 27 then print_string "\\x1b"
22
+
else if code < 32 || code > 126 then Printf.printf "\\x%02x" code
23
+
else print_char c
24
+
) s;
25
+
print_newline ()
26
+
27
+
let () =
28
+
let width, height = 80, 80 in
29
+
let image_id = 300 in
30
+
31
+
print_endline "=== OCaml Animation Debug ===\n";
32
+
33
+
(* Step 1: Transmit base frame *)
34
+
print_endline "1. Transmit base frame (a=t):";
35
+
let red_frame = solid_color_rgba ~width ~height ~r:255 ~g:0 ~b:0 ~a:255 in
36
+
send
37
+
(K.Command.transmit
38
+
~image_id
39
+
~format:`Rgba32
40
+
~width ~height
41
+
~quiet:`Errors_only
42
+
())
43
+
~data:red_frame;
44
+
print_newline ();
45
+
46
+
(* Step 2: Add frame *)
47
+
print_endline "2. Add frame (a=f):";
48
+
let orange_frame = solid_color_rgba ~width ~height ~r:255 ~g:165 ~b:0 ~a:255 in
49
+
send
50
+
(K.Command.frame
51
+
~image_id
52
+
~format:`Rgba32
53
+
~width ~height
54
+
~frame:(K.Frame.make ~gap_ms:100 ~composition:`Overwrite ())
55
+
~quiet:`Errors_only
56
+
())
57
+
~data:orange_frame;
58
+
print_newline ();
59
+
60
+
(* Step 3: Put/display placement *)
61
+
print_endline "3. Create placement (a=p):";
62
+
send
63
+
(K.Command.display
64
+
~image_id
65
+
~placement:(K.Placement.make
66
+
~placement_id:1
67
+
~cell_x_offset:0
68
+
~cell_y_offset:0
69
+
~cursor:`Static
70
+
())
71
+
~quiet:`Errors_only
72
+
())
73
+
~data:"";
74
+
print_newline ();
75
+
76
+
(* Step 4: Set root frame gap *)
77
+
print_endline "4. Set root frame gap (a=a,r=1,z=100):";
78
+
send
79
+
(K.Command.animate ~image_id (K.Animation.set_gap ~frame:1 ~gap_ms:100))
80
+
~data:"";
81
+
print_newline ();
82
+
83
+
(* Step 5: Animate *)
84
+
print_endline "5. Start animation (a=a,s=3,v=1):";
85
+
send
86
+
(K.Command.animate ~image_id (K.Animation.set_state ~loops:1 `Run))
87
+
~data:"";
88
+
print_newline ();
89
+
90
+
(* Step 6: Stop animation *)
91
+
print_endline "6. Stop animation:";
92
+
send
93
+
(K.Command.animate ~image_id (K.Animation.set_state `Stop))
94
+
~data:""
+17
-1
stack/kitty_graphics/example/dune
+17
-1
stack/kitty_graphics/example/dune
···
1
1
(executable
2
2
(name example)
3
-
(libraries kitty_graphics))
3
+
(libraries kgp unix))
4
+
5
+
(executable
6
+
(name debug_anim)
7
+
(libraries kgp))
8
+
9
+
(executable
10
+
(name test_output)
11
+
(libraries kgp))
12
+
13
+
(executable
14
+
(name anim_test)
15
+
(libraries kgp))
16
+
17
+
(executable
18
+
(name tiny_anim)
19
+
(libraries kgp))
+250
-60
stack/kitty_graphics/example/example.ml
+250
-60
stack/kitty_graphics/example/example.ml
···
1
-
(* Kitty Graphics Protocol Demo - Matching kgp/examples/demo workflow *)
1
+
(* Kitty Graphics Protocol Demo - Matching kgp/examples/demo *)
2
2
3
-
module K = Kitty_graphics
3
+
module K = Kgp
4
4
5
-
(* Generate a solid color RGBA frame *)
6
-
let make_solid_frame ~width ~height ~r ~g ~b =
5
+
(* Helper: Generate a solid color RGBA image *)
6
+
let solid_color_rgba ~width ~height ~r ~g ~b ~a =
7
7
let pixels = Bytes.create (width * height * 4) in
8
8
for i = 0 to (width * height) - 1 do
9
9
let idx = i * 4 in
10
10
Bytes.set pixels idx (Char.chr r);
11
11
Bytes.set pixels (idx + 1) (Char.chr g);
12
12
Bytes.set pixels (idx + 2) (Char.chr b);
13
-
Bytes.set pixels (idx + 3) '\xff'
13
+
Bytes.set pixels (idx + 3) (Char.chr a)
14
+
done;
15
+
Bytes.to_string pixels
16
+
17
+
(* Helper: Generate a solid color RGB image (no alpha) *)
18
+
let solid_color_rgb ~width ~height ~r ~g ~b =
19
+
let pixels = Bytes.create (width * height * 3) in
20
+
for i = 0 to (width * height) - 1 do
21
+
let idx = i * 3 in
22
+
Bytes.set pixels idx (Char.chr r);
23
+
Bytes.set pixels (idx + 1) (Char.chr g);
24
+
Bytes.set pixels (idx + 2) (Char.chr b)
25
+
done;
26
+
Bytes.to_string pixels
27
+
28
+
(* Helper: Generate a gradient RGBA image *)
29
+
let gradient_rgba ~width ~height =
30
+
let pixels = Bytes.create (width * height * 4) in
31
+
for y = 0 to height - 1 do
32
+
for x = 0 to width - 1 do
33
+
let idx = (y * width + x) * 4 in
34
+
let r = 255 * x / width in
35
+
let b = 255 * (width - x) / width in
36
+
Bytes.set pixels idx (Char.chr r);
37
+
Bytes.set pixels (idx + 1) (Char.chr 128);
38
+
Bytes.set pixels (idx + 2) (Char.chr b);
39
+
Bytes.set pixels (idx + 3) '\xff'
40
+
done
14
41
done;
15
42
Bytes.to_string pixels
16
43
44
+
(* Helper: Read a file *)
45
+
let read_file filename =
46
+
let ic = open_in_bin filename in
47
+
let n = in_channel_length ic in
48
+
let s = really_input_string ic n in
49
+
close_in ic;
50
+
s
51
+
17
52
let send cmd ~data =
18
53
print_string (K.Command.to_string cmd ~data);
19
54
flush stdout
···
30
65
flush stdout
31
66
32
67
let () =
68
+
let reader = stdin in
69
+
ignore reader;
70
+
33
71
clear_screen ();
34
72
print_endline "Kitty Graphics Protocol - OCaml Demo";
35
73
print_endline "=====================================";
36
74
print_newline ();
37
75
print_endline "Press Enter to proceed through each demo...";
38
76
print_newline ();
77
+
78
+
(* Demo 1: Basic formats - PNG *)
79
+
clear_screen ();
80
+
print_endline "Demo 1: Image Formats - PNG format";
81
+
(* Read sf.png and display a small portion as demo *)
82
+
(try
83
+
let png_data = read_file "sf.png" in
84
+
send
85
+
(K.Command.transmit_and_display
86
+
~image_id:1
87
+
~format:`Png
88
+
~quiet:`Errors_only
89
+
~placement:(K.Placement.make ~columns:15 ~rows:8 ())
90
+
())
91
+
~data:png_data;
92
+
print_endline "sf.png displayed using PNG format"
93
+
with _ ->
94
+
(* Fallback: red square as RGBA *)
95
+
let red_data = solid_color_rgba ~width:100 ~height:100 ~r:255 ~g:0 ~b:0 ~a:255 in
96
+
send
97
+
(K.Command.transmit_and_display
98
+
~image_id:1
99
+
~format:`Rgba32
100
+
~width:100 ~height:100
101
+
~quiet:`Errors_only
102
+
())
103
+
~data:red_data;
104
+
print_endline "Red square displayed (sf.png not found)");
105
+
print_newline ();
39
106
wait_for_enter ();
40
107
41
-
(* Demo 1: Basic RGBA format *)
108
+
(* Demo 2: Basic formats - RGBA *)
42
109
clear_screen ();
43
-
print_endline "Demo 1: Image Format - RGBA (32-bit)";
44
-
let blue_data = make_solid_frame ~width:100 ~height:100 ~r:0 ~g:0 ~b:255 in
110
+
print_endline "Demo 2: Image Formats - RGBA format (32-bit)";
111
+
let blue_data = solid_color_rgba ~width:100 ~height:100 ~r:0 ~g:0 ~b:255 ~a:255 in
45
112
send
46
113
(K.Command.transmit_and_display
47
-
~image_id:1
114
+
~image_id:2
48
115
~format:`Rgba32
49
116
~width:100 ~height:100
50
117
~quiet:`Errors_only
···
54
121
print_newline ();
55
122
wait_for_enter ();
56
123
57
-
(* Demo 2: Basic RGB format *)
124
+
(* Demo 3: Basic formats - RGB *)
58
125
clear_screen ();
59
-
print_endline "Demo 2: Image Format - RGB (24-bit)";
60
-
(* RGB is 3 bytes per pixel *)
61
-
let green_rgb =
62
-
let pixels = Bytes.create (100 * 100 * 3) in
63
-
for i = 0 to (100 * 100) - 1 do
64
-
let idx = i * 3 in
65
-
Bytes.set pixels idx '\x00'; (* R *)
66
-
Bytes.set pixels (idx + 1) '\xff'; (* G *)
67
-
Bytes.set pixels (idx + 2) '\x00' (* B *)
68
-
done;
69
-
Bytes.to_string pixels
70
-
in
126
+
print_endline "Demo 3: Image Formats - RGB format (24-bit)";
127
+
let green_data = solid_color_rgb ~width:100 ~height:100 ~r:0 ~g:255 ~b:0 in
71
128
send
72
129
(K.Command.transmit_and_display
73
-
~image_id:2
130
+
~image_id:3
74
131
~format:`Rgb24
75
132
~width:100 ~height:100
76
133
~quiet:`Errors_only
77
134
())
78
-
~data:green_rgb;
79
-
print_endline "Green square displayed using raw RGB format (no alpha)";
135
+
~data:green_data;
136
+
print_endline "Green square displayed using raw RGB format (no alpha channel)";
137
+
print_newline ();
138
+
wait_for_enter ();
139
+
140
+
(* Demo 4: Compression - Note: would need zlib library for actual compression *)
141
+
clear_screen ();
142
+
print_endline "Demo 4: Large Image (compression requires zlib library)";
143
+
let orange_data = solid_color_rgba ~width:200 ~height:200 ~r:255 ~g:165 ~b:0 ~a:255 in
144
+
send
145
+
(K.Command.transmit_and_display
146
+
~image_id:4
147
+
~format:`Rgba32
148
+
~width:200 ~height:200
149
+
~quiet:`Errors_only
150
+
())
151
+
~data:orange_data;
152
+
Printf.printf "Orange square (200x200) - %d bytes uncompressed\n" (String.length orange_data);
80
153
print_newline ();
81
154
wait_for_enter ();
82
155
83
-
(* Demo 3: Multiple placements - transmit once, display multiple times *)
156
+
(* Demo 5: Load and display external PNG file *)
84
157
clear_screen ();
85
-
print_endline "Demo 3: Multiple Placements";
86
-
let cyan_data = make_solid_frame ~width:80 ~height:80 ~r:0 ~g:255 ~b:255 in
87
-
(* Transmit only (a=t) *)
158
+
print_endline "Demo 5: Loading external PNG file (sf.png)";
159
+
(try
160
+
let png_data = read_file "sf.png" in
161
+
send
162
+
(K.Command.transmit_and_display
163
+
~image_id:10
164
+
~format:`Png
165
+
~quiet:`Errors_only
166
+
())
167
+
~data:png_data;
168
+
print_endline "sf.png loaded and displayed"
169
+
with Sys_error msg ->
170
+
Printf.printf "sf.png not found: %s\n" msg);
171
+
print_newline ();
172
+
wait_for_enter ();
173
+
174
+
(* Demo 6: Cropping and scaling *)
175
+
clear_screen ();
176
+
print_endline "Demo 6: Cropping and Scaling - Display part of an image";
177
+
let gradient = gradient_rgba ~width:200 ~height:200 in
178
+
send
179
+
(K.Command.transmit_and_display
180
+
~image_id:20
181
+
~format:`Rgba32
182
+
~width:200 ~height:200
183
+
~placement:(K.Placement.make
184
+
~source_x:50 ~source_y:50
185
+
~source_width:100 ~source_height:100
186
+
~columns:10 ~rows:10
187
+
())
188
+
~quiet:`Errors_only
189
+
())
190
+
~data:gradient;
191
+
print_endline "Cropped to center 100x100 region of a 200x200 gradient";
192
+
print_newline ();
193
+
wait_for_enter ();
194
+
195
+
(* Demo 7: Multiple placements *)
196
+
clear_screen ();
197
+
print_endline "Demo 7: Multiple Placements - One image, multiple displays";
198
+
let cyan_data = solid_color_rgba ~width:80 ~height:80 ~r:0 ~g:255 ~b:255 ~a:255 in
199
+
(* Transmit once with an ID *)
88
200
send
89
201
(K.Command.transmit
90
202
~image_id:100
···
93
205
~quiet:`Errors_only
94
206
())
95
207
~data:cyan_data;
96
-
(* Display first placement *)
208
+
(* Create first placement *)
97
209
send
98
210
(K.Command.display
99
211
~image_id:100
···
101
213
~quiet:`Errors_only
102
214
())
103
215
~data:"";
104
-
print_string " ";
105
-
(* Display second placement *)
216
+
(* Create second placement *)
106
217
send
107
218
(K.Command.display
108
219
~image_id:100
···
111
222
())
112
223
~data:"";
113
224
print_newline ();
114
-
print_endline "Same image displayed twice at different sizes";
225
+
wait_for_enter ();
226
+
227
+
(* Demo 8: Multiple placements with spacing *)
228
+
clear_screen ();
229
+
print_endline "Demo 8: Multiple Placements with Different Sizes";
230
+
print_newline ();
231
+
print_endline "Showing same image at different sizes:";
232
+
print_newline ();
233
+
(* Create a gradient square *)
234
+
let grad_small = gradient_rgba ~width:100 ~height:100 in
235
+
(* Transmit once *)
236
+
send
237
+
(K.Command.transmit
238
+
~image_id:160
239
+
~format:`Rgba32
240
+
~width:100 ~height:100
241
+
~quiet:`Errors_only
242
+
())
243
+
~data:grad_small;
244
+
(* Place same image three times at different sizes *)
245
+
send
246
+
(K.Command.display
247
+
~image_id:160
248
+
~placement:(K.Placement.make ~columns:5 ~rows:5 ())
249
+
~quiet:`Errors_only
250
+
())
251
+
~data:"";
252
+
print_string " ";
253
+
send
254
+
(K.Command.display
255
+
~image_id:160
256
+
~placement:(K.Placement.make ~columns:8 ~rows:8 ())
257
+
~quiet:`Errors_only
258
+
())
259
+
~data:"";
260
+
print_string " ";
261
+
send
262
+
(K.Command.display
263
+
~image_id:160
264
+
~placement:(K.Placement.make ~columns:12 ~rows:12 ())
265
+
~quiet:`Errors_only
266
+
())
267
+
~data:"";
268
+
print_newline ();
269
+
print_newline ();
270
+
print_endline "Small (5x5 cells), Medium (8x8 cells), Large (12x12 cells)";
115
271
print_newline ();
116
272
wait_for_enter ();
117
273
118
-
(* Demo 4: Z-index layering *)
274
+
(* Demo 9: Z-index layering *)
119
275
clear_screen ();
120
-
print_endline "Demo 4: Z-Index Layering";
121
-
let orange_data = make_solid_frame ~width:200 ~height:100 ~r:255 ~g:165 ~b:0 in
276
+
print_endline "Demo 9: Z-Index Layering - Images above/below text";
277
+
let bg_data = solid_color_rgba ~width:200 ~height:100 ~r:255 ~g:165 ~b:0 ~a:128 in
122
278
send
123
279
(K.Command.transmit_and_display
124
280
~image_id:200
···
127
283
~placement:(K.Placement.make ~z_index:(-1) ~cursor:`Static ())
128
284
~quiet:`Errors_only
129
285
())
130
-
~data:orange_data;
286
+
~data:bg_data;
131
287
print_endline "This orange square should appear behind the text!";
132
288
print_newline ();
133
289
wait_for_enter ();
134
290
135
-
(* Demo 5: Animation - matching kgp demo exactly *)
291
+
(* Demo 10: Query support *)
136
292
clear_screen ();
137
-
print_endline "Demo 5: Animation - Color-changing square";
138
-
print_endline "Creating animated sequence...";
293
+
print_endline "Demo 10: Query Support - Check terminal capabilities";
294
+
let query_str = K.Detect.make_query () in
295
+
print_string query_str;
139
296
flush stdout;
297
+
print_endline "(Check if your terminal responds with OK)";
298
+
print_newline ();
299
+
wait_for_enter ();
140
300
141
-
(* Using small size to avoid chunking - 10x10 = 400 bytes raw *)
142
-
let width, height = 10, 10 in
301
+
(* Demo 11: Animation - color-changing square *)
302
+
clear_screen ();
303
+
print_endline "Demo 11: Animation - Color-changing square";
304
+
print_endline "Creating animated sequence with 4 colors...";
305
+
306
+
let width, height = 80, 80 in
143
307
let image_id = 300 in
144
308
145
-
(* Step 1: Create base frame (red) - transmit only, don't display yet *)
146
-
let red_frame = make_solid_frame ~width ~height ~r:255 ~g:0 ~b:0 in
309
+
(* Create base frame (red) - transmit without displaying *)
310
+
let red_frame = solid_color_rgba ~width ~height ~r:255 ~g:0 ~b:0 ~a:255 in
147
311
send
148
312
(K.Command.transmit
149
313
~image_id
···
153
317
())
154
318
~data:red_frame;
155
319
156
-
(* Step 2: Add frame 2 (orange) with gap and composition replace *)
157
-
let orange_frame = make_solid_frame ~width ~height ~r:255 ~g:165 ~b:0 in
320
+
(* Add frames with composition replace *)
321
+
let orange_frame = solid_color_rgba ~width ~height ~r:255 ~g:165 ~b:0 ~a:255 in
158
322
send
159
323
(K.Command.frame
160
324
~image_id
···
165
329
())
166
330
~data:orange_frame;
167
331
168
-
(* Step 3: Add frame 3 (yellow) *)
169
-
let yellow_frame = make_solid_frame ~width ~height ~r:255 ~g:255 ~b:0 in
332
+
let yellow_frame = solid_color_rgba ~width ~height ~r:255 ~g:255 ~b:0 ~a:255 in
170
333
send
171
334
(K.Command.frame
172
335
~image_id
···
177
340
())
178
341
~data:yellow_frame;
179
342
180
-
(* Step 4: Add frame 4 (green) *)
181
-
let green_frame = make_solid_frame ~width ~height ~r:0 ~g:255 ~b:0 in
343
+
let green_frame = solid_color_rgba ~width ~height ~r:0 ~g:255 ~b:0 ~a:255 in
182
344
send
183
345
(K.Command.frame
184
346
~image_id
···
189
351
())
190
352
~data:green_frame;
191
353
192
-
(* Step 5: Create placement to display the animation *)
193
-
(* Add columns/rows to scale up the small image for visibility *)
354
+
(* Create placement and start animation *)
194
355
send
195
356
(K.Command.display
196
357
~image_id
197
358
~placement:(K.Placement.make
198
359
~placement_id:1
199
-
~columns:10
200
-
~rows:5
360
+
~cell_x_offset:0
361
+
~cell_y_offset:0
201
362
~cursor:`Static
202
363
())
203
364
~quiet:`Errors_only
204
365
())
205
366
~data:"";
206
367
207
-
(* Step 6: Start animation with infinite looping (s=3, v=1) *)
368
+
(* Set root frame gap - root frame has no gap by default per Kitty protocol *)
369
+
send
370
+
(K.Command.animate ~image_id (K.Animation.set_gap ~frame:1 ~gap_ms:100))
371
+
~data:"";
372
+
373
+
(* Start animation with infinite looping *)
208
374
send
209
375
(K.Command.animate ~image_id (K.Animation.set_state ~loops:1 `Run))
210
376
~data:"";
211
377
212
378
print_newline ();
213
-
print_endline "Animation playing: Red -> Orange -> Yellow -> Green";
379
+
print_endline "Animation playing with colors: Red -> Orange -> Yellow -> Green";
214
380
print_newline ();
215
-
wait_for_enter ();
381
+
382
+
(* Simulate movement by deleting and recreating placement at different positions *)
383
+
for i = 1 to 7 do
384
+
Unix.sleepf 0.4;
385
+
386
+
(* Delete the current placement *)
387
+
send
388
+
(K.Command.delete ~quiet:`Errors_only (`By_id (image_id, Some 1)))
389
+
~data:"";
390
+
391
+
(* Create new placement at next position *)
392
+
send
393
+
(K.Command.display
394
+
~image_id
395
+
~placement:(K.Placement.make
396
+
~placement_id:1
397
+
~cell_x_offset:(i * 5)
398
+
~cell_y_offset:0
399
+
~cursor:`Static
400
+
())
401
+
~quiet:`Errors_only
402
+
())
403
+
~data:""
404
+
done;
216
405
217
406
(* Stop the animation *)
218
407
send
···
221
410
222
411
print_endline "Animation stopped.";
223
412
print_newline ();
224
-
225
-
(* Cleanup *)
413
+
print_newline ();
226
414
print_endline "Demo complete!";
227
-
()
415
+
print_newline ();
416
+
print_endline "For more examples, see the library documentation.";
417
+
wait_for_enter ()
stack/kitty_graphics/example/sf.png
stack/kitty_graphics/example/sf.png
This is a binary file and will not be displayed.
+59
stack/kitty_graphics/example/test_output.ml
+59
stack/kitty_graphics/example/test_output.ml
···
1
+
(* Simple test to show exact escape sequences without data *)
2
+
3
+
module K = Kgp
4
+
5
+
let print_escaped s =
6
+
String.iter (fun c ->
7
+
let code = Char.code c in
8
+
if code = 27 then print_string "\\x1b"
9
+
else if code < 32 || code > 126 then Printf.printf "\\x%02x" code
10
+
else print_char c
11
+
) s;
12
+
print_newline ()
13
+
14
+
let () =
15
+
let image_id = 300 in
16
+
let width, height = 80, 80 in
17
+
18
+
print_endline "=== Animation Escape Sequences (no data) ===\n";
19
+
20
+
(* 1. Transmit base frame (no data for testing) *)
21
+
print_endline "1. Transmit (a=t):";
22
+
let cmd1 = K.Command.transmit
23
+
~image_id ~format:`Rgba32 ~width ~height ~quiet:`Errors_only () in
24
+
print_escaped (K.Command.to_string cmd1 ~data:"");
25
+
26
+
(* 2. Frame command *)
27
+
print_endline "\n2. Frame (a=f):";
28
+
let cmd2 = K.Command.frame
29
+
~image_id ~format:`Rgba32 ~width ~height
30
+
~frame:(K.Frame.make ~gap_ms:100 ~composition:`Overwrite ())
31
+
~quiet:`Errors_only () in
32
+
print_escaped (K.Command.to_string cmd2 ~data:"");
33
+
34
+
(* 3. Put/display command *)
35
+
print_endline "\n3. Display/Put (a=p):";
36
+
let cmd3 = K.Command.display
37
+
~image_id
38
+
~placement:(K.Placement.make
39
+
~placement_id:1
40
+
~cell_x_offset:0
41
+
~cell_y_offset:0
42
+
~cursor:`Static ())
43
+
~quiet:`Errors_only () in
44
+
print_escaped (K.Command.to_string cmd3 ~data:"");
45
+
46
+
(* 4. Set root frame gap - IMPORTANT for animation! *)
47
+
print_endline "\n4. Set root frame gap (a=a, r=1, z=100):";
48
+
let cmd4 = K.Command.animate ~image_id (K.Animation.set_gap ~frame:1 ~gap_ms:100) in
49
+
print_escaped (K.Command.to_string cmd4 ~data:"");
50
+
51
+
(* 5. Animate - start *)
52
+
print_endline "\n5. Animate start (a=a, s=3, v=1):";
53
+
let cmd5 = K.Command.animate ~image_id (K.Animation.set_state ~loops:1 `Run) in
54
+
print_escaped (K.Command.to_string cmd5 ~data:"");
55
+
56
+
(* 6. Animate - stop *)
57
+
print_endline "\n6. Animate stop (a=a, s=1):";
58
+
let cmd6 = K.Command.animate ~image_id (K.Animation.set_state `Stop) in
59
+
print_escaped (K.Command.to_string cmd6 ~data:"")
+108
stack/kitty_graphics/example/tiny_anim.ml
+108
stack/kitty_graphics/example/tiny_anim.ml
···
1
+
(* Tiny animation test - no chunking needed *)
2
+
(* Uses 20x20 images which are ~1067 bytes base64 (well under 4096) *)
3
+
4
+
module K = Kgp
5
+
6
+
let solid_color_rgba ~width ~height ~r ~g ~b ~a =
7
+
let pixels = Bytes.create (width * height * 4) in
8
+
for i = 0 to (width * height) - 1 do
9
+
let idx = i * 4 in
10
+
Bytes.set pixels idx (Char.chr r);
11
+
Bytes.set pixels (idx + 1) (Char.chr g);
12
+
Bytes.set pixels (idx + 2) (Char.chr b);
13
+
Bytes.set pixels (idx + 3) (Char.chr a)
14
+
done;
15
+
Bytes.to_string pixels
16
+
17
+
let send cmd ~data =
18
+
print_string (K.Command.to_string cmd ~data);
19
+
flush stdout
20
+
21
+
let () =
22
+
(* Use 20x20 to avoid chunking: 20*20*4 = 1600 bytes, base64 ~2134 bytes *)
23
+
let width, height = 20, 20 in
24
+
let image_id = 999 in
25
+
26
+
(* Clear any existing images *)
27
+
send (K.Command.delete ~quiet:`Errors_only (`All_visible_and_free)) ~data:"";
28
+
29
+
(* Step 1: Transmit base frame (red) - matching Go's sequence *)
30
+
let red_frame = solid_color_rgba ~width ~height ~r:255 ~g:0 ~b:0 ~a:255 in
31
+
send
32
+
(K.Command.transmit
33
+
~image_id
34
+
~format:`Rgba32
35
+
~width ~height
36
+
~quiet:`Errors_only
37
+
())
38
+
~data:red_frame;
39
+
40
+
(* Step 2: Add frame (orange) with 100ms gap - like Go *)
41
+
let orange_frame = solid_color_rgba ~width ~height ~r:255 ~g:165 ~b:0 ~a:255 in
42
+
send
43
+
(K.Command.frame
44
+
~image_id
45
+
~format:`Rgba32
46
+
~width ~height
47
+
~frame:(K.Frame.make ~gap_ms:100 ~composition:`Overwrite ())
48
+
~quiet:`Errors_only
49
+
())
50
+
~data:orange_frame;
51
+
52
+
(* Step 3: Add frame (yellow) *)
53
+
let yellow_frame = solid_color_rgba ~width ~height ~r:255 ~g:255 ~b:0 ~a:255 in
54
+
send
55
+
(K.Command.frame
56
+
~image_id
57
+
~format:`Rgba32
58
+
~width ~height
59
+
~frame:(K.Frame.make ~gap_ms:100 ~composition:`Overwrite ())
60
+
~quiet:`Errors_only
61
+
())
62
+
~data:yellow_frame;
63
+
64
+
(* Step 4: Add frame (green) *)
65
+
let green_frame = solid_color_rgba ~width ~height ~r:0 ~g:255 ~b:0 ~a:255 in
66
+
send
67
+
(K.Command.frame
68
+
~image_id
69
+
~format:`Rgba32
70
+
~width ~height
71
+
~frame:(K.Frame.make ~gap_ms:100 ~composition:`Overwrite ())
72
+
~quiet:`Errors_only
73
+
())
74
+
~data:green_frame;
75
+
76
+
(* Step 5: Create placement - exactly like Go *)
77
+
send
78
+
(K.Command.display
79
+
~image_id
80
+
~placement:(K.Placement.make
81
+
~placement_id:1
82
+
~cell_x_offset:0
83
+
~cell_y_offset:0
84
+
~cursor:`Static
85
+
())
86
+
~quiet:`Errors_only
87
+
())
88
+
~data:"";
89
+
90
+
(* Step 6: Start animation - exactly like Go (NO root frame gap) *)
91
+
send
92
+
(K.Command.animate ~image_id (K.Animation.set_state ~loops:1 `Run))
93
+
~data:"";
94
+
95
+
print_endline "";
96
+
print_endline "Tiny animation (20x20) - Red -> Orange -> Yellow -> Green";
97
+
print_endline "This uses no chunking. Press Enter to stop...";
98
+
flush stdout;
99
+
let _ = read_line () in
100
+
101
+
(* Stop animation *)
102
+
send
103
+
(K.Command.animate ~image_id (K.Animation.set_state `Stop))
104
+
~data:"";
105
+
106
+
(* Clean up *)
107
+
send (K.Command.delete ~quiet:`Errors_only (`All_visible_and_free)) ~data:"";
108
+
print_endline "Done."
+2
-2
stack/kitty_graphics/lib/dune
+2
-2
stack/kitty_graphics/lib/dune
+32
stack/kitty_graphics/lib/kgp.ml
+32
stack/kitty_graphics/lib/kgp.ml
···
1
+
(* Kitty Terminal Graphics Protocol
2
+
3
+
This library implements the Kitty terminal graphics protocol, allowing
4
+
OCaml programs to display images in terminals that support the protocol
5
+
(Kitty, WezTerm, Konsole, Ghostty, etc.). *)
6
+
7
+
(* Re-export types at top level *)
8
+
type format = Kgp_types.format
9
+
type transmission = Kgp_types.transmission
10
+
type compression = Kgp_types.compression
11
+
type quiet = Kgp_types.quiet
12
+
type cursor = Kgp_types.cursor
13
+
type composition = Kgp_types.composition
14
+
type delete = Kgp_types.delete
15
+
type animation_state = Kgp_types.animation_state
16
+
17
+
(* Module aliases *)
18
+
module Format = Kgp_types.Format
19
+
module Transmission = Kgp_types.Transmission
20
+
module Compression = Kgp_types.Compression
21
+
module Quiet = Kgp_types.Quiet
22
+
module Cursor = Kgp_types.Cursor
23
+
module Composition = Kgp_types.Composition
24
+
module Delete = Kgp_types.Delete
25
+
module Placement = Kgp_placement
26
+
module Frame = Kgp_frame
27
+
module Animation = Kgp_animation
28
+
module Compose = Kgp_compose
29
+
module Command = Kgp_command
30
+
module Response = Kgp_response
31
+
module Unicode_placeholder = Kgp_unicode
32
+
module Detect = Kgp_detect
+12
stack/kitty_graphics/lib/kgp_animation.ml
+12
stack/kitty_graphics/lib/kgp_animation.ml
···
1
+
(* Kitty Graphics Protocol - Animation *)
2
+
3
+
type state = Kgp_types.animation_state
4
+
5
+
type t =
6
+
[ `Set_state of state * int option
7
+
| `Set_gap of int * int
8
+
| `Set_current of int ]
9
+
10
+
let set_state ?loops state = `Set_state (state, loops)
11
+
let set_gap ~frame ~gap_ms = `Set_gap (frame, gap_ms)
12
+
let set_current_frame frame = `Set_current frame
+21
stack/kitty_graphics/lib/kgp_animation.mli
+21
stack/kitty_graphics/lib/kgp_animation.mli
···
1
+
(** Kitty Graphics Protocol - Animation *)
2
+
3
+
type state = Kgp_types.animation_state
4
+
5
+
type t =
6
+
[ `Set_state of state * int option
7
+
| `Set_gap of int * int
8
+
| `Set_current of int ]
9
+
(** Animation control operations. *)
10
+
11
+
val set_state : ?loops:int -> state -> t
12
+
(** Set animation state.
13
+
@param loops Number of loops: 0 = ignored, 1 = infinite, n = n-1 loops *)
14
+
15
+
val set_gap : frame:int -> gap_ms:int -> t
16
+
(** Set the gap (delay) for a specific frame.
17
+
@param frame 1-based frame number
18
+
@param gap_ms Delay in milliseconds (negative = gapless) *)
19
+
20
+
val set_current_frame : int -> t
21
+
(** Make a specific frame (1-based) the current displayed frame. *)
+332
stack/kitty_graphics/lib/kgp_command.ml
+332
stack/kitty_graphics/lib/kgp_command.ml
···
1
+
(* Kitty Graphics Protocol - Command *)
2
+
3
+
type action =
4
+
[ `Transmit
5
+
| `Transmit_and_display
6
+
| `Query
7
+
| `Display
8
+
| `Delete
9
+
| `Frame
10
+
| `Animate
11
+
| `Compose ]
12
+
13
+
type t = {
14
+
action : action;
15
+
format : Kgp_types.format option;
16
+
transmission : Kgp_types.transmission option;
17
+
compression : Kgp_types.compression option;
18
+
width : int option;
19
+
height : int option;
20
+
size : int option;
21
+
offset : int option;
22
+
quiet : Kgp_types.quiet option;
23
+
image_id : int option;
24
+
image_number : int option;
25
+
placement : Kgp_placement.t option;
26
+
delete : Kgp_types.delete option;
27
+
frame : Kgp_frame.t option;
28
+
animation : Kgp_animation.t option;
29
+
compose : Kgp_compose.t option;
30
+
}
31
+
32
+
let make action =
33
+
{
34
+
action;
35
+
format = None;
36
+
transmission = None;
37
+
compression = None;
38
+
width = None;
39
+
height = None;
40
+
size = None;
41
+
offset = None;
42
+
quiet = None;
43
+
image_id = None;
44
+
image_number = None;
45
+
placement = None;
46
+
delete = None;
47
+
frame = None;
48
+
animation = None;
49
+
compose = None;
50
+
}
51
+
52
+
let transmit ?image_id ?image_number ?format ?transmission ?compression ?width
53
+
?height ?size ?offset ?quiet () =
54
+
{
55
+
(make `Transmit) with
56
+
image_id;
57
+
image_number;
58
+
format;
59
+
transmission;
60
+
compression;
61
+
width;
62
+
height;
63
+
size;
64
+
offset;
65
+
quiet;
66
+
}
67
+
68
+
let transmit_and_display ?image_id ?image_number ?format ?transmission
69
+
?compression ?width ?height ?size ?offset ?quiet ?placement () =
70
+
{
71
+
(make `Transmit_and_display) with
72
+
image_id;
73
+
image_number;
74
+
format;
75
+
transmission;
76
+
compression;
77
+
width;
78
+
height;
79
+
size;
80
+
offset;
81
+
quiet;
82
+
placement;
83
+
}
84
+
85
+
let query ?format ?transmission ?width ?height ?quiet () =
86
+
{ (make `Query) with format; transmission; width; height; quiet }
87
+
88
+
let display ?image_id ?image_number ?placement ?quiet () =
89
+
{ (make `Display) with image_id; image_number; placement; quiet }
90
+
91
+
let delete ?quiet del = { (make `Delete) with quiet; delete = Some del }
92
+
93
+
let frame ?image_id ?image_number ?format ?transmission ?compression ?width
94
+
?height ?quiet ~frame () =
95
+
{
96
+
(make `Frame) with
97
+
image_id;
98
+
image_number;
99
+
format;
100
+
transmission;
101
+
compression;
102
+
width;
103
+
height;
104
+
quiet;
105
+
frame = Some frame;
106
+
}
107
+
108
+
let animate ?image_id ?image_number ?quiet anim =
109
+
{ (make `Animate) with image_id; image_number; quiet; animation = Some anim }
110
+
111
+
let compose ?image_id ?image_number ?quiet comp =
112
+
{ (make `Compose) with image_id; image_number; quiet; compose = Some comp }
113
+
114
+
(* Serialization helpers *)
115
+
let apc_start = "\027_G"
116
+
let apc_end = "\027\\"
117
+
118
+
(* Key-value writer with separator handling *)
119
+
type kv_writer = { mutable first : bool; buf : Buffer.t }
120
+
121
+
let kv_writer buf = { first = true; buf }
122
+
123
+
let kv w key value =
124
+
if not w.first then Buffer.add_char w.buf ',';
125
+
w.first <- false;
126
+
Buffer.add_char w.buf key;
127
+
Buffer.add_char w.buf '=';
128
+
Buffer.add_string w.buf value
129
+
130
+
let kv_int w key value = kv w key (string_of_int value)
131
+
let kv_int32 w key value = kv w key (Int32.to_string value)
132
+
let kv_char w key value = kv w key (String.make 1 value)
133
+
134
+
(* Conditional writers using Option.iter *)
135
+
let kv_int_opt w key = Option.iter (kv_int w key)
136
+
let kv_int32_opt w key = Option.iter (kv_int32 w key)
137
+
138
+
let kv_int_if w key ~default opt =
139
+
Option.iter (fun v -> if v <> default then kv_int w key v) opt
140
+
141
+
let action_char : action -> char = function
142
+
| `Transmit -> 't'
143
+
| `Transmit_and_display -> 'T'
144
+
| `Query -> 'q'
145
+
| `Display -> 'p'
146
+
| `Delete -> 'd'
147
+
| `Frame -> 'f'
148
+
| `Animate -> 'a'
149
+
| `Compose -> 'c'
150
+
151
+
let delete_char : Kgp_types.delete -> char = function
152
+
| `All_visible -> 'a'
153
+
| `All_visible_and_free -> 'A'
154
+
| `By_id _ -> 'i'
155
+
| `By_id_and_free _ -> 'I'
156
+
| `By_number _ -> 'n'
157
+
| `By_number_and_free _ -> 'N'
158
+
| `At_cursor -> 'c'
159
+
| `At_cursor_and_free -> 'C'
160
+
| `At_cell _ -> 'p'
161
+
| `At_cell_and_free _ -> 'P'
162
+
| `At_cell_z _ -> 'q'
163
+
| `At_cell_z_and_free _ -> 'Q'
164
+
| `By_column _ -> 'x'
165
+
| `By_column_and_free _ -> 'X'
166
+
| `By_row _ -> 'y'
167
+
| `By_row_and_free _ -> 'Y'
168
+
| `By_z_index _ -> 'z'
169
+
| `By_z_index_and_free _ -> 'Z'
170
+
| `By_id_range _ -> 'r'
171
+
| `By_id_range_and_free _ -> 'R'
172
+
| `Frames -> 'f'
173
+
| `Frames_and_free -> 'F'
174
+
175
+
let write_placement w (p : Kgp_placement.t) =
176
+
kv_int_opt w 'x' p.source_x;
177
+
kv_int_opt w 'y' p.source_y;
178
+
kv_int_opt w 'w' p.source_width;
179
+
kv_int_opt w 'h' p.source_height;
180
+
kv_int_opt w 'X' p.cell_x_offset;
181
+
kv_int_opt w 'Y' p.cell_y_offset;
182
+
kv_int_opt w 'c' p.columns;
183
+
kv_int_opt w 'r' p.rows;
184
+
kv_int_opt w 'z' p.z_index;
185
+
kv_int_opt w 'p' p.placement_id;
186
+
p.cursor
187
+
|> Option.iter (fun c ->
188
+
kv_int_if w 'C' ~default:0 (Some (Kgp_types.Cursor.to_int c)));
189
+
if p.unicode_placeholder then kv_int w 'U' 1
190
+
191
+
let write_delete w (d : Kgp_types.delete) =
192
+
kv_char w 'd' (delete_char d);
193
+
match d with
194
+
| `By_id (id, pid) | `By_id_and_free (id, pid) ->
195
+
kv_int w 'i' id;
196
+
kv_int_opt w 'p' pid
197
+
| `By_number (n, pid) | `By_number_and_free (n, pid) ->
198
+
kv_int w 'I' n;
199
+
kv_int_opt w 'p' pid
200
+
| `At_cell (x, y) | `At_cell_and_free (x, y) ->
201
+
kv_int w 'x' x;
202
+
kv_int w 'y' y
203
+
| `At_cell_z (x, y, z) | `At_cell_z_and_free (x, y, z) ->
204
+
kv_int w 'x' x;
205
+
kv_int w 'y' y;
206
+
kv_int w 'z' z
207
+
| `By_column c | `By_column_and_free c -> kv_int w 'x' c
208
+
| `By_row r | `By_row_and_free r -> kv_int w 'y' r
209
+
| `By_z_index z | `By_z_index_and_free z -> kv_int w 'z' z
210
+
| `By_id_range (min_id, max_id) | `By_id_range_and_free (min_id, max_id) ->
211
+
kv_int w 'x' min_id;
212
+
kv_int w 'y' max_id
213
+
| `All_visible | `All_visible_and_free | `At_cursor | `At_cursor_and_free
214
+
| `Frames | `Frames_and_free ->
215
+
()
216
+
217
+
let write_frame w (f : Kgp_frame.t) =
218
+
kv_int_opt w 'x' f.x;
219
+
kv_int_opt w 'y' f.y;
220
+
kv_int_opt w 'c' f.base_frame;
221
+
kv_int_opt w 'r' f.edit_frame;
222
+
kv_int_opt w 'z' f.gap_ms;
223
+
f.composition
224
+
|> Option.iter (fun c ->
225
+
kv_int_if w 'X' ~default:0 (Some (Kgp_types.Composition.to_int c)));
226
+
kv_int32_opt w 'Y' f.background_color
227
+
228
+
let write_animation w : Kgp_animation.t -> unit = function
229
+
| `Set_state (state, loops) ->
230
+
let s = match state with `Stop -> 1 | `Loading -> 2 | `Run -> 3 in
231
+
kv_int w 's' s;
232
+
kv_int_opt w 'v' loops
233
+
| `Set_gap (frame, gap_ms) ->
234
+
kv_int w 'r' frame;
235
+
kv_int w 'z' gap_ms
236
+
| `Set_current frame -> kv_int w 'c' frame
237
+
238
+
let write_compose w (c : Kgp_compose.t) =
239
+
kv_int w 'r' c.source_frame;
240
+
kv_int w 'c' c.dest_frame;
241
+
kv_int_opt w 'w' c.width;
242
+
kv_int_opt w 'h' c.height;
243
+
kv_int_opt w 'x' c.dest_x;
244
+
kv_int_opt w 'y' c.dest_y;
245
+
kv_int_opt w 'X' c.source_x;
246
+
kv_int_opt w 'Y' c.source_y;
247
+
c.composition
248
+
|> Option.iter (fun comp ->
249
+
kv_int_if w 'C' ~default:0 (Some (Kgp_types.Composition.to_int comp)))
250
+
251
+
let write_control_data buf cmd =
252
+
let w = kv_writer buf in
253
+
(* Action *)
254
+
kv_char w 'a' (action_char cmd.action);
255
+
(* Quiet - only if non-default *)
256
+
cmd.quiet
257
+
|> Option.iter (fun q ->
258
+
kv_int_if w 'q' ~default:0 (Some (Kgp_types.Quiet.to_int q)));
259
+
(* Format *)
260
+
cmd.format
261
+
|> Option.iter (fun f -> kv_int w 'f' (Kgp_types.Format.to_int f));
262
+
(* Transmission - only for transmit/frame actions, always include t=d for compatibility *)
263
+
(match cmd.action with
264
+
| `Transmit | `Transmit_and_display | `Frame -> (
265
+
match cmd.transmission with
266
+
| Some t -> kv_char w 't' (Kgp_types.Transmission.to_char t)
267
+
| None -> kv_char w 't' 'd')
268
+
| _ -> ());
269
+
(* Compression *)
270
+
cmd.compression
271
+
|> Option.iter (fun c ->
272
+
Kgp_types.Compression.to_char c |> Option.iter (kv_char w 'o'));
273
+
(* Dimensions *)
274
+
kv_int_opt w 's' cmd.width;
275
+
kv_int_opt w 'v' cmd.height;
276
+
(* File size/offset *)
277
+
kv_int_opt w 'S' cmd.size;
278
+
kv_int_opt w 'O' cmd.offset;
279
+
(* Image ID/number *)
280
+
kv_int_opt w 'i' cmd.image_id;
281
+
kv_int_opt w 'I' cmd.image_number;
282
+
(* Complex options *)
283
+
cmd.placement |> Option.iter (write_placement w);
284
+
cmd.delete |> Option.iter (write_delete w);
285
+
cmd.frame |> Option.iter (write_frame w);
286
+
cmd.animation |> Option.iter (write_animation w);
287
+
cmd.compose |> Option.iter (write_compose w);
288
+
w
289
+
290
+
(* Use large chunk size to avoid chunking - Kitty animation doesn't handle chunks well *)
291
+
let chunk_size = 1024 * 1024 (* 1MB - effectively no chunking *)
292
+
293
+
let write buf cmd ~data =
294
+
Buffer.add_string buf apc_start;
295
+
let w = write_control_data buf cmd in
296
+
if String.length data > 0 then begin
297
+
let encoded = Base64.encode_string data in
298
+
let len = String.length encoded in
299
+
if len <= chunk_size then (
300
+
Buffer.add_char buf ';';
301
+
Buffer.add_string buf encoded;
302
+
Buffer.add_string buf apc_end)
303
+
else begin
304
+
(* Multiple chunks *)
305
+
let rec write_chunks pos first =
306
+
if pos < len then begin
307
+
let remaining = len - pos in
308
+
let this_chunk = min chunk_size remaining in
309
+
let is_last = pos + this_chunk >= len in
310
+
if first then (
311
+
kv_int w 'm' 1;
312
+
Buffer.add_char buf ';';
313
+
Buffer.add_substring buf encoded pos this_chunk;
314
+
Buffer.add_string buf apc_end)
315
+
else (
316
+
Buffer.add_string buf apc_start;
317
+
Buffer.add_string buf (if is_last then "m=0" else "m=1");
318
+
Buffer.add_char buf ';';
319
+
Buffer.add_substring buf encoded pos this_chunk;
320
+
Buffer.add_string buf apc_end);
321
+
write_chunks (pos + this_chunk) false
322
+
end
323
+
in
324
+
write_chunks 0 true
325
+
end
326
+
end
327
+
else Buffer.add_string buf apc_end
328
+
329
+
let to_string cmd ~data =
330
+
let buf = Buffer.create 1024 in
331
+
write buf cmd ~data;
332
+
Buffer.contents buf
+113
stack/kitty_graphics/lib/kgp_command.mli
+113
stack/kitty_graphics/lib/kgp_command.mli
···
1
+
(** Kitty Graphics Protocol - Command *)
2
+
3
+
type action =
4
+
[ `Transmit
5
+
| `Transmit_and_display
6
+
| `Query
7
+
| `Display
8
+
| `Delete
9
+
| `Frame
10
+
| `Animate
11
+
| `Compose ]
12
+
13
+
type t
14
+
(** A graphics protocol command. *)
15
+
16
+
(** {2 Image Transmission} *)
17
+
18
+
val transmit :
19
+
?image_id:int ->
20
+
?image_number:int ->
21
+
?format:Kgp_types.format ->
22
+
?transmission:Kgp_types.transmission ->
23
+
?compression:Kgp_types.compression ->
24
+
?width:int ->
25
+
?height:int ->
26
+
?size:int ->
27
+
?offset:int ->
28
+
?quiet:Kgp_types.quiet ->
29
+
unit ->
30
+
t
31
+
(** Transmit image data without displaying. *)
32
+
33
+
val transmit_and_display :
34
+
?image_id:int ->
35
+
?image_number:int ->
36
+
?format:Kgp_types.format ->
37
+
?transmission:Kgp_types.transmission ->
38
+
?compression:Kgp_types.compression ->
39
+
?width:int ->
40
+
?height:int ->
41
+
?size:int ->
42
+
?offset:int ->
43
+
?quiet:Kgp_types.quiet ->
44
+
?placement:Kgp_placement.t ->
45
+
unit ->
46
+
t
47
+
(** Transmit image data and display it immediately. *)
48
+
49
+
val query :
50
+
?format:Kgp_types.format ->
51
+
?transmission:Kgp_types.transmission ->
52
+
?width:int ->
53
+
?height:int ->
54
+
?quiet:Kgp_types.quiet ->
55
+
unit ->
56
+
t
57
+
(** Query terminal support without storing the image. *)
58
+
59
+
(** {2 Display} *)
60
+
61
+
val display :
62
+
?image_id:int ->
63
+
?image_number:int ->
64
+
?placement:Kgp_placement.t ->
65
+
?quiet:Kgp_types.quiet ->
66
+
unit ->
67
+
t
68
+
(** Display a previously transmitted image. *)
69
+
70
+
(** {2 Deletion} *)
71
+
72
+
val delete : ?quiet:Kgp_types.quiet -> Kgp_types.delete -> t
73
+
(** Delete images or placements. *)
74
+
75
+
(** {2 Animation} *)
76
+
77
+
val frame :
78
+
?image_id:int ->
79
+
?image_number:int ->
80
+
?format:Kgp_types.format ->
81
+
?transmission:Kgp_types.transmission ->
82
+
?compression:Kgp_types.compression ->
83
+
?width:int ->
84
+
?height:int ->
85
+
?quiet:Kgp_types.quiet ->
86
+
frame:Kgp_frame.t ->
87
+
unit ->
88
+
t
89
+
(** Transmit animation frame data. *)
90
+
91
+
val animate :
92
+
?image_id:int ->
93
+
?image_number:int ->
94
+
?quiet:Kgp_types.quiet ->
95
+
Kgp_animation.t ->
96
+
t
97
+
(** Control animation playback. *)
98
+
99
+
val compose :
100
+
?image_id:int ->
101
+
?image_number:int ->
102
+
?quiet:Kgp_types.quiet ->
103
+
Kgp_compose.t ->
104
+
t
105
+
(** Compose animation frames. *)
106
+
107
+
(** {2 Output} *)
108
+
109
+
val write : Buffer.t -> t -> data:string -> unit
110
+
(** Write the command to a buffer. *)
111
+
112
+
val to_string : t -> data:string -> string
113
+
(** Convert command to a string. *)
+27
stack/kitty_graphics/lib/kgp_compose.ml
+27
stack/kitty_graphics/lib/kgp_compose.ml
···
1
+
(* Kitty Graphics Protocol - Compose *)
2
+
3
+
type t = {
4
+
source_frame : int;
5
+
dest_frame : int;
6
+
width : int option;
7
+
height : int option;
8
+
source_x : int option;
9
+
source_y : int option;
10
+
dest_x : int option;
11
+
dest_y : int option;
12
+
composition : Kgp_types.composition option;
13
+
}
14
+
15
+
let make ~source_frame ~dest_frame ?width ?height ?source_x ?source_y ?dest_x
16
+
?dest_y ?composition () =
17
+
{
18
+
source_frame;
19
+
dest_frame;
20
+
width;
21
+
height;
22
+
source_x;
23
+
source_y;
24
+
dest_x;
25
+
dest_y;
26
+
composition;
27
+
}
+27
stack/kitty_graphics/lib/kgp_compose.mli
+27
stack/kitty_graphics/lib/kgp_compose.mli
···
1
+
(** Kitty Graphics Protocol - Compose *)
2
+
3
+
type t = {
4
+
source_frame : int;
5
+
dest_frame : int;
6
+
width : int option;
7
+
height : int option;
8
+
source_x : int option;
9
+
source_y : int option;
10
+
dest_x : int option;
11
+
dest_y : int option;
12
+
composition : Kgp_types.composition option;
13
+
}
14
+
15
+
val make :
16
+
source_frame:int ->
17
+
dest_frame:int ->
18
+
?width:int ->
19
+
?height:int ->
20
+
?source_x:int ->
21
+
?source_y:int ->
22
+
?dest_x:int ->
23
+
?dest_y:int ->
24
+
?composition:Kgp_types.composition ->
25
+
unit ->
26
+
t
27
+
(** Compose a rectangle from one frame onto another. *)
+13
stack/kitty_graphics/lib/kgp_detect.ml
+13
stack/kitty_graphics/lib/kgp_detect.ml
···
1
+
(* Kitty Graphics Protocol - Detection *)
2
+
3
+
let make_query () =
4
+
(* Query without DA1 suffix - matches Go's QuerySupport() *)
5
+
let cmd =
6
+
Kgp_command.query ~format:`Rgb24 ~transmission:`Direct ~width:1 ~height:1 ()
7
+
in
8
+
Kgp_command.to_string cmd ~data:"\x00\x00\x00"
9
+
10
+
let supports_graphics response ~da1_received =
11
+
response
12
+
|> Option.map Kgp_response.is_ok
13
+
|> Option.value ~default:(not da1_received)
+7
stack/kitty_graphics/lib/kgp_detect.mli
+7
stack/kitty_graphics/lib/kgp_detect.mli
···
1
+
(** Kitty Graphics Protocol - Terminal Detection *)
2
+
3
+
val make_query : unit -> string
4
+
(** Generate a query command to test graphics support. *)
5
+
6
+
val supports_graphics : Kgp_response.t option -> da1_received:bool -> bool
7
+
(** Determine if graphics are supported based on query results. *)
+26
stack/kitty_graphics/lib/kgp_frame.ml
+26
stack/kitty_graphics/lib/kgp_frame.ml
···
1
+
(* Kitty Graphics Protocol - Frame *)
2
+
3
+
type t = {
4
+
x : int option;
5
+
y : int option;
6
+
base_frame : int option;
7
+
edit_frame : int option;
8
+
gap_ms : int option;
9
+
composition : Kgp_types.composition option;
10
+
background_color : int32 option;
11
+
}
12
+
13
+
let empty =
14
+
{
15
+
x = None;
16
+
y = None;
17
+
base_frame = None;
18
+
edit_frame = None;
19
+
gap_ms = None;
20
+
composition = None;
21
+
background_color = None;
22
+
}
23
+
24
+
let make ?x ?y ?base_frame ?edit_frame ?gap_ms ?composition ?background_color
25
+
() =
26
+
{ x; y; base_frame; edit_frame; gap_ms; composition; background_color }
+34
stack/kitty_graphics/lib/kgp_frame.mli
+34
stack/kitty_graphics/lib/kgp_frame.mli
···
1
+
(** Kitty Graphics Protocol - Frame *)
2
+
3
+
type t = {
4
+
x : int option;
5
+
y : int option;
6
+
base_frame : int option;
7
+
edit_frame : int option;
8
+
gap_ms : int option;
9
+
composition : Kgp_types.composition option;
10
+
background_color : int32 option;
11
+
}
12
+
13
+
val empty : t
14
+
(** Empty frame spec with defaults. *)
15
+
16
+
val make :
17
+
?x:int ->
18
+
?y:int ->
19
+
?base_frame:int ->
20
+
?edit_frame:int ->
21
+
?gap_ms:int ->
22
+
?composition:Kgp_types.composition ->
23
+
?background_color:int32 ->
24
+
unit ->
25
+
t
26
+
(** Create a frame specification.
27
+
28
+
@param x Left edge where frame data is placed (pixels)
29
+
@param y Top edge where frame data is placed (pixels)
30
+
@param base_frame 1-based frame number to use as background canvas
31
+
@param edit_frame 1-based frame number to edit (0 = new frame)
32
+
@param gap_ms Delay before next frame in milliseconds
33
+
@param composition How to blend pixels onto the canvas
34
+
@param background_color 32-bit RGBA background when no base frame *)
+50
stack/kitty_graphics/lib/kgp_placement.ml
+50
stack/kitty_graphics/lib/kgp_placement.ml
···
1
+
(* Kitty Graphics Protocol - Placement *)
2
+
3
+
type t = {
4
+
source_x : int option;
5
+
source_y : int option;
6
+
source_width : int option;
7
+
source_height : int option;
8
+
cell_x_offset : int option;
9
+
cell_y_offset : int option;
10
+
columns : int option;
11
+
rows : int option;
12
+
z_index : int option;
13
+
placement_id : int option;
14
+
cursor : Kgp_types.cursor option;
15
+
unicode_placeholder : bool;
16
+
}
17
+
18
+
let empty =
19
+
{
20
+
source_x = None;
21
+
source_y = None;
22
+
source_width = None;
23
+
source_height = None;
24
+
cell_x_offset = None;
25
+
cell_y_offset = None;
26
+
columns = None;
27
+
rows = None;
28
+
z_index = None;
29
+
placement_id = None;
30
+
cursor = None;
31
+
unicode_placeholder = false;
32
+
}
33
+
34
+
let make ?source_x ?source_y ?source_width ?source_height ?cell_x_offset
35
+
?cell_y_offset ?columns ?rows ?z_index ?placement_id ?cursor
36
+
?(unicode_placeholder = false) () =
37
+
{
38
+
source_x;
39
+
source_y;
40
+
source_width;
41
+
source_height;
42
+
cell_x_offset;
43
+
cell_y_offset;
44
+
columns;
45
+
rows;
46
+
z_index;
47
+
placement_id;
48
+
cursor;
49
+
unicode_placeholder;
50
+
}
+49
stack/kitty_graphics/lib/kgp_placement.mli
+49
stack/kitty_graphics/lib/kgp_placement.mli
···
1
+
(** Kitty Graphics Protocol - Placement *)
2
+
3
+
type t = {
4
+
source_x : int option;
5
+
source_y : int option;
6
+
source_width : int option;
7
+
source_height : int option;
8
+
cell_x_offset : int option;
9
+
cell_y_offset : int option;
10
+
columns : int option;
11
+
rows : int option;
12
+
z_index : int option;
13
+
placement_id : int option;
14
+
cursor : Kgp_types.cursor option;
15
+
unicode_placeholder : bool;
16
+
}
17
+
18
+
val empty : t
19
+
(** Empty placement with all defaults. *)
20
+
21
+
val make :
22
+
?source_x:int ->
23
+
?source_y:int ->
24
+
?source_width:int ->
25
+
?source_height:int ->
26
+
?cell_x_offset:int ->
27
+
?cell_y_offset:int ->
28
+
?columns:int ->
29
+
?rows:int ->
30
+
?z_index:int ->
31
+
?placement_id:int ->
32
+
?cursor:Kgp_types.cursor ->
33
+
?unicode_placeholder:bool ->
34
+
unit ->
35
+
t
36
+
(** Create a placement configuration.
37
+
38
+
@param source_x Left edge of source rectangle in pixels (default 0)
39
+
@param source_y Top edge of source rectangle in pixels (default 0)
40
+
@param source_width Width of source rectangle (default: full width)
41
+
@param source_height Height of source rectangle (default: full height)
42
+
@param cell_x_offset X offset within the first cell in pixels
43
+
@param cell_y_offset Y offset within the first cell in pixels
44
+
@param columns Number of columns to display over (scales image)
45
+
@param rows Number of rows to display over (scales image)
46
+
@param z_index Stacking order (negative = under text)
47
+
@param placement_id Unique ID for this placement
48
+
@param cursor Cursor movement policy after display
49
+
@param unicode_placeholder Create virtual placement for Unicode mode *)
+56
stack/kitty_graphics/lib/kgp_response.ml
+56
stack/kitty_graphics/lib/kgp_response.ml
···
1
+
(* Kitty Graphics Protocol - Response *)
2
+
3
+
type t = {
4
+
message : string;
5
+
image_id : int option;
6
+
image_number : int option;
7
+
placement_id : int option;
8
+
}
9
+
10
+
let is_ok t = t.message = "OK"
11
+
let message t = t.message
12
+
13
+
let error_code t =
14
+
if is_ok t then None
15
+
else
16
+
String.index_opt t.message ':'
17
+
|> Option.fold ~none:(Some t.message) ~some:(fun i ->
18
+
Some (String.sub t.message 0 i))
19
+
20
+
let image_id t = t.image_id
21
+
let image_number t = t.image_number
22
+
let placement_id t = t.placement_id
23
+
24
+
let parse s =
25
+
let ( let* ) = Option.bind in
26
+
let esc = '\027' in
27
+
let len = String.length s in
28
+
let* () =
29
+
if len >= 5 && s.[0] = esc && s.[1] = '_' && s.[2] = 'G' then Some ()
30
+
else None
31
+
in
32
+
let* semi_pos = String.index_from_opt s 3 ';' in
33
+
let rec find_end pos =
34
+
if pos + 1 < len && s.[pos] = esc && s.[pos + 1] = '\\' then Some pos
35
+
else if pos + 1 < len then find_end (pos + 1)
36
+
else None
37
+
in
38
+
let* end_pos = find_end (semi_pos + 1) in
39
+
let keys_str = String.sub s 3 (semi_pos - 3) in
40
+
let message = String.sub s (semi_pos + 1) (end_pos - semi_pos - 1) in
41
+
let parse_kv part =
42
+
if String.length part >= 3 && part.[1] = '=' then
43
+
Some (part.[0], String.sub part 2 (String.length part - 2))
44
+
else None
45
+
in
46
+
let keys = String.split_on_char ',' keys_str |> List.filter_map parse_kv in
47
+
let find_int key =
48
+
List.assoc_opt key keys |> Fun.flip Option.bind int_of_string_opt
49
+
in
50
+
Some
51
+
{
52
+
message;
53
+
image_id = find_int 'i';
54
+
image_number = find_int 'I';
55
+
placement_id = find_int 'p';
56
+
}
+25
stack/kitty_graphics/lib/kgp_response.mli
+25
stack/kitty_graphics/lib/kgp_response.mli
···
1
+
(** Kitty Graphics Protocol - Response Parsing *)
2
+
3
+
type t
4
+
(** A parsed terminal response. *)
5
+
6
+
val parse : string -> t option
7
+
(** Parse a response from terminal output. *)
8
+
9
+
val is_ok : t -> bool
10
+
(** Check if the response indicates success. *)
11
+
12
+
val message : t -> string
13
+
(** Get the response message. *)
14
+
15
+
val error_code : t -> string option
16
+
(** Extract the error code if this is an error response. *)
17
+
18
+
val image_id : t -> int option
19
+
(** Get the image ID from the response. *)
20
+
21
+
val image_number : t -> int option
22
+
(** Get the image number from the response. *)
23
+
24
+
val placement_id : t -> int option
25
+
(** Get the placement ID from the response. *)
+89
stack/kitty_graphics/lib/kgp_types.ml
+89
stack/kitty_graphics/lib/kgp_types.ml
···
1
+
(* Kitty Graphics Protocol - Types *)
2
+
3
+
type format = [ `Rgba32 | `Rgb24 | `Png ]
4
+
type transmission = [ `Direct | `File | `Tempfile ]
5
+
type compression = [ `None | `Zlib ]
6
+
type quiet = [ `Noisy | `Errors_only | `Silent ]
7
+
type cursor = [ `Move | `Static ]
8
+
type composition = [ `Alpha_blend | `Overwrite ]
9
+
10
+
type delete =
11
+
[ `All_visible
12
+
| `All_visible_and_free
13
+
| `By_id of int * int option
14
+
| `By_id_and_free of int * int option
15
+
| `By_number of int * int option
16
+
| `By_number_and_free of int * int option
17
+
| `At_cursor
18
+
| `At_cursor_and_free
19
+
| `At_cell of int * int
20
+
| `At_cell_and_free of int * int
21
+
| `At_cell_z of int * int * int
22
+
| `At_cell_z_and_free of int * int * int
23
+
| `By_column of int
24
+
| `By_column_and_free of int
25
+
| `By_row of int
26
+
| `By_row_and_free of int
27
+
| `By_z_index of int
28
+
| `By_z_index_and_free of int
29
+
| `By_id_range of int * int
30
+
| `By_id_range_and_free of int * int
31
+
| `Frames
32
+
| `Frames_and_free ]
33
+
34
+
type animation_state = [ `Stop | `Loading | `Run ]
35
+
36
+
module Format = struct
37
+
type t = format
38
+
39
+
let to_int : t -> int = function
40
+
| `Rgba32 -> 32
41
+
| `Rgb24 -> 24
42
+
| `Png -> 100
43
+
end
44
+
45
+
module Transmission = struct
46
+
type t = transmission
47
+
48
+
let to_char : t -> char = function
49
+
| `Direct -> 'd'
50
+
| `File -> 'f'
51
+
| `Tempfile -> 't'
52
+
end
53
+
54
+
module Compression = struct
55
+
type t = compression
56
+
57
+
let to_char : t -> char option = function
58
+
| `None -> None
59
+
| `Zlib -> Some 'z'
60
+
end
61
+
62
+
module Quiet = struct
63
+
type t = quiet
64
+
65
+
let to_int : t -> int = function
66
+
| `Noisy -> 0
67
+
| `Errors_only -> 1
68
+
| `Silent -> 2
69
+
end
70
+
71
+
module Cursor = struct
72
+
type t = cursor
73
+
74
+
let to_int : t -> int = function
75
+
| `Move -> 0
76
+
| `Static -> 1
77
+
end
78
+
79
+
module Composition = struct
80
+
type t = composition
81
+
82
+
let to_int : t -> int = function
83
+
| `Alpha_blend -> 0
84
+
| `Overwrite -> 1
85
+
end
86
+
87
+
module Delete = struct
88
+
type t = delete
89
+
end
+81
stack/kitty_graphics/lib/kgp_types.mli
+81
stack/kitty_graphics/lib/kgp_types.mli
···
1
+
(** Kitty Graphics Protocol - Types *)
2
+
3
+
type format = [ `Rgba32 | `Rgb24 | `Png ]
4
+
(** Image data formats. *)
5
+
6
+
type transmission = [ `Direct | `File | `Tempfile ]
7
+
(** Transmission methods. *)
8
+
9
+
type compression = [ `None | `Zlib ]
10
+
(** Compression options. *)
11
+
12
+
type quiet = [ `Noisy | `Errors_only | `Silent ]
13
+
(** Response suppression. *)
14
+
15
+
type cursor = [ `Move | `Static ]
16
+
(** Cursor movement after displaying. *)
17
+
18
+
type composition = [ `Alpha_blend | `Overwrite ]
19
+
(** Composition modes. *)
20
+
21
+
type delete =
22
+
[ `All_visible
23
+
| `All_visible_and_free
24
+
| `By_id of int * int option
25
+
| `By_id_and_free of int * int option
26
+
| `By_number of int * int option
27
+
| `By_number_and_free of int * int option
28
+
| `At_cursor
29
+
| `At_cursor_and_free
30
+
| `At_cell of int * int
31
+
| `At_cell_and_free of int * int
32
+
| `At_cell_z of int * int * int
33
+
| `At_cell_z_and_free of int * int * int
34
+
| `By_column of int
35
+
| `By_column_and_free of int
36
+
| `By_row of int
37
+
| `By_row_and_free of int
38
+
| `By_z_index of int
39
+
| `By_z_index_and_free of int
40
+
| `By_id_range of int * int
41
+
| `By_id_range_and_free of int * int
42
+
| `Frames
43
+
| `Frames_and_free ]
44
+
(** Delete target specification. *)
45
+
46
+
type animation_state = [ `Stop | `Loading | `Run ]
47
+
(** Animation playback state. *)
48
+
49
+
module Format : sig
50
+
type t = format
51
+
val to_int : t -> int
52
+
end
53
+
54
+
module Transmission : sig
55
+
type t = transmission
56
+
val to_char : t -> char
57
+
end
58
+
59
+
module Compression : sig
60
+
type t = compression
61
+
val to_char : t -> char option
62
+
end
63
+
64
+
module Quiet : sig
65
+
type t = quiet
66
+
val to_int : t -> int
67
+
end
68
+
69
+
module Cursor : sig
70
+
type t = cursor
71
+
val to_int : t -> int
72
+
end
73
+
74
+
module Composition : sig
75
+
type t = composition
76
+
val to_int : t -> int
77
+
end
78
+
79
+
module Delete : sig
80
+
type t = delete
81
+
end
+91
stack/kitty_graphics/lib/kgp_unicode.ml
+91
stack/kitty_graphics/lib/kgp_unicode.ml
···
1
+
(* Kitty Graphics Protocol - Unicode Placeholders *)
2
+
3
+
let placeholder_char = Uchar.of_int 0x10EEEE
4
+
5
+
let diacritics =
6
+
[|
7
+
0x0305; 0x030D; 0x030E; 0x0310; 0x0312; 0x033D; 0x033E; 0x033F; 0x0346;
8
+
0x034A; 0x034B; 0x034C; 0x0350; 0x0351; 0x0352; 0x0357; 0x035B; 0x0363;
9
+
0x0364; 0x0365; 0x0366; 0x0367; 0x0368; 0x0369; 0x036A; 0x036B; 0x036C;
10
+
0x036D; 0x036E; 0x036F; 0x0483; 0x0484; 0x0485; 0x0486; 0x0487; 0x0592;
11
+
0x0593; 0x0594; 0x0595; 0x0597; 0x0598; 0x0599; 0x059C; 0x059D; 0x059E;
12
+
0x059F; 0x05A0; 0x05A1; 0x05A8; 0x05A9; 0x05AB; 0x05AC; 0x05AF; 0x05C4;
13
+
0x0610; 0x0611; 0x0612; 0x0613; 0x0614; 0x0615; 0x0616; 0x0617; 0x0657;
14
+
0x0658; 0x0659; 0x065A; 0x065B; 0x065D; 0x065E; 0x06D6; 0x06D7; 0x06D8;
15
+
0x06D9; 0x06DA; 0x06DB; 0x06DC; 0x06DF; 0x06E0; 0x06E1; 0x06E2; 0x06E4;
16
+
0x06E7; 0x06E8; 0x06EB; 0x06EC; 0x0730; 0x0732; 0x0733; 0x0735; 0x0736;
17
+
0x073A; 0x073D; 0x073F; 0x0740; 0x0741; 0x0743; 0x0745; 0x0747; 0x0749;
18
+
0x074A; 0x07EB; 0x07EC; 0x07ED; 0x07EE; 0x07EF; 0x07F0; 0x07F1; 0x07F3;
19
+
0x0816; 0x0817; 0x0818; 0x0819; 0x081B; 0x081C; 0x081D; 0x081E; 0x081F;
20
+
0x0820; 0x0821; 0x0822; 0x0823; 0x0825; 0x0826; 0x0827; 0x0829; 0x082A;
21
+
0x082B; 0x082C; 0x082D; 0x0951; 0x0953; 0x0954; 0x0F82; 0x0F83; 0x0F86;
22
+
0x0F87; 0x135D; 0x135E; 0x135F; 0x17DD; 0x193A; 0x1A17; 0x1A75; 0x1A76;
23
+
0x1A77; 0x1A78; 0x1A79; 0x1A7A; 0x1A7B; 0x1A7C; 0x1B6B; 0x1B6D; 0x1B6E;
24
+
0x1B6F; 0x1B70; 0x1B71; 0x1B72; 0x1B73; 0x1CD0; 0x1CD1; 0x1CD2; 0x1CDA;
25
+
0x1CDB; 0x1CE0; 0x1DC0; 0x1DC1; 0x1DC3; 0x1DC4; 0x1DC5; 0x1DC6; 0x1DC7;
26
+
0x1DC8; 0x1DC9; 0x1DCB; 0x1DCC; 0x1DD1; 0x1DD2; 0x1DD3; 0x1DD4; 0x1DD5;
27
+
0x1DD6; 0x1DD7; 0x1DD8; 0x1DD9; 0x1DDA; 0x1DDB; 0x1DDC; 0x1DDD; 0x1DDE;
28
+
0x1DDF; 0x1DE0; 0x1DE1; 0x1DE2; 0x1DE3; 0x1DE4; 0x1DE5; 0x1DE6; 0x1DFE;
29
+
0x20D0; 0x20D1; 0x20D4; 0x20D5; 0x20D6; 0x20D7; 0x20DB; 0x20DC; 0x20E1;
30
+
0x20E7; 0x20E9; 0x20F0; 0xA66F; 0xA67C; 0xA67D; 0xA6F0; 0xA6F1; 0xA8E0;
31
+
0xA8E1; 0xA8E2; 0xA8E3; 0xA8E4; 0xA8E5; 0xA8E6; 0xA8E7; 0xA8E8; 0xA8E9;
32
+
0xA8EA; 0xA8EB; 0xA8EC; 0xA8ED; 0xA8EE; 0xA8EF; 0xA8F0; 0xA8F1; 0xAAB0;
33
+
0xAAB2; 0xAAB3; 0xAAB7; 0xAAB8; 0xAABE; 0xAABF; 0xAAC1; 0xFE20; 0xFE21;
34
+
0xFE22; 0xFE23; 0xFE24; 0xFE25; 0xFE26; 0x10A0F; 0x10A38; 0x1D185;
35
+
0x1D186; 0x1D187; 0x1D188; 0x1D189; 0x1D1AA; 0x1D1AB; 0x1D1AC; 0x1D1AD;
36
+
0x1D242; 0x1D243; 0x1D244;
37
+
|]
38
+
39
+
let diacritic n = Uchar.of_int diacritics.(n mod Array.length diacritics)
40
+
let row_diacritic = diacritic
41
+
let column_diacritic = diacritic
42
+
let id_high_byte_diacritic = diacritic
43
+
44
+
let add_uchar buf u =
45
+
let code = Uchar.to_int u in
46
+
let put = Buffer.add_char buf in
47
+
if code < 0x80 then put (Char.chr code)
48
+
else if code < 0x800 then (
49
+
put (Char.chr (0xC0 lor (code lsr 6)));
50
+
put (Char.chr (0x80 lor (code land 0x3F))))
51
+
else if code < 0x10000 then (
52
+
put (Char.chr (0xE0 lor (code lsr 12)));
53
+
put (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
54
+
put (Char.chr (0x80 lor (code land 0x3F))))
55
+
else (
56
+
put (Char.chr (0xF0 lor (code lsr 18)));
57
+
put (Char.chr (0x80 lor ((code lsr 12) land 0x3F)));
58
+
put (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
59
+
put (Char.chr (0x80 lor (code land 0x3F))))
60
+
61
+
let write buf ~image_id ?placement_id ~rows ~cols () =
62
+
(* Set foreground color *)
63
+
Printf.bprintf buf "\027[38;2;%d;%d;%dm"
64
+
((image_id lsr 16) land 0xFF)
65
+
((image_id lsr 8) land 0xFF)
66
+
(image_id land 0xFF);
67
+
(* Optional placement ID in underline color *)
68
+
placement_id
69
+
|> Option.iter (fun pid ->
70
+
Printf.bprintf buf "\027[58;2;%d;%d;%dm"
71
+
((pid lsr 16) land 0xFF)
72
+
((pid lsr 8) land 0xFF)
73
+
(pid land 0xFF));
74
+
(* High byte diacritic *)
75
+
let high_byte = (image_id lsr 24) land 0xFF in
76
+
let high_diac =
77
+
if high_byte > 0 then Some (id_high_byte_diacritic high_byte) else None
78
+
in
79
+
(* Write grid *)
80
+
for row = 0 to rows - 1 do
81
+
for col = 0 to cols - 1 do
82
+
add_uchar buf placeholder_char;
83
+
add_uchar buf (row_diacritic row);
84
+
add_uchar buf (column_diacritic col);
85
+
high_diac |> Option.iter (add_uchar buf)
86
+
done;
87
+
if row < rows - 1 then Buffer.add_string buf "\n\r"
88
+
done;
89
+
(* Reset colors *)
90
+
Buffer.add_string buf "\027[39m";
91
+
if Option.is_some placement_id then Buffer.add_string buf "\027[59m"
+23
stack/kitty_graphics/lib/kgp_unicode.mli
+23
stack/kitty_graphics/lib/kgp_unicode.mli
···
1
+
(** Kitty Graphics Protocol - Unicode Placeholders *)
2
+
3
+
val placeholder_char : Uchar.t
4
+
(** The Unicode placeholder character U+10EEEE. *)
5
+
6
+
val write :
7
+
Buffer.t ->
8
+
image_id:int ->
9
+
?placement_id:int ->
10
+
rows:int ->
11
+
cols:int ->
12
+
unit ->
13
+
unit
14
+
(** Write placeholder characters to a buffer. *)
15
+
16
+
val row_diacritic : int -> Uchar.t
17
+
(** Get the combining diacritic for a row number (0-based). *)
18
+
19
+
val column_diacritic : int -> Uchar.t
20
+
(** Get the combining diacritic for a column number (0-based). *)
21
+
22
+
val id_high_byte_diacritic : int -> Uchar.t
23
+
(** Get the diacritic for the high byte of a 32-bit image ID. *)
-684
stack/kitty_graphics/lib/kitty_graphics.ml
-684
stack/kitty_graphics/lib/kitty_graphics.ml
···
1
-
(* Kitty Terminal Graphics Protocol - Implementation *)
2
-
3
-
(* Polymorphic variant types *)
4
-
type format = [ `Rgba32 | `Rgb24 | `Png ]
5
-
type transmission = [ `Direct | `File | `Tempfile ]
6
-
type compression = [ `None | `Zlib ]
7
-
type quiet = [ `Noisy | `Errors_only | `Silent ]
8
-
type cursor = [ `Move | `Static ]
9
-
type composition = [ `Alpha_blend | `Overwrite ]
10
-
11
-
type delete =
12
-
[ `All_visible
13
-
| `All_visible_and_free
14
-
| `By_id of int * int option
15
-
| `By_id_and_free of int * int option
16
-
| `By_number of int * int option
17
-
| `By_number_and_free of int * int option
18
-
| `At_cursor
19
-
| `At_cursor_and_free
20
-
| `At_cell of int * int
21
-
| `At_cell_and_free of int * int
22
-
| `At_cell_z of int * int * int
23
-
| `At_cell_z_and_free of int * int * int
24
-
| `By_column of int
25
-
| `By_column_and_free of int
26
-
| `By_row of int
27
-
| `By_row_and_free of int
28
-
| `By_z_index of int
29
-
| `By_z_index_and_free of int
30
-
| `By_id_range of int * int
31
-
| `By_id_range_and_free of int * int
32
-
| `Frames
33
-
| `Frames_and_free ]
34
-
35
-
type animation_state = [ `Stop | `Loading | `Run ]
36
-
37
-
(* Modules re-export the types with conversion functions *)
38
-
module Format = struct
39
-
type t = format
40
-
41
-
let to_int : t -> int = function
42
-
| `Rgba32 -> 32
43
-
| `Rgb24 -> 24
44
-
| `Png -> 100
45
-
end
46
-
47
-
module Transmission = struct
48
-
type t = transmission
49
-
50
-
let to_char : t -> char = function
51
-
| `Direct -> 'd'
52
-
| `File -> 'f'
53
-
| `Tempfile -> 't'
54
-
end
55
-
56
-
module Compression = struct
57
-
type t = compression
58
-
59
-
let to_char : t -> char option = function
60
-
| `None -> None
61
-
| `Zlib -> Some 'z'
62
-
end
63
-
64
-
module Quiet = struct
65
-
type t = quiet
66
-
67
-
let to_int : t -> int = function
68
-
| `Noisy -> 0
69
-
| `Errors_only -> 1
70
-
| `Silent -> 2
71
-
end
72
-
73
-
module Cursor = struct
74
-
type t = cursor
75
-
76
-
let to_int : t -> int = function
77
-
| `Move -> 0
78
-
| `Static -> 1
79
-
end
80
-
81
-
module Composition = struct
82
-
type t = composition
83
-
84
-
let to_int : t -> int = function
85
-
| `Alpha_blend -> 0
86
-
| `Overwrite -> 1
87
-
end
88
-
89
-
module Delete = struct
90
-
type t = delete
91
-
end
92
-
93
-
module Placement = struct
94
-
type t = {
95
-
source_x : int option;
96
-
source_y : int option;
97
-
source_width : int option;
98
-
source_height : int option;
99
-
cell_x_offset : int option;
100
-
cell_y_offset : int option;
101
-
columns : int option;
102
-
rows : int option;
103
-
z_index : int option;
104
-
placement_id : int option;
105
-
cursor : cursor option;
106
-
unicode_placeholder : bool;
107
-
}
108
-
109
-
let empty =
110
-
{
111
-
source_x = None;
112
-
source_y = None;
113
-
source_width = None;
114
-
source_height = None;
115
-
cell_x_offset = None;
116
-
cell_y_offset = None;
117
-
columns = None;
118
-
rows = None;
119
-
z_index = None;
120
-
placement_id = None;
121
-
cursor = None;
122
-
unicode_placeholder = false;
123
-
}
124
-
125
-
let make ?source_x ?source_y ?source_width ?source_height ?cell_x_offset
126
-
?cell_y_offset ?columns ?rows ?z_index ?placement_id ?cursor
127
-
?(unicode_placeholder = false) () =
128
-
{
129
-
source_x;
130
-
source_y;
131
-
source_width;
132
-
source_height;
133
-
cell_x_offset;
134
-
cell_y_offset;
135
-
columns;
136
-
rows;
137
-
z_index;
138
-
placement_id;
139
-
cursor;
140
-
unicode_placeholder;
141
-
}
142
-
end
143
-
144
-
module Frame = struct
145
-
type t = {
146
-
x : int option;
147
-
y : int option;
148
-
base_frame : int option;
149
-
edit_frame : int option;
150
-
gap_ms : int option;
151
-
composition : composition option;
152
-
background_color : int32 option;
153
-
}
154
-
155
-
let empty =
156
-
{
157
-
x = None;
158
-
y = None;
159
-
base_frame = None;
160
-
edit_frame = None;
161
-
gap_ms = None;
162
-
composition = None;
163
-
background_color = None;
164
-
}
165
-
166
-
let make ?x ?y ?base_frame ?edit_frame ?gap_ms ?composition ?background_color
167
-
() =
168
-
{ x; y; base_frame; edit_frame; gap_ms; composition; background_color }
169
-
end
170
-
171
-
module Animation = struct
172
-
type state = animation_state
173
-
174
-
type t =
175
-
[ `Set_state of state * int option
176
-
| `Set_gap of int * int
177
-
| `Set_current of int ]
178
-
179
-
let set_state ?loops state = `Set_state (state, loops)
180
-
let set_gap ~frame ~gap_ms = `Set_gap (frame, gap_ms)
181
-
let set_current_frame frame = `Set_current frame
182
-
end
183
-
184
-
module Compose = struct
185
-
type t = {
186
-
source_frame : int;
187
-
dest_frame : int;
188
-
width : int option;
189
-
height : int option;
190
-
source_x : int option;
191
-
source_y : int option;
192
-
dest_x : int option;
193
-
dest_y : int option;
194
-
composition : composition option;
195
-
}
196
-
197
-
let make ~source_frame ~dest_frame ?width ?height ?source_x ?source_y ?dest_x
198
-
?dest_y ?composition () =
199
-
{
200
-
source_frame;
201
-
dest_frame;
202
-
width;
203
-
height;
204
-
source_x;
205
-
source_y;
206
-
dest_x;
207
-
dest_y;
208
-
composition;
209
-
}
210
-
end
211
-
212
-
module Command = struct
213
-
type action =
214
-
[ `Transmit
215
-
| `Transmit_and_display
216
-
| `Query
217
-
| `Display
218
-
| `Delete
219
-
| `Frame
220
-
| `Animate
221
-
| `Compose ]
222
-
223
-
type t = {
224
-
action : action;
225
-
format : format option;
226
-
transmission : transmission option;
227
-
compression : compression option;
228
-
width : int option;
229
-
height : int option;
230
-
size : int option;
231
-
offset : int option;
232
-
quiet : quiet option;
233
-
image_id : int option;
234
-
image_number : int option;
235
-
placement : Placement.t option;
236
-
delete : delete option;
237
-
frame : Frame.t option;
238
-
animation : Animation.t option;
239
-
compose : Compose.t option;
240
-
}
241
-
242
-
let make action =
243
-
{
244
-
action;
245
-
format = None;
246
-
transmission = None;
247
-
compression = None;
248
-
width = None;
249
-
height = None;
250
-
size = None;
251
-
offset = None;
252
-
quiet = None;
253
-
image_id = None;
254
-
image_number = None;
255
-
placement = None;
256
-
delete = None;
257
-
frame = None;
258
-
animation = None;
259
-
compose = None;
260
-
}
261
-
262
-
let transmit ?image_id ?image_number ?format ?transmission ?compression ?width
263
-
?height ?size ?offset ?quiet () =
264
-
{
265
-
(make `Transmit) with
266
-
image_id;
267
-
image_number;
268
-
format;
269
-
transmission;
270
-
compression;
271
-
width;
272
-
height;
273
-
size;
274
-
offset;
275
-
quiet;
276
-
}
277
-
278
-
let transmit_and_display ?image_id ?image_number ?format ?transmission
279
-
?compression ?width ?height ?size ?offset ?quiet ?placement () =
280
-
{
281
-
(make `Transmit_and_display) with
282
-
image_id;
283
-
image_number;
284
-
format;
285
-
transmission;
286
-
compression;
287
-
width;
288
-
height;
289
-
size;
290
-
offset;
291
-
quiet;
292
-
placement;
293
-
}
294
-
295
-
let query ?format ?transmission ?width ?height ?quiet () =
296
-
{ (make `Query) with format; transmission; width; height; quiet }
297
-
298
-
let display ?image_id ?image_number ?placement ?quiet () =
299
-
{ (make `Display) with image_id; image_number; placement; quiet }
300
-
301
-
let delete ?quiet del = { (make `Delete) with quiet; delete = Some del }
302
-
303
-
let frame ?image_id ?image_number ?format ?transmission ?compression ?width
304
-
?height ?quiet ~frame () =
305
-
{
306
-
(make `Frame) with
307
-
image_id;
308
-
image_number;
309
-
format;
310
-
transmission;
311
-
compression;
312
-
width;
313
-
height;
314
-
quiet;
315
-
frame = Some frame;
316
-
}
317
-
318
-
let animate ?image_id ?image_number ?quiet anim =
319
-
{ (make `Animate) with image_id; image_number; quiet; animation = Some anim }
320
-
321
-
let compose ?image_id ?image_number ?quiet comp =
322
-
{ (make `Compose) with image_id; image_number; quiet; compose = Some comp }
323
-
324
-
(* Serialization helpers *)
325
-
let apc_start = "\027_G"
326
-
let apc_end = "\027\\"
327
-
328
-
(* Key-value writer with separator handling *)
329
-
type kv_writer = { mutable first : bool; buf : Buffer.t }
330
-
331
-
let kv_writer buf = { first = true; buf }
332
-
333
-
let kv w key value =
334
-
if not w.first then Buffer.add_char w.buf ',';
335
-
w.first <- false;
336
-
Buffer.add_char w.buf key;
337
-
Buffer.add_char w.buf '=';
338
-
Buffer.add_string w.buf value
339
-
340
-
let kv_int w key value = kv w key (string_of_int value)
341
-
let kv_int32 w key value = kv w key (Int32.to_string value)
342
-
let kv_char w key value = kv w key (String.make 1 value)
343
-
344
-
(* Conditional writers using Option.iter *)
345
-
let kv_int_opt w key = Option.iter (kv_int w key)
346
-
let kv_int32_opt w key = Option.iter (kv_int32 w key)
347
-
348
-
let kv_int_if w key ~default opt =
349
-
Option.iter (fun v -> if v <> default then kv_int w key v) opt
350
-
351
-
let action_char : action -> char = function
352
-
| `Transmit -> 't'
353
-
| `Transmit_and_display -> 'T'
354
-
| `Query -> 'q'
355
-
| `Display -> 'p'
356
-
| `Delete -> 'd'
357
-
| `Frame -> 'f'
358
-
| `Animate -> 'a'
359
-
| `Compose -> 'c'
360
-
361
-
let delete_char : delete -> char = function
362
-
| `All_visible -> 'a'
363
-
| `All_visible_and_free -> 'A'
364
-
| `By_id _ -> 'i'
365
-
| `By_id_and_free _ -> 'I'
366
-
| `By_number _ -> 'n'
367
-
| `By_number_and_free _ -> 'N'
368
-
| `At_cursor -> 'c'
369
-
| `At_cursor_and_free -> 'C'
370
-
| `At_cell _ -> 'p'
371
-
| `At_cell_and_free _ -> 'P'
372
-
| `At_cell_z _ -> 'q'
373
-
| `At_cell_z_and_free _ -> 'Q'
374
-
| `By_column _ -> 'x'
375
-
| `By_column_and_free _ -> 'X'
376
-
| `By_row _ -> 'y'
377
-
| `By_row_and_free _ -> 'Y'
378
-
| `By_z_index _ -> 'z'
379
-
| `By_z_index_and_free _ -> 'Z'
380
-
| `By_id_range _ -> 'r'
381
-
| `By_id_range_and_free _ -> 'R'
382
-
| `Frames -> 'f'
383
-
| `Frames_and_free -> 'F'
384
-
385
-
let write_placement w (p : Placement.t) =
386
-
kv_int_opt w 'x' p.source_x;
387
-
kv_int_opt w 'y' p.source_y;
388
-
kv_int_opt w 'w' p.source_width;
389
-
kv_int_opt w 'h' p.source_height;
390
-
kv_int_opt w 'X' p.cell_x_offset;
391
-
kv_int_opt w 'Y' p.cell_y_offset;
392
-
kv_int_opt w 'c' p.columns;
393
-
kv_int_opt w 'r' p.rows;
394
-
kv_int_opt w 'z' p.z_index;
395
-
kv_int_opt w 'p' p.placement_id;
396
-
p.cursor |> Option.iter (fun c -> kv_int_if w 'C' ~default:0 (Some (Cursor.to_int c)));
397
-
if p.unicode_placeholder then kv_int w 'U' 1
398
-
399
-
let write_delete w (d : delete) =
400
-
kv_char w 'd' (delete_char d);
401
-
match d with
402
-
| `By_id (id, pid) | `By_id_and_free (id, pid) ->
403
-
kv_int w 'i' id;
404
-
kv_int_opt w 'p' pid
405
-
| `By_number (n, pid) | `By_number_and_free (n, pid) ->
406
-
kv_int w 'I' n;
407
-
kv_int_opt w 'p' pid
408
-
| `At_cell (x, y) | `At_cell_and_free (x, y) ->
409
-
kv_int w 'x' x;
410
-
kv_int w 'y' y
411
-
| `At_cell_z (x, y, z) | `At_cell_z_and_free (x, y, z) ->
412
-
kv_int w 'x' x;
413
-
kv_int w 'y' y;
414
-
kv_int w 'z' z
415
-
| `By_column c | `By_column_and_free c -> kv_int w 'x' c
416
-
| `By_row r | `By_row_and_free r -> kv_int w 'y' r
417
-
| `By_z_index z | `By_z_index_and_free z -> kv_int w 'z' z
418
-
| `By_id_range (min_id, max_id) | `By_id_range_and_free (min_id, max_id) ->
419
-
kv_int w 'x' min_id;
420
-
kv_int w 'y' max_id
421
-
| `All_visible | `All_visible_and_free | `At_cursor | `At_cursor_and_free
422
-
| `Frames | `Frames_and_free ->
423
-
()
424
-
425
-
let write_frame w (f : Frame.t) =
426
-
kv_int_opt w 'x' f.x;
427
-
kv_int_opt w 'y' f.y;
428
-
kv_int_opt w 'c' f.base_frame;
429
-
kv_int_opt w 'r' f.edit_frame;
430
-
kv_int_opt w 'z' f.gap_ms;
431
-
f.composition
432
-
|> Option.iter (fun c -> kv_int_if w 'X' ~default:0 (Some (Composition.to_int c)));
433
-
kv_int32_opt w 'Y' f.background_color
434
-
435
-
let write_animation w : Animation.t -> unit = function
436
-
| `Set_state (state, loops) ->
437
-
let s = match state with `Stop -> 1 | `Loading -> 2 | `Run -> 3 in
438
-
kv_int w 's' s;
439
-
kv_int_opt w 'v' loops
440
-
| `Set_gap (frame, gap_ms) ->
441
-
kv_int w 'r' frame;
442
-
kv_int w 'z' gap_ms
443
-
| `Set_current frame -> kv_int w 'c' frame
444
-
445
-
let write_compose w (c : Compose.t) =
446
-
kv_int w 'r' c.source_frame;
447
-
kv_int w 'c' c.dest_frame;
448
-
kv_int_opt w 'w' c.width;
449
-
kv_int_opt w 'h' c.height;
450
-
kv_int_opt w 'x' c.dest_x;
451
-
kv_int_opt w 'y' c.dest_y;
452
-
kv_int_opt w 'X' c.source_x;
453
-
kv_int_opt w 'Y' c.source_y;
454
-
c.composition
455
-
|> Option.iter (fun comp -> kv_int_if w 'C' ~default:0 (Some (Composition.to_int comp)))
456
-
457
-
let write_control_data buf cmd =
458
-
let w = kv_writer buf in
459
-
(* Action *)
460
-
kv_char w 'a' (action_char cmd.action);
461
-
(* Quiet - only if non-default *)
462
-
cmd.quiet |> Option.iter (fun q -> kv_int_if w 'q' ~default:0 (Some (Quiet.to_int q)));
463
-
(* Format *)
464
-
cmd.format |> Option.iter (fun f -> kv_int w 'f' (Format.to_int f));
465
-
(* Transmission - only if non-default *)
466
-
cmd.transmission
467
-
|> Option.iter (fun t ->
468
-
let c = Transmission.to_char t in
469
-
if c <> 'd' then kv_char w 't' c);
470
-
(* Compression *)
471
-
cmd.compression |> Option.iter (fun c -> Compression.to_char c |> Option.iter (kv_char w 'o'));
472
-
(* Dimensions *)
473
-
kv_int_opt w 's' cmd.width;
474
-
kv_int_opt w 'v' cmd.height;
475
-
(* File size/offset *)
476
-
kv_int_opt w 'S' cmd.size;
477
-
kv_int_opt w 'O' cmd.offset;
478
-
(* Image ID/number *)
479
-
kv_int_opt w 'i' cmd.image_id;
480
-
kv_int_opt w 'I' cmd.image_number;
481
-
(* Complex options *)
482
-
cmd.placement |> Option.iter (write_placement w);
483
-
cmd.delete |> Option.iter (write_delete w);
484
-
cmd.frame |> Option.iter (write_frame w);
485
-
cmd.animation |> Option.iter (write_animation w);
486
-
cmd.compose |> Option.iter (write_compose w);
487
-
w
488
-
489
-
let chunk_size = 4096
490
-
491
-
let write buf cmd ~data =
492
-
Buffer.add_string buf apc_start;
493
-
let w = write_control_data buf cmd in
494
-
if String.length data > 0 then begin
495
-
let encoded = Base64.encode_string data in
496
-
let len = String.length encoded in
497
-
if len <= chunk_size then (
498
-
Buffer.add_char buf ';';
499
-
Buffer.add_string buf encoded;
500
-
Buffer.add_string buf apc_end)
501
-
else begin
502
-
(* Multiple chunks *)
503
-
let rec write_chunks pos first =
504
-
if pos < len then begin
505
-
let remaining = len - pos in
506
-
let this_chunk = min chunk_size remaining in
507
-
let is_last = pos + this_chunk >= len in
508
-
if first then (
509
-
kv_int w 'm' 1;
510
-
Buffer.add_char buf ';';
511
-
Buffer.add_substring buf encoded pos this_chunk;
512
-
Buffer.add_string buf apc_end)
513
-
else (
514
-
Buffer.add_string buf apc_start;
515
-
Buffer.add_string buf (if is_last then "m=0" else "m=1");
516
-
Buffer.add_char buf ';';
517
-
Buffer.add_substring buf encoded pos this_chunk;
518
-
Buffer.add_string buf apc_end);
519
-
write_chunks (pos + this_chunk) false
520
-
end
521
-
in
522
-
write_chunks 0 true
523
-
end
524
-
end
525
-
else Buffer.add_string buf apc_end
526
-
527
-
let to_string cmd ~data =
528
-
let buf = Buffer.create 1024 in
529
-
write buf cmd ~data;
530
-
Buffer.contents buf
531
-
end
532
-
533
-
module Response = struct
534
-
type t = {
535
-
message : string;
536
-
image_id : int option;
537
-
image_number : int option;
538
-
placement_id : int option;
539
-
}
540
-
541
-
let is_ok t = t.message = "OK"
542
-
let message t = t.message
543
-
544
-
let error_code t =
545
-
if is_ok t then None
546
-
else String.index_opt t.message ':' |> Option.fold ~none:(Some t.message) ~some:(fun i -> Some (String.sub t.message 0 i))
547
-
548
-
let image_id t = t.image_id
549
-
let image_number t = t.image_number
550
-
let placement_id t = t.placement_id
551
-
552
-
let parse s =
553
-
let ( let* ) = Option.bind in
554
-
let esc = '\027' in
555
-
let len = String.length s in
556
-
let* () = if len >= 5 && s.[0] = esc && s.[1] = '_' && s.[2] = 'G' then Some () else None in
557
-
let* semi_pos = String.index_from_opt s 3 ';' in
558
-
let rec find_end pos =
559
-
if pos + 1 < len && s.[pos] = esc && s.[pos + 1] = '\\' then Some pos
560
-
else if pos + 1 < len then find_end (pos + 1)
561
-
else None
562
-
in
563
-
let* end_pos = find_end (semi_pos + 1) in
564
-
let keys_str = String.sub s 3 (semi_pos - 3) in
565
-
let message = String.sub s (semi_pos + 1) (end_pos - semi_pos - 1) in
566
-
let parse_kv part =
567
-
if String.length part >= 3 && part.[1] = '=' then
568
-
Some (part.[0], String.sub part 2 (String.length part - 2))
569
-
else None
570
-
in
571
-
let keys = String.split_on_char ',' keys_str |> List.filter_map parse_kv in
572
-
let find_int key = List.assoc_opt key keys |> Fun.flip Option.bind int_of_string_opt in
573
-
Some
574
-
{
575
-
message;
576
-
image_id = find_int 'i';
577
-
image_number = find_int 'I';
578
-
placement_id = find_int 'p';
579
-
}
580
-
end
581
-
582
-
module Unicode_placeholder = struct
583
-
let placeholder_char = Uchar.of_int 0x10EEEE
584
-
585
-
let diacritics =
586
-
[|
587
-
0x0305; 0x030D; 0x030E; 0x0310; 0x0312; 0x033D; 0x033E; 0x033F;
588
-
0x0346; 0x034A; 0x034B; 0x034C; 0x0350; 0x0351; 0x0352; 0x0357;
589
-
0x035B; 0x0363; 0x0364; 0x0365; 0x0366; 0x0367; 0x0368; 0x0369;
590
-
0x036A; 0x036B; 0x036C; 0x036D; 0x036E; 0x036F; 0x0483; 0x0484;
591
-
0x0485; 0x0486; 0x0487; 0x0592; 0x0593; 0x0594; 0x0595; 0x0597;
592
-
0x0598; 0x0599; 0x059C; 0x059D; 0x059E; 0x059F; 0x05A0; 0x05A1;
593
-
0x05A8; 0x05A9; 0x05AB; 0x05AC; 0x05AF; 0x05C4; 0x0610; 0x0611;
594
-
0x0612; 0x0613; 0x0614; 0x0615; 0x0616; 0x0617; 0x0657; 0x0658;
595
-
0x0659; 0x065A; 0x065B; 0x065D; 0x065E; 0x06D6; 0x06D7; 0x06D8;
596
-
0x06D9; 0x06DA; 0x06DB; 0x06DC; 0x06DF; 0x06E0; 0x06E1; 0x06E2;
597
-
0x06E4; 0x06E7; 0x06E8; 0x06EB; 0x06EC; 0x0730; 0x0732; 0x0733;
598
-
0x0735; 0x0736; 0x073A; 0x073D; 0x073F; 0x0740; 0x0741; 0x0743;
599
-
0x0745; 0x0747; 0x0749; 0x074A; 0x07EB; 0x07EC; 0x07ED; 0x07EE;
600
-
0x07EF; 0x07F0; 0x07F1; 0x07F3; 0x0816; 0x0817; 0x0818; 0x0819;
601
-
0x081B; 0x081C; 0x081D; 0x081E; 0x081F; 0x0820; 0x0821; 0x0822;
602
-
0x0823; 0x0825; 0x0826; 0x0827; 0x0829; 0x082A; 0x082B; 0x082C;
603
-
0x082D; 0x0951; 0x0953; 0x0954; 0x0F82; 0x0F83; 0x0F86; 0x0F87;
604
-
0x135D; 0x135E; 0x135F; 0x17DD; 0x193A; 0x1A17; 0x1A75; 0x1A76;
605
-
0x1A77; 0x1A78; 0x1A79; 0x1A7A; 0x1A7B; 0x1A7C; 0x1B6B; 0x1B6D;
606
-
0x1B6E; 0x1B6F; 0x1B70; 0x1B71; 0x1B72; 0x1B73; 0x1CD0; 0x1CD1;
607
-
0x1CD2; 0x1CDA; 0x1CDB; 0x1CE0; 0x1DC0; 0x1DC1; 0x1DC3; 0x1DC4;
608
-
0x1DC5; 0x1DC6; 0x1DC7; 0x1DC8; 0x1DC9; 0x1DCB; 0x1DCC; 0x1DD1;
609
-
0x1DD2; 0x1DD3; 0x1DD4; 0x1DD5; 0x1DD6; 0x1DD7; 0x1DD8; 0x1DD9;
610
-
0x1DDA; 0x1DDB; 0x1DDC; 0x1DDD; 0x1DDE; 0x1DDF; 0x1DE0; 0x1DE1;
611
-
0x1DE2; 0x1DE3; 0x1DE4; 0x1DE5; 0x1DE6; 0x1DFE; 0x20D0; 0x20D1;
612
-
0x20D4; 0x20D5; 0x20D6; 0x20D7; 0x20DB; 0x20DC; 0x20E1; 0x20E7;
613
-
0x20E9; 0x20F0; 0xA66F; 0xA67C; 0xA67D; 0xA6F0; 0xA6F1; 0xA8E0;
614
-
0xA8E1; 0xA8E2; 0xA8E3; 0xA8E4; 0xA8E5; 0xA8E6; 0xA8E7; 0xA8E8;
615
-
0xA8E9; 0xA8EA; 0xA8EB; 0xA8EC; 0xA8ED; 0xA8EE; 0xA8EF; 0xA8F0;
616
-
0xA8F1; 0xAAB0; 0xAAB2; 0xAAB3; 0xAAB7; 0xAAB8; 0xAABE; 0xAABF;
617
-
0xAAC1; 0xFE20; 0xFE21; 0xFE22; 0xFE23; 0xFE24; 0xFE25; 0xFE26;
618
-
0x10A0F; 0x10A38; 0x1D185; 0x1D186; 0x1D187; 0x1D188; 0x1D189;
619
-
0x1D1AA; 0x1D1AB; 0x1D1AC; 0x1D1AD; 0x1D242; 0x1D243; 0x1D244;
620
-
|]
621
-
622
-
let diacritic n =
623
-
Uchar.of_int diacritics.(n mod Array.length diacritics)
624
-
625
-
let row_diacritic = diacritic
626
-
let column_diacritic = diacritic
627
-
let id_high_byte_diacritic = diacritic
628
-
629
-
let add_uchar buf u =
630
-
let code = Uchar.to_int u in
631
-
let put = Buffer.add_char buf in
632
-
if code < 0x80 then put (Char.chr code)
633
-
else if code < 0x800 then (
634
-
put (Char.chr (0xC0 lor (code lsr 6)));
635
-
put (Char.chr (0x80 lor (code land 0x3F))))
636
-
else if code < 0x10000 then (
637
-
put (Char.chr (0xE0 lor (code lsr 12)));
638
-
put (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
639
-
put (Char.chr (0x80 lor (code land 0x3F))))
640
-
else (
641
-
put (Char.chr (0xF0 lor (code lsr 18)));
642
-
put (Char.chr (0x80 lor ((code lsr 12) land 0x3F)));
643
-
put (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));
644
-
put (Char.chr (0x80 lor (code land 0x3F))))
645
-
646
-
let write buf ~image_id ?placement_id ~rows ~cols () =
647
-
(* Set foreground color *)
648
-
Printf.bprintf buf "\027[38;2;%d;%d;%dm"
649
-
((image_id lsr 16) land 0xFF)
650
-
((image_id lsr 8) land 0xFF)
651
-
(image_id land 0xFF);
652
-
(* Optional placement ID in underline color *)
653
-
placement_id
654
-
|> Option.iter (fun pid ->
655
-
Printf.bprintf buf "\027[58;2;%d;%d;%dm"
656
-
((pid lsr 16) land 0xFF)
657
-
((pid lsr 8) land 0xFF)
658
-
(pid land 0xFF));
659
-
(* High byte diacritic *)
660
-
let high_byte = (image_id lsr 24) land 0xFF in
661
-
let high_diac = if high_byte > 0 then Some (id_high_byte_diacritic high_byte) else None in
662
-
(* Write grid *)
663
-
for row = 0 to rows - 1 do
664
-
for col = 0 to cols - 1 do
665
-
add_uchar buf placeholder_char;
666
-
add_uchar buf (row_diacritic row);
667
-
add_uchar buf (column_diacritic col);
668
-
high_diac |> Option.iter (add_uchar buf)
669
-
done;
670
-
if row < rows - 1 then Buffer.add_string buf "\n\r"
671
-
done;
672
-
(* Reset colors *)
673
-
Buffer.add_string buf "\027[39m";
674
-
if Option.is_some placement_id then Buffer.add_string buf "\027[59m"
675
-
end
676
-
677
-
module Detect = struct
678
-
let make_query () =
679
-
let cmd = Command.query ~format:`Rgb24 ~transmission:`Direct ~width:1 ~height:1 () in
680
-
Command.to_string cmd ~data:"\x00\x00\x00" ^ "\027[c"
681
-
682
-
let supports_graphics response ~da1_received =
683
-
response |> Option.map Response.is_ok |> Option.value ~default:(not da1_received)
684
-
end
+8
-11
stack/kitty_graphics/lib/kitty_graphics.mli
stack/kitty_graphics/lib/kgp.mli
+8
-11
stack/kitty_graphics/lib/kitty_graphics.mli
stack/kitty_graphics/lib/kgp.mli
···
14
14
{[
15
15
(* Display a PNG image *)
16
16
let png_data = read_file "image.png" in
17
-
let cmd = Kitty_graphics.Command.transmit_and_display ~format:`Png () in
17
+
let cmd = Kgp.Command.transmit_and_display ~format:`Png () in
18
18
let buf = Buffer.create 1024 in
19
-
Kitty_graphics.Command.write buf cmd ~data:png_data;
19
+
Kgp.Command.write buf cmd ~data:png_data;
20
20
print_string (Buffer.contents buf)
21
21
]}
22
22
···
133
133
(** {1 Placement Options} *)
134
134
135
135
module Placement : sig
136
-
type t
136
+
type t = Kgp_placement.t
137
137
(** Placement configuration. *)
138
138
139
139
val make :
···
173
173
(** {1 Animation} *)
174
174
175
175
module Frame : sig
176
-
type t
176
+
type t = Kgp_frame.t
177
177
(** Animation frame configuration. *)
178
178
179
179
val make :
···
203
203
module Animation : sig
204
204
type state = animation_state
205
205
206
-
type t =
207
-
[ `Set_state of state * int option
208
-
| `Set_gap of int * int
209
-
| `Set_current of int ]
206
+
type t = Kgp_animation.t
210
207
(** Animation control operations. *)
211
208
212
209
val set_state : ?loops:int -> state -> t
···
223
220
end
224
221
225
222
module Compose : sig
226
-
type t
223
+
type t = Kgp_compose.t
227
224
(** Composition operation. *)
228
225
229
226
val make :
···
244
241
(** {1 Commands} *)
245
242
246
243
module Command : sig
247
-
type t
244
+
type t = Kgp_command.t
248
245
(** A graphics protocol command. *)
249
246
250
247
(** {2 Image Transmission} *)
···
340
337
(** {1 Response Parsing} *)
341
338
342
339
module Response : sig
343
-
type t
340
+
type t = Kgp_response.t
344
341
(** A parsed terminal response. *)
345
342
346
343
val parse : string -> t option
stack/kitty_graphics/sf.png
stack/kitty_graphics/sf.png
This is a binary file and will not be displayed.
+32
-11
stack/sortal/lib/sortal.ml
+32
-11
stack/sortal/lib/sortal.ml
···
64
64
bluesky : string option;
65
65
mastodon : string option;
66
66
orcid : string option;
67
-
url : string option;
67
+
url_ : string option;
68
+
urls_ : string list option;
68
69
feeds : Feed.t list option;
69
70
}
70
71
71
72
let make ~handle ~names ?email ?icon ?thumbnail ?github ?twitter ?bluesky ?mastodon
72
-
?orcid ?url ?feeds () =
73
+
?orcid ?url ?urls ?feeds () =
73
74
{ handle; names; email; icon; thumbnail; github; twitter; bluesky; mastodon;
74
-
orcid; url; feeds }
75
+
orcid; url_ = url; urls_ = urls; feeds }
75
76
76
77
let handle t = t.handle
77
78
let names t = t.names
···
85
86
let bluesky t = t.bluesky
86
87
let mastodon t = t.mastodon
87
88
let orcid t = t.orcid
88
-
let url t = t.url
89
+
90
+
let url t =
91
+
match t.url_ with
92
+
| Some _ as u -> u
93
+
| None ->
94
+
match t.urls_ with
95
+
| Some (first :: _) -> Some first
96
+
| _ -> None
97
+
98
+
let urls t =
99
+
match t.url_, t.urls_ with
100
+
| Some u, Some us -> u :: us
101
+
| Some u, None -> [u]
102
+
| None, Some us -> us
103
+
| None, None -> []
104
+
89
105
let feeds t = t.feeds
90
106
91
107
let add_feed t feed =
···
103
119
{ t with feeds }
104
120
105
121
let best_url t =
106
-
match t.url with
122
+
match url t with
107
123
| Some v -> Some v
108
124
| None ->
109
125
(match t.github with
···
117
133
let open Jsont in
118
134
let open Jsont.Object in
119
135
let mem_opt f v ~enc = mem f v ~dec_absent:None ~enc_omit:Option.is_none ~enc in
120
-
let make handle names email icon thumbnail github twitter bluesky mastodon orcid url feeds =
136
+
let make handle names email icon thumbnail github twitter bluesky mastodon orcid url urls feeds =
121
137
{ handle; names; email; icon; thumbnail; github; twitter; bluesky; mastodon;
122
-
orcid; url; feeds }
138
+
orcid; url_ = url; urls_ = urls; feeds }
123
139
in
124
140
map ~kind:"Contact" make
125
141
|> mem "handle" string ~enc:handle
···
132
148
|> mem_opt "bluesky" (some string) ~enc:bluesky
133
149
|> mem_opt "mastodon" (some string) ~enc:mastodon
134
150
|> mem_opt "orcid" (some string) ~enc:orcid
135
-
|> mem_opt "url" (some string) ~enc:url
151
+
|> mem_opt "url" (some string) ~enc:(fun t -> t.url_)
152
+
|> mem_opt "urls" (some (list string)) ~enc:(fun t -> t.urls_)
136
153
|> mem_opt "feeds" (some (list Feed.json_t)) ~enc:feeds
137
154
|> finish
138
155
···
168
185
| Some o -> pf ppf "%a: https://orcid.org/%a@,"
169
186
(styled `Bold string) "ORCID" string o
170
187
| None -> ());
171
-
(match t.url with
172
-
| Some u -> pf ppf "%a: %a@," (styled `Bold string) "URL" string u
173
-
| None -> ());
188
+
(let all_urls = urls t in
189
+
match all_urls with
190
+
| [] -> ()
191
+
| [u] -> pf ppf "%a: %a@," (styled `Bold string) "URL" string u
192
+
| _ ->
193
+
pf ppf "%a:@," (styled `Bold string) "URLs";
194
+
List.iter (fun u -> pf ppf " - %s@," u) all_urls);
174
195
(match t.icon with
175
196
| Some i -> pf ppf "%a: %a@," (styled `Bold string) "Icon" string i
176
197
| None -> ());
+14
-2
stack/sortal/lib/sortal.mli
+14
-2
stack/sortal/lib/sortal.mli
···
99
99
@param bluesky Bluesky handle
100
100
@param mastodon Mastodon handle (including instance)
101
101
@param orcid ORCID identifier
102
-
@param url Personal or professional website URL
102
+
@param url Personal or professional website URL (primary URL)
103
+
@param urls Additional website URLs
103
104
@param feeds List of feed subscriptions (Atom/RSS/JSON) associated with this contact
104
105
*)
105
106
val make :
···
114
115
?mastodon:string ->
115
116
?orcid:string ->
116
117
?url:string ->
118
+
?urls:string list ->
117
119
?feeds:Feed.t list ->
118
120
unit ->
119
121
t
···
158
160
(** [orcid t] returns the ORCID identifier if available. *)
159
161
val orcid : t -> string option
160
162
161
-
(** [url t] returns the personal/professional website URL if available. *)
163
+
(** [url t] returns the primary URL if available.
164
+
165
+
Returns the [url] field if set, otherwise returns the first element
166
+
of [urls] if available, or [None] if neither is set. *)
162
167
val url : t -> string option
168
+
169
+
(** [urls t] returns all URLs associated with this contact.
170
+
171
+
Combines the [url] field (if set) with the [urls] list (if set).
172
+
The primary [url] appears first if present. Returns an empty list
173
+
if neither [url] nor [urls] is set. *)
174
+
val urls : t -> string list
163
175
164
176
(** [feeds t] returns the list of feed subscriptions if available. *)
165
177
val feeds : t -> Feed.t list option
+40
stack/sortal/test/test_sortal.ml
+40
stack/sortal/test/test_sortal.ml
···
154
154
assert (Sortal.Contact.compare c1 c3 = 0);
155
155
traceln "✓ Contact comparison works"
156
156
157
+
let test_urls () =
158
+
(* Test with only url set *)
159
+
let c1 = Sortal.Contact.make
160
+
~handle:"test1"
161
+
~names:["Test 1"]
162
+
~url:"https://example.com"
163
+
() in
164
+
assert (Sortal.Contact.url c1 = Some "https://example.com");
165
+
assert (Sortal.Contact.urls c1 = ["https://example.com"]);
166
+
167
+
(* Test with only urls set *)
168
+
let c2 = Sortal.Contact.make
169
+
~handle:"test2"
170
+
~names:["Test 2"]
171
+
~urls:["https://one.com"; "https://two.com"]
172
+
() in
173
+
assert (Sortal.Contact.url c2 = Some "https://one.com");
174
+
assert (Sortal.Contact.urls c2 = ["https://one.com"; "https://two.com"]);
175
+
176
+
(* Test with both url and urls set *)
177
+
let c3 = Sortal.Contact.make
178
+
~handle:"test3"
179
+
~names:["Test 3"]
180
+
~url:"https://primary.com"
181
+
~urls:["https://secondary.com"; "https://tertiary.com"]
182
+
() in
183
+
assert (Sortal.Contact.url c3 = Some "https://primary.com");
184
+
assert (Sortal.Contact.urls c3 = ["https://primary.com"; "https://secondary.com"; "https://tertiary.com"]);
185
+
186
+
(* Test with neither set *)
187
+
let c4 = Sortal.Contact.make
188
+
~handle:"test4"
189
+
~names:["Test 4"]
190
+
() in
191
+
assert (Sortal.Contact.url c4 = None);
192
+
assert (Sortal.Contact.urls c4 = []);
193
+
194
+
traceln "✓ URLs field works correctly"
195
+
157
196
let () =
158
197
traceln "\n=== Running Sortal Tests ===\n";
159
198
···
162
201
test_json_encoding ();
163
202
test_handle_generation ();
164
203
test_contact_compare ();
204
+
test_urls ();
165
205
test_store_operations ();
166
206
167
207
traceln "\n=== All Tests Passed ===\n"
-5
stack/xdge/CLAUDE.md
-5
stack/xdge/CLAUDE.md
-30
stack/xdge/dune-project
-30
stack/xdge/dune-project
···
1
-
(lang dune 3.20)
2
-
3
-
(name xdge)
4
-
5
-
(generate_opam_files true)
6
-
7
-
(license ISC)
8
-
(authors "Anil Madhavapeddy")
9
-
(homepage "https://tangled.sh/@anil.recoil.org/ocaml-gpx")
10
-
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
11
-
(bug_reports https://tangled.sh/@anil.recoil.org/xgde)
12
-
(maintenance_intent "(latest)")
13
-
14
-
(package
15
-
(name xdge)
16
-
(synopsis "XDG Base Directory Specification support for Eio")
17
-
(description
18
-
"This library implements the XDG Base Directory Specification \
19
-
with Eio capabilities to provides safe access to configuration, \
20
-
data, cache, state, and runtime directories with proper environment \
21
-
variable overrides and Cmdliner integration.")
22
-
(depends
23
-
(ocaml (>= 5.1.0))
24
-
(eio (>= 1.1))
25
-
eio_main
26
-
(xdg (>= 3.9.0))
27
-
(cmdliner (>= 1.2.0))
28
-
(fmt (>= 0.11.0))
29
-
(odoc :with-doc)
30
-
(alcotest (and :with-test (>= 1.7.0)))))
-4
stack/xdge/example/dune
-4
stack/xdge/example/dune
stack/xdge/example/minimal_test.cmi
stack/xdge/example/minimal_test.cmi
This is a binary file and will not be displayed.
stack/xdge/example/minimal_test.cmo
stack/xdge/example/minimal_test.cmo
This is a binary file and will not be displayed.
-37
stack/xdge/example/xdg_example.ml
-37
stack/xdge/example/xdg_example.ml
···
1
-
let run (xdg, cfg) =
2
-
Fmt.pr
3
-
"%a@.%a@.@.%a@.%a@."
4
-
Fmt.(styled `Bold string)
5
-
"=== Cmdliner Config ==="
6
-
Xdge.Cmd.pp
7
-
cfg
8
-
Fmt.(styled `Bold string)
9
-
"=== XDG Directories ==="
10
-
(Xdge.pp ~brief:false ~sources:true)
11
-
xdg
12
-
;;
13
-
14
-
open Cmdliner
15
-
16
-
let () =
17
-
Fmt.set_style_renderer Fmt.stdout `Ansi_tty;
18
-
let app_name = "xdg_example" in
19
-
let doc = "Example program demonstrating XDG directory selection with Cmdliner" in
20
-
let man =
21
-
[ `S Manpage.s_description
22
-
; `P
23
-
"This example shows how to use the Xdge library with Cmdliner to handle XDG Base \
24
-
Directory Specification paths with command-line and environment variable \
25
-
overrides."
26
-
; `S Manpage.s_environment
27
-
; `P (Xdge.Cmd.env_docs app_name)
28
-
]
29
-
in
30
-
let info = Cmdliner.Cmd.info "xdg_example" ~version:"1.0" ~doc ~man in
31
-
Eio_main.run
32
-
@@ fun env ->
33
-
let create_xdg_term = Xdge.Cmd.term app_name env#fs () in
34
-
let main_term = Term.(const run $ create_xdg_term) in
35
-
let cmd = Cmdliner.Cmd.v info main_term in
36
-
exit @@ Cmdliner.Cmd.eval cmd
37
-
;;
-4
stack/xdge/lib/dune
-4
stack/xdge/lib/dune
-770
stack/xdge/lib/xdge.ml
-770
stack/xdge/lib/xdge.ml
···
1
-
type source =
2
-
| Default
3
-
| Env of string
4
-
| Cmdline
5
-
6
-
type t =
7
-
{ app_name : string
8
-
; config_dir : Eio.Fs.dir_ty Eio.Path.t
9
-
; config_dir_source : source
10
-
; data_dir : Eio.Fs.dir_ty Eio.Path.t
11
-
; data_dir_source : source
12
-
; cache_dir : Eio.Fs.dir_ty Eio.Path.t
13
-
; cache_dir_source : source
14
-
; state_dir : Eio.Fs.dir_ty Eio.Path.t
15
-
; state_dir_source : source
16
-
; runtime_dir : Eio.Fs.dir_ty Eio.Path.t option
17
-
; runtime_dir_source : source
18
-
; config_dirs : Eio.Fs.dir_ty Eio.Path.t list
19
-
; data_dirs : Eio.Fs.dir_ty Eio.Path.t list
20
-
}
21
-
22
-
type dir = [
23
-
| `Config
24
-
| `Cache
25
-
| `Data
26
-
| `State
27
-
| `Runtime
28
-
]
29
-
30
-
let ensure_dir ?(perm = 0o755) path = Eio.Path.mkdirs ~exists_ok:true ~perm path
31
-
32
-
let validate_runtime_base_dir base_path =
33
-
(* Validate the base XDG_RUNTIME_DIR has correct permissions per spec *)
34
-
try
35
-
let path_str = Eio.Path.native_exn base_path in
36
-
let stat = Eio.Path.stat ~follow:true base_path in
37
-
let current_perm = stat.perm land 0o777 in
38
-
if current_perm <> 0o700
39
-
then
40
-
failwith
41
-
(Printf.sprintf
42
-
"XDG_RUNTIME_DIR base directory %s has incorrect permissions: %o (must be \
43
-
0700)"
44
-
path_str
45
-
current_perm);
46
-
(* Check ownership - directory should be owned by current user *)
47
-
let uid = Unix.getuid () in
48
-
if stat.uid <> Int64.of_int uid
49
-
then
50
-
failwith
51
-
(Printf.sprintf
52
-
"XDG_RUNTIME_DIR base directory %s not owned by current user (uid %d, owner \
53
-
%Ld)"
54
-
path_str
55
-
uid
56
-
stat.uid)
57
-
(* TODO: Check that directory is on local filesystem (not networked).
58
-
This would require filesystem type detection which is OS-specific. *)
59
-
with
60
-
| exn ->
61
-
failwith
62
-
(Printf.sprintf "Cannot validate XDG_RUNTIME_DIR: %s" (Printexc.to_string exn))
63
-
;;
64
-
65
-
let ensure_runtime_dir _fs app_runtime_path =
66
-
(* Base directory validation is done in resolve_runtime_dir,
67
-
so we just create the app subdirectory *)
68
-
ensure_dir app_runtime_path
69
-
;;
70
-
71
-
let get_home_dir fs =
72
-
let home_str =
73
-
match Sys.getenv_opt "HOME" with
74
-
| Some home -> home
75
-
| None ->
76
-
(match Sys.os_type with
77
-
| "Win32" | "Cygwin" ->
78
-
(match Sys.getenv_opt "USERPROFILE" with
79
-
| Some profile -> profile
80
-
| None -> failwith "Cannot determine home directory")
81
-
| _ ->
82
-
(try Unix.((getpwuid (getuid ())).pw_dir) with
83
-
| _ -> failwith "Cannot determine home directory"))
84
-
in
85
-
Eio.Path.(fs / home_str)
86
-
;;
87
-
88
-
let make_env_var_name app_name suffix = String.uppercase_ascii app_name ^ "_" ^ suffix
89
-
90
-
exception Invalid_xdg_path of string
91
-
92
-
let validate_absolute_path context path =
93
-
if Filename.is_relative path
94
-
then
95
-
raise
96
-
(Invalid_xdg_path
97
-
(Printf.sprintf "%s must be an absolute path, got: %s" context path))
98
-
;;
99
-
100
-
let resolve_path fs home_path base_path =
101
-
if Filename.is_relative base_path
102
-
then Eio.Path.(home_path / base_path)
103
-
else Eio.Path.(fs / base_path)
104
-
;;
105
-
106
-
(* Helper to resolve system directories (config_dirs or data_dirs) *)
107
-
let resolve_system_dirs fs home_path app_name override_suffix xdg_var default_paths =
108
-
let override_var = make_env_var_name app_name override_suffix in
109
-
match Sys.getenv_opt override_var with
110
-
| Some dirs when dirs <> "" ->
111
-
String.split_on_char ':' dirs
112
-
|> List.filter (fun s -> s <> "")
113
-
|> List.filter_map (fun path ->
114
-
try
115
-
validate_absolute_path override_var path;
116
-
Some Eio.Path.(resolve_path fs home_path path / app_name)
117
-
with
118
-
| Invalid_xdg_path _ -> None)
119
-
| Some _ | None ->
120
-
(match Sys.getenv_opt xdg_var with
121
-
| Some dirs when dirs <> "" ->
122
-
String.split_on_char ':' dirs
123
-
|> List.filter (fun s -> s <> "")
124
-
|> List.filter_map (fun path ->
125
-
try
126
-
validate_absolute_path xdg_var path;
127
-
Some Eio.Path.(resolve_path fs home_path path / app_name)
128
-
with
129
-
| Invalid_xdg_path _ -> None)
130
-
| Some _ | None ->
131
-
List.map
132
-
(fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
133
-
default_paths)
134
-
;;
135
-
136
-
(* Helper to resolve a user directory with override precedence *)
137
-
let resolve_user_dir fs home_path app_name xdg_ctx xdg_getter override_suffix =
138
-
let override_var = make_env_var_name app_name override_suffix in
139
-
match Sys.getenv_opt override_var with
140
-
| Some dir when dir <> "" ->
141
-
validate_absolute_path override_var dir;
142
-
Eio.Path.(fs / dir / app_name), Env override_var
143
-
| Some _ | None ->
144
-
let xdg_base = xdg_getter xdg_ctx in
145
-
let base_path = resolve_path fs home_path xdg_base in
146
-
Eio.Path.(base_path / app_name), Default
147
-
;;
148
-
149
-
(* Helper to resolve runtime directory (special case since it can be None) *)
150
-
let resolve_runtime_dir fs home_path app_name xdg_ctx =
151
-
let override_var = make_env_var_name app_name "RUNTIME_DIR" in
152
-
match Sys.getenv_opt override_var with
153
-
| Some dir when dir <> "" ->
154
-
validate_absolute_path override_var dir;
155
-
(* Validate the base runtime directory has correct permissions *)
156
-
let base_runtime_dir = resolve_path fs home_path dir in
157
-
validate_runtime_base_dir base_runtime_dir;
158
-
Some Eio.Path.(base_runtime_dir / app_name), Env override_var
159
-
| Some _ | None ->
160
-
( (match Xdg.runtime_dir xdg_ctx with
161
-
| Some base ->
162
-
(* Validate the base runtime directory has correct permissions *)
163
-
let base_runtime_dir = resolve_path fs home_path base in
164
-
validate_runtime_base_dir base_runtime_dir;
165
-
Some Eio.Path.(base_runtime_dir / app_name)
166
-
| None -> None)
167
-
, Default )
168
-
;;
169
-
170
-
let validate_standard_xdg_vars () =
171
-
(* Validate standard XDG environment variables for absolute paths *)
172
-
let xdg_vars =
173
-
[ "XDG_CONFIG_HOME"
174
-
; "XDG_DATA_HOME"
175
-
; "XDG_CACHE_HOME"
176
-
; "XDG_STATE_HOME"
177
-
; "XDG_RUNTIME_DIR"
178
-
; "XDG_CONFIG_DIRS"
179
-
; "XDG_DATA_DIRS"
180
-
]
181
-
in
182
-
List.iter
183
-
(fun var ->
184
-
match Sys.getenv_opt var with
185
-
| Some value when value <> "" ->
186
-
if String.contains value ':'
187
-
then
188
-
(* Colon-separated list - validate each part *)
189
-
String.split_on_char ':' value
190
-
|> List.filter (fun s -> s <> "")
191
-
|> List.iter (fun path -> validate_absolute_path var path)
192
-
else
193
-
(* Single path *)
194
-
validate_absolute_path var value
195
-
| _ -> ())
196
-
xdg_vars
197
-
;;
198
-
199
-
let create fs app_name =
200
-
let fs = fs in
201
-
let home_path = get_home_dir fs in
202
-
(* First validate all standard XDG environment variables *)
203
-
validate_standard_xdg_vars ();
204
-
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
205
-
(* User directories *)
206
-
let config_dir, config_dir_source =
207
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.config_dir "CONFIG_DIR"
208
-
in
209
-
let data_dir, data_dir_source =
210
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.data_dir "DATA_DIR"
211
-
in
212
-
let cache_dir, cache_dir_source =
213
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.cache_dir "CACHE_DIR"
214
-
in
215
-
let state_dir, state_dir_source =
216
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.state_dir "STATE_DIR"
217
-
in
218
-
(* Runtime directory *)
219
-
let runtime_dir, runtime_dir_source =
220
-
resolve_runtime_dir fs home_path app_name xdg_ctx
221
-
in
222
-
(* System directories *)
223
-
let config_dirs =
224
-
resolve_system_dirs
225
-
fs
226
-
home_path
227
-
app_name
228
-
"CONFIG_DIRS"
229
-
"XDG_CONFIG_DIRS"
230
-
[ "/etc/xdg" ]
231
-
in
232
-
let data_dirs =
233
-
resolve_system_dirs
234
-
fs
235
-
home_path
236
-
app_name
237
-
"DATA_DIRS"
238
-
"XDG_DATA_DIRS"
239
-
[ "/usr/local/share"; "/usr/share" ]
240
-
in
241
-
ensure_dir config_dir;
242
-
ensure_dir data_dir;
243
-
ensure_dir cache_dir;
244
-
ensure_dir state_dir;
245
-
Option.iter (ensure_runtime_dir fs) runtime_dir;
246
-
{ app_name
247
-
; config_dir
248
-
; config_dir_source
249
-
; data_dir
250
-
; data_dir_source
251
-
; cache_dir
252
-
; cache_dir_source
253
-
; state_dir
254
-
; state_dir_source
255
-
; runtime_dir
256
-
; runtime_dir_source
257
-
; config_dirs
258
-
; data_dirs
259
-
}
260
-
;;
261
-
262
-
let app_name t = t.app_name
263
-
let config_dir t = t.config_dir
264
-
let data_dir t = t.data_dir
265
-
let cache_dir t = t.cache_dir
266
-
let state_dir t = t.state_dir
267
-
let runtime_dir t = t.runtime_dir
268
-
let config_dirs t = t.config_dirs
269
-
let data_dirs t = t.data_dirs
270
-
271
-
(* File search following XDG specification *)
272
-
let find_file_in_dirs dirs filename =
273
-
let rec search_dirs = function
274
-
| [] -> None
275
-
| dir :: remaining_dirs ->
276
-
let file_path = Eio.Path.(dir / filename) in
277
-
(try
278
-
(* Try to check if file exists and is readable *)
279
-
let _ = Eio.Path.stat ~follow:true file_path in
280
-
Some file_path
281
-
with
282
-
| _ ->
283
-
(* File is inaccessible (non-existent, permissions, etc.)
284
-
Skip and continue with next directory per XDG spec *)
285
-
search_dirs remaining_dirs)
286
-
in
287
-
search_dirs dirs
288
-
;;
289
-
290
-
let find_config_file t filename =
291
-
(* Search user config dir first, then system config dirs *)
292
-
find_file_in_dirs (t.config_dir :: t.config_dirs) filename
293
-
;;
294
-
295
-
let find_data_file t filename =
296
-
(* Search user data dir first, then system data dirs *)
297
-
find_file_in_dirs (t.data_dir :: t.data_dirs) filename
298
-
;;
299
-
300
-
let pp ?(brief = false) ?(sources = false) ppf t =
301
-
let pp_source ppf = function
302
-
| Default -> Fmt.(styled `Faint string) ppf "default"
303
-
| Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
304
-
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
305
-
in
306
-
let pp_path_with_source ppf path source =
307
-
if sources
308
-
then
309
-
Fmt.pf
310
-
ppf
311
-
"%a %a"
312
-
Fmt.(styled `Green Eio.Path.pp)
313
-
path
314
-
Fmt.(styled `Faint (brackets pp_source))
315
-
source
316
-
else Fmt.(styled `Green Eio.Path.pp) ppf path
317
-
in
318
-
let pp_path_opt_with_source ppf path_opt source =
319
-
match path_opt with
320
-
| None ->
321
-
if sources
322
-
then
323
-
Fmt.pf
324
-
ppf
325
-
"%a %a"
326
-
Fmt.(styled `Red string)
327
-
"<none>"
328
-
Fmt.(styled `Faint (brackets pp_source))
329
-
source
330
-
else Fmt.(styled `Red string) ppf "<none>"
331
-
| Some path -> pp_path_with_source ppf path source
332
-
in
333
-
let pp_paths ppf paths =
334
-
Fmt.(list ~sep:(any ";@ ") (styled `Green Eio.Path.pp)) ppf paths
335
-
in
336
-
if brief
337
-
then
338
-
Fmt.pf
339
-
ppf
340
-
"%a config=%a data=%a>"
341
-
Fmt.(styled `Cyan string)
342
-
("<xdg:" ^ t.app_name)
343
-
(fun ppf (path, source) -> pp_path_with_source ppf path source)
344
-
(t.config_dir, t.config_dir_source)
345
-
(fun ppf (path, source) -> pp_path_with_source ppf path source)
346
-
(t.data_dir, t.data_dir_source)
347
-
else (
348
-
Fmt.pf
349
-
ppf
350
-
"@[<v>%a@,"
351
-
Fmt.(styled `Bold string)
352
-
("XDG directories for '" ^ t.app_name ^ "':");
353
-
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "User directories:";
354
-
Fmt.pf
355
-
ppf
356
-
"%a %a@,"
357
-
Fmt.(styled `Cyan string)
358
-
"config:"
359
-
(fun ppf (path, source) -> pp_path_with_source ppf path source)
360
-
(t.config_dir, t.config_dir_source);
361
-
Fmt.pf
362
-
ppf
363
-
"%a %a@,"
364
-
Fmt.(styled `Cyan string)
365
-
"data:"
366
-
(fun ppf (path, source) -> pp_path_with_source ppf path source)
367
-
(t.data_dir, t.data_dir_source);
368
-
Fmt.pf
369
-
ppf
370
-
"%a %a@,"
371
-
Fmt.(styled `Cyan string)
372
-
"cache:"
373
-
(fun ppf (path, source) -> pp_path_with_source ppf path source)
374
-
(t.cache_dir, t.cache_dir_source);
375
-
Fmt.pf
376
-
ppf
377
-
"%a %a@,"
378
-
Fmt.(styled `Cyan string)
379
-
"state:"
380
-
(fun ppf (path, source) -> pp_path_with_source ppf path source)
381
-
(t.state_dir, t.state_dir_source);
382
-
Fmt.pf
383
-
ppf
384
-
"%a %a@]@,"
385
-
Fmt.(styled `Cyan string)
386
-
"runtime:"
387
-
(fun ppf (path_opt, source) -> pp_path_opt_with_source ppf path_opt source)
388
-
(t.runtime_dir, t.runtime_dir_source);
389
-
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "System directories:";
390
-
Fmt.pf
391
-
ppf
392
-
"%a [@[<hov>%a@]]@,"
393
-
Fmt.(styled `Cyan string)
394
-
"config_dirs:"
395
-
pp_paths
396
-
t.config_dirs;
397
-
Fmt.pf
398
-
ppf
399
-
"%a [@[<hov>%a@]]@]@]"
400
-
Fmt.(styled `Cyan string)
401
-
"data_dirs:"
402
-
pp_paths
403
-
t.data_dirs)
404
-
;;
405
-
406
-
module Cmd = struct
407
-
type xdg_t = t
408
-
409
-
type 'a with_source =
410
-
{ value : 'a option
411
-
; source : source
412
-
}
413
-
414
-
type t =
415
-
{ config_dir : string with_source
416
-
; data_dir : string with_source
417
-
; cache_dir : string with_source
418
-
; state_dir : string with_source
419
-
; runtime_dir : string with_source
420
-
}
421
-
422
-
let term app_name fs
423
-
?(dirs=[`Config; `Data; `Cache; `State; `Runtime]) () =
424
-
let open Cmdliner in
425
-
let app_upper = String.uppercase_ascii app_name in
426
-
let show_paths =
427
-
let doc = "Show only the resolved directory paths without formatting" in
428
-
Arg.(value & flag & info [ "show-paths" ] ~doc)
429
-
in
430
-
let has_dir d = List.mem d dirs in
431
-
let make_dir_arg ~enabled name env_suffix xdg_var default_path =
432
-
if not enabled then
433
-
(* Return a term that always gives the environment-only result *)
434
-
Term.(const (fun () ->
435
-
let app_env = app_upper ^ "_" ^ env_suffix in
436
-
match Sys.getenv_opt app_env with
437
-
| Some v when v <> "" -> { value = Some v; source = Env app_env }
438
-
| Some _ | None ->
439
-
(match Sys.getenv_opt xdg_var with
440
-
| Some v -> { value = Some v; source = Env xdg_var }
441
-
| None -> { value = None; source = Default }))
442
-
$ const ())
443
-
else
444
-
let app_env = app_upper ^ "_" ^ env_suffix in
445
-
let doc =
446
-
match default_path with
447
-
| Some path ->
448
-
Printf.sprintf
449
-
"Override %s directory. Can also be set with %s or %s. Default: %s"
450
-
name
451
-
app_env
452
-
xdg_var
453
-
path
454
-
| None ->
455
-
Printf.sprintf
456
-
"Override %s directory. Can also be set with %s or %s. No default value."
457
-
name
458
-
app_env
459
-
xdg_var
460
-
in
461
-
let arg =
462
-
Arg.(value & opt (some string) None & info [ name ^ "-dir" ] ~docv:"DIR" ~doc)
463
-
in
464
-
Term.(
465
-
const (fun cmdline_val ->
466
-
match cmdline_val with
467
-
| Some v -> { value = Some v; source = Cmdline }
468
-
| None ->
469
-
(match Sys.getenv_opt app_env with
470
-
| Some v when v <> "" -> { value = Some v; source = Env app_env }
471
-
| Some _ | None ->
472
-
(match Sys.getenv_opt xdg_var with
473
-
| Some v -> { value = Some v; source = Env xdg_var }
474
-
| None -> { value = None; source = Default })))
475
-
$ arg)
476
-
in
477
-
let home_prefix = "\\$HOME" in
478
-
let config_dir =
479
-
make_dir_arg
480
-
~enabled:(has_dir `Config)
481
-
"config"
482
-
"CONFIG_DIR"
483
-
"XDG_CONFIG_HOME"
484
-
(Some (home_prefix ^ "/.config/" ^ app_name))
485
-
in
486
-
let data_dir =
487
-
make_dir_arg
488
-
~enabled:(has_dir `Data)
489
-
"data"
490
-
"DATA_DIR"
491
-
"XDG_DATA_HOME"
492
-
(Some (home_prefix ^ "/.local/share/" ^ app_name))
493
-
in
494
-
let cache_dir =
495
-
make_dir_arg
496
-
~enabled:(has_dir `Cache)
497
-
"cache"
498
-
"CACHE_DIR"
499
-
"XDG_CACHE_HOME"
500
-
(Some (home_prefix ^ "/.cache/" ^ app_name))
501
-
in
502
-
let state_dir =
503
-
make_dir_arg
504
-
~enabled:(has_dir `State)
505
-
"state"
506
-
"STATE_DIR"
507
-
"XDG_STATE_HOME"
508
-
(Some (home_prefix ^ "/.local/state/" ^ app_name))
509
-
in
510
-
let runtime_dir = make_dir_arg ~enabled:(has_dir `Runtime) "runtime" "RUNTIME_DIR" "XDG_RUNTIME_DIR" None in
511
-
Term.(
512
-
const
513
-
(fun
514
-
show_paths_flag
515
-
config_dir_ws
516
-
data_dir_ws
517
-
cache_dir_ws
518
-
state_dir_ws
519
-
runtime_dir_ws
520
-
->
521
-
let config =
522
-
{ config_dir = config_dir_ws
523
-
; data_dir = data_dir_ws
524
-
; cache_dir = cache_dir_ws
525
-
; state_dir = state_dir_ws
526
-
; runtime_dir = runtime_dir_ws
527
-
}
528
-
in
529
-
let home_path = get_home_dir fs in
530
-
(* First validate all standard XDG environment variables *)
531
-
validate_standard_xdg_vars ();
532
-
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
533
-
(* Helper to resolve directory from config with source tracking *)
534
-
let resolve_from_config config_ws xdg_getter =
535
-
match config_ws.value with
536
-
| Some dir -> resolve_path fs home_path dir, config_ws.source
537
-
| None ->
538
-
let xdg_base = xdg_getter xdg_ctx in
539
-
let base_path = resolve_path fs home_path xdg_base in
540
-
Eio.Path.(base_path / app_name), config_ws.source
541
-
in
542
-
(* User directories *)
543
-
let config_dir, config_dir_source =
544
-
resolve_from_config config.config_dir Xdg.config_dir
545
-
in
546
-
let data_dir, data_dir_source =
547
-
resolve_from_config config.data_dir Xdg.data_dir
548
-
in
549
-
let cache_dir, cache_dir_source =
550
-
resolve_from_config config.cache_dir Xdg.cache_dir
551
-
in
552
-
let state_dir, state_dir_source =
553
-
resolve_from_config config.state_dir Xdg.state_dir
554
-
in
555
-
(* Runtime directory *)
556
-
let runtime_dir, runtime_dir_source =
557
-
match config.runtime_dir.value with
558
-
| Some dir -> Some (resolve_path fs home_path dir), config.runtime_dir.source
559
-
| None ->
560
-
( Option.map
561
-
(fun base ->
562
-
let base_path = resolve_path fs home_path base in
563
-
Eio.Path.(base_path / app_name))
564
-
(Xdg.runtime_dir xdg_ctx)
565
-
, config.runtime_dir.source )
566
-
in
567
-
(* System directories - reuse shared helper *)
568
-
let config_dirs =
569
-
resolve_system_dirs
570
-
fs
571
-
home_path
572
-
app_name
573
-
"CONFIG_DIRS"
574
-
"XDG_CONFIG_DIRS"
575
-
[ "/etc/xdg" ]
576
-
in
577
-
let data_dirs =
578
-
resolve_system_dirs
579
-
fs
580
-
home_path
581
-
app_name
582
-
"DATA_DIRS"
583
-
"XDG_DATA_DIRS"
584
-
[ "/usr/local/share"; "/usr/share" ]
585
-
in
586
-
ensure_dir config_dir;
587
-
ensure_dir data_dir;
588
-
ensure_dir cache_dir;
589
-
ensure_dir state_dir;
590
-
Option.iter (ensure_runtime_dir fs) runtime_dir;
591
-
let xdg =
592
-
{ app_name
593
-
; config_dir
594
-
; config_dir_source
595
-
; data_dir
596
-
; data_dir_source
597
-
; cache_dir
598
-
; cache_dir_source
599
-
; state_dir
600
-
; state_dir_source
601
-
; runtime_dir
602
-
; runtime_dir_source
603
-
; config_dirs
604
-
; data_dirs
605
-
}
606
-
in
607
-
(* Handle --show-paths option *)
608
-
if show_paths_flag
609
-
then (
610
-
let print_path name path =
611
-
match path with
612
-
| None -> Printf.printf "%s: <none>\n" name
613
-
| Some p -> Printf.printf "%s: %s\n" name (Eio.Path.native_exn p)
614
-
in
615
-
let print_paths name paths =
616
-
match paths with
617
-
| [] -> Printf.printf "%s: []\n" name
618
-
| paths ->
619
-
let paths_str = String.concat ":" (List.map Eio.Path.native_exn paths) in
620
-
Printf.printf "%s: %s\n" name paths_str
621
-
in
622
-
print_path "config_dir" (Some config_dir);
623
-
print_path "data_dir" (Some data_dir);
624
-
print_path "cache_dir" (Some cache_dir);
625
-
print_path "state_dir" (Some state_dir);
626
-
print_path "runtime_dir" runtime_dir;
627
-
print_paths "config_dirs" config_dirs;
628
-
print_paths "data_dirs" data_dirs;
629
-
Stdlib.exit 0);
630
-
xdg, config)
631
-
$ show_paths
632
-
$ config_dir
633
-
$ data_dir
634
-
$ cache_dir
635
-
$ state_dir
636
-
$ runtime_dir)
637
-
;;
638
-
639
-
let cache_term app_name =
640
-
let open Cmdliner in
641
-
let app_upper = String.uppercase_ascii app_name in
642
-
let app_env = app_upper ^ "_CACHE_DIR" in
643
-
let xdg_var = "XDG_CACHE_HOME" in
644
-
let home = Sys.getenv "HOME" in
645
-
let default_path = home ^ "/.cache/" ^ app_name in
646
-
647
-
let doc =
648
-
Printf.sprintf
649
-
"Override cache directory. Can also be set with %s or %s. Default: %s"
650
-
app_env xdg_var default_path
651
-
in
652
-
653
-
let arg = Arg.(value & opt string default_path & info ["cache-dir"; "c"] ~docv:"DIR" ~doc) in
654
-
655
-
Term.(const (fun cmdline_val ->
656
-
(* Check command line first *)
657
-
if cmdline_val <> default_path then
658
-
cmdline_val
659
-
else
660
-
(* Then check app-specific env var *)
661
-
match Sys.getenv_opt app_env with
662
-
| Some v when v <> "" -> v
663
-
| _ ->
664
-
(* Then check XDG env var *)
665
-
match Sys.getenv_opt xdg_var with
666
-
| Some v when v <> "" -> v ^ "/" ^ app_name
667
-
| _ -> default_path
668
-
) $ arg)
669
-
;;
670
-
671
-
let env_docs app_name =
672
-
let app_upper = String.uppercase_ascii app_name in
673
-
Printf.sprintf
674
-
{|
675
-
Configuration Precedence (follows standard Unix conventions):
676
-
1. Command-line flags (e.g., --config-dir) - highest priority
677
-
2. Application-specific environment variable (e.g., %s_CONFIG_DIR)
678
-
3. XDG standard environment variable (e.g., XDG_CONFIG_HOME)
679
-
4. Default path (e.g., ~/.config/%s) - lowest priority
680
-
681
-
This allows per-application overrides without affecting other XDG-compliant programs.
682
-
For example, setting %s_CONFIG_DIR only changes the config directory for %s,
683
-
while XDG_CONFIG_HOME affects all XDG-compliant applications.
684
-
685
-
Application-specific variables:
686
-
%s_CONFIG_DIR Override config directory for %s only
687
-
%s_DATA_DIR Override data directory for %s only
688
-
%s_CACHE_DIR Override cache directory for %s only
689
-
%s_STATE_DIR Override state directory for %s only
690
-
%s_RUNTIME_DIR Override runtime directory for %s only
691
-
692
-
XDG standard variables (shared by all XDG applications):
693
-
XDG_CONFIG_HOME User configuration directory (default: ~/.config/%s)
694
-
XDG_DATA_HOME User data directory (default: ~/.local/share/%s)
695
-
XDG_CACHE_HOME User cache directory (default: ~/.cache/%s)
696
-
XDG_STATE_HOME User state directory (default: ~/.local/state/%s)
697
-
XDG_RUNTIME_DIR User runtime directory (no default)
698
-
XDG_CONFIG_DIRS System configuration directories (default: /etc/xdg/%s)
699
-
XDG_DATA_DIRS System data directories (default: /usr/local/share/%s:/usr/share/%s)
700
-
|}
701
-
app_upper
702
-
app_name
703
-
app_upper
704
-
app_name
705
-
app_upper
706
-
app_name
707
-
app_upper
708
-
app_name
709
-
app_upper
710
-
app_name
711
-
app_upper
712
-
app_name
713
-
app_upper
714
-
app_name
715
-
app_name
716
-
app_name
717
-
app_name
718
-
app_name
719
-
app_name
720
-
app_name
721
-
app_name
722
-
;;
723
-
724
-
let pp ppf config =
725
-
let pp_source ppf = function
726
-
| Default -> Fmt.(styled `Faint string) ppf "default"
727
-
| Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
728
-
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
729
-
in
730
-
let pp_with_source name ppf ws =
731
-
match ws.value with
732
-
| None when ws.source = Default -> ()
733
-
| None ->
734
-
Fmt.pf
735
-
ppf
736
-
"@,%a %a %a"
737
-
Fmt.(styled `Cyan string)
738
-
(name ^ ":")
739
-
Fmt.(styled `Red string)
740
-
"<unset>"
741
-
Fmt.(styled `Faint (brackets pp_source))
742
-
ws.source
743
-
| Some value ->
744
-
Fmt.pf
745
-
ppf
746
-
"@,%a %a %a"
747
-
Fmt.(styled `Cyan string)
748
-
(name ^ ":")
749
-
Fmt.(styled `Green string)
750
-
value
751
-
Fmt.(styled `Faint (brackets pp_source))
752
-
ws.source
753
-
in
754
-
Fmt.pf
755
-
ppf
756
-
"@[<v>%a%a%a%a%a%a@]"
757
-
Fmt.(styled `Bold string)
758
-
"XDG config:"
759
-
(pp_with_source "config_dir")
760
-
config.config_dir
761
-
(pp_with_source "data_dir")
762
-
config.data_dir
763
-
(pp_with_source "cache_dir")
764
-
config.cache_dir
765
-
(pp_with_source "state_dir")
766
-
config.state_dir
767
-
(pp_with_source "runtime_dir")
768
-
config.runtime_dir
769
-
;;
770
-
end
-415
stack/xdge/lib/xdge.mli
-415
stack/xdge/lib/xdge.mli
···
1
-
(** XDG Base Directory Specification support with Eio capabilities
2
-
3
-
This library provides an OCaml implementation of the XDG Base Directory
4
-
Specification with Eio filesystem integration. The XDG specification defines
5
-
standard locations for user-specific and system-wide application files,
6
-
helping to keep user home directories clean and organized.
7
-
8
-
The specification is available at:
9
-
{{:https://specifications.freedesktop.org/basedir-spec/latest/} XDG Base Directory Specification}
10
-
11
-
{b Key Concepts:}
12
-
13
-
The XDG specification defines several types of directories:
14
-
- {b User directories}: Store user-specific files (config, data, cache, state, runtime)
15
-
- {b System directories}: Store system-wide files shared across users
16
-
- {b Precedence}: User directories take precedence over system directories
17
-
- {b Application isolation}: Each application gets its own subdirectory
18
-
19
-
{b Environment Variable Precedence:}
20
-
21
-
This library follows a three-level precedence system:
22
-
+ Application-specific variables (e.g., [MYAPP_CONFIG_DIR]) - highest priority
23
-
+ XDG standard variables (e.g., [XDG_CONFIG_HOME])
24
-
+ Default paths (e.g., [$HOME/.config]) - lowest priority
25
-
26
-
This allows fine-grained control over directory locations without affecting
27
-
other XDG-compliant applications.
28
-
29
-
{b Directory Creation:}
30
-
31
-
All directories are automatically created with appropriate permissions (0o755)
32
-
when accessed, except for runtime directories which require stricter permissions
33
-
as per the specification.
34
-
35
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/> XDG Base Directory Specification *)
36
-
37
-
(** The main XDG context type containing all directory paths for an application.
38
-
39
-
A value of type [t] represents the complete XDG directory structure for a
40
-
specific application, including both user-specific and system-wide directories.
41
-
All paths are resolved at creation time and are absolute paths within the
42
-
Eio filesystem. *)
43
-
type t
44
-
45
-
(** XDG directory types for specifying which directories an application needs.
46
-
47
-
These polymorphic variants allow applications to declare which XDG directories
48
-
they use, enabling runtime systems to only provide the requested directories. *)
49
-
type dir = [
50
-
| `Config (** User configuration files *)
51
-
| `Cache (** User-specific cached data *)
52
-
| `Data (** User-specific application data *)
53
-
| `State (** User-specific state data (logs, history, etc.) *)
54
-
| `Runtime (** User-specific runtime files (sockets, pipes, etc.) *)
55
-
]
56
-
57
-
(** {1 Exceptions} *)
58
-
59
-
(** Exception raised when XDG environment variables contain invalid paths.
60
-
61
-
The XDG specification requires all paths in environment variables to be
62
-
absolute. This exception is raised when a relative path is found. *)
63
-
exception Invalid_xdg_path of string
64
-
65
-
(** {1 Construction} *)
66
-
67
-
(** [create fs app_name] creates an XDG context for the given application.
68
-
69
-
This function initializes the complete XDG directory structure for your application,
70
-
resolving all paths according to the environment variables and creating directories
71
-
as needed.
72
-
73
-
@param fs The Eio filesystem providing filesystem access
74
-
@param app_name The name of your application (used as subdirectory name)
75
-
76
-
{b Path Resolution:}
77
-
78
-
For each directory type, the following precedence is used:
79
-
+ Application-specific environment variable (e.g., [MYAPP_CONFIG_DIR])
80
-
+ XDG standard environment variable (e.g., [XDG_CONFIG_HOME])
81
-
+ Default path as specified in the XDG specification
82
-
83
-
{b Example:}
84
-
{[
85
-
let xdg = Xdge.create env#fs "myapp" in
86
-
let config = Xdge.config_dir xdg in
87
-
(* config is now <fs:$HOME/.config/myapp> or the overridden path *)
88
-
]}
89
-
90
-
All directories are created with permissions 0o755 if they don't exist,
91
-
except for runtime directories which are created with 0o700 permissions and
92
-
validated according to the XDG specification.
93
-
94
-
@raise Invalid_xdg_path if any environment variable contains a relative path *)
95
-
val create : Eio.Fs.dir_ty Eio.Path.t -> string -> t
96
-
97
-
(** {1 Accessors} *)
98
-
99
-
(** [app_name t] returns the application name used when creating this XDG context.
100
-
101
-
This is the name that was passed to {!create} and is used as the subdirectory
102
-
name within each XDG base directory. *)
103
-
val app_name : t -> string
104
-
105
-
(** {1 Base Directories} *)
106
-
107
-
(** [config_dir t] returns the path to user-specific configuration files.
108
-
109
-
{b Purpose:} Store user preferences, settings, and configuration files.
110
-
Configuration files should be human-readable when possible.
111
-
112
-
{b Environment Variables:}
113
-
- [${APP_NAME}_CONFIG_DIR]: Application-specific override (highest priority)
114
-
- [XDG_CONFIG_HOME]: XDG standard variable
115
-
- Default: [$HOME/.config/{app_name}]
116
-
117
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_CONFIG_HOME specification *)
118
-
val config_dir : t -> Eio.Fs.dir_ty Eio.Path.t
119
-
120
-
(** [data_dir t] returns the path to user-specific data files.
121
-
122
-
{b Purpose:} Store persistent application data that should be preserved
123
-
across application restarts and system reboots. This data is typically
124
-
not modified by users directly.
125
-
126
-
{b Environment Variables:}
127
-
- [${APP_NAME}_DATA_DIR]: Application-specific override (highest priority)
128
-
- [XDG_DATA_HOME]: XDG standard variable
129
-
- Default: [$HOME/.local/share/{app_name}]
130
-
131
-
{b Example Files:}
132
-
- Application databases
133
-
- User-generated content (documents, projects)
134
-
- Downloaded resources
135
-
- Application plugins or extensions
136
-
137
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_DATA_HOME specification *)
138
-
val data_dir : t -> Eio.Fs.dir_ty Eio.Path.t
139
-
140
-
(** [cache_dir t] returns the path to user-specific cache files.
141
-
142
-
{b Purpose:} Store non-essential cached data that can be regenerated
143
-
if deleted. The application should remain functional if this directory
144
-
is cleared, though performance may be temporarily impacted.
145
-
146
-
{b Environment Variables:}
147
-
- [${APP_NAME}_CACHE_DIR]: Application-specific override (highest priority)
148
-
- [XDG_CACHE_HOME]: XDG standard variable
149
-
- Default: [$HOME/.cache/{app_name}]
150
-
151
-
{b Example Files:}
152
-
- Downloaded thumbnails and previews
153
-
- Compiled bytecode or object files
154
-
- Network response caches
155
-
- Temporary computation results
156
-
157
-
Users may clear cache directories to free disk space, so
158
-
always check for cache validity and be prepared to regenerate data.
159
-
160
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_CACHE_HOME specification *)
161
-
val cache_dir : t -> Eio.Fs.dir_ty Eio.Path.t
162
-
163
-
(** [state_dir t] returns the path to user-specific state files.
164
-
165
-
{b Purpose:} Store persistent state data that should be preserved between
166
-
application restarts but is not important enough to be user data. This
167
-
includes application state that can be regenerated but would impact the
168
-
user experience if lost.
169
-
170
-
{b Environment Variables:}
171
-
- [${APP_NAME}_STATE_DIR]: Application-specific override (highest priority)
172
-
- [XDG_STATE_HOME]: XDG standard variable
173
-
- Default: [$HOME/.local/state/{app_name}]
174
-
175
-
{b Example Files:}
176
-
- Application history (recently used files, command history)
177
-
- Current application state (window positions, open tabs)
178
-
- Logs and journal files
179
-
- Undo/redo history
180
-
181
-
{b Comparison with other directories:}
182
-
- Unlike cache: State should persist between reboots
183
-
- Unlike data: State can be regenerated (though inconvenient)
184
-
- Unlike config: State changes frequently during normal use
185
-
186
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_STATE_HOME specification *)
187
-
val state_dir : t -> Eio.Fs.dir_ty Eio.Path.t
188
-
189
-
(** [runtime_dir t] returns the path to user-specific runtime files.
190
-
191
-
{b Purpose:} Store runtime files such as sockets, named pipes, and
192
-
process IDs. These files are only valid for the duration of the user's
193
-
login session.
194
-
195
-
{b Environment Variables:}
196
-
- [${APP_NAME}_RUNTIME_DIR]: Application-specific override (highest priority)
197
-
- [XDG_RUNTIME_DIR]: XDG standard variable
198
-
- Default: None (returns [None] if not set)
199
-
200
-
{b Required Properties (per specification):}
201
-
- Owned by the user with access mode 0700
202
-
- Bound to the user login session lifetime
203
-
- Located on a local filesystem (not networked)
204
-
- Fully-featured by the OS (supporting proper locking, etc.)
205
-
206
-
{b Example Files:}
207
-
- Unix domain sockets
208
-
- Named pipes (FIFOs)
209
-
- Lock files
210
-
- Small process communication files
211
-
212
-
This may return [None] if no suitable runtime directory
213
-
is available. Applications should handle this gracefully, perhaps by
214
-
falling back to [/tmp] with appropriate security measures.
215
-
216
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_RUNTIME_DIR specification *)
217
-
val runtime_dir : t -> Eio.Fs.dir_ty Eio.Path.t option
218
-
219
-
(** {1 System Directories} *)
220
-
221
-
(** [config_dirs t] returns search paths for system-wide configuration files.
222
-
223
-
{b Purpose:} Provide a search path for configuration files that are
224
-
shared between multiple users. Files in user-specific {!config_dir}
225
-
take precedence over these system directories.
226
-
227
-
{b Environment Variables:}
228
-
- [${APP_NAME}_CONFIG_DIRS]: Application-specific override (highest priority)
229
-
- [XDG_CONFIG_DIRS]: XDG standard variable (colon-separated list)
230
-
- Default: [[/etc/xdg/{app_name}]]
231
-
232
-
{b Search Order:}
233
-
Directories are ordered by preference, with earlier entries taking
234
-
precedence over later ones. When looking for a configuration file,
235
-
search {!config_dir} first, then each directory in this list.
236
-
237
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_CONFIG_DIRS specification *)
238
-
val config_dirs : t -> Eio.Fs.dir_ty Eio.Path.t list
239
-
240
-
(** [data_dirs t] returns search paths for system-wide data files.
241
-
242
-
{b Purpose:} Provide a search path for data files that are shared
243
-
between multiple users. Files in user-specific {!data_dir} take
244
-
precedence over these system directories.
245
-
246
-
{b Environment Variables:}
247
-
- [${APP_NAME}_DATA_DIRS]: Application-specific override (highest priority)
248
-
- [XDG_DATA_DIRS]: XDG standard variable (colon-separated list)
249
-
- Default: [[/usr/local/share/{app_name}; /usr/share/{app_name}]]
250
-
251
-
{b Search Order:}
252
-
Directories are ordered by preference, with earlier entries taking
253
-
precedence over later ones. When looking for a data file, search
254
-
{!data_dir} first, then each directory in this list.
255
-
256
-
{b Example Files:}
257
-
- Application icons and themes
258
-
- Desktop files
259
-
- Shared application resources
260
-
- Documentation files
261
-
- Default templates
262
-
263
-
@see <https://specifications.freedesktop.org/basedir-spec/latest/#variables> XDG_DATA_DIRS specification *)
264
-
val data_dirs : t -> Eio.Fs.dir_ty Eio.Path.t list
265
-
266
-
(** {1 File Search} *)
267
-
268
-
(** [find_config_file t filename] searches for a configuration file following XDG precedence.
269
-
270
-
This function searches for the given filename in the user configuration directory
271
-
first, then in system configuration directories in order of preference.
272
-
Files that are inaccessible (due to permissions, non-existence, etc.) are
273
-
silently skipped as per the XDG specification.
274
-
275
-
@param t The XDG context
276
-
@param filename The name of the file to search for
277
-
@return [Some path] if found, [None] if not found in any directory
278
-
279
-
{b Search Order:}
280
-
1. User config directory ({!config_dir})
281
-
2. System config directories ({!config_dirs}) in preference order
282
-
283
-
*)
284
-
val find_config_file : t -> string -> Eio.Fs.dir_ty Eio.Path.t option
285
-
286
-
(** [find_data_file t filename] searches for a data file following XDG precedence.
287
-
288
-
This function searches for the given filename in the user data directory
289
-
first, then in system data directories in order of preference.
290
-
Files that are inaccessible (due to permissions, non-existence, etc.) are
291
-
silently skipped as per the XDG specification.
292
-
293
-
@param t The XDG context
294
-
@param filename The name of the file to search for
295
-
@return [Some path] if found, [None] if not found in any directory
296
-
297
-
{b Search Order:}
298
-
1. User data directory ({!data_dir})
299
-
2. System data directories ({!data_dirs}) in preference order
300
-
301
-
*)
302
-
val find_data_file : t -> string -> Eio.Fs.dir_ty Eio.Path.t option
303
-
304
-
(** {1 Pretty Printing} *)
305
-
306
-
(** [pp ?brief ?sources ppf t] pretty prints the XDG directory configuration.
307
-
308
-
@param brief If [true], prints a compact one-line summary (default: [false])
309
-
@param sources If [true], shows the source of each directory value,
310
-
indicating whether it came from defaults, environment
311
-
variables, or command line (default: [false])
312
-
@param ppf The formatter to print to
313
-
@param t The XDG context to print
314
-
315
-
{b Output formats:}
316
-
- Normal: Multi-line detailed view of all directories
317
-
- Brief: Single line showing app name and key directories
318
-
- With sources: Adds annotations showing where each path came from
319
-
*)
320
-
val pp : ?brief:bool -> ?sources:bool -> Format.formatter -> t -> unit
321
-
322
-
(** {1 Cmdliner Integration} *)
323
-
324
-
module Cmd : sig
325
-
(** The type of the outer XDG context *)
326
-
type xdg_t = t
327
-
(** Cmdliner integration for XDG directory configuration.
328
-
329
-
This module provides integration with the Cmdliner library,
330
-
allowing XDG directories to be configured via command-line arguments
331
-
while respecting the precedence of environment variables. *)
332
-
333
-
(** Type of XDG configuration gathered from command-line and environment.
334
-
335
-
This contains all XDG directory paths along with their sources,
336
-
as determined by command-line arguments and environment variables. *)
337
-
type t
338
-
339
-
(** [term app_name fs ?dirs ()] creates a Cmdliner term for XDG directory configuration.
340
-
341
-
This function generates a Cmdliner term that handles XDG directory
342
-
configuration through both command-line flags and environment variables,
343
-
and directly returns the XDG context. Only command-line flags for the
344
-
requested directories are generated.
345
-
346
-
@param app_name The application name (used for environment variable prefixes)
347
-
@param fs The Eio filesystem to use for path resolution
348
-
@param dirs List of directories to include flags for (default: all directories)
349
-
350
-
{b Generated Command-line Flags:}
351
-
Only the flags for requested directories are generated:
352
-
- [--config-dir DIR]: Override configuration directory (if [`Config] in dirs)
353
-
- [--data-dir DIR]: Override data directory (if [`Data] in dirs)
354
-
- [--cache-dir DIR]: Override cache directory (if [`Cache] in dirs)
355
-
- [--state-dir DIR]: Override state directory (if [`State] in dirs)
356
-
- [--runtime-dir DIR]: Override runtime directory (if [`Runtime] in dirs)
357
-
358
-
{b Environment Variable Precedence:}
359
-
For each directory type, the following precedence applies:
360
-
+ Command-line flag (e.g., [--config-dir]) - if enabled
361
-
+ Application-specific variable (e.g., [MYAPP_CONFIG_DIR])
362
-
+ XDG standard variable (e.g., [XDG_CONFIG_HOME])
363
-
+ Default value
364
-
*)
365
-
val term : string -> Eio.Fs.dir_ty Eio.Path.t ->
366
-
?dirs:dir list ->
367
-
unit -> (xdg_t * t) Cmdliner.Term.t
368
-
369
-
(** [cache_term app_name] creates a Cmdliner term that provides just the cache
370
-
directory path as a string, respecting XDG precedence.
371
-
372
-
This is a convenience function for applications that only need cache
373
-
directory configuration. It returns the resolved cache directory path
374
-
directly as a string, suitable for use in other Cmdliner terms.
375
-
376
-
@param app_name The application name (used for environment variable prefixes)
377
-
378
-
{b Generated Command-line Flag:}
379
-
- [--cache-dir DIR]: Override cache directory
380
-
381
-
{b Environment Variable Precedence:}
382
-
+ Command-line flag ([--cache-dir])
383
-
+ Application-specific variable (e.g., [MYAPP_CACHE_DIR])
384
-
+ XDG standard variable ([XDG_CACHE_HOME])
385
-
+ Default value ([$HOME/.cache/{app_name}])
386
-
*)
387
-
val cache_term : string -> string Cmdliner.Term.t
388
-
389
-
(** [env_docs app_name] generates documentation for environment variables.
390
-
391
-
Returns a formatted string documenting all environment variables that
392
-
affect XDG directory configuration for the given application. This is
393
-
useful for generating man pages or help text.
394
-
395
-
@param app_name The application name
396
-
@return A formatted documentation string
397
-
398
-
{b Included Information:}
399
-
- Configuration precedence rules
400
-
- Application-specific environment variables
401
-
- XDG standard environment variables
402
-
- Default values for each directory type
403
-
*)
404
-
val env_docs : string -> string
405
-
406
-
(** [pp ppf config] pretty prints a Cmdliner configuration.
407
-
408
-
This function formats the configuration showing each directory path
409
-
along with its source, which is helpful for debugging configuration
410
-
issues or displaying the current configuration to users.
411
-
412
-
@param ppf The formatter to print to
413
-
@param config The configuration to print *)
414
-
val pp : Format.formatter -> t -> unit
415
-
end
-6
stack/xdge/test/dune
-6
stack/xdge/test/dune
-112
stack/xdge/test/test_paths.ml
-112
stack/xdge/test/test_paths.ml
···
1
-
let test_path_validation () =
2
-
Printf.printf "Testing XDG path validation...\n";
3
-
(* Test absolute path validation for environment variables *)
4
-
let test_relative_path_rejection env_var relative_path =
5
-
Printf.printf "Testing rejection of relative path in %s...\n" env_var;
6
-
Unix.putenv env_var relative_path;
7
-
try
8
-
Eio_main.run
9
-
@@ fun env ->
10
-
let _ = Xdge.create env#fs "test_validation" in
11
-
Printf.printf "ERROR: Should have rejected relative path\n";
12
-
false
13
-
with
14
-
| Xdge.Invalid_xdg_path msg ->
15
-
Printf.printf "SUCCESS: Correctly rejected relative path: %s\n" msg;
16
-
true
17
-
| exn ->
18
-
Printf.printf "ERROR: Wrong exception: %s\n" (Printexc.to_string exn);
19
-
false
20
-
in
21
-
let old_config_home = Sys.getenv_opt "XDG_CONFIG_HOME" in
22
-
let old_data_dirs = Sys.getenv_opt "XDG_DATA_DIRS" in
23
-
let success1 = test_relative_path_rejection "XDG_CONFIG_HOME" "relative/path" in
24
-
let success2 = test_relative_path_rejection "XDG_DATA_DIRS" "rel1:rel2:/abs/path" in
25
-
(* Restore original env vars *)
26
-
(match old_config_home with
27
-
| Some v -> Unix.putenv "XDG_CONFIG_HOME" v
28
-
| None ->
29
-
(try Unix.putenv "XDG_CONFIG_HOME" "" with
30
-
| _ -> ()));
31
-
(match old_data_dirs with
32
-
| Some v -> Unix.putenv "XDG_DATA_DIRS" v
33
-
| None ->
34
-
(try Unix.putenv "XDG_DATA_DIRS" "" with
35
-
| _ -> ()));
36
-
success1 && success2
37
-
;;
38
-
39
-
let test_file_search () =
40
-
Printf.printf "\nTesting XDG file search...\n";
41
-
Eio_main.run
42
-
@@ fun env ->
43
-
let xdg = Xdge.create env#fs "search_test" in
44
-
(* Create test files *)
45
-
let config_file = Eio.Path.(Xdge.config_dir xdg / "test.conf") in
46
-
let data_file = Eio.Path.(Xdge.data_dir xdg / "test.dat") in
47
-
Eio.Path.save ~create:(`Or_truncate 0o644) config_file "config content";
48
-
Eio.Path.save ~create:(`Or_truncate 0o644) data_file "data content";
49
-
(* Test finding existing files *)
50
-
(match Xdge.find_config_file xdg "test.conf" with
51
-
| Some path ->
52
-
let content = Eio.Path.load path in
53
-
Printf.printf "Found config file: %s\n" (String.trim content)
54
-
| None -> Printf.printf "ERROR: Config file not found\n");
55
-
(match Xdge.find_data_file xdg "test.dat" with
56
-
| Some path ->
57
-
let content = Eio.Path.load path in
58
-
Printf.printf "Found data file: %s\n" (String.trim content)
59
-
| None -> Printf.printf "ERROR: Data file not found\n");
60
-
(* Test non-existent file *)
61
-
match Xdge.find_config_file xdg "nonexistent.conf" with
62
-
| Some _ -> Printf.printf "ERROR: Should not have found nonexistent file\n"
63
-
| None -> Printf.printf "Correctly handled nonexistent file\n"
64
-
;;
65
-
66
-
let () =
67
-
(* Check if we should run validation tests *)
68
-
if Array.length Sys.argv > 1 && Sys.argv.(1) = "--validate"
69
-
then (
70
-
let validation_success = test_path_validation () in
71
-
test_file_search ();
72
-
if validation_success
73
-
then Printf.printf "\nAll path validation tests passed!\n"
74
-
else Printf.printf "\nSome validation tests failed!\n")
75
-
else
76
-
(* Run original simple functionality test *)
77
-
Eio_main.run
78
-
@@ fun env ->
79
-
let xdg = Xdge.create env#fs "path_test" in
80
-
(* Test config subdirectory *)
81
-
let profiles_path = Eio.Path.(Xdge.config_dir xdg / "profiles") in
82
-
let profile_file = Eio.Path.(profiles_path / "default.json") in
83
-
(try
84
-
let content = Eio.Path.load profile_file in
85
-
Printf.printf "config file content: %s" (String.trim content)
86
-
with
87
-
| exn -> Printf.printf "config file error: %s" (Printexc.to_string exn));
88
-
(* Test data subdirectory *)
89
-
let db_path = Eio.Path.(Xdge.data_dir xdg / "databases") in
90
-
let db_file = Eio.Path.(db_path / "main.db") in
91
-
(try
92
-
let content = Eio.Path.load db_file in
93
-
Printf.printf "\ndata file content: %s" (String.trim content)
94
-
with
95
-
| exn -> Printf.printf "\ndata file error: %s" (Printexc.to_string exn));
96
-
(* Test cache subdirectory *)
97
-
let cache_path = Eio.Path.(Xdge.cache_dir xdg / "thumbnails") in
98
-
let cache_file = Eio.Path.(cache_path / "thumb1.png") in
99
-
(try
100
-
let content = Eio.Path.load cache_file in
101
-
Printf.printf "\ncache file content: %s" (String.trim content)
102
-
with
103
-
| exn -> Printf.printf "\ncache file error: %s" (Printexc.to_string exn));
104
-
(* Test state subdirectory *)
105
-
let logs_path = Eio.Path.(Xdge.state_dir xdg / "logs") in
106
-
let log_file = Eio.Path.(logs_path / "app.log") in
107
-
try
108
-
let content = Eio.Path.load log_file in
109
-
Printf.printf "\nstate file content: %s\n" (String.trim content)
110
-
with
111
-
| exn -> Printf.printf "\nstate file error: %s\n" (Printexc.to_string exn)
112
-
;;
-402
stack/xdge/test/xdg.t
-402
stack/xdge/test/xdg.t
···
1
-
Test with default directories:
2
-
3
-
$ export HOME=./test_home
4
-
$ unset XDG_CONFIG_HOME XDG_DATA_HOME XDG_CACHE_HOME XDG_STATE_HOME XDG_RUNTIME_DIR
5
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
6
-
$ ../example/xdg_example.exe
7
-
=== Cmdliner Config ===
8
-
XDG config:
9
-
10
-
=== XDG Directories ===
11
-
XDG directories for 'xdg_example':
12
-
User directories:
13
-
config: <fs:./test_home/./test_home/.config/xdg_example> [default]
14
-
data: <fs:./test_home/./test_home/.local/share/xdg_example> [default]
15
-
cache: <fs:./test_home/./test_home/.cache/xdg_example> [default]
16
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
17
-
runtime: <none> [default]
18
-
System directories:
19
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
20
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
21
-
22
-
This test is correct: No command-line args or env vars are set, so all directories
23
-
use defaults. Config shows empty (no overrides), and directories show [default] source.
24
-
User directories follow XDG spec: ~/.config, ~/.local/share, ~/.cache, ~/.local/state.
25
-
Runtime dir is <none> since XDG_RUNTIME_DIR has no default.
26
-
System dirs use XDG spec defaults: /etc/xdg for config, /usr/{local/,}share for data.
27
-
28
-
Test with all command line arguments specified
29
-
$ unset XDG_CONFIG_HOME XDG_DATA_HOME XDG_CACHE_HOME XDG_STATE_HOME XDG_RUNTIME_DIR
30
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
31
-
$ ../example/xdg_example.exe \
32
-
> --config-dir ./test-config \
33
-
> --data-dir ./test-data \
34
-
> --cache-dir ./test-cache \
35
-
> --state-dir ./test-state \
36
-
> --runtime-dir ./test-runtime
37
-
=== Cmdliner Config ===
38
-
XDG config:
39
-
config_dir: ./test-config [cmdline]
40
-
data_dir: ./test-data [cmdline]
41
-
cache_dir: ./test-cache [cmdline]
42
-
state_dir: ./test-state [cmdline]
43
-
runtime_dir: ./test-runtime [cmdline]
44
-
45
-
=== XDG Directories ===
46
-
XDG directories for 'xdg_example':
47
-
User directories:
48
-
config: <fs:./test_home/./test-config> [cmdline]
49
-
data: <fs:./test_home/./test-data> [cmdline]
50
-
cache: <fs:./test_home/./test-cache> [cmdline]
51
-
state: <fs:./test_home/./test-state> [cmdline]
52
-
runtime: <fs:./test_home/./test-runtime> [cmdline]
53
-
System directories:
54
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
55
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
56
-
57
-
This test is correct: All user directories are overridden by command-line arguments,
58
-
showing [cmdline] as the source. The config section shows all overrides with their
59
-
values and [cmdline] sources. System directories remain at their defaults since
60
-
they cannot be overridden by user directories command-line options.
61
-
62
-
Test with environment variables (app-specific)
63
-
$ XDG_EXAMPLE_CONFIG_DIR=./env-config \
64
-
> XDG_EXAMPLE_DATA_DIR=./env-data \
65
-
> XDG_EXAMPLE_CACHE_DIR=./env-cache \
66
-
> XDG_EXAMPLE_STATE_DIR=./env-state \
67
-
> XDG_EXAMPLE_RUNTIME_DIR=./env-runtime \
68
-
> ../example/xdg_example.exe
69
-
=== Cmdliner Config ===
70
-
XDG config:
71
-
config_dir: ./env-config [env(XDG_EXAMPLE_CONFIG_DIR)]
72
-
data_dir: ./env-data [env(XDG_EXAMPLE_DATA_DIR)]
73
-
cache_dir: ./env-cache [env(XDG_EXAMPLE_CACHE_DIR)]
74
-
state_dir: ./env-state [env(XDG_EXAMPLE_STATE_DIR)]
75
-
runtime_dir: ./env-runtime [env(XDG_EXAMPLE_RUNTIME_DIR)]
76
-
77
-
=== XDG Directories ===
78
-
XDG directories for 'xdg_example':
79
-
User directories:
80
-
config: <fs:./test_home/./env-config> [env(XDG_EXAMPLE_CONFIG_DIR)]
81
-
data: <fs:./test_home/./env-data> [env(XDG_EXAMPLE_DATA_DIR)]
82
-
cache: <fs:./test_home/./env-cache> [env(XDG_EXAMPLE_CACHE_DIR)]
83
-
state: <fs:./test_home/./env-state> [env(XDG_EXAMPLE_STATE_DIR)]
84
-
runtime: <fs:./test_home/./env-runtime> [env(XDG_EXAMPLE_RUNTIME_DIR)]
85
-
System directories:
86
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
87
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
88
-
89
-
This test is correct: App-specific environment variables (XDG_EXAMPLE_*) override
90
-
the defaults. The source correctly shows [env(XDG_EXAMPLE_*)] for each variable.
91
-
These app-specific variables take precedence over XDG standard variables when both
92
-
are available, allowing per-application customization.
93
-
94
-
Test with standard XDG environment variables:
95
-
96
-
$ XDG_CONFIG_HOME=/tmp/xdge/xdg-config \
97
-
> XDG_DATA_HOME=/tmp/xdge/xdg-data \
98
-
> XDG_CACHE_HOME=/tmp/xdge/xdg-cache \
99
-
> XDG_STATE_HOME=/tmp/xdge/xdg-state \
100
-
> XDG_RUNTIME_DIR=/tmp/xdge/xdg-runtime \
101
-
> ../example/xdg_example.exe
102
-
=== Cmdliner Config ===
103
-
XDG config:
104
-
config_dir: /tmp/xdge/xdg-config [env(XDG_CONFIG_HOME)]
105
-
data_dir: /tmp/xdge/xdg-data [env(XDG_DATA_HOME)]
106
-
cache_dir: /tmp/xdge/xdg-cache [env(XDG_CACHE_HOME)]
107
-
state_dir: /tmp/xdge/xdg-state [env(XDG_STATE_HOME)]
108
-
runtime_dir: /tmp/xdge/xdg-runtime [env(XDG_RUNTIME_DIR)]
109
-
110
-
=== XDG Directories ===
111
-
XDG directories for 'xdg_example':
112
-
User directories:
113
-
config: <fs:/tmp/xdge/xdg-config> [env(XDG_CONFIG_HOME)]
114
-
data: <fs:/tmp/xdge/xdg-data> [env(XDG_DATA_HOME)]
115
-
cache: <fs:/tmp/xdge/xdg-cache> [env(XDG_CACHE_HOME)]
116
-
state: <fs:/tmp/xdge/xdg-state> [env(XDG_STATE_HOME)]
117
-
runtime: <fs:/tmp/xdge/xdg-runtime> [env(XDG_RUNTIME_DIR)]
118
-
System directories:
119
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
120
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
121
-
122
-
This test is correct: Standard XDG environment variables (XDG_*_HOME, XDG_RUNTIME_DIR)
123
-
override the defaults. The source correctly shows [env(XDG_*)] for each variable.
124
-
Note that the user directories use the raw paths from env vars (not app-specific subdirs)
125
-
since XDG_CONFIG_HOME etc. are intended to be the base directories for the user.
126
-
127
-
Test command line overrides environment variables:
128
-
129
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
130
-
$ XDG_EXAMPLE_CONFIG_DIR=./env-config \
131
-
> ../example/xdg_example.exe --config-dir ./cli-config
132
-
=== Cmdliner Config ===
133
-
XDG config:
134
-
config_dir: ./cli-config [cmdline]
135
-
136
-
=== XDG Directories ===
137
-
XDG directories for 'xdg_example':
138
-
User directories:
139
-
config: <fs:./test_home/./cli-config> [cmdline]
140
-
data: <fs:./test_home/./test_home/.local/share/xdg_example> [default]
141
-
cache: <fs:./test_home/./test_home/.cache/xdg_example> [default]
142
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
143
-
runtime: <none> [default]
144
-
System directories:
145
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
146
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
147
-
148
-
This test is correct: Command-line arguments have highest precedence, overriding
149
-
environment variables. Only config_dir is shown in the config section since it is
150
-
the only one explicitly set. The config_dir shows [cmdline] source while other
151
-
directories fall back to defaults, demonstrating the precedence hierarchy:
152
-
of cmdline then app env vars then XDG env vars then defaults.
153
-
154
-
Test mixed environment variable precedence (app-specific overrides XDG standard):
155
-
156
-
$ export HOME=./test_home
157
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
158
-
$ XDG_CONFIG_HOME=/tmp/xdge/xdg-config \
159
-
> XDG_EXAMPLE_CONFIG_DIR=./app-config \
160
-
> XDG_DATA_HOME=/tmp/xdge/xdg-data \
161
-
> XDG_EXAMPLE_DATA_DIR=./app-data \
162
-
> ../example/xdg_example.exe
163
-
=== Cmdliner Config ===
164
-
XDG config:
165
-
config_dir: ./app-config [env(XDG_EXAMPLE_CONFIG_DIR)]
166
-
data_dir: ./app-data [env(XDG_EXAMPLE_DATA_DIR)]
167
-
168
-
=== XDG Directories ===
169
-
XDG directories for 'xdg_example':
170
-
User directories:
171
-
config: <fs:./test_home/./app-config> [env(XDG_EXAMPLE_CONFIG_DIR)]
172
-
data: <fs:./test_home/./app-data> [env(XDG_EXAMPLE_DATA_DIR)]
173
-
cache: <fs:./test_home/./test_home/.cache/xdg_example> [default]
174
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
175
-
runtime: <none> [default]
176
-
System directories:
177
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
178
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
179
-
180
-
This test is correct: Demonstrates app-specific environment variables taking
181
-
precedence over XDG standard ones. Both XDG_CONFIG_HOME and XDG_EXAMPLE_CONFIG_DIR
182
-
are set, but the app-specific one wins. Same for data directories. Cache, state,
183
-
and runtime fall back to defaults since no variables are set for them.
184
-
185
-
Test partial environment variable override:
186
-
187
-
$ export HOME=./test_home
188
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
189
-
$ XDG_EXAMPLE_CONFIG_DIR=./app-config \
190
-
> XDG_DATA_HOME=/tmp/xdge/xdg-data \
191
-
> XDG_CACHE_HOME=/tmp/xdge/xdg-cache \
192
-
> ../example/xdg_example.exe
193
-
=== Cmdliner Config ===
194
-
XDG config:
195
-
config_dir: ./app-config [env(XDG_EXAMPLE_CONFIG_DIR)]
196
-
data_dir: /tmp/xdge/xdg-data [env(XDG_DATA_HOME)]
197
-
cache_dir: /tmp/xdge/xdg-cache [env(XDG_CACHE_HOME)]
198
-
199
-
=== XDG Directories ===
200
-
XDG directories for 'xdg_example':
201
-
User directories:
202
-
config: <fs:./test_home/./app-config> [env(XDG_EXAMPLE_CONFIG_DIR)]
203
-
data: <fs:/tmp/xdge/xdg-data> [env(XDG_DATA_HOME)]
204
-
cache: <fs:/tmp/xdge/xdg-cache> [env(XDG_CACHE_HOME)]
205
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
206
-
runtime: <none> [default]
207
-
System directories:
208
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
209
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
210
-
211
-
This test is correct: Shows mixed sources working together. Config uses app-specific
212
-
env var (highest priority among env vars), data and cache use XDG standard env vars
213
-
(no app-specific ones set), and state uses default (no env vars set). Each directory
214
-
gets its value from the highest-priority available source.
215
-
216
-
Test command line overrides mixed environment variables:
217
-
218
-
$ export HOME=./test_home
219
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
220
-
$ XDG_CONFIG_HOME=/tmp/xdge/xdg-config \
221
-
> XDG_EXAMPLE_CONFIG_DIR=./app-config \
222
-
> ../example/xdg_example.exe --config-dir ./cli-config
223
-
=== Cmdliner Config ===
224
-
XDG config:
225
-
config_dir: ./cli-config [cmdline]
226
-
227
-
=== XDG Directories ===
228
-
XDG directories for 'xdg_example':
229
-
User directories:
230
-
config: <fs:./test_home/./cli-config> [cmdline]
231
-
data: <fs:./test_home/./test_home/.local/share/xdg_example> [default]
232
-
cache: <fs:./test_home/./test_home/.cache/xdg_example> [default]
233
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
234
-
runtime: <none> [default]
235
-
System directories:
236
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
237
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
238
-
239
-
This test is correct: Command-line argument overrides both types of environment
240
-
variables. Even though both XDG_CONFIG_HOME and XDG_EXAMPLE_CONFIG_DIR are set,
241
-
the --config-dir flag takes precedence and shows [cmdline] source. Other directories
242
-
fall back to defaults since no other command-line args are provided.
243
-
244
-
245
-
Test empty environment variable handling:
246
-
$ export HOME=./test_home
247
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
248
-
$ XDG_EXAMPLE_CONFIG_DIR="" \
249
-
> XDG_CONFIG_HOME=/tmp/xdge/xdg-config \
250
-
> ../example/xdg_example.exe
251
-
=== Cmdliner Config ===
252
-
XDG config:
253
-
config_dir: /tmp/xdge/xdg-config [env(XDG_CONFIG_HOME)]
254
-
255
-
=== XDG Directories ===
256
-
XDG directories for 'xdg_example':
257
-
User directories:
258
-
config: <fs:/tmp/xdge/xdg-config> [env(XDG_CONFIG_HOME)]
259
-
data: <fs:./test_home/./test_home/.local/share/xdg_example> [default]
260
-
cache: <fs:./test_home/./test_home/.cache/xdg_example> [default]
261
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
262
-
runtime: <none> [default]
263
-
System directories:
264
-
config_dirs: [<fs:/etc/xdg/xdg_example>]
265
-
data_dirs: [<fs:/usr/local/share/xdg_example>; <fs:/usr/share/xdg_example>]
266
-
267
-
This test is correct: When an app-specific env var is empty (""), it falls back to
268
-
the XDG standard variable. XDG_EXAMPLE_CONFIG_DIR="" is ignored, so XDG_CONFIG_HOME
269
-
is used instead, correctly showing [env(XDG_CONFIG_HOME)] as the source.
270
-
This behavior ensures that empty app-specific variables do not override useful
271
-
XDG standard settings.
272
-
273
-
274
-
Test system directory environment variables:
275
-
276
-
$ export HOME=./test_home
277
-
$ unset XDG_CONFIG_HOME XDG_DATA_HOME XDG_CACHE_HOME XDG_STATE_HOME XDG_RUNTIME_DIR
278
-
$ XDG_CONFIG_DIRS=/tmp/xdge/sys1:/tmp/xdge/sys2 \
279
-
> XDG_DATA_DIRS=/tmp/xdge/data1:/tmp/xdge/data2 \
280
-
> ../example/xdg_example.exe
281
-
=== Cmdliner Config ===
282
-
XDG config:
283
-
284
-
=== XDG Directories ===
285
-
XDG directories for 'xdg_example':
286
-
User directories:
287
-
config: <fs:./test_home/./test_home/.config/xdg_example> [default]
288
-
data: <fs:./test_home/./test_home/.local/share/xdg_example> [default]
289
-
cache: <fs:./test_home/./test_home/.cache/xdg_example> [default]
290
-
state: <fs:./test_home/./test_home/.local/state/xdg_example> [default]
291
-
runtime: <none> [default]
292
-
System directories:
293
-
config_dirs: [<fs:/tmp/xdge/sys1/xdg_example>;
294
-
<fs:/tmp/xdge/sys2/xdg_example>]
295
-
data_dirs: [<fs:/tmp/xdge/data1/xdg_example>;
296
-
<fs:/tmp/xdge/data2/xdg_example>]
297
-
298
-
This test is correct: XDG_CONFIG_DIRS and XDG_DATA_DIRS environment variables
299
-
override the default system directories. The colon-separated paths are parsed
300
-
and the app name is appended to each path. User directories remain at defaults
301
-
since no user-level overrides are provided. System directory env vars only
302
-
affect the system directories, not user directories.
303
-
304
-
305
-
Test help message:
306
-
307
-
$ ../example/xdg_example.exe --help=plain | head -20
308
-
NAME
309
-
xdg_example - Example program demonstrating XDG directory selection
310
-
with Cmdliner
311
-
312
-
SYNOPSIS
313
-
xdg_example [OPTION]…
314
-
315
-
DESCRIPTION
316
-
This example shows how to use the Xdge library with Cmdliner to handle
317
-
XDG Base Directory Specification paths with command-line and
318
-
environment variable overrides.
319
-
320
-
OPTIONS
321
-
--cache-dir=DIR
322
-
Override cache directory. Can also be set with
323
-
XDG_EXAMPLE_CACHE_DIR or XDG_CACHE_HOME. Default:
324
-
$HOME/.cache/xdg_example
325
-
326
-
--config-dir=DIR
327
-
Override config directory. Can also be set with
328
-
329
-
Test _path functions do not create directories but can access files within them:
330
-
331
-
$ export HOME=/tmp/xdge/xdg_path_test
332
-
$ mkdir -p /tmp/xdge/xdg_path_test
333
-
$ unset XDG_CONFIG_HOME XDG_DATA_HOME XDG_CACHE_HOME XDG_STATE_HOME XDG_RUNTIME_DIR
334
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
335
-
Create config subdirectory manually and write a test file:
336
-
$ mkdir -p "/tmp/xdge/xdg_path_test/.config/path_test/profiles"
337
-
$ echo "test profile content" > "/tmp/xdge/xdg_path_test/.config/path_test/profiles/default.json"
338
-
Create data subdirectory manually and write a test file:
339
-
$ mkdir -p "/tmp/xdge/xdg_path_test/.local/share/path_test/databases"
340
-
$ echo "test database content" > "/tmp/xdge/xdg_path_test/.local/share/path_test/databases/main.db"
341
-
Create cache subdirectory manually and write a test file:
342
-
$ mkdir -p "/tmp/xdge/xdg_path_test/.cache/path_test/thumbnails"
343
-
$ echo "test cache content" > "/tmp/xdge/xdg_path_test/.cache/path_test/thumbnails/thumb1.png"
344
-
Create state subdirectory manually and write a test file:
345
-
$ mkdir -p "/tmp/xdge/xdg_path_test/.local/state/path_test/logs"
346
-
$ echo "test log content" > "/tmp/xdge/xdg_path_test/.local/state/path_test/logs/app.log"
347
-
348
-
Now test that we can read the files through the XDG _path functions:
349
-
$ ./test_paths.exe
350
-
config file content: test profile content
351
-
data file content: test database content
352
-
cache file content: test cache content
353
-
state file content: test log content
354
-
355
-
This test verifies that the _path functions return correct paths that can be used to access
356
-
files within XDG subdirectories, without the functions automatically creating those directories.
357
-
358
-
Test path resolution with --show-paths:
359
-
360
-
Test with a preset HOME to verify correct path resolution:
361
-
$ export HOME=./home_testuser
362
-
$ unset XDG_CONFIG_HOME XDG_DATA_HOME XDG_CACHE_HOME XDG_STATE_HOME XDG_RUNTIME_DIR
363
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
364
-
$ ../example/xdg_example.exe --show-paths
365
-
config_dir: ./home_testuser/./home_testuser/.config/xdg_example
366
-
data_dir: ./home_testuser/./home_testuser/.local/share/xdg_example
367
-
cache_dir: ./home_testuser/./home_testuser/.cache/xdg_example
368
-
state_dir: ./home_testuser/./home_testuser/.local/state/xdg_example
369
-
runtime_dir: <none>
370
-
config_dirs: /etc/xdg/xdg_example
371
-
data_dirs: /usr/local/share/xdg_example:/usr/share/xdg_example
372
-
373
-
Test with environment variables set:
374
-
$ export HOME=./home_testuser
375
-
$ export XDG_CONFIG_HOME=/tmp/xdge/config
376
-
$ export XDG_DATA_HOME=/tmp/xdge/data
377
-
$ export XDG_CACHE_HOME=/tmp/xdge/cache
378
-
$ export XDG_STATE_HOME=/tmp/xdge/state
379
-
$ export XDG_CONFIG_DIRS=/tmp/xdge/config1:/tmp/xdge/config2
380
-
$ export XDG_DATA_DIRS=/tmp/xdge/data1:/tmp/xdge/data2
381
-
$ ../example/xdg_example.exe --show-paths
382
-
config_dir: /tmp/xdge/config
383
-
data_dir: /tmp/xdge/data
384
-
cache_dir: /tmp/xdge/cache
385
-
state_dir: /tmp/xdge/state
386
-
runtime_dir: <none>
387
-
config_dirs: /tmp/xdge/config1/xdg_example:/tmp/xdge/config2/xdg_example
388
-
data_dirs: /tmp/xdge/data1/xdg_example:/tmp/xdge/data2/xdg_example
389
-
390
-
Test with command-line overrides:
391
-
$ export HOME=./home_testuser
392
-
$ unset XDG_CONFIG_HOME XDG_DATA_HOME XDG_CACHE_HOME XDG_STATE_HOME XDG_RUNTIME_DIR
393
-
$ unset XDG_CONFIG_DIRS XDG_DATA_DIRS
394
-
$ ../example/xdg_example.exe --show-paths --config-dir ./override/config --data-dir ./override/data
395
-
config_dir: ./home_testuser/./override/config
396
-
data_dir: ./home_testuser/./override/data
397
-
cache_dir: ./home_testuser/./home_testuser/.cache/xdg_example
398
-
state_dir: ./home_testuser/./home_testuser/.local/state/xdg_example
399
-
runtime_dir: <none>
400
-
config_dirs: /etc/xdg/xdg_example
401
-
data_dirs: /usr/local/share/xdg_example:/usr/share/xdg_example
402
-
-36
stack/xdge/xdge.opam
-36
stack/xdge/xdge.opam
···
1
-
# This file is generated by dune, edit dune-project instead
2
-
opam-version: "2.0"
3
-
synopsis: "XDG Base Directory Specification support for Eio"
4
-
description:
5
-
"This library implements the XDG Base Directory Specification with Eio capabilities to provides safe access to configuration, data, cache, state, and runtime directories with proper environment variable overrides and Cmdliner integration."
6
-
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
-
authors: ["Anil Madhavapeddy"]
8
-
license: "ISC"
9
-
homepage: "https://tangled.sh/@anil.recoil.org/ocaml-gpx"
10
-
bug-reports: "https://tangled.sh/@anil.recoil.org/xgde"
11
-
depends: [
12
-
"dune" {>= "3.20"}
13
-
"ocaml" {>= "5.1.0"}
14
-
"eio" {>= "1.1"}
15
-
"eio_main"
16
-
"xdg" {>= "3.9.0"}
17
-
"cmdliner" {>= "1.2.0"}
18
-
"fmt" {>= "0.11.0"}
19
-
"odoc" {with-doc}
20
-
"alcotest" {with-test & >= "1.7.0"}
21
-
]
22
-
build: [
23
-
["dune" "subst"] {dev}
24
-
[
25
-
"dune"
26
-
"build"
27
-
"-p"
28
-
name
29
-
"-j"
30
-
jobs
31
-
"@install"
32
-
"@runtest" {with-test}
33
-
"@doc" {with-doc}
34
-
]
35
-
]
36
-
x-maintenance-intent: ["(latest)"]