commit 1bdbc842e2a1d6681a6cf73d44c768ef1cca5f67 · anil.recoil.org/slop

+3 -3

claudeio/lib/client.mli

···

       77
       77
        
       (** [receive t] returns a lazy sequence of messages from Claude.

     

       78
       78
        
       

     

       79
       79
        
           The sequence yields messages as they arrive from Claude, including:

     

       80
       80
       -
           - {!Message.Assistant} - Claude's responses

     

       81
       81
       -
           - {!Message.System} - System notifications

     

       82
       82
       -
           - {!Message.Result} - Final result with usage statistics

     

       80
       80
       +
           - {!constructor:Message.Assistant} - Claude's responses

     

       81
       81
       +
           - {!constructor:Message.System} - System notifications

     

       82
       82
       +
           - {!constructor:Message.Result} - Final result with usage statistics

     

       83
       83
        
       

     

       84
       84
        
           Control messages (permission requests, hook callbacks) are handled

     

       85
       85
        
           internally and not yielded to the sequence. *)

+11

stack/kitty_graphics/dune-project

···

       1
       1
       +
       (lang dune 3.20)

     

       2
       2
       +
       (name kitty_graphics)

     

       3
       3
       +
       

     

       4
       4
       +
       (package

     

       5
       5
       +
        (name kitty_graphics)

     

       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.")

     

       9
       9
       +
        (depends

     

       10
       10
       +
         (ocaml (>= 4.14.0))

     

       11
       11
       +
         base64))

stack/kitty_graphics/example/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name example)

     

       3
       3
       +
        (libraries kitty_graphics))

+116

stack/kitty_graphics/example/example.ml

···

       1
       1
       +
       (* Example usage of the Kitty Graphics Protocol library *)

     

       2
       2
       +
       

     

       3
       3
       +
       (* Create a 64x64 colorful gradient image in RGBA format *)

     

       4
       4
       +
       let test_rgba_image () =

     

       5
       5
       +
         let size = 64 in

     

       6
       6
       +
         let pixels = Bytes.create (size * size * 4) in

     

       7
       7
       +
         for y = 0 to size - 1 do

     

       8
       8
       +
           for x = 0 to size - 1 do

     

       9
       9
       +
             let offset = (y * size + x) * 4 in

     

       10
       10
       +
             (* Red gradient left to right *)

     

       11
       11
       +
             Bytes.set pixels offset (Char.chr (x * 4 land 0xFF));

     

       12
       12
       +
             (* Green gradient top to bottom *)

     

       13
       13
       +
             Bytes.set pixels (offset + 1) (Char.chr (y * 4 land 0xFF));

     

       14
       14
       +
             (* Blue diagonal gradient *)

     

       15
       15
       +
             Bytes.set pixels (offset + 2) (Char.chr ((x + y) * 2 land 0xFF));

     

       16
       16
       +
             (* Fully opaque *)

     

       17
       17
       +
             Bytes.set pixels (offset + 3) '\xff'

     

       18
       18
       +
           done

     

       19
       19
       +
         done;

     

       20
       20
       +
         (size, Bytes.to_string pixels)

     

       21
       21
       +
       

     

       22
       22
       +
       let () =

     

       23
       23
       +
         print_endline "Kitty Graphics Protocol Example";

     

       24
       24
       +
         print_endline "================================";

     

       25
       25
       +
         print_newline ();

     

       26
       26
       +
       

     

       27
       27
       +
         (* Example 1: Display a simple RGBA image *)

     

       28
       28
       +
         print_endline "1. Displaying a 64x64 RGBA gradient image:";

     

       29
       29
       +
         print_newline ();

     

       30
       30
       +
         flush stdout;

     

       31
       31
       +
       

     

       32
       32
       +
         let (size, image_data) = test_rgba_image () in

     

       33
       33
       +
         let cmd =

     

       34
       34
       +
           Kitty_graphics.Command.transmit_and_display

     

       35
       35
       +
             ~format:Kitty_graphics.Format.Rgba32

     

       36
       36
       +
             ~width:size ~height:size

     

       37
       37
       +
             ()

     

       38
       38
       +
         in

     

       39
       39
       +
         let buf = Buffer.create 4096 in

     

       40
       40
       +
         Kitty_graphics.Command.write buf cmd ~data:image_data;

     

       41
       41
       +
         print_string (Buffer.contents buf);

     

       42
       42
       +
         flush stdout;

     

       43
       43
       +
         print_newline ();

     

       44
       44
       +
         print_newline ();

     

       45
       45
       +
       

     

       46
       46
       +
         (* Example 2: Display scaled to specific cell size *)

     

       47
       47
       +
         print_endline "2. Same image scaled to 20 columns x 10 rows:";

     

       48
       48
       +
         print_newline ();

     

       49
       49
       +
         flush stdout;

     

       50
       50
       +
       

     

       51
       51
       +
         let placement =

     

       52
       52
       +
           Kitty_graphics.Placement.make ~columns:20 ~rows:10 ()

     

       53
       53
       +
         in

     

       54
       54
       +
         let cmd =

     

       55
       55
       +
           Kitty_graphics.Command.transmit_and_display

     

       56
       56
       +
             ~format:Kitty_graphics.Format.Rgba32

     

       57
       57
       +
             ~width:size ~height:size

     

       58
       58
       +
             ~placement

     

       59
       59
       +
             ()

     

       60
       60
       +
         in

     

       61
       61
       +
         Buffer.clear buf;

     

       62
       62
       +
         Kitty_graphics.Command.write buf cmd ~data:image_data;

     

       63
       63
       +
         print_string (Buffer.contents buf);

     

       64
       64
       +
         flush stdout;

     

       65
       65
       +
         print_newline ();

     

       66
       66
       +
         print_newline ();

     

       67
       67
       +
       

     

       68
       68
       +
         (* Example 3: Query terminal support *)

     

       69
       69
       +
         print_endline "3. Query command (to test graphics support):";

     

       70
       70
       +
         let query = Kitty_graphics.Detect.make_query () in

     

       71
       71
       +
         Printf.printf "   Query escape sequence: %S\n" query;

     

       72
       72
       +
         print_newline ();

     

       73
       73
       +
       

     

       74
       74
       +
         (* Example 4: Delete command *)

     

       75
       75
       +
         print_endline "4. Delete all visible images:";

     

       76
       76
       +
         let del_cmd =

     

       77
       77
       +
           Kitty_graphics.Command.delete Kitty_graphics.Delete.All_visible

     

       78
       78
       +
         in

     

       79
       79
       +
         Buffer.clear buf;

     

       80
       80
       +
         Kitty_graphics.Command.write buf del_cmd ~data:"";

     

       81
       81
       +
         Printf.printf "   Delete escape sequence: %S\n" (Buffer.contents buf);

     

       82
       82
       +
         print_newline ();

     

       83
       83
       +
       

     

       84
       84
       +
         (* Example 5: Unicode placeholder *)

     

       85
       85
       +
         print_endline "5. Unicode placeholder (for tmux compatibility):";

     

       86
       86
       +
         print_newline ();

     

       87
       87
       +
         Buffer.clear buf;

     

       88
       88
       +
         Kitty_graphics.Unicode_placeholder.write buf ~image_id:42 ~rows:2 ~cols:4 ();

     

       89
       89
       +
         print_string (Buffer.contents buf);

     

       90
       90
       +
         print_newline ();

     

       91
       91
       +
         print_newline ();

     

       92
       92
       +
       

     

       93
       93
       +
         (* Example 6: Parse a response *)

     

       94
       94
       +
         print_endline "6. Parsing terminal responses:";

     

       95
       95
       +
         let test_response = "\027_Gi=123;OK\027\\" in

     

       96
       96
       +
         (match Kitty_graphics.Response.parse test_response with

     

       97
       97
       +
         | Some r ->

     

       98
       98
       +
             Printf.printf "   Parsed response: is_ok=%b, image_id=%s\n"

     

       99
       99
       +
               (Kitty_graphics.Response.is_ok r)

     

       100
       100
       +
               (match Kitty_graphics.Response.image_id r with

     

       101
       101
       +
               | Some id -> string_of_int id

     

       102
       102
       +
               | None -> "none")

     

       103
       103
       +
         | None -> print_endline "   Failed to parse");

     

       104
       104
       +
       

     

       105
       105
       +
         let error_response = "\027_Gi=456;ENOENT:Image not found\027\\" in

     

       106
       106
       +
         (match Kitty_graphics.Response.parse error_response with

     

       107
       107
       +
         | Some r ->

     

       108
       108
       +
             Printf.printf "   Error response: code=%s, message=%s\n"

     

       109
       109
       +
               (match Kitty_graphics.Response.error_code r with

     

       110
       110
       +
               | Some c -> c

     

       111
       111
       +
               | None -> "none")

     

       112
       112
       +
               (Kitty_graphics.Response.message r)

     

       113
       113
       +
         | None -> print_endline "   Failed to parse");

     

       114
       114
       +
       

     

       115
       115
       +
         print_newline ();

     

       116
       116
       +
         print_endline "Done!"

stack/kitty_graphics/lib/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name kitty_graphics)

     

       3
       3
       +
        (public_name kitty_graphics)

     

       4
       4
       +
        (libraries base64))

+901

stack/kitty_graphics/lib/kitty_graphics.ml

···

       1
       1
       +
       (* Kitty Terminal Graphics Protocol - Implementation *)

     

       2
       2
       +
       

     

       3
       3
       +
       module Format = struct

     

       4
       4
       +
         type t = Rgba32 | Rgb24 | Png

     

       5
       5
       +
       

     

       6
       6
       +
         let to_int = function Rgba32 -> 32 | Rgb24 -> 24 | Png -> 100

     

       7
       7
       +
       end

     

       8
       8
       +
       

     

       9
       9
       +
       module Transmission = struct

     

       10
       10
       +
         type t = Direct | File | Tempfile

     

       11
       11
       +
       

     

       12
       12
       +
         let to_char = function Direct -> 'd' | File -> 'f' | Tempfile -> 't'

     

       13
       13
       +
       end

     

       14
       14
       +
       

     

       15
       15
       +
       module Compression = struct

     

       16
       16
       +
         type t = None | Zlib

     

       17
       17
       +
       

     

       18
       18
       +
         let to_char = function None -> Option.none | Zlib -> Some 'z'

     

       19
       19
       +
       end

     

       20
       20
       +
       

     

       21
       21
       +
       module Quiet = struct

     

       22
       22
       +
         type t = Noisy | Errors_only | Silent

     

       23
       23
       +
       

     

       24
       24
       +
         let to_int = function Noisy -> 0 | Errors_only -> 1 | Silent -> 2

     

       25
       25
       +
       end

     

       26
       26
       +
       

     

       27
       27
       +
       module Cursor = struct

     

       28
       28
       +
         type t = Move | Static

     

       29
       29
       +
       

     

       30
       30
       +
         let to_int = function Move -> 0 | Static -> 1

     

       31
       31
       +
       end

     

       32
       32
       +
       

     

       33
       33
       +
       module Composition = struct

     

       34
       34
       +
         type t = Alpha_blend | Overwrite

     

       35
       35
       +
       

     

       36
       36
       +
         let to_int = function Alpha_blend -> 0 | Overwrite -> 1

     

       37
       37
       +
       end

     

       38
       38
       +
       

     

       39
       39
       +
       module Delete = struct

     

       40
       40
       +
         type t =

     

       41
       41
       +
           | All_visible

     

       42
       42
       +
           | All_visible_and_free

     

       43
       43
       +
           | By_id of { image_id : int; placement_id : int option }

     

       44
       44
       +
           | By_id_and_free of { image_id : int; placement_id : int option }

     

       45
       45
       +
           | By_number of { image_number : int; placement_id : int option }

     

       46
       46
       +
           | By_number_and_free of { image_number : int; placement_id : int option }

     

       47
       47
       +
           | At_cursor

     

       48
       48
       +
           | At_cursor_and_free

     

       49
       49
       +
           | At_cell of { x : int; y : int }

     

       50
       50
       +
           | At_cell_and_free of { x : int; y : int }

     

       51
       51
       +
           | At_cell_z of { x : int; y : int; z : int }

     

       52
       52
       +
           | At_cell_z_and_free of { x : int; y : int; z : int }

     

       53
       53
       +
           | By_column of int

     

       54
       54
       +
           | By_column_and_free of int

     

       55
       55
       +
           | By_row of int

     

       56
       56
       +
           | By_row_and_free of int

     

       57
       57
       +
           | By_z_index of int

     

       58
       58
       +
           | By_z_index_and_free of int

     

       59
       59
       +
           | By_id_range of { min_id : int; max_id : int }

     

       60
       60
       +
           | By_id_range_and_free of { min_id : int; max_id : int }

     

       61
       61
       +
           | Frames

     

       62
       62
       +
           | Frames_and_free

     

       63
       63
       +
       end

     

       64
       64
       +
       

     

       65
       65
       +
       module Placement = struct

     

       66
       66
       +
         type t = {

     

       67
       67
       +
           source_x : int option;

     

       68
       68
       +
           source_y : int option;

     

       69
       69
       +
           source_width : int option;

     

       70
       70
       +
           source_height : int option;

     

       71
       71
       +
           cell_x_offset : int option;

     

       72
       72
       +
           cell_y_offset : int option;

     

       73
       73
       +
           columns : int option;

     

       74
       74
       +
           rows : int option;

     

       75
       75
       +
           z_index : int option;

     

       76
       76
       +
           placement_id : int option;

     

       77
       77
       +
           cursor : Cursor.t option;

     

       78
       78
       +
           unicode_placeholder : bool;

     

       79
       79
       +
         }

     

       80
       80
       +
       

     

       81
       81
       +
         let empty =

     

       82
       82
       +
           {

     

       83
       83
       +
             source_x = None;

     

       84
       84
       +
             source_y = None;

     

       85
       85
       +
             source_width = None;

     

       86
       86
       +
             source_height = None;

     

       87
       87
       +
             cell_x_offset = None;

     

       88
       88
       +
             cell_y_offset = None;

     

       89
       89
       +
             columns = None;

     

       90
       90
       +
             rows = None;

     

       91
       91
       +
             z_index = None;

     

       92
       92
       +
             placement_id = None;

     

       93
       93
       +
             cursor = None;

     

       94
       94
       +
             unicode_placeholder = false;

     

       95
       95
       +
           }

     

       96
       96
       +
       

     

       97
       97
       +
         let make ?source_x ?source_y ?source_width ?source_height ?cell_x_offset

     

       98
       98
       +
             ?cell_y_offset ?columns ?rows ?z_index ?placement_id ?cursor

     

       99
       99
       +
             ?(unicode_placeholder = false) () =

     

       100
       100
       +
           {

     

       101
       101
       +
             source_x;

     

       102
       102
       +
             source_y;

     

       103
       103
       +
             source_width;

     

       104
       104
       +
             source_height;

     

       105
       105
       +
             cell_x_offset;

     

       106
       106
       +
             cell_y_offset;

     

       107
       107
       +
             columns;

     

       108
       108
       +
             rows;

     

       109
       109
       +
             z_index;

     

       110
       110
       +
             placement_id;

     

       111
       111
       +
             cursor;

     

       112
       112
       +
             unicode_placeholder;

     

       113
       113
       +
           }

     

       114
       114
       +
       end

     

       115
       115
       +
       

     

       116
       116
       +
       module Frame = struct

     

       117
       117
       +
         type t = {

     

       118
       118
       +
           x : int option;

     

       119
       119
       +
           y : int option;

     

       120
       120
       +
           base_frame : int option;

     

       121
       121
       +
           edit_frame : int option;

     

       122
       122
       +
           gap_ms : int option;

     

       123
       123
       +
           composition : Composition.t option;

     

       124
       124
       +
           background_color : int32 option;

     

       125
       125
       +
         }

     

       126
       126
       +
       

     

       127
       127
       +
         let empty =

     

       128
       128
       +
           {

     

       129
       129
       +
             x = None;

     

       130
       130
       +
             y = None;

     

       131
       131
       +
             base_frame = None;

     

       132
       132
       +
             edit_frame = None;

     

       133
       133
       +
             gap_ms = None;

     

       134
       134
       +
             composition = None;

     

       135
       135
       +
             background_color = None;

     

       136
       136
       +
           }

     

       137
       137
       +
       

     

       138
       138
       +
         let make ?x ?y ?base_frame ?edit_frame ?gap_ms ?composition ?background_color

     

       139
       139
       +
             () =

     

       140
       140
       +
           { x; y; base_frame; edit_frame; gap_ms; composition; background_color }

     

       141
       141
       +
       end

     

       142
       142
       +
       

     

       143
       143
       +
       module Animation = struct

     

       144
       144
       +
         type state = Stop | Loading | Run

     

       145
       145
       +
       

     

       146
       146
       +
         type t =

     

       147
       147
       +
           | Set_state of { state : state; loops : int option }

     

       148
       148
       +
           | Set_gap of { frame : int; gap_ms : int }

     

       149
       149
       +
           | Set_current of int

     

       150
       150
       +
       

     

       151
       151
       +
         let set_state ?loops state = Set_state { state; loops }

     

       152
       152
       +
         let set_gap ~frame ~gap_ms = Set_gap { frame; gap_ms }

     

       153
       153
       +
         let set_current_frame frame = Set_current frame

     

       154
       154
       +
       end

     

       155
       155
       +
       

     

       156
       156
       +
       module Compose = struct

     

       157
       157
       +
         type t = {

     

       158
       158
       +
           source_frame : int;

     

       159
       159
       +
           dest_frame : int;

     

       160
       160
       +
           width : int option;

     

       161
       161
       +
           height : int option;

     

       162
       162
       +
           source_x : int option;

     

       163
       163
       +
           source_y : int option;

     

       164
       164
       +
           dest_x : int option;

     

       165
       165
       +
           dest_y : int option;

     

       166
       166
       +
           composition : Composition.t option;

     

       167
       167
       +
         }

     

       168
       168
       +
       

     

       169
       169
       +
         let make ~source_frame ~dest_frame ?width ?height ?source_x ?source_y ?dest_x

     

       170
       170
       +
             ?dest_y ?composition () =

     

       171
       171
       +
           {

     

       172
       172
       +
             source_frame;

     

       173
       173
       +
             dest_frame;

     

       174
       174
       +
             width;

     

       175
       175
       +
             height;

     

       176
       176
       +
             source_x;

     

       177
       177
       +
             source_y;

     

       178
       178
       +
             dest_x;

     

       179
       179
       +
             dest_y;

     

       180
       180
       +
             composition;

     

       181
       181
       +
           }

     

       182
       182
       +
       end

     

       183
       183
       +
       

     

       184
       184
       +
       module Command = struct

     

       185
       185
       +
         type action =

     

       186
       186
       +
           | Transmit

     

       187
       187
       +
           | Transmit_and_display

     

       188
       188
       +
           | Query

     

       189
       189
       +
           | Display

     

       190
       190
       +
           | Delete

     

       191
       191
       +
           | Frame

     

       192
       192
       +
           | Animate

     

       193
       193
       +
           | Compose

     

       194
       194
       +
       

     

       195
       195
       +
         type t = {

     

       196
       196
       +
           action : action;

     

       197
       197
       +
           format : Format.t option;

     

       198
       198
       +
           transmission : Transmission.t option;

     

       199
       199
       +
           compression : Compression.t option;

     

       200
       200
       +
           width : int option;

     

       201
       201
       +
           height : int option;

     

       202
       202
       +
           size : int option;

     

       203
       203
       +
           offset : int option;

     

       204
       204
       +
           quiet : Quiet.t option;

     

       205
       205
       +
           image_id : int option;

     

       206
       206
       +
           image_number : int option;

     

       207
       207
       +
           placement : Placement.t option;

     

       208
       208
       +
           delete : Delete.t option;

     

       209
       209
       +
           frame : Frame.t option;

     

       210
       210
       +
           animation : Animation.t option;

     

       211
       211
       +
           compose : Compose.t option;

     

       212
       212
       +
         }

     

       213
       213
       +
       

     

       214
       214
       +
         let make_base action =

     

       215
       215
       +
           {

     

       216
       216
       +
             action;

     

       217
       217
       +
             format = None;

     

       218
       218
       +
             transmission = None;

     

       219
       219
       +
             compression = None;

     

       220
       220
       +
             width = None;

     

       221
       221
       +
             height = None;

     

       222
       222
       +
             size = None;

     

       223
       223
       +
             offset = None;

     

       224
       224
       +
             quiet = None;

     

       225
       225
       +
             image_id = None;

     

       226
       226
       +
             image_number = None;

     

       227
       227
       +
             placement = None;

     

       228
       228
       +
             delete = None;

     

       229
       229
       +
             frame = None;

     

       230
       230
       +
             animation = None;

     

       231
       231
       +
             compose = None;

     

       232
       232
       +
           }

     

       233
       233
       +
       

     

       234
       234
       +
         let transmit ?image_id ?image_number ?format ?transmission ?compression ?width

     

       235
       235
       +
             ?height ?size ?offset ?quiet () =

     

       236
       236
       +
           {

     

       237
       237
       +
             (make_base Transmit) with

     

       238
       238
       +
             image_id;

     

       239
       239
       +
             image_number;

     

       240
       240
       +
             format;

     

       241
       241
       +
             transmission;

     

       242
       242
       +
             compression;

     

       243
       243
       +
             width;

     

       244
       244
       +
             height;

     

       245
       245
       +
             size;

     

       246
       246
       +
             offset;

     

       247
       247
       +
             quiet;

     

       248
       248
       +
           }

     

       249
       249
       +
       

     

       250
       250
       +
         let transmit_and_display ?image_id ?image_number ?format ?transmission

     

       251
       251
       +
             ?compression ?width ?height ?size ?offset ?quiet ?placement () =

     

       252
       252
       +
           {

     

       253
       253
       +
             (make_base Transmit_and_display) with

     

       254
       254
       +
             image_id;

     

       255
       255
       +
             image_number;

     

       256
       256
       +
             format;

     

       257
       257
       +
             transmission;

     

       258
       258
       +
             compression;

     

       259
       259
       +
             width;

     

       260
       260
       +
             height;

     

       261
       261
       +
             size;

     

       262
       262
       +
             offset;

     

       263
       263
       +
             quiet;

     

       264
       264
       +
             placement;

     

       265
       265
       +
           }

     

       266
       266
       +
       

     

       267
       267
       +
         let query ?format ?transmission ?width ?height ?quiet () =

     

       268
       268
       +
           { (make_base Query) with format; transmission; width; height; quiet }

     

       269
       269
       +
       

     

       270
       270
       +
         let display ?image_id ?image_number ?placement ?quiet () =

     

       271
       271
       +
           { (make_base Display) with image_id; image_number; placement; quiet }

     

       272
       272
       +
       

     

       273
       273
       +
         let delete ?quiet del =

     

       274
       274
       +
           { (make_base Delete) with quiet; delete = Some del }

     

       275
       275
       +
       

     

       276
       276
       +
         let frame ?image_id ?image_number ?format ?transmission ?compression ?width

     

       277
       277
       +
             ?height ?quiet ~frame () =

     

       278
       278
       +
           {

     

       279
       279
       +
             (make_base Frame) with

     

       280
       280
       +
             image_id;

     

       281
       281
       +
             image_number;

     

       282
       282
       +
             format;

     

       283
       283
       +
             transmission;

     

       284
       284
       +
             compression;

     

       285
       285
       +
             width;

     

       286
       286
       +
             height;

     

       287
       287
       +
             quiet;

     

       288
       288
       +
             frame = Some frame;

     

       289
       289
       +
           }

     

       290
       290
       +
       

     

       291
       291
       +
         let animate ?image_id ?image_number ?quiet anim =

     

       292
       292
       +
           { (make_base Animate) with image_id; image_number; quiet; animation = Some anim }

     

       293
       293
       +
       

     

       294
       294
       +
         let compose ?image_id ?image_number ?quiet comp =

     

       295
       295
       +
           { (make_base Compose) with image_id; image_number; quiet; compose = Some comp }

     

       296
       296
       +
       

     

       297
       297
       +
         (* APC escape sequences *)

     

       298
       298
       +
         let apc_start = "\027_G"

     

       299
       299
       +
         let apc_end = "\027\\"

     

       300
       300
       +
       

     

       301
       301
       +
         (* Helper to add key=value pairs *)

     

       302
       302
       +
         let add_kv buf key value =

     

       303
       303
       +
           Buffer.add_char buf key;

     

       304
       304
       +
           Buffer.add_char buf '=';

     

       305
       305
       +
           Buffer.add_string buf value

     

       306
       306
       +
       

     

       307
       307
       +
         let add_kv_int buf key value =

     

       308
       308
       +
           Buffer.add_char buf key;

     

       309
       309
       +
           Buffer.add_char buf '=';

     

       310
       310
       +
           Buffer.add_string buf (string_of_int value)

     

       311
       311
       +
       

     

       312
       312
       +
         let add_kv_int32 buf key value =

     

       313
       313
       +
           Buffer.add_char buf key;

     

       314
       314
       +
           Buffer.add_char buf '=';

     

       315
       315
       +
           Buffer.add_string buf (Int32.to_string value)

     

       316
       316
       +
       

     

       317
       317
       +
         let add_comma buf = Buffer.add_char buf ','

     

       318
       318
       +
       

     

       319
       319
       +
         let action_char = function

     

       320
       320
       +
           | Transmit -> 't'

     

       321
       321
       +
           | Transmit_and_display -> 'T'

     

       322
       322
       +
           | Query -> 'q'

     

       323
       323
       +
           | Display -> 'p'

     

       324
       324
       +
           | Delete -> 'd'

     

       325
       325
       +
           | Frame -> 'f'

     

       326
       326
       +
           | Animate -> 'a'

     

       327
       327
       +
           | Compose -> 'c'

     

       328
       328
       +
       

     

       329
       329
       +
         let delete_char = function

     

       330
       330
       +
           | Delete.All_visible -> 'a'

     

       331
       331
       +
           | All_visible_and_free -> 'A'

     

       332
       332
       +
           | By_id _ -> 'i'

     

       333
       333
       +
           | By_id_and_free _ -> 'I'

     

       334
       334
       +
           | By_number _ -> 'n'

     

       335
       335
       +
           | By_number_and_free _ -> 'N'

     

       336
       336
       +
           | At_cursor -> 'c'

     

       337
       337
       +
           | At_cursor_and_free -> 'C'

     

       338
       338
       +
           | At_cell _ -> 'p'

     

       339
       339
       +
           | At_cell_and_free _ -> 'P'

     

       340
       340
       +
           | At_cell_z _ -> 'q'

     

       341
       341
       +
           | At_cell_z_and_free _ -> 'Q'

     

       342
       342
       +
           | By_column _ -> 'x'

     

       343
       343
       +
           | By_column_and_free _ -> 'X'

     

       344
       344
       +
           | By_row _ -> 'y'

     

       345
       345
       +
           | By_row_and_free _ -> 'Y'

     

       346
       346
       +
           | By_z_index _ -> 'z'

     

       347
       347
       +
           | By_z_index_and_free _ -> 'Z'

     

       348
       348
       +
           | By_id_range _ -> 'r'

     

       349
       349
       +
           | By_id_range_and_free _ -> 'R'

     

       350
       350
       +
           | Frames -> 'f'

     

       351
       351
       +
           | Frames_and_free -> 'F'

     

       352
       352
       +
       

     

       353
       353
       +
         let write_control_data buf cmd =

     

       354
       354
       +
           let first = ref true in

     

       355
       355
       +
           let sep () =

     

       356
       356
       +
             if !first then first := false else add_comma buf

     

       357
       357
       +
           in

     

       358
       358
       +
           (* Action *)

     

       359
       359
       +
           sep ();

     

       360
       360
       +
           add_kv buf 'a' (String.make 1 (action_char cmd.action));

     

       361
       361
       +
           (* Quiet *)

     

       362
       362
       +
           Option.iter

     

       363
       363
       +
             (fun q ->

     

       364
       364
       +
               let v = Quiet.to_int q in

     

       365
       365
       +
               if v <> 0 then (

     

       366
       366
       +
                 sep ();

     

       367
       367
       +
                 add_kv_int buf 'q' v))

     

       368
       368
       +
             cmd.quiet;

     

       369
       369
       +
           (* Format *)

     

       370
       370
       +
           Option.iter

     

       371
       371
       +
             (fun f ->

     

       372
       372
       +
               sep ();

     

       373
       373
       +
               add_kv_int buf 'f' (Format.to_int f))

     

       374
       374
       +
             cmd.format;

     

       375
       375
       +
           (* Transmission *)

     

       376
       376
       +
           Option.iter

     

       377
       377
       +
             (fun t ->

     

       378
       378
       +
               let c = Transmission.to_char t in

     

       379
       379
       +
               if c <> 'd' then (

     

       380
       380
       +
                 sep ();

     

       381
       381
       +
                 add_kv buf 't' (String.make 1 c)))

     

       382
       382
       +
             cmd.transmission;

     

       383
       383
       +
           (* Compression *)

     

       384
       384
       +
           Option.iter

     

       385
       385
       +
             (fun c ->

     

       386
       386
       +
               match Compression.to_char c with

     

       387
       387
       +
               | Some ch ->

     

       388
       388
       +
                   sep ();

     

       389
       389
       +
                   add_kv buf 'o' (String.make 1 ch)

     

       390
       390
       +
               | None -> ())

     

       391
       391
       +
             cmd.compression;

     

       392
       392
       +
           (* Dimensions *)

     

       393
       393
       +
           Option.iter

     

       394
       394
       +
             (fun w ->

     

       395
       395
       +
               sep ();

     

       396
       396
       +
               add_kv_int buf 's' w)

     

       397
       397
       +
             cmd.width;

     

       398
       398
       +
           Option.iter

     

       399
       399
       +
             (fun h ->

     

       400
       400
       +
               sep ();

     

       401
       401
       +
               add_kv_int buf 'v' h)

     

       402
       402
       +
             cmd.height;

     

       403
       403
       +
           (* File size/offset *)

     

       404
       404
       +
           Option.iter

     

       405
       405
       +
             (fun s ->

     

       406
       406
       +
               sep ();

     

       407
       407
       +
               add_kv_int buf 'S' s)

     

       408
       408
       +
             cmd.size;

     

       409
       409
       +
           Option.iter

     

       410
       410
       +
             (fun o ->

     

       411
       411
       +
               sep ();

     

       412
       412
       +
               add_kv_int buf 'O' o)

     

       413
       413
       +
             cmd.offset;

     

       414
       414
       +
           (* Image ID *)

     

       415
       415
       +
           Option.iter

     

       416
       416
       +
             (fun id ->

     

       417
       417
       +
               sep ();

     

       418
       418
       +
               add_kv_int buf 'i' id)

     

       419
       419
       +
             cmd.image_id;

     

       420
       420
       +
           (* Image number *)

     

       421
       421
       +
           Option.iter

     

       422
       422
       +
             (fun n ->

     

       423
       423
       +
               sep ();

     

       424
       424
       +
               add_kv_int buf 'I' n)

     

       425
       425
       +
             cmd.image_number;

     

       426
       426
       +
           (* Placement options *)

     

       427
       427
       +
           Option.iter

     

       428
       428
       +
             (fun (p : Placement.t) ->

     

       429
       429
       +
               Option.iter

     

       430
       430
       +
                 (fun v ->

     

       431
       431
       +
                   sep ();

     

       432
       432
       +
                   add_kv_int buf 'x' v)

     

       433
       433
       +
                 p.source_x;

     

       434
       434
       +
               Option.iter

     

       435
       435
       +
                 (fun v ->

     

       436
       436
       +
                   sep ();

     

       437
       437
       +
                   add_kv_int buf 'y' v)

     

       438
       438
       +
                 p.source_y;

     

       439
       439
       +
               Option.iter

     

       440
       440
       +
                 (fun v ->

     

       441
       441
       +
                   sep ();

     

       442
       442
       +
                   add_kv_int buf 'w' v)

     

       443
       443
       +
                 p.source_width;

     

       444
       444
       +
               Option.iter

     

       445
       445
       +
                 (fun v ->

     

       446
       446
       +
                   sep ();

     

       447
       447
       +
                   add_kv_int buf 'h' v)

     

       448
       448
       +
                 p.source_height;

     

       449
       449
       +
               Option.iter

     

       450
       450
       +
                 (fun v ->

     

       451
       451
       +
                   sep ();

     

       452
       452
       +
                   add_kv_int buf 'X' v)

     

       453
       453
       +
                 p.cell_x_offset;

     

       454
       454
       +
               Option.iter

     

       455
       455
       +
                 (fun v ->

     

       456
       456
       +
                   sep ();

     

       457
       457
       +
                   add_kv_int buf 'Y' v)

     

       458
       458
       +
                 p.cell_y_offset;

     

       459
       459
       +
               Option.iter

     

       460
       460
       +
                 (fun v ->

     

       461
       461
       +
                   sep ();

     

       462
       462
       +
                   add_kv_int buf 'c' v)

     

       463
       463
       +
                 p.columns;

     

       464
       464
       +
               Option.iter

     

       465
       465
       +
                 (fun v ->

     

       466
       466
       +
                   sep ();

     

       467
       467
       +
                   add_kv_int buf 'r' v)

     

       468
       468
       +
                 p.rows;

     

       469
       469
       +
               Option.iter

     

       470
       470
       +
                 (fun v ->

     

       471
       471
       +
                   sep ();

     

       472
       472
       +
                   add_kv_int buf 'z' v)

     

       473
       473
       +
                 p.z_index;

     

       474
       474
       +
               Option.iter

     

       475
       475
       +
                 (fun v ->

     

       476
       476
       +
                   sep ();

     

       477
       477
       +
                   add_kv_int buf 'p' v)

     

       478
       478
       +
                 p.placement_id;

     

       479
       479
       +
               Option.iter

     

       480
       480
       +
                 (fun c ->

     

       481
       481
       +
                   let v = Cursor.to_int c in

     

       482
       482
       +
                   if v <> 0 then (

     

       483
       483
       +
                     sep ();

     

       484
       484
       +
                     add_kv_int buf 'C' v))

     

       485
       485
       +
                 p.cursor;

     

       486
       486
       +
               if p.unicode_placeholder then (

     

       487
       487
       +
                 sep ();

     

       488
       488
       +
                 add_kv_int buf 'U' 1))

     

       489
       489
       +
             cmd.placement;

     

       490
       490
       +
           (* Delete options *)

     

       491
       491
       +
           Option.iter

     

       492
       492
       +
             (fun d ->

     

       493
       493
       +
               sep ();

     

       494
       494
       +
               add_kv buf 'd' (String.make 1 (delete_char d));

     

       495
       495
       +
               match d with

     

       496
       496
       +
               | Delete.By_id { image_id; placement_id }

     

       497
       497
       +
               | Delete.By_id_and_free { image_id; placement_id } ->

     

       498
       498
       +
                   sep ();

     

       499
       499
       +
                   add_kv_int buf 'i' image_id;

     

       500
       500
       +
                   Option.iter

     

       501
       501
       +
                     (fun p ->

     

       502
       502
       +
                       sep ();

     

       503
       503
       +
                       add_kv_int buf 'p' p)

     

       504
       504
       +
                     placement_id

     

       505
       505
       +
               | Delete.By_number { image_number; placement_id }

     

       506
       506
       +
               | Delete.By_number_and_free { image_number; placement_id } ->

     

       507
       507
       +
                   sep ();

     

       508
       508
       +
                   add_kv_int buf 'I' image_number;

     

       509
       509
       +
                   Option.iter

     

       510
       510
       +
                     (fun p ->

     

       511
       511
       +
                       sep ();

     

       512
       512
       +
                       add_kv_int buf 'p' p)

     

       513
       513
       +
                     placement_id

     

       514
       514
       +
               | Delete.At_cell { x; y } | Delete.At_cell_and_free { x; y } ->

     

       515
       515
       +
                   sep ();

     

       516
       516
       +
                   add_kv_int buf 'x' x;

     

       517
       517
       +
                   sep ();

     

       518
       518
       +
                   add_kv_int buf 'y' y

     

       519
       519
       +
               | Delete.At_cell_z { x; y; z }

     

       520
       520
       +
               | Delete.At_cell_z_and_free { x; y; z } ->

     

       521
       521
       +
                   sep ();

     

       522
       522
       +
                   add_kv_int buf 'x' x;

     

       523
       523
       +
                   sep ();

     

       524
       524
       +
                   add_kv_int buf 'y' y;

     

       525
       525
       +
                   sep ();

     

       526
       526
       +
                   add_kv_int buf 'z' z

     

       527
       527
       +
               | Delete.By_column c | Delete.By_column_and_free c ->

     

       528
       528
       +
                   sep ();

     

       529
       529
       +
                   add_kv_int buf 'x' c

     

       530
       530
       +
               | Delete.By_row r | Delete.By_row_and_free r ->

     

       531
       531
       +
                   sep ();

     

       532
       532
       +
                   add_kv_int buf 'y' r

     

       533
       533
       +
               | Delete.By_z_index z | Delete.By_z_index_and_free z ->

     

       534
       534
       +
                   sep ();

     

       535
       535
       +
                   add_kv_int buf 'z' z

     

       536
       536
       +
               | Delete.By_id_range { min_id; max_id }

     

       537
       537
       +
               | Delete.By_id_range_and_free { min_id; max_id } ->

     

       538
       538
       +
                   sep ();

     

       539
       539
       +
                   add_kv_int buf 'x' min_id;

     

       540
       540
       +
                   sep ();

     

       541
       541
       +
                   add_kv_int buf 'y' max_id

     

       542
       542
       +
               | _ -> ())

     

       543
       543
       +
             cmd.delete;

     

       544
       544
       +
           (* Frame options *)

     

       545
       545
       +
           Option.iter

     

       546
       546
       +
             (fun (f : Frame.t) ->

     

       547
       547
       +
               Option.iter

     

       548
       548
       +
                 (fun v ->

     

       549
       549
       +
                   sep ();

     

       550
       550
       +
                   add_kv_int buf 'x' v)

     

       551
       551
       +
                 f.x;

     

       552
       552
       +
               Option.iter

     

       553
       553
       +
                 (fun v ->

     

       554
       554
       +
                   sep ();

     

       555
       555
       +
                   add_kv_int buf 'y' v)

     

       556
       556
       +
                 f.y;

     

       557
       557
       +
               Option.iter

     

       558
       558
       +
                 (fun v ->

     

       559
       559
       +
                   sep ();

     

       560
       560
       +
                   add_kv_int buf 'c' v)

     

       561
       561
       +
                 f.base_frame;

     

       562
       562
       +
               Option.iter

     

       563
       563
       +
                 (fun v ->

     

       564
       564
       +
                   sep ();

     

       565
       565
       +
                   add_kv_int buf 'r' v)

     

       566
       566
       +
                 f.edit_frame;

     

       567
       567
       +
               Option.iter

     

       568
       568
       +
                 (fun v ->

     

       569
       569
       +
                   sep ();

     

       570
       570
       +
                   add_kv_int buf 'z' v)

     

       571
       571
       +
                 f.gap_ms;

     

       572
       572
       +
               Option.iter

     

       573
       573
       +
                 (fun c ->

     

       574
       574
       +
                   let v = Composition.to_int c in

     

       575
       575
       +
                   if v <> 0 then (

     

       576
       576
       +
                     sep ();

     

       577
       577
       +
                     add_kv_int buf 'X' v))

     

       578
       578
       +
                 f.composition;

     

       579
       579
       +
               Option.iter

     

       580
       580
       +
                 (fun v ->

     

       581
       581
       +
                   sep ();

     

       582
       582
       +
                   add_kv_int32 buf 'Y' v)

     

       583
       583
       +
                 f.background_color)

     

       584
       584
       +
             cmd.frame;

     

       585
       585
       +
           (* Animation options *)

     

       586
       586
       +
           Option.iter

     

       587
       587
       +
             (fun a ->

     

       588
       588
       +
               match a with

     

       589
       589
       +
               | Animation.Set_state { state; loops } ->

     

       590
       590
       +
                   let s =

     

       591
       591
       +
                     match state with

     

       592
       592
       +
                     | Animation.Stop -> 1

     

       593
       593
       +
                     | Animation.Loading -> 2

     

       594
       594
       +
                     | Animation.Run -> 3

     

       595
       595
       +
                   in

     

       596
       596
       +
                   sep ();

     

       597
       597
       +
                   add_kv_int buf 's' s;

     

       598
       598
       +
                   Option.iter

     

       599
       599
       +
                     (fun v ->

     

       600
       600
       +
                       sep ();

     

       601
       601
       +
                       add_kv_int buf 'v' v)

     

       602
       602
       +
                     loops

     

       603
       603
       +
               | Animation.Set_gap { frame; gap_ms } ->

     

       604
       604
       +
                   sep ();

     

       605
       605
       +
                   add_kv_int buf 'r' frame;

     

       606
       606
       +
                   sep ();

     

       607
       607
       +
                   add_kv_int buf 'z' gap_ms

     

       608
       608
       +
               | Animation.Set_current frame ->

     

       609
       609
       +
                   sep ();

     

       610
       610
       +
                   add_kv_int buf 'c' frame)

     

       611
       611
       +
             cmd.animation;

     

       612
       612
       +
           (* Compose options *)

     

       613
       613
       +
           Option.iter

     

       614
       614
       +
             (fun (c : Compose.t) ->

     

       615
       615
       +
               sep ();

     

       616
       616
       +
               add_kv_int buf 'r' c.source_frame;

     

       617
       617
       +
               sep ();

     

       618
       618
       +
               add_kv_int buf 'c' c.dest_frame;

     

       619
       619
       +
               Option.iter

     

       620
       620
       +
                 (fun v ->

     

       621
       621
       +
                   sep ();

     

       622
       622
       +
                   add_kv_int buf 'w' v)

     

       623
       623
       +
                 c.width;

     

       624
       624
       +
               Option.iter

     

       625
       625
       +
                 (fun v ->

     

       626
       626
       +
                   sep ();

     

       627
       627
       +
                   add_kv_int buf 'h' v)

     

       628
       628
       +
                 c.height;

     

       629
       629
       +
               Option.iter

     

       630
       630
       +
                 (fun v ->

     

       631
       631
       +
                   sep ();

     

       632
       632
       +
                   add_kv_int buf 'x' v)

     

       633
       633
       +
                 c.dest_x;

     

       634
       634
       +
               Option.iter

     

       635
       635
       +
                 (fun v ->

     

       636
       636
       +
                   sep ();

     

       637
       637
       +
                   add_kv_int buf 'y' v)

     

       638
       638
       +
                 c.dest_y;

     

       639
       639
       +
               Option.iter

     

       640
       640
       +
                 (fun v ->

     

       641
       641
       +
                   sep ();

     

       642
       642
       +
                   add_kv_int buf 'X' v)

     

       643
       643
       +
                 c.source_x;

     

       644
       644
       +
               Option.iter

     

       645
       645
       +
                 (fun v ->

     

       646
       646
       +
                   sep ();

     

       647
       647
       +
                   add_kv_int buf 'Y' v)

     

       648
       648
       +
                 c.source_y;

     

       649
       649
       +
               Option.iter

     

       650
       650
       +
                 (fun comp ->

     

       651
       651
       +
                   let v = Composition.to_int comp in

     

       652
       652
       +
                   if v <> 0 then (

     

       653
       653
       +
                     sep ();

     

       654
       654
       +
                     add_kv_int buf 'C' v))

     

       655
       655
       +
                 c.composition)

     

       656
       656
       +
             cmd.compose

     

       657
       657
       +
       

     

       658
       658
       +
         let chunk_size = 4096

     

       659
       659
       +
       

     

       660
       660
       +
         let write buf cmd ~data =

     

       661
       661
       +
           Buffer.add_string buf apc_start;

     

       662
       662
       +
           write_control_data buf cmd;

     

       663
       663
       +
           if String.length data > 0 then begin

     

       664
       664
       +
             let encoded = Base64.encode_string data in

     

       665
       665
       +
             let len = String.length encoded in

     

       666
       666
       +
             if len <= chunk_size then (

     

       667
       667
       +
               Buffer.add_char buf ';';

     

       668
       668
       +
               Buffer.add_string buf encoded;

     

       669
       669
       +
               Buffer.add_string buf apc_end)

     

       670
       670
       +
             else begin

     

       671
       671
       +
               (* Multiple chunks *)

     

       672
       672
       +
               let pos = ref 0 in

     

       673
       673
       +
               let first = ref true in

     

       674
       674
       +
               while !pos < len do

     

       675
       675
       +
                 let remaining = len - !pos in

     

       676
       676
       +
                 let this_chunk = min chunk_size remaining in

     

       677
       677
       +
                 let is_last = !pos + this_chunk >= len in

     

       678
       678
       +
                 if !first then (

     

       679
       679
       +
                   (* First chunk *)

     

       680
       680
       +
                   first := false;

     

       681
       681
       +
                   add_comma buf;

     

       682
       682
       +
                   add_kv_int buf 'm' 1;

     

       683
       683
       +
                   Buffer.add_char buf ';';

     

       684
       684
       +
                   Buffer.add_substring buf encoded !pos this_chunk;

     

       685
       685
       +
                   Buffer.add_string buf apc_end)

     

       686
       686
       +
                 else (

     

       687
       687
       +
                   (* Continuation chunk *)

     

       688
       688
       +
                   Buffer.add_string buf apc_start;

     

       689
       689
       +
                   add_kv_int buf 'm' (if is_last then 0 else 1);

     

       690
       690
       +
                   Buffer.add_char buf ';';

     

       691
       691
       +
                   Buffer.add_substring buf encoded !pos this_chunk;

     

       692
       692
       +
                   Buffer.add_string buf apc_end);

     

       693
       693
       +
                 pos := !pos + this_chunk

     

       694
       694
       +
               done

     

       695
       695
       +
             end

     

       696
       696
       +
           end

     

       697
       697
       +
           else Buffer.add_string buf apc_end

     

       698
       698
       +
       

     

       699
       699
       +
         let to_string cmd ~data =

     

       700
       700
       +
           let buf = Buffer.create 1024 in

     

       701
       701
       +
           write buf cmd ~data;

     

       702
       702
       +
           Buffer.contents buf

     

       703
       703
       +
       end

     

       704
       704
       +
       

     

       705
       705
       +
       module Response = struct

     

       706
       706
       +
         type t = {

     

       707
       707
       +
           message : string;

     

       708
       708
       +
           image_id : int option;

     

       709
       709
       +
           image_number : int option;

     

       710
       710
       +
           placement_id : int option;

     

       711
       711
       +
         }

     

       712
       712
       +
       

     

       713
       713
       +
         let is_ok t = t.message = "OK"

     

       714
       714
       +
         let message t = t.message

     

       715
       715
       +
       

     

       716
       716
       +
         let error_code t =

     

       717
       717
       +
           if is_ok t then None

     

       718
       718
       +
           else

     

       719
       719
       +
             match String.index_opt t.message ':' with

     

       720
       720
       +
             | Some i -> Some (String.sub t.message 0 i)

     

       721
       721
       +
             | None -> Some t.message

     

       722
       722
       +
       

     

       723
       723
       +
         let image_id t = t.image_id

     

       724
       724
       +
         let image_number t = t.image_number

     

       725
       725
       +
         let placement_id t = t.placement_id

     

       726
       726
       +
       

     

       727
       727
       +
         let parse s =

     

       728
       728
       +
           (* Format: <ESC>_G<keys>;message<ESC>\ *)

     

       729
       729
       +
           let esc = '\027' in

     

       730
       730
       +
           let len = String.length s in

     

       731
       731
       +
           if len < 5 then None

     

       732
       732
       +
           else if s.[0] <> esc || s.[1] <> '_' || s.[2] <> 'G' then None

     

       733
       733
       +
           else

     

       734
       734
       +
             (* Find the semicolon and end *)

     

       735
       735
       +
             match String.index_from_opt s 3 ';' with

     

       736
       736
       +
             | None -> None

     

       737
       737
       +
             | Some semi_pos -> (

     

       738
       738
       +
                 (* Find the APC terminator *)

     

       739
       739
       +
                 let rec find_end pos =

     

       740
       740
       +
                   if pos + 1 < len && s.[pos] = esc && s.[pos + 1] = '\\' then

     

       741
       741
       +
                     Some pos

     

       742
       742
       +
                   else if pos + 1 < len then find_end (pos + 1)

     

       743
       743
       +
                   else None

     

       744
       744
       +
                 in

     

       745
       745
       +
                 match find_end (semi_pos + 1) with

     

       746
       746
       +
                 | None -> None

     

       747
       747
       +
                 | Some end_pos ->

     

       748
       748
       +
                     let keys_str = String.sub s 3 (semi_pos - 3) in

     

       749
       749
       +
                     let message =

     

       750
       750
       +
                       String.sub s (semi_pos + 1) (end_pos - semi_pos - 1)

     

       751
       751
       +
                     in

     

       752
       752
       +
                     (* Parse keys *)

     

       753
       753
       +
                     let image_id = ref None in

     

       754
       754
       +
                     let image_number = ref None in

     

       755
       755
       +
                     let placement_id = ref None in

     

       756
       756
       +
                     let parts = String.split_on_char ',' keys_str in

     

       757
       757
       +
                     List.iter

     

       758
       758
       +
                       (fun part ->

     

       759
       759
       +
                         if String.length part >= 3 && part.[1] = '=' then

     

       760
       760
       +
                           let key = part.[0] in

     

       761
       761
       +
                           let value = String.sub part 2 (String.length part - 2) in

     

       762
       762
       +
                           match key with

     

       763
       763
       +
                           | 'i' -> image_id := int_of_string_opt value

     

       764
       764
       +
                           | 'I' -> image_number := int_of_string_opt value

     

       765
       765
       +
                           | 'p' -> placement_id := int_of_string_opt value

     

       766
       766
       +
                           | _ -> ())

     

       767
       767
       +
                       parts;

     

       768
       768
       +
                     Some

     

       769
       769
       +
                       {

     

       770
       770
       +
                         message;

     

       771
       771
       +
                         image_id = !image_id;

     

       772
       772
       +
                         image_number = !image_number;

     

       773
       773
       +
                         placement_id = !placement_id;

     

       774
       774
       +
                       })

     

       775
       775
       +
       end

     

       776
       776
       +
       

     

       777
       777
       +
       module Unicode_placeholder = struct

     

       778
       778
       +
         let placeholder_char = Uchar.of_int 0x10EEEE

     

       779
       779
       +
       

     

       780
       780
       +
         (* Row/column diacritics from the protocol spec *)

     

       781
       781
       +
         let diacritics =

     

       782
       782
       +
           [|

     

       783
       783
       +
             0x0305; 0x030D; 0x030E; 0x0310; 0x0312; 0x033D; 0x033E; 0x033F;

     

       784
       784
       +
             0x0346; 0x034A; 0x034B; 0x034C; 0x0350; 0x0351; 0x0352; 0x0357;

     

       785
       785
       +
             0x035B; 0x0363; 0x0364; 0x0365; 0x0366; 0x0367; 0x0368; 0x0369;

     

       786
       786
       +
             0x036A; 0x036B; 0x036C; 0x036D; 0x036E; 0x036F; 0x0483; 0x0484;

     

       787
       787
       +
             0x0485; 0x0486; 0x0487; 0x0592; 0x0593; 0x0594; 0x0595; 0x0597;

     

       788
       788
       +
             0x0598; 0x0599; 0x059C; 0x059D; 0x059E; 0x059F; 0x05A0; 0x05A1;

     

       789
       789
       +
             0x05A8; 0x05A9; 0x05AB; 0x05AC; 0x05AF; 0x05C4; 0x0610; 0x0611;

     

       790
       790
       +
             0x0612; 0x0613; 0x0614; 0x0615; 0x0616; 0x0617; 0x0657; 0x0658;

     

       791
       791
       +
             0x0659; 0x065A; 0x065B; 0x065D; 0x065E; 0x06D6; 0x06D7; 0x06D8;

     

       792
       792
       +
             0x06D9; 0x06DA; 0x06DB; 0x06DC; 0x06DF; 0x06E0; 0x06E1; 0x06E2;

     

       793
       793
       +
             0x06E4; 0x06E7; 0x06E8; 0x06EB; 0x06EC; 0x0730; 0x0732; 0x0733;

     

       794
       794
       +
             0x0735; 0x0736; 0x073A; 0x073D; 0x073F; 0x0740; 0x0741; 0x0743;

     

       795
       795
       +
             0x0745; 0x0747; 0x0749; 0x074A; 0x07EB; 0x07EC; 0x07ED; 0x07EE;

     

       796
       796
       +
             0x07EF; 0x07F0; 0x07F1; 0x07F3; 0x0816; 0x0817; 0x0818; 0x0819;

     

       797
       797
       +
             0x081B; 0x081C; 0x081D; 0x081E; 0x081F; 0x0820; 0x0821; 0x0822;

     

       798
       798
       +
             0x0823; 0x0825; 0x0826; 0x0827; 0x0829; 0x082A; 0x082B; 0x082C;

     

       799
       799
       +
             0x082D; 0x0951; 0x0953; 0x0954; 0x0F82; 0x0F83; 0x0F86; 0x0F87;

     

       800
       800
       +
             0x135D; 0x135E; 0x135F; 0x17DD; 0x193A; 0x1A17; 0x1A75; 0x1A76;

     

       801
       801
       +
             0x1A77; 0x1A78; 0x1A79; 0x1A7A; 0x1A7B; 0x1A7C; 0x1B6B; 0x1B6D;

     

       802
       802
       +
             0x1B6E; 0x1B6F; 0x1B70; 0x1B71; 0x1B72; 0x1B73; 0x1CD0; 0x1CD1;

     

       803
       803
       +
             0x1CD2; 0x1CDA; 0x1CDB; 0x1CE0; 0x1DC0; 0x1DC1; 0x1DC3; 0x1DC4;

     

       804
       804
       +
             0x1DC5; 0x1DC6; 0x1DC7; 0x1DC8; 0x1DC9; 0x1DCB; 0x1DCC; 0x1DD1;

     

       805
       805
       +
             0x1DD2; 0x1DD3; 0x1DD4; 0x1DD5; 0x1DD6; 0x1DD7; 0x1DD8; 0x1DD9;

     

       806
       806
       +
             0x1DDA; 0x1DDB; 0x1DDC; 0x1DDD; 0x1DDE; 0x1DDF; 0x1DE0; 0x1DE1;

     

       807
       807
       +
             0x1DE2; 0x1DE3; 0x1DE4; 0x1DE5; 0x1DE6; 0x1DFE; 0x20D0; 0x20D1;

     

       808
       808
       +
             0x20D4; 0x20D5; 0x20D6; 0x20D7; 0x20DB; 0x20DC; 0x20E1; 0x20E7;

     

       809
       809
       +
             0x20E9; 0x20F0; 0xA66F; 0xA67C; 0xA67D; 0xA6F0; 0xA6F1; 0xA8E0;

     

       810
       810
       +
             0xA8E1; 0xA8E2; 0xA8E3; 0xA8E4; 0xA8E5; 0xA8E6; 0xA8E7; 0xA8E8;

     

       811
       811
       +
             0xA8E9; 0xA8EA; 0xA8EB; 0xA8EC; 0xA8ED; 0xA8EE; 0xA8EF; 0xA8F0;

     

       812
       812
       +
             0xA8F1; 0xAAB0; 0xAAB2; 0xAAB3; 0xAAB7; 0xAAB8; 0xAABE; 0xAABF;

     

       813
       813
       +
             0xAAC1; 0xFE20; 0xFE21; 0xFE22; 0xFE23; 0xFE24; 0xFE25; 0xFE26;

     

       814
       814
       +
             0x10A0F; 0x10A38; 0x1D185; 0x1D186; 0x1D187; 0x1D188; 0x1D189;

     

       815
       815
       +
             0x1D1AA; 0x1D1AB; 0x1D1AC; 0x1D1AD; 0x1D242; 0x1D243; 0x1D244;

     

       816
       816
       +
           |]

     

       817
       817
       +
       

     

       818
       818
       +
         let row_diacritic n =

     

       819
       819
       +
           if n >= 0 && n < Array.length diacritics then

     

       820
       820
       +
             Uchar.of_int diacritics.(n)

     

       821
       821
       +
           else Uchar.of_int diacritics.(0)

     

       822
       822
       +
       

     

       823
       823
       +
         let column_diacritic = row_diacritic

     

       824
       824
       +
         let id_high_byte_diacritic = row_diacritic

     

       825
       825
       +
       

     

       826
       826
       +
         let add_uchar buf u =

     

       827
       827
       +
           let b = Bytes.create 4 in

     

       828
       828
       +
           let len = Uchar.utf_8_byte_length u in

     

       829
       829
       +
           let _ = Uchar.unsafe_to_char u in

     

       830
       830
       +
           (* Encode UTF-8 manually *)

     

       831
       831
       +
           let code = Uchar.to_int u in

     

       832
       832
       +
           if code < 0x80 then (

     

       833
       833
       +
             Bytes.set b 0 (Char.chr code);

     

       834
       834
       +
             Buffer.add_subbytes buf b 0 1)

     

       835
       835
       +
           else if code < 0x800 then (

     

       836
       836
       +
             Bytes.set b 0 (Char.chr (0xC0 lor (code lsr 6)));

     

       837
       837
       +
             Bytes.set b 1 (Char.chr (0x80 lor (code land 0x3F)));

     

       838
       838
       +
             Buffer.add_subbytes buf b 0 2)

     

       839
       839
       +
           else if code < 0x10000 then (

     

       840
       840
       +
             Bytes.set b 0 (Char.chr (0xE0 lor (code lsr 12)));

     

       841
       841
       +
             Bytes.set b 1 (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));

     

       842
       842
       +
             Bytes.set b 2 (Char.chr (0x80 lor (code land 0x3F)));

     

       843
       843
       +
             Buffer.add_subbytes buf b 0 3)

     

       844
       844
       +
           else (

     

       845
       845
       +
             Bytes.set b 0 (Char.chr (0xF0 lor (code lsr 18)));

     

       846
       846
       +
             Bytes.set b 1 (Char.chr (0x80 lor ((code lsr 12) land 0x3F)));

     

       847
       847
       +
             Bytes.set b 2 (Char.chr (0x80 lor ((code lsr 6) land 0x3F)));

     

       848
       848
       +
             Bytes.set b 3 (Char.chr (0x80 lor (code land 0x3F)));

     

       849
       849
       +
             Buffer.add_subbytes buf b 0 len)

     

       850
       850
       +
       

     

       851
       851
       +
         let write buf ~image_id ?placement_id ~rows ~cols () =

     

       852
       852
       +
           (* Set foreground color using 24-bit mode *)

     

       853
       853
       +
           let r = (image_id lsr 16) land 0xFF in

     

       854
       854
       +
           let g = (image_id lsr 8) land 0xFF in

     

       855
       855
       +
           let b = image_id land 0xFF in

     

       856
       856
       +
           Buffer.add_string buf (Printf.sprintf "\027[38;2;%d;%d;%dm" r g b);

     

       857
       857
       +
           (* Optionally set underline color for placement ID *)

     

       858
       858
       +
           (match placement_id with

     

       859
       859
       +
           | Some pid ->

     

       860
       860
       +
               let pr = (pid lsr 16) land 0xFF in

     

       861
       861
       +
               let pg = (pid lsr 8) land 0xFF in

     

       862
       862
       +
               let pb = pid land 0xFF in

     

       863
       863
       +
               Buffer.add_string buf (Printf.sprintf "\027[58;2;%d;%d;%dm" pr pg pb)

     

       864
       864
       +
           | None -> ());

     

       865
       865
       +
           (* High byte diacritic if needed *)

     

       866
       866
       +
           let high_byte = (image_id lsr 24) land 0xFF in

     

       867
       867
       +
           let high_diac =

     

       868
       868
       +
             if high_byte > 0 then Some (id_high_byte_diacritic high_byte) else None

     

       869
       869
       +
           in

     

       870
       870
       +
           (* Write placeholder grid *)

     

       871
       871
       +
           for row = 0 to rows - 1 do

     

       872
       872
       +
             for col = 0 to cols - 1 do

     

       873
       873
       +
               add_uchar buf placeholder_char;

     

       874
       874
       +
               add_uchar buf (row_diacritic row);

     

       875
       875
       +
               add_uchar buf (column_diacritic col);

     

       876
       876
       +
               Option.iter (add_uchar buf) high_diac

     

       877
       877
       +
             done;

     

       878
       878
       +
             if row < rows - 1 then Buffer.add_string buf "\n\r"

     

       879
       879
       +
           done;

     

       880
       880
       +
           (* Reset colors *)

     

       881
       881
       +
           Buffer.add_string buf "\027[39m";

     

       882
       882
       +
           match placement_id with Some _ -> Buffer.add_string buf "\027[59m" | None -> ()

     

       883
       883
       +
       end

     

       884
       884
       +
       

     

       885
       885
       +
       module Detect = struct

     

       886
       886
       +
         let make_query () =

     

       887
       887
       +
           (* Send a 1x1 transparent pixel query *)

     

       888
       888
       +
           let cmd =

     

       889
       889
       +
             Command.query ~format:Format.Rgb24 ~transmission:Transmission.Direct

     

       890
       890
       +
               ~width:1 ~height:1 ()

     

       891
       891
       +
           in

     

       892
       892
       +
           let data = "\x00\x00\x00" in

     

       893
       893
       +
           let query = Command.to_string cmd ~data in

     

       894
       894
       +
           (* Add DA1 query to detect non-supporting terminals *)

     

       895
       895
       +
           query ^ "\027[c"

     

       896
       896
       +
       

     

       897
       897
       +
         let supports_graphics response ~da1_received =

     

       898
       898
       +
           match response with

     

       899
       899
       +
           | Some r -> Response.is_ok r

     

       900
       900
       +
           | None -> not da1_received

     

       901
       901
       +
       end

+520

stack/kitty_graphics/lib/kitty_graphics.mli

···

       1
       1
       +
       (** Kitty Terminal Graphics Protocol

     

       2
       2
       +
       

     

       3
       3
       +
           This library implements the Kitty terminal graphics protocol, allowing

     

       4
       4
       +
           OCaml programs to display images in terminals that support the protocol

     

       5
       5
       +
           (Kitty, WezTerm, Konsole, Ghostty, etc.).

     

       6
       6
       +
       

     

       7
       7
       +
           The protocol uses APC (Application Programming Command) escape sequences

     

       8
       8
       +
           to transmit and display pixel graphics. Images can be transmitted as raw

     

       9
       9
       +
           RGB/RGBA data or PNG, and displayed at specific positions with various

     

       10
       10
       +
           placement options.

     

       11
       11
       +
       

     

       12
       12
       +
           {2 Basic Usage}

     

       13
       13
       +
       

     

       14
       14
       +
           {[

     

       15
       15
       +
             (* Display a PNG image *)

     

       16
       16
       +
             let png_data = read_file "image.png" in

     

       17
       17
       +
             let cmd = Kitty_graphics.Command.transmit_and_display

     

       18
       18
       +
               ~format:Kitty_graphics.Format.Png

     

       19
       19
       +
               ()

     

       20
       20
       +
             in

     

       21
       21
       +
             let buf = Buffer.create 1024 in

     

       22
       22
       +
             Kitty_graphics.Command.write buf cmd ~data:png_data;

     

       23
       23
       +
             print_string (Buffer.contents buf)

     

       24
       24
       +
           ]}

     

       25
       25
       +
       

     

       26
       26
       +
           {2 Protocol Reference}

     

       27
       27
       +
       

     

       28
       28
       +
           See {{:https://sw.kovidgoyal.net/kitty/graphics-protocol/} Kitty Graphics Protocol}

     

       29
       29
       +
           for the full specification. *)

     

       30
       30
       +
       

     

       31
       31
       +
       (** {1 Core Types} *)

     

       32
       32
       +
       

     

       33
       33
       +
       (** Image data formats. *)

     

       34
       34
       +
       module Format : sig

     

       35
       35
       +
         type t =

     

       36
       36
       +
           | Rgba32  (** 32-bit RGBA, 4 bytes per pixel *)

     

       37
       37
       +
           | Rgb24   (** 24-bit RGB, 3 bytes per pixel *)

     

       38
       38
       +
           | Png     (** PNG encoded data *)

     

       39
       39
       +
       

     

       40
       40
       +
         val to_int : t -> int

     

       41
       41
       +
         (** Convert to protocol integer value (32, 24, or 100). *)

     

       42
       42
       +
       end

     

       43
       43
       +
       

     

       44
       44
       +
       (** Transmission methods for image data. *)

     

       45
       45
       +
       module Transmission : sig

     

       46
       46
       +
         type t =

     

       47
       47
       +
           | Direct    (** Data transmitted inline in the escape sequence *)

     

       48
       48
       +
           | File      (** Data read from a file path *)

     

       49
       49
       +
           | Tempfile  (** Data read from a temp file, deleted after reading *)

     

       50
       50
       +
       

     

       51
       51
       +
         val to_char : t -> char

     

       52
       52
       +
         (** Convert to protocol character ('d', 'f', or 't'). *)

     

       53
       53
       +
       end

     

       54
       54
       +
       

     

       55
       55
       +
       (** Compression options for transmitted data. *)

     

       56
       56
       +
       module Compression : sig

     

       57
       57
       +
         type t =

     

       58
       58
       +
           | None  (** No compression *)

     

       59
       59
       +
           | Zlib  (** RFC 1950 zlib compression *)

     

       60
       60
       +
       

     

       61
       61
       +
         val to_char : t -> char option

     

       62
       62
       +
         (** Convert to protocol character (None or Some 'z'). *)

     

       63
       63
       +
       end

     

       64
       64
       +
       

     

       65
       65
       +
       (** Response suppression modes. *)

     

       66
       66
       +
       module Quiet : sig

     

       67
       67
       +
         type t =

     

       68
       68
       +
           | Noisy        (** Terminal sends all responses (default) *)

     

       69
       69
       +
           | Errors_only  (** Terminal only sends error responses *)

     

       70
       70
       +
           | Silent       (** Terminal sends no responses *)

     

       71
       71
       +
       

     

       72
       72
       +
         val to_int : t -> int

     

       73
       73
       +
         (** Convert to protocol integer (0, 1, or 2). *)

     

       74
       74
       +
       end

     

       75
       75
       +
       

     

       76
       76
       +
       (** Cursor movement policy after displaying an image. *)

     

       77
       77
       +
       module Cursor : sig

     

       78
       78
       +
         type t =

     

       79
       79
       +
           | Move    (** Move cursor after image (default) *)

     

       80
       80
       +
           | Static  (** Keep cursor in place *)

     

       81
       81
       +
       

     

       82
       82
       +
         val to_int : t -> int

     

       83
       83
       +
         (** Convert to protocol integer (0 or 1). *)

     

       84
       84
       +
       end

     

       85
       85
       +
       

     

       86
       86
       +
       (** Composition modes for blending. *)

     

       87
       87
       +
       module Composition : sig

     

       88
       88
       +
         type t =

     

       89
       89
       +
           | Alpha_blend  (** Full alpha blending (default) *)

     

       90
       90
       +
           | Overwrite    (** Simple pixel replacement *)

     

       91
       91
       +
       

     

       92
       92
       +
         val to_int : t -> int

     

       93
       93
       +
         (** Convert to protocol integer (0 or 1). *)

     

       94
       94
       +
       end

     

       95
       95
       +
       

     

       96
       96
       +
       (** {1 Delete Operations} *)

     

       97
       97
       +
       

     

       98
       98
       +
       (** Specifies what to delete when using delete commands. *)

     

       99
       99
       +
       module Delete : sig

     

       100
       100
       +
         (** Delete target specification.

     

       101
       101
       +
       

     

       102
       102
       +
             Each variant has two forms: one that only removes placements (keeping

     

       103
       103
       +
             image data for potential reuse) and one that also frees the image data. *)

     

       104
       104
       +
         type t =

     

       105
       105
       +
           | All_visible

     

       106
       106
       +
               (** Delete all visible placements. *)

     

       107
       107
       +
           | All_visible_and_free

     

       108
       108
       +
               (** Delete all visible placements and free their image data. *)

     

       109
       109
       +
           | By_id of { image_id : int; placement_id : int option }

     

       110
       110
       +
               (** Delete placements for a specific image ID, optionally filtered

     

       111
       111
       +
                   by placement ID. *)

     

       112
       112
       +
           | By_id_and_free of { image_id : int; placement_id : int option }

     

       113
       113
       +
               (** Delete and free by image ID. *)

     

       114
       114
       +
           | By_number of { image_number : int; placement_id : int option }

     

       115
       115
       +
               (** Delete by image number (newest with that number). *)

     

       116
       116
       +
           | By_number_and_free of { image_number : int; placement_id : int option }

     

       117
       117
       +
               (** Delete and free by image number. *)

     

       118
       118
       +
           | At_cursor

     

       119
       119
       +
               (** Delete placements intersecting cursor position. *)

     

       120
       120
       +
           | At_cursor_and_free

     

       121
       121
       +
               (** Delete and free at cursor position. *)

     

       122
       122
       +
           | At_cell of { x : int; y : int }

     

       123
       123
       +
               (** Delete placements intersecting a specific cell (1-based). *)

     

       124
       124
       +
           | At_cell_and_free of { x : int; y : int }

     

       125
       125
       +
               (** Delete and free at specific cell. *)

     

       126
       126
       +
           | At_cell_z of { x : int; y : int; z : int }

     

       127
       127
       +
               (** Delete at cell with specific z-index. *)

     

       128
       128
       +
           | At_cell_z_and_free of { x : int; y : int; z : int }

     

       129
       129
       +
               (** Delete and free at cell with z-index. *)

     

       130
       130
       +
           | By_column of int

     

       131
       131
       +
               (** Delete all placements intersecting a column (1-based). *)

     

       132
       132
       +
           | By_column_and_free of int

     

       133
       133
       +
               (** Delete and free by column. *)

     

       134
       134
       +
           | By_row of int

     

       135
       135
       +
               (** Delete all placements intersecting a row (1-based). *)

     

       136
       136
       +
           | By_row_and_free of int

     

       137
       137
       +
               (** Delete and free by row. *)

     

       138
       138
       +
           | By_z_index of int

     

       139
       139
       +
               (** Delete all placements with a specific z-index. *)

     

       140
       140
       +
           | By_z_index_and_free of int

     

       141
       141
       +
               (** Delete and free by z-index. *)

     

       142
       142
       +
           | By_id_range of { min_id : int; max_id : int }

     

       143
       143
       +
               (** Delete images with IDs in range [min_id, max_id]. *)

     

       144
       144
       +
           | By_id_range_and_free of { min_id : int; max_id : int }

     

       145
       145
       +
               (** Delete and free by ID range. *)

     

       146
       146
       +
           | Frames

     

       147
       147
       +
               (** Delete animation frames. *)

     

       148
       148
       +
           | Frames_and_free

     

       149
       149
       +
               (** Delete animation frames and free if no frames remain. *)

     

       150
       150
       +
       end

     

       151
       151
       +
       

     

       152
       152
       +
       (** {1 Placement Options} *)

     

       153
       153
       +
       

     

       154
       154
       +
       (** Image placement configuration.

     

       155
       155
       +
       

     

       156
       156
       +
           Controls how an image is positioned and scaled when displayed. *)

     

       157
       157
       +
       module Placement : sig

     

       158
       158
       +
         type t

     

       159
       159
       +
         (** Placement configuration. *)

     

       160
       160
       +
       

     

       161
       161
       +
         val make :

     

       162
       162
       +
           ?source_x:int ->

     

       163
       163
       +
           ?source_y:int ->

     

       164
       164
       +
           ?source_width:int ->

     

       165
       165
       +
           ?source_height:int ->

     

       166
       166
       +
           ?cell_x_offset:int ->

     

       167
       167
       +
           ?cell_y_offset:int ->

     

       168
       168
       +
           ?columns:int ->

     

       169
       169
       +
           ?rows:int ->

     

       170
       170
       +
           ?z_index:int ->

     

       171
       171
       +
           ?placement_id:int ->

     

       172
       172
       +
           ?cursor:Cursor.t ->

     

       173
       173
       +
           ?unicode_placeholder:bool ->

     

       174
       174
       +
           unit ->

     

       175
       175
       +
           t

     

       176
       176
       +
         (** Create a placement configuration.

     

       177
       177
       +
       

     

       178
       178
       +
             @param source_x Left edge of source rectangle in pixels (default 0)

     

       179
       179
       +
             @param source_y Top edge of source rectangle in pixels (default 0)

     

       180
       180
       +
             @param source_width Width of source rectangle (default: full width)

     

       181
       181
       +
             @param source_height Height of source rectangle (default: full height)

     

       182
       182
       +
             @param cell_x_offset X offset within the first cell in pixels

     

       183
       183
       +
             @param cell_y_offset Y offset within the first cell in pixels

     

       184
       184
       +
             @param columns Number of columns to display over (scales image)

     

       185
       185
       +
             @param rows Number of rows to display over (scales image)

     

       186
       186
       +
             @param z_index Stacking order (negative = under text)

     

       187
       187
       +
             @param placement_id Unique ID for this placement

     

       188
       188
       +
             @param cursor Cursor movement policy after display

     

       189
       189
       +
             @param unicode_placeholder Create virtual placement for Unicode mode *)

     

       190
       190
       +
       

     

       191
       191
       +
         val empty : t

     

       192
       192
       +
         (** Empty placement with all defaults. *)

     

       193
       193
       +
       end

     

       194
       194
       +
       

     

       195
       195
       +
       (** {1 Animation} *)

     

       196
       196
       +
       

     

       197
       197
       +
       (** Animation frame specification. *)

     

       198
       198
       +
       module Frame : sig

     

       199
       199
       +
         type t

     

       200
       200
       +
         (** Animation frame configuration. *)

     

       201
       201
       +
       

     

       202
       202
       +
         val make :

     

       203
       203
       +
           ?x:int ->

     

       204
       204
       +
           ?y:int ->

     

       205
       205
       +
           ?base_frame:int ->

     

       206
       206
       +
           ?edit_frame:int ->

     

       207
       207
       +
           ?gap_ms:int ->

     

       208
       208
       +
           ?composition:Composition.t ->

     

       209
       209
       +
           ?background_color:int32 ->

     

       210
       210
       +
           unit ->

     

       211
       211
       +
           t

     

       212
       212
       +
         (** Create a frame specification.

     

       213
       213
       +
       

     

       214
       214
       +
             @param x Left edge where frame data is placed (pixels)

     

       215
       215
       +
             @param y Top edge where frame data is placed (pixels)

     

       216
       216
       +
             @param base_frame 1-based frame number to use as background canvas

     

       217
       217
       +
             @param edit_frame 1-based frame number to edit (0 = new frame)

     

       218
       218
       +
             @param gap_ms Delay before next frame in milliseconds

     

       219
       219
       +
             @param composition How to blend pixels onto the canvas

     

       220
       220
       +
             @param background_color 32-bit RGBA background when no base frame *)

     

       221
       221
       +
       

     

       222
       222
       +
         val empty : t

     

       223
       223
       +
         (** Empty frame spec with defaults. *)

     

       224
       224
       +
       end

     

       225
       225
       +
       

     

       226
       226
       +
       (** Animation control operations. *)

     

       227
       227
       +
       module Animation : sig

     

       228
       228
       +
         type state =

     

       229
       229
       +
           | Stop     (** Stop the animation *)

     

       230
       230
       +
           | Loading  (** Run but wait for new frames at end *)

     

       231
       231
       +
           | Run      (** Run normally, loop at end *)

     

       232
       232
       +
       

     

       233
       233
       +
         type t

     

       234
       234
       +
         (** Animation control configuration. *)

     

       235
       235
       +
       

     

       236
       236
       +
         val set_state : ?loops:int -> state -> t

     

       237
       237
       +
         (** Set animation state.

     

       238
       238
       +
       

     

       239
       239
       +
             @param loops Number of loops: 0 = ignored, 1 = infinite, n = n-1 loops *)

     

       240
       240
       +
       

     

       241
       241
       +
         val set_gap : frame:int -> gap_ms:int -> t

     

       242
       242
       +
         (** Set the gap (delay) for a specific frame.

     

       243
       243
       +
       

     

       244
       244
       +
             @param frame 1-based frame number

     

       245
       245
       +
             @param gap_ms Delay in milliseconds (negative = gapless) *)

     

       246
       246
       +
       

     

       247
       247
       +
         val set_current_frame : int -> t

     

       248
       248
       +
         (** Make a specific frame (1-based) the current displayed frame. *)

     

       249
       249
       +
       end

     

       250
       250
       +
       

     

       251
       251
       +
       (** Frame composition for combining frame regions. *)

     

       252
       252
       +
       module Compose : sig

     

       253
       253
       +
         type t

     

       254
       254
       +
         (** Composition operation. *)

     

       255
       255
       +
       

     

       256
       256
       +
         val make :

     

       257
       257
       +
           source_frame:int ->

     

       258
       258
       +
           dest_frame:int ->

     

       259
       259
       +
           ?width:int ->

     

       260
       260
       +
           ?height:int ->

     

       261
       261
       +
           ?source_x:int ->

     

       262
       262
       +
           ?source_y:int ->

     

       263
       263
       +
           ?dest_x:int ->

     

       264
       264
       +
           ?dest_y:int ->

     

       265
       265
       +
           ?composition:Composition.t ->

     

       266
       266
       +
           unit ->

     

       267
       267
       +
           t

     

       268
       268
       +
         (** Compose a rectangle from one frame onto another.

     

       269
       269
       +
       

     

       270
       270
       +
             @param source_frame 1-based source frame number

     

       271
       271
       +
             @param dest_frame 1-based destination frame number

     

       272
       272
       +
             @param width Rectangle width in pixels (default: full width)

     

       273
       273
       +
             @param height Rectangle height in pixels (default: full height)

     

       274
       274
       +
             @param source_x Left edge of source rectangle

     

       275
       275
       +
             @param source_y Top edge of source rectangle

     

       276
       276
       +
             @param dest_x Left edge of destination rectangle

     

       277
       277
       +
             @param dest_y Top edge of destination rectangle

     

       278
       278
       +
             @param composition Blend mode *)

     

       279
       279
       +
       end

     

       280
       280
       +
       

     

       281
       281
       +
       (** {1 Commands} *)

     

       282
       282
       +
       

     

       283
       283
       +
       (** Graphics command builder.

     

       284
       284
       +
       

     

       285
       285
       +
           This is the main API for constructing graphics protocol commands.

     

       286
       286
       +
           Commands are built using the various constructors, then written to

     

       287
       287
       +
           a buffer with {!write}. *)

     

       288
       288
       +
       module Command : sig

     

       289
       289
       +
         type t

     

       290
       290
       +
         (** A graphics protocol command. *)

     

       291
       291
       +
       

     

       292
       292
       +
         (** {2 Image Transmission} *)

     

       293
       293
       +
       

     

       294
       294
       +
         val transmit :

     

       295
       295
       +
           ?image_id:int ->

     

       296
       296
       +
           ?image_number:int ->

     

       297
       297
       +
           ?format:Format.t ->

     

       298
       298
       +
           ?transmission:Transmission.t ->

     

       299
       299
       +
           ?compression:Compression.t ->

     

       300
       300
       +
           ?width:int ->

     

       301
       301
       +
           ?height:int ->

     

       302
       302
       +
           ?size:int ->

     

       303
       303
       +
           ?offset:int ->

     

       304
       304
       +
           ?quiet:Quiet.t ->

     

       305
       305
       +
           unit ->

     

       306
       306
       +
           t

     

       307
       307
       +
         (** Transmit image data without displaying.

     

       308
       308
       +
       

     

       309
       309
       +
             @param image_id Unique ID for the image (1-4294967295)

     

       310
       310
       +
             @param image_number Image number (terminal assigns ID)

     

       311
       311
       +
             @param format Pixel format of the data

     

       312
       312
       +
             @param transmission How data is transmitted

     

       313
       313
       +
             @param compression Compression applied to data

     

       314
       314
       +
             @param width Image width in pixels (required for RGB/RGBA)

     

       315
       315
       +
             @param height Image height in pixels (required for RGB/RGBA)

     

       316
       316
       +
             @param size Number of bytes to read (for file transmission)

     

       317
       317
       +
             @param offset Byte offset to start reading (for file transmission)

     

       318
       318
       +
             @param quiet Response suppression mode *)

     

       319
       319
       +
       

     

       320
       320
       +
         val transmit_and_display :

     

       321
       321
       +
           ?image_id:int ->

     

       322
       322
       +
           ?image_number:int ->

     

       323
       323
       +
           ?format:Format.t ->

     

       324
       324
       +
           ?transmission:Transmission.t ->

     

       325
       325
       +
           ?compression:Compression.t ->

     

       326
       326
       +
           ?width:int ->

     

       327
       327
       +
           ?height:int ->

     

       328
       328
       +
           ?size:int ->

     

       329
       329
       +
           ?offset:int ->

     

       330
       330
       +
           ?quiet:Quiet.t ->

     

       331
       331
       +
           ?placement:Placement.t ->

     

       332
       332
       +
           unit ->

     

       333
       333
       +
           t

     

       334
       334
       +
         (** Transmit image data and display it immediately.

     

       335
       335
       +
       

     

       336
       336
       +
             This is the most common operation for displaying images.

     

       337
       337
       +
             See {!transmit} for transmission parameters and {!Placement}

     

       338
       338
       +
             for display options. *)

     

       339
       339
       +
       

     

       340
       340
       +
         val query :

     

       341
       341
       +
           ?format:Format.t ->

     

       342
       342
       +
           ?transmission:Transmission.t ->

     

       343
       343
       +
           ?width:int ->

     

       344
       344
       +
           ?height:int ->

     

       345
       345
       +
           ?quiet:Quiet.t ->

     

       346
       346
       +
           unit ->

     

       347
       347
       +
           t

     

       348
       348
       +
         (** Query terminal support without storing the image.

     

       349
       349
       +
       

     

       350
       350
       +
             Send a small test image to check if the terminal supports

     

       351
       351
       +
             the graphics protocol. The terminal responds with OK or

     

       352
       352
       +
             an error without storing the image. *)

     

       353
       353
       +
       

     

       354
       354
       +
         (** {2 Display} *)

     

       355
       355
       +
       

     

       356
       356
       +
         val display :

     

       357
       357
       +
           ?image_id:int ->

     

       358
       358
       +
           ?image_number:int ->

     

       359
       359
       +
           ?placement:Placement.t ->

     

       360
       360
       +
           ?quiet:Quiet.t ->

     

       361
       361
       +
           unit ->

     

       362
       362
       +
           t

     

       363
       363
       +
         (** Display a previously transmitted image.

     

       364
       364
       +
       

     

       365
       365
       +
             @param image_id ID of a previously transmitted image

     

       366
       366
       +
             @param image_number Number of the image to display

     

       367
       367
       +
             @param placement Display placement options

     

       368
       368
       +
             @param quiet Response suppression *)

     

       369
       369
       +
       

     

       370
       370
       +
         (** {2 Deletion} *)

     

       371
       371
       +
       

     

       372
       372
       +
         val delete : ?quiet:Quiet.t -> Delete.t -> t

     

       373
       373
       +
         (** Delete images or placements.

     

       374
       374
       +
       

     

       375
       375
       +
             See {!Delete} for the various deletion modes. *)

     

       376
       376
       +
       

     

       377
       377
       +
         (** {2 Animation} *)

     

       378
       378
       +
       

     

       379
       379
       +
         val frame :

     

       380
       380
       +
           ?image_id:int ->

     

       381
       381
       +
           ?image_number:int ->

     

       382
       382
       +
           ?format:Format.t ->

     

       383
       383
       +
           ?transmission:Transmission.t ->

     

       384
       384
       +
           ?compression:Compression.t ->

     

       385
       385
       +
           ?width:int ->

     

       386
       386
       +
           ?height:int ->

     

       387
       387
       +
           ?quiet:Quiet.t ->

     

       388
       388
       +
           frame:Frame.t ->

     

       389
       389
       +
           unit ->

     

       390
       390
       +
           t

     

       391
       391
       +
         (** Transmit animation frame data.

     

       392
       392
       +
       

     

       393
       393
       +
             Similar to {!transmit} but adds frame-specific parameters. *)

     

       394
       394
       +
       

     

       395
       395
       +
         val animate :

     

       396
       396
       +
           ?image_id:int ->

     

       397
       397
       +
           ?image_number:int ->

     

       398
       398
       +
           ?quiet:Quiet.t ->

     

       399
       399
       +
           Animation.t ->

     

       400
       400
       +
           t

     

       401
       401
       +
         (** Control animation playback. *)

     

       402
       402
       +
       

     

       403
       403
       +
         val compose :

     

       404
       404
       +
           ?image_id:int ->

     

       405
       405
       +
           ?image_number:int ->

     

       406
       406
       +
           ?quiet:Quiet.t ->

     

       407
       407
       +
           Compose.t ->

     

       408
       408
       +
           t

     

       409
       409
       +
         (** Compose animation frames. *)

     

       410
       410
       +
       

     

       411
       411
       +
         (** {2 Output} *)

     

       412
       412
       +
       

     

       413
       413
       +
         val write : Buffer.t -> t -> data:string -> unit

     

       414
       414
       +
         (** Write the command to a buffer.

     

       415
       415
       +
       

     

       416
       416
       +
             @param data The payload data (image bytes, file path, etc.).

     

       417
       417
       +
                    For {!display}, {!delete}, {!animate}, pass empty string. *)

     

       418
       418
       +
       

     

       419
       419
       +
         val to_string : t -> data:string -> string

     

       420
       420
       +
         (** Convert command to a string. *)

     

       421
       421
       +
       end

     

       422
       422
       +
       

     

       423
       423
       +
       (** {1 Response Parsing} *)

     

       424
       424
       +
       

     

       425
       425
       +
       (** Terminal response parsing.

     

       426
       426
       +
       

     

       427
       427
       +
           When the terminal processes a graphics command, it may send back

     

       428
       428
       +
           a response indicating success or failure. *)

     

       429
       429
       +
       module Response : sig

     

       430
       430
       +
         type t

     

       431
       431
       +
         (** A parsed terminal response. *)

     

       432
       432
       +
       

     

       433
       433
       +
         val parse : string -> t option

     

       434
       434
       +
         (** Parse a response from terminal output.

     

       435
       435
       +
       

     

       436
       436
       +
             Expects the format: [<ESC>_G...;message<ESC>\]

     

       437
       437
       +
             Returns [None] if the string is not a valid graphics response. *)

     

       438
       438
       +
       

     

       439
       439
       +
         val is_ok : t -> bool

     

       440
       440
       +
         (** Check if the response indicates success. *)

     

       441
       441
       +
       

     

       442
       442
       +
         val message : t -> string

     

       443
       443
       +
         (** Get the response message ("OK" or error description). *)

     

       444
       444
       +
       

     

       445
       445
       +
         val error_code : t -> string option

     

       446
       446
       +
         (** Extract the error code if this is an error response.

     

       447
       447
       +
       

     

       448
       448
       +
             Error codes include: ENOENT, EINVAL, ENOSPC, EBADPNG, etc. *)

     

       449
       449
       +
       

     

       450
       450
       +
         val image_id : t -> int option

     

       451
       451
       +
         (** Get the image ID from the response, if present. *)

     

       452
       452
       +
       

     

       453
       453
       +
         val image_number : t -> int option

     

       454
       454
       +
         (** Get the image number from the response, if present. *)

     

       455
       455
       +
       

     

       456
       456
       +
         val placement_id : t -> int option

     

       457
       457
       +
         (** Get the placement ID from the response, if present. *)

     

       458
       458
       +
       end

     

       459
       459
       +
       

     

       460
       460
       +
       (** {1 Unicode Placeholders} *)

     

       461
       461
       +
       

     

       462
       462
       +
       (** Unicode placeholder generation for tmux/vim compatibility.

     

       463
       463
       +
       

     

       464
       464
       +
           Unicode placeholders allow images to work with applications that

     

       465
       465
       +
           don't understand the graphics protocol but support Unicode and

     

       466
       466
       +
           foreground colors. The image is transmitted with a virtual placement,

     

       467
       467
       +
           then placeholder characters are written to the terminal. *)

     

       468
       468
       +
       module Unicode_placeholder : sig

     

       469
       469
       +
         val placeholder_char : Uchar.t

     

       470
       470
       +
         (** The Unicode placeholder character U+10EEEE. *)

     

       471
       471
       +
       

     

       472
       472
       +
         val write :

     

       473
       473
       +
           Buffer.t ->

     

       474
       474
       +
           image_id:int ->

     

       475
       475
       +
           ?placement_id:int ->

     

       476
       476
       +
           rows:int ->

     

       477
       477
       +
           cols:int ->

     

       478
       478
       +
           unit ->

     

       479
       479
       +
           unit

     

       480
       480
       +
         (** Write placeholder characters to a buffer.

     

       481
       481
       +
       

     

       482
       482
       +
             The image ID is encoded in the foreground color (24-bit mode).

     

       483
       483
       +
             Row and column positions are encoded using combining diacritics.

     

       484
       484
       +
       

     

       485
       485
       +
             @param image_id The image ID (should have non-zero bytes for 24-bit)

     

       486
       486
       +
             @param placement_id Optional placement ID (encoded in underline color)

     

       487
       487
       +
             @param rows Number of rows to fill

     

       488
       488
       +
             @param cols Number of columns per row *)

     

       489
       489
       +
       

     

       490
       490
       +
         val row_diacritic : int -> Uchar.t

     

       491
       491
       +
         (** Get the combining diacritic for a row number (0-based). *)

     

       492
       492
       +
       

     

       493
       493
       +
         val column_diacritic : int -> Uchar.t

     

       494
       494
       +
         (** Get the combining diacritic for a column number (0-based). *)

     

       495
       495
       +
       

     

       496
       496
       +
         val id_high_byte_diacritic : int -> Uchar.t

     

       497
       497
       +
         (** Get the diacritic for the high byte of a 32-bit image ID. *)

     

       498
       498
       +
       end

     

       499
       499
       +
       

     

       500
       500
       +
       (** {1 Terminal Detection} *)

     

       501
       501
       +
       

     

       502
       502
       +
       (** Helpers for detecting terminal graphics support. *)

     

       503
       503
       +
       module Detect : sig

     

       504
       504
       +
         val make_query : unit -> string

     

       505
       505
       +
         (** Generate a query command to test graphics support.

     

       506
       506
       +
       

     

       507
       507
       +
             Send this to stdout and read the terminal's response.

     

       508
       508
       +
             Follow with a DA1 query ([<ESC>[c]) to detect terminals

     

       509
       509
       +
             that don't support graphics (they'll answer DA1 but not

     

       510
       510
       +
             the graphics query). *)

     

       511
       511
       +
       

     

       512
       512
       +
         val supports_graphics : Response.t option -> da1_received:bool -> bool

     

       513
       513
       +
         (** Determine if graphics are supported based on query results.

     

       514
       514
       +
       

     

       515
       515
       +
             @param response The parsed graphics response, if any

     

       516
       516
       +
             @param da1_received Whether a DA1 response was received

     

       517
       517
       +
       

     

       518
       518
       +
             Returns [true] if a graphics OK response was received,

     

       519
       519
       +
             or [false] if only DA1 was received (no graphics support). *)

     

       520
       520
       +
       end

+21 -26

stack/river/lib/feed.ml

···

       20
       20
        
       let src = Logs.Src.create "river" ~doc:"River RSS/Atom aggregator"

     

       21
       21
        
       module Log = (val Logs.src_log src : Logs.LOG)

     

       22
       22
        
       

     

       23
       23
       -
       type feed_content =

     

       24
       24
       -
         | Atom of Syndic.Atom.feed

     

       25
       25
       -
         | Rss2 of Syndic.Rss2.channel

     

       26
       26
       -
         | Json of Jsonfeed.t

     

       23
       23
       +
       type feed_content = River_jsonfeed.t

     

       27
       24
        
       

     

       28
       25
        
       type t = {

     

       29
       26
        
         source : Source.t;

     

       30
       27
        
         title : string;

     

       31
       28
        
         content : feed_content;

     

       29
       29
       +
         original_format : string; (* "Atom", "RSS2", or "JSONFeed" *)

     

       32
       30
        
       }

     

       33
       33
       -
       

     

       34
       34
       -
       let string_of_feed = function

     

       35
       35
       -
         | Atom _ -> "Atom"

     

       36
       36
       -
         | Rss2 _ -> "Rss2"

     

       37
       37
       -
         | Json _ -> "JSONFeed"

     

       38
       31
        
       

     

       39
       32
        
       let classify_feed ~xmlbase (body : string) =

     

       40
       33
        
         Log.debug (fun m -> m "Attempting to parse feed (%d bytes)" (String.length body));

     
···

       52
       45
        
           match Jsonfeed.of_string body with

     

       53
       46
        
           | Ok jsonfeed ->

     

       54
       47
        
               Log.debug (fun m -> m "Successfully parsed as JSONFeed");

     

       55
       55
       -
               Json jsonfeed

     

       48
       48
       +
               (* Wrap plain JSONFeed with River_jsonfeed (no extensions needed) *)

     

       49
       49
       +
               let river_jsonfeed = { River_jsonfeed.feed = jsonfeed; extension = None } in

     

       50
       50
       +
               (river_jsonfeed, "JSONFeed")

     

       56
       51
        
           | Error err ->

     

       57
       52
        
               let err_str = Jsont.Error.to_string err in

     

       58
       53
        
               Log.debug (fun m -> m "Not a JSONFeed: %s" err_str);

     
···

       61
       56
        
         ) else (

     

       62
       57
        
           (* Try XML formats *)

     

       63
       58
        
           try

     

       64
       64
       -
             let feed = Atom (Syndic.Atom.parse ~xmlbase (Xmlm.make_input (`String (0, body)))) in

     

       65
       65
       -
             Log.debug (fun m -> m "Successfully parsed as Atom feed");

     

       66
       66
       -
             feed

     

       59
       59
       +
             let atom_feed = Syndic.Atom.parse ~xmlbase (Xmlm.make_input (`String (0, body))) in

     

       60
       60
       +
             Log.debug (fun m -> m "Successfully parsed as Atom feed, converting to JSONFeed");

     

       61
       61
       +
             (* Convert Atom to JSONFeed with extensions *)

     

       62
       62
       +
             let river_jsonfeed = River_jsonfeed.of_atom atom_feed in

     

       63
       63
       +
             (river_jsonfeed, "Atom")

     

       67
       64
        
           with

     

       68
       65
        
           | Syndic.Atom.Error.Error (pos, msg) -> (

     

       69
       66
        
             Log.debug (fun m -> m "Not an Atom feed: %s at position (%d, %d)"

     

       70
       67
        
               msg (fst pos) (snd pos));

     

       71
       68
        
             try

     

       72
       72
       -
               let feed = Rss2 (Syndic.Rss2.parse ~xmlbase (Xmlm.make_input (`String (0, body)))) in

     

       73
       73
       -
               Log.debug (fun m -> m "Successfully parsed as RSS2 feed");

     

       74
       74
       -
               feed

     

       69
       69
       +
               let rss2_channel = Syndic.Rss2.parse ~xmlbase (Xmlm.make_input (`String (0, body))) in

     

       70
       70
       +
               Log.debug (fun m -> m "Successfully parsed as RSS2 feed, converting to JSONFeed");

     

       71
       71
       +
               (* Convert RSS2 to JSONFeed *)

     

       72
       72
       +
               let river_jsonfeed = River_jsonfeed.of_rss2 rss2_channel in

     

       73
       73
       +
               (river_jsonfeed, "RSS2")

     

       75
       74
        
             with Syndic.Rss2.Error.Error (pos, msg) ->

     

       76
       75
        
               Log.err (fun m -> m "Failed to parse as RSS2: %s at position (%d, %d)"

     

       77
       76
        
                 msg (fst pos) (snd pos));

     
···

       111
       110
        
               failwith (Printf.sprintf "HTTP %d: %s" status truncated_msg)

     

       112
       111
        
         in

     

       113
       112
        
       

     

       114
       114
       -
         let content =

     

       113
       113
       +
         let (content, original_format) =

     

       115
       114
        
           try classify_feed ~xmlbase response

     

       116
       115
        
           with Failure msg ->

     

       117
       116
        
             Log.err (fun m -> m "Failed to parse feed '%s' (%s): %s"

     

       118
       117
        
               (Source.name source) (Source.url source) msg);

     

       119
       118
        
             raise (Failure msg)

     

       120
       120
       -
         in

     

       121
       121
       -
         let title =

     

       122
       122
       -
           match content with

     

       123
       123
       -
           | Atom atom -> Text_extract.string_of_text_construct atom.Syndic.Atom.title

     

       124
       124
       -
           | Rss2 ch -> ch.Syndic.Rss2.title

     

       125
       125
       -
           | Json jsonfeed -> Jsonfeed.title jsonfeed

     

       126
       119
        
         in

     

       127
       120
        
       

     

       128
       128
       -
         Log.info (fun m -> m "Successfully fetched %s feed '%s' (title: '%s')"

     

       129
       129
       -
           (string_of_feed content) (Source.name source) title);

     

       121
       121
       +
         let title = Jsonfeed.title content.River_jsonfeed.feed in

     

       130
       122
        
       

     

       131
       131
       -
         { source; title; content }

     

       123
       123
       +
         Log.info (fun m -> m "Successfully fetched %s feed '%s' (title: '%s'), converted to JSONFeed"

     

       124
       124
       +
           original_format (Source.name source) title);

     

       125
       125
       +
       

     

       126
       126
       +
         { source; title; content; original_format }

     

       132
       127
        
       

     

       133
       128
        
       let source t = t.source

     

       134
       129
        
       let content t = t.content

+6 -6

stack/river/lib/feed.mli

···

       17
       17
        
       

     

       18
       18
        
       (** Feed fetching and parsing. *)

     

       19
       19
        
       

     

       20
       20
       -
       type feed_content =

     

       21
       21
       -
         | Atom of Syndic.Atom.feed

     

       22
       22
       -
         | Rss2 of Syndic.Rss2.channel

     

       23
       23
       -
         | Json of Jsonfeed.t

     

       24
       24
       -
       (** The underlying feed content, which can be Atom, RSS2, or JSONFeed format. *)

     

       20
       20
       +
       type feed_content = River_jsonfeed.t

     

       21
       21
       +
       (** The underlying feed content, stored in JSONFeed format with extensions.

     

       22
       22
       +
       

     

       23
       23
       +
           All feed formats (Atom, RSS2, JSONFeed) are converted to JSONFeed upon

     

       24
       24
       +
           fetching. Atom-specific metadata is preserved using extensions. *)

     

       25
       25
        
       

     

       26
       26
        
       type t

     

       27
       27
       -
       (** An Atom, RSS2, or JSON Feed. *)

     

       27
       27
       +
       (** A feed, stored natively in JSONFeed format. *)

     

       28
       28
        
       

     

       29
       29
        
       val fetch : Session.t -> Source.t -> t

     

       30
       30
        
       (** [fetch session source] fetches and parses a feed from the given source.

+7 -6

stack/river/lib/format.ml

···

       89
       89
        
       

     

       90
       90
        
       module Rss2 = struct

     

       91
       91
        
         let of_feed feed =

     

       92
       92
       -
           match Feed.content feed with

     

       93
       93
       -
           | Feed.Rss2 ch -> Some ch

     

       94
       94
       -
           | _ -> None

     

       92
       92
       +
           (* Feed content is now always JSONFeed - cannot extract RSS2 directly *)

     

       93
       93
       +
           (* This function is kept for backwards compatibility but always returns None *)

     

       94
       94
       +
           let _ = feed in

     

       95
       95
       +
           None

     

       95
       96
        
       end

     

       96
       97
        
       

     

       97
       98
        
       module Jsonfeed = struct

     
···

       136
       137
        
           | Error err -> Error (Jsont.Error.to_string err)

     

       137
       138
        
       

     

       138
       139
        
         let of_feed feed =

     

       139
       139
       -
           match Feed.content feed with

     

       140
       140
       -
           | Feed.Json jf -> Some jf

     

       141
       141
       -
           | _ -> None

     

       140
       140
       +
           (* Feed content is now always River_jsonfeed.t - extract the inner Jsonfeed.t *)

     

       141
       141
       +
           let jsonfeed_content = Feed.content feed in

     

       142
       142
       +
           Some jsonfeed_content.River_jsonfeed.feed

     

       142
       143
        
       end

     

       143
       144
        
       

     

       144
       145
        
       module Html = struct

+22 -36

stack/river/lib/post.ml

···

       154
       154
        
             if is_valid_author_name author.name then trimmed

     

       155
       155
        
             else raise Not_found (* Try feed-level author *)

     

       156
       156
        
           with Not_found -> (

     

       157
       157
       -
             match Feed.content feed with

     

       158
       158
       -
             | Feed.Atom atom_feed -> (

     

       159
       159
       -
                 (* Try feed-level authors *)

     

       160
       160
       -
                 match atom_feed.Syndic.Atom.authors with

     

       161
       161
       -
                 | author :: _ when is_valid_author_name author.name ->

     

       162
       162
       -
                     String.trim author.name

     

       163
       163
       -
                 | _ ->

     

       164
       164
       -
                     (* Use feed title *)

     

       165
       165
       -
                     Text_extract.string_of_text_construct atom_feed.Syndic.Atom.title)

     

       166
       166
       -
             | Feed.Rss2 _ | Feed.Json _ ->

     

       167
       167
       -
                 (* For RSS2 and JSONFeed, use the source name *)

     

       168
       168
       -
                 Source.name (Feed.source feed))

     

       157
       157
       +
             (* Feed content is now JSONFeed - try feed-level authors *)

     

       158
       158
       +
             let jsonfeed_content = Feed.content feed in

     

       159
       159
       +
             match Jsonfeed.authors jsonfeed_content.River_jsonfeed.feed with

     

       160
       160
       +
             | Some (first :: _) ->

     

       161
       161
       +
                 let name = Jsonfeed.Author.name first |> Option.value ~default:"" in

     

       162
       162
       +
                 if is_valid_author_name name then name

     

       163
       163
       +
                 else Feed.title feed

     

       164
       164
       +
             | _ ->

     

       165
       165
       +
                 (* Use feed title as fallback *)

     

       166
       166
       +
                 Feed.title feed)

     

       169
       167
        
         in

     

       170
       168
        
         (* Extract tags from Atom categories *)

     

       171
       169
        
         let tags =

     
···

       276
       274
        
               (name, "")

     

       277
       275
        
           | _ ->

     

       278
       276
        
               (* Fall back to feed-level authors or feed title *)

     

       279
       279
       -
               (match Feed.content feed with

     

       280
       280
       -
                | Feed.Json jsonfeed ->

     

       281
       281
       -
                    (match Jsonfeed.authors jsonfeed with

     

       282
       282
       -
                     | Some (first :: _) ->

     

       283
       283
       -
                         let name = Jsonfeed.Author.name first |> Option.value ~default:(Feed.title feed) in

     

       284
       284
       -
                         (name, "")

     

       285
       285
       -
                     | _ -> (Feed.title feed, ""))

     

       277
       277
       +
               let jsonfeed_content = Feed.content feed in

     

       278
       278
       +
               (match Jsonfeed.authors jsonfeed_content.River_jsonfeed.feed with

     

       279
       279
       +
                | Some (first :: _) ->

     

       280
       280
       +
                    let name = Jsonfeed.Author.name first |> Option.value ~default:(Feed.title feed) in

     

       281
       281
       +
                    (name, "")

     

       286
       282
        
                | _ -> (Feed.title feed, ""))

     

       287
       283
        
         in

     

       288
       284
        
       

     
···

       327
       323
        
         }

     

       328
       324
        
       

     

       329
       325
        
       let posts_of_feed c =

     

       330
       330
       -
         match Feed.content c with

     

       331
       331
       -
         | Feed.Atom f ->

     

       332
       332
       -
             let posts = List.map (post_of_atom ~feed:c) f.Syndic.Atom.entries in

     

       333
       333
       -
             Log.debug (fun m -> m "Extracted %d posts from Atom feed '%s'"

     

       334
       334
       -
               (List.length posts) (Source.name (Feed.source c)));

     

       335
       335
       -
             posts

     

       336
       336
       -
         | Feed.Rss2 ch ->

     

       337
       337
       -
             let posts = List.map (post_of_rss2 ~feed:c) ch.Syndic.Rss2.items in

     

       338
       338
       -
             Log.debug (fun m -> m "Extracted %d posts from RSS2 feed '%s'"

     

       339
       339
       -
               (List.length posts) (Source.name (Feed.source c)));

     

       340
       340
       -
             posts

     

       341
       341
       -
         | Feed.Json jsonfeed ->

     

       342
       342
       -
             let items = Jsonfeed.items jsonfeed in

     

       343
       343
       -
             let posts = List.map (post_of_jsonfeed_item ~feed:c) items in

     

       344
       344
       -
             Log.debug (fun m -> m "Extracted %d posts from JSONFeed '%s'"

     

       345
       345
       -
               (List.length posts) (Source.name (Feed.source c)));

     

       346
       346
       -
             posts

     

       326
       326
       +
         (* Feed content is now always JSONFeed *)

     

       327
       327
       +
         let jsonfeed_content = Feed.content c in

     

       328
       328
       +
         let items = Jsonfeed.items jsonfeed_content.River_jsonfeed.feed in

     

       329
       329
       +
         let posts = List.map (post_of_jsonfeed_item ~feed:c) items in

     

       330
       330
       +
         Log.debug (fun m -> m "Extracted %d posts from feed '%s' (converted to JSONFeed)"

     

       331
       331
       +
           (List.length posts) (Source.name (Feed.source c)));

     

       332
       332
       +
         posts

     

       347
       333
        
       

     

       348
       334
        
       let get_posts ?n ?(ofs = 0) planet_feeds =

     

       349
       335
        
         Log.info (fun m -> m "Processing %d feeds for posts" (List.length planet_feeds));

stack/river/lib/river.ml

···

       24
       24
        
       module Feed = Feed

     

       25
       25
        
       module Post = Post

     

       26
       26
        
       module Format = Format

     

       27
       27
       +
       module River_jsonfeed = River_jsonfeed

     

       27
       28
        
       module Category = Category

     

       28
       29
        
       module User = User

     

       29
       30
        
       module Quality = Quality

+122

stack/river/lib/river.mli

···

       234
       234
        
         end

     

       235
       235
        
       end

     

       236
       236
        
       

     

       237
       237
       +
       (** {1 JSONFeed with Atom Extensions} *)

     

       238
       238
       +
       

     

       239
       239
       +
       module River_jsonfeed : sig

     

       240
       240
       +
         (** JSONFeed with Atom extension support for River.

     

       241
       241
       +
       

     

       242
       242
       +
             This module provides conversion between Atom feeds and JSONFeed format,

     

       243
       243
       +
             with custom extensions to preserve Atom-specific metadata that doesn't

     

       244
       244
       +
             have direct JSONFeed equivalents.

     

       245
       245
       +
       

     

       246
       246
       +
             The extensions follow the JSONFeed specification for custom fields:

     

       247
       247
       +
             - Prefixed with underscore + letter: [_atom]

     

       248
       248
       +
             - Contains [about] field with documentation URL

     

       249
       249
       +
             - Feed readers can safely ignore unknown extensions

     

       250
       250
       +
       

     

       251
       251
       +
             See: https://www.jsonfeed.org/mappingrssandatom/ *)

     

       252
       252
       +
       

     

       253
       253
       +
         (** {2 Extension Types} *)

     

       254
       254
       +
       

     

       255
       255
       +
         type category = {

     

       256
       256
       +
           term : string;  (** Category term (required in Atom) *)

     

       257
       257
       +
           scheme : string option;  (** Category scheme/domain *)

     

       258
       258
       +
           label : string option;  (** Human-readable label *)

     

       259
       259
       +
         }

     

       260
       260
       +
       

     

       261
       261
       +
         type contributor = {

     

       262
       262
       +
           contributor_name : string;

     

       263
       263
       +
           contributor_uri : string option;

     

       264
       264
       +
           contributor_email : string option;

     

       265
       265
       +
         }

     

       266
       266
       +
       

     

       267
       267
       +
         type generator = {

     

       268
       268
       +
           generator_name : string;  (** Generator name *)

     

       269
       269
       +
           generator_uri : string option;  (** Generator URI *)

     

       270
       270
       +
           generator_version : string option;  (** Generator version *)

     

       271
       271
       +
         }

     

       272
       272
       +
       

     

       273
       273
       +
         type source = {

     

       274
       274
       +
           source_id : string;  (** Source feed ID *)

     

       275
       275
       +
           source_title : string;  (** Source feed title *)

     

       276
       276
       +
           source_updated : Ptime.t;  (** Source feed update time *)

     

       277
       277
       +
         }

     

       278
       278
       +
       

     

       279
       279
       +
         type content_type =

     

       280
       280
       +
           | Text  (** Plain text *)

     

       281
       281
       +
           | Html  (** HTML content *)

     

       282
       282
       +
           | Xhtml  (** XHTML content *)

     

       283
       283
       +
       

     

       284
       284
       +
         type feed_extension = {

     

       285
       285
       +
           feed_subtitle : string option;

     

       286
       286
       +
           feed_id : string;

     

       287
       287
       +
           feed_categories : category list;

     

       288
       288
       +
           feed_contributors : contributor list;

     

       289
       289
       +
           feed_generator : generator option;

     

       290
       290
       +
           feed_rights : string option;

     

       291
       291
       +
           feed_logo : string option;

     

       292
       292
       +
         }

     

       293
       293
       +
       

     

       294
       294
       +
         type item_extension = {

     

       295
       295
       +
           item_id : string;

     

       296
       296
       +
           item_published : Ptime.t option;

     

       297
       297
       +
           item_contributors : contributor list;

     

       298
       298
       +
           item_source : source option;

     

       299
       299
       +
           item_rights : string option;

     

       300
       300
       +
           item_categories : category list;

     

       301
       301
       +
           item_content_type : content_type option;

     

       302
       302
       +
         }

     

       303
       303
       +
       

     

       304
       304
       +
         type t = {

     

       305
       305
       +
           feed : Jsonfeed.t;

     

       306
       306
       +
           extension : feed_extension option;

     

       307
       307
       +
         }

     

       308
       308
       +
       

     

       309
       309
       +
         type item = {

     

       310
       310
       +
           item : Jsonfeed.Item.t;

     

       311
       311
       +
           extension : item_extension option;

     

       312
       312
       +
         }

     

       313
       313
       +
       

     

       314
       314
       +
         (** {2 Conversion from Atom} *)

     

       315
       315
       +
       

     

       316
       316
       +
         val of_atom : Syndic.Atom.feed -> t

     

       317
       317
       +
         (** [of_atom feed] converts an Atom feed to JSONFeed with extensions.

     

       318
       318
       +
       

     

       319
       319
       +
             All Atom metadata is preserved using extensions. *)

     

       320
       320
       +
       

     

       321
       321
       +
         val item_of_atom : Syndic.Atom.entry -> item

     

       322
       322
       +
         (** [item_of_atom entry] converts an Atom entry to JSONFeed item with extensions. *)

     

       323
       323
       +
       

     

       324
       324
       +
         (** {2 Conversion from RSS} *)

     

       325
       325
       +
       

     

       326
       326
       +
         val of_rss2 : Syndic.Rss2.channel -> t

     

       327
       327
       +
         (** [of_rss2 channel] converts an RSS2 channel to JSONFeed. *)

     

       328
       328
       +
       

     

       329
       329
       +
         val item_of_rss2 : Syndic.Rss2.item -> item

     

       330
       330
       +
         (** [item_of_rss2 item] converts an RSS2 item to JSONFeed item. *)

     

       331
       331
       +
       

     

       332
       332
       +
         (** {2 Conversion to Atom} *)

     

       333
       333
       +
       

     

       334
       334
       +
         val to_atom : t -> Syndic.Atom.feed

     

       335
       335
       +
         (** [to_atom t] converts JSONFeed with extensions back to Atom feed.

     

       336
       336
       +
       

     

       337
       337
       +
             All original Atom metadata is restored from extensions. *)

     

       338
       338
       +
       

     

       339
       339
       +
         val item_to_atom : item -> Syndic.Atom.entry

     

       340
       340
       +
         (** [item_to_atom item] converts JSONFeed item with extensions back to Atom entry. *)

     

       341
       341
       +
       

     

       342
       342
       +
         (** {2 Serialization} *)

     

       343
       343
       +
       

     

       344
       344
       +
         val to_string : ?minify:bool -> t -> (string, string) result

     

       345
       345
       +
         (** [to_string ?minify t] serializes to JSON string with extensions. *)

     

       346
       346
       +
       

     

       347
       347
       +
         val of_string : string -> (t, string) result

     

       348
       348
       +
         (** [of_string s] parses JSON string with extensions. *)

     

       349
       349
       +
       

     

       350
       350
       +
         (** {2 Utilities} *)

     

       351
       351
       +
       

     

       352
       352
       +
         val of_posts : title:string -> Post.t list -> t

     

       353
       353
       +
         (** [of_posts ~title posts] creates JSONFeed from Post list with Atom extensions. *)

     

       354
       354
       +
       

     

       355
       355
       +
         val to_posts : feed:Feed.t -> t -> Post.t list

     

       356
       356
       +
         (** [to_posts ~feed t] extracts posts from extended JSONFeed. *)

     

       357
       357
       +
       end

     

       358
       358
       +
       

     

       237
       359
        
       (** {1 Category Management} *)

     

       238
       360
        
       

     

       239
       361
        
       module Category : sig

+93 -15

stack/river/lib/state.ml

···

       38
       38
        
         (** Get the sync state file path *)

     

       39
       39
        
         let sync_state_file state = Eio.Path.(Xdge.state_dir state.xdg / "sync_state.json")

     

       40
       40
        
       

     

       41
       41
       -
         (** Get the path to a user's Atom feed file *)

     

       41
       41
       +
         (** Get the path to a user's JSONFeed file *)

     

       42
       42
        
         let user_feed_file state username =

     

       43
       43
       +
           Eio.Path.(user_feeds_dir state / (username ^ ".json"))

     

       44
       44
       +
       

     

       45
       45
       +
         (** Get the path to a user's old Atom feed file (for migration) *)

     

       46
       46
       +
         let user_feed_file_legacy state username =

     

       43
       47
        
           Eio.Path.(user_feeds_dir state / (username ^ ".xml"))

     

       44
       48
        
       

     

       45
       49
        
         (** Ensure all necessary directories exist *)

     
···

       291
       295
        
             Log.err (fun m -> m "Error getting all users: %s" (Printexc.to_string e));

     

       292
       296
        
             []

     

       293
       297
        
       

     

       294
       294
       -
         (** Load existing Atom entries for a user *)

     

       295
       295
       -
         let load_existing_posts state username =

     

       296
       296
       -
           let file = Paths.user_feed_file state username in

     

       298
       298
       +
         (** Migrate legacy Atom XML feed to JSONFeed format *)

     

       299
       299
       +
         let migrate_legacy_feed state username =

     

       300
       300
       +
           let legacy_file = Paths.user_feed_file_legacy state username in

     

       297
       301
        
           try

     

       298
       298
       -
             let content = Eio.Path.load file in

     

       302
       302
       +
             let content = Eio.Path.load legacy_file in

     

       303
       303
       +
             Log.info (fun m -> m "Migrating legacy Atom feed for %s to JSONFeed" username);

     

       299
       304
        
             (* Parse existing Atom feed *)

     

       300
       305
        
             let input = Xmlm.make_input (`String (0, content)) in

     

       301
       301
       -
             let feed = Syndic.Atom.parse input in

     

       302
       302
       -
             feed.Syndic.Atom.entries

     

       306
       306
       +
             let atom_feed = Syndic.Atom.parse input in

     

       307
       307
       +
             (* Convert to JSONFeed with extensions *)

     

       308
       308
       +
             let jsonfeed = River_jsonfeed.of_atom atom_feed in

     

       309
       309
       +
             (* Save as JSONFeed *)

     

       310
       310
       +
             let json_file = Paths.user_feed_file state username in

     

       311
       311
       +
             (match River_jsonfeed.to_string ~minify:false jsonfeed with

     

       312
       312
       +
              | Ok json ->

     

       313
       313
       +
                  Eio.Path.save ~create:(`Or_truncate 0o644) json_file json;

     

       314
       314
       +
                  Log.info (fun m -> m "Successfully migrated %s from Atom to JSONFeed" username);

     

       315
       315
       +
                  (* Rename legacy file to .xml.backup *)

     

       316
       316
       +
                  let backup_file = Eio.Path.(Paths.user_feeds_dir state / (username ^ ".xml.backup")) in

     

       317
       317
       +
                  (try

     

       318
       318
       +
                    Eio.Path.save ~create:(`Or_truncate 0o644) backup_file content;

     

       319
       319
       +
                    Log.info (fun m -> m "Backed up legacy Atom file to %s.xml.backup" username)

     

       320
       320
       +
                  with e ->

     

       321
       321
       +
                    Log.warn (fun m -> m "Failed to backup legacy file: %s" (Printexc.to_string e)));

     

       322
       322
       +
                  Some jsonfeed

     

       323
       323
       +
              | Error err ->

     

       324
       324
       +
                  Log.err (fun m -> m "Failed to serialize JSONFeed during migration: %s" err);

     

       325
       325
       +
                  None)

     

       303
       326
        
           with

     

       304
       304
       -
           | Eio.Io (Eio.Fs.E (Not_found _), _) -> []

     

       327
       327
       +
           | Eio.Io (Eio.Fs.E (Not_found _), _) -> None

     

       305
       328
        
           | e ->

     

       306
       306
       -
             Log.err (fun m -> m "Error loading existing posts for %s: %s"

     

       329
       329
       +
             Log.err (fun m -> m "Error migrating legacy feed for %s: %s"

     

       307
       330
        
               username (Printexc.to_string e));

     

       308
       308
       -
             []

     

       331
       331
       +
             None

     

       309
       332
        
       

     

       310
       310
       -
         (** Save Atom entries for a user *)

     

       311
       311
       -
         let save_atom_feed state username entries =

     

       333
       333
       +
         (** Load existing JSONFeed for a user (with legacy migration support) *)

     

       334
       334
       +
         let load_existing_feed state username =

     

       312
       335
        
           let file = Paths.user_feed_file state username in

     

       313
       313
       -
           let feed = Format.Atom.feed_of_entries ~title:username entries in

     

       314
       314
       -
           let xml = Format.Atom.to_string feed in

     

       315
       315
       -
           Eio.Path.save ~create:(`Or_truncate 0o644) file xml

     

       336
       336
       +
           try

     

       337
       337
       +
             let content = Eio.Path.load file in

     

       338
       338
       +
             (* Parse JSONFeed *)

     

       339
       339
       +
             match River_jsonfeed.of_string content with

     

       340
       340
       +
             | Ok jsonfeed -> Some jsonfeed

     

       341
       341
       +
             | Error err ->

     

       342
       342
       +
                 Log.err (fun m -> m "Failed to parse JSONFeed for %s: %s" username err);

     

       343
       343
       +
                 (* Try migration from legacy Atom *)

     

       344
       344
       +
                 migrate_legacy_feed state username

     

       345
       345
       +
           with

     

       346
       346
       +
           | Eio.Io (Eio.Fs.E (Not_found _), _) ->

     

       347
       347
       +
               (* JSON file not found, try legacy migration *)

     

       348
       348
       +
               migrate_legacy_feed state username

     

       349
       349
       +
           | e ->

     

       350
       350
       +
             Log.err (fun m -> m "Error loading feed for %s: %s"

     

       351
       351
       +
               username (Printexc.to_string e));

     

       352
       352
       +
             None

     

       353
       353
       +
       

     

       354
       354
       +
         (** Load existing posts as Atom entries for a user (for backwards compatibility) *)

     

       355
       355
       +
         let load_existing_posts state username =

     

       356
       356
       +
           match load_existing_feed state username with

     

       357
       357
       +
           | None -> []

     

       358
       358
       +
           | Some jsonfeed ->

     

       359
       359
       +
               (* Convert JSONFeed back to Atom for backwards compatibility *)

     

       360
       360
       +
               let atom_feed = River_jsonfeed.to_atom jsonfeed in

     

       361
       361
       +
               atom_feed.Syndic.Atom.entries

     

       362
       362
       +
       

     

       363
       363
       +
         (** Save JSONFeed for a user *)

     

       364
       364
       +
         let save_jsonfeed state username jsonfeed =

     

       365
       365
       +
           let file = Paths.user_feed_file state username in

     

       366
       366
       +
           match River_jsonfeed.to_string ~minify:false jsonfeed with

     

       367
       367
       +
           | Ok json -> Eio.Path.save ~create:(`Or_truncate 0o644) file json

     

       368
       368
       +
           | Error err -> failwith ("Failed to serialize JSONFeed: " ^ err)

     

       369
       369
       +
       

     

       370
       370
       +
         (** Save Atom entries for a user (converts to JSONFeed first) *)

     

       371
       371
       +
         let save_atom_feed state username entries =

     

       372
       372
       +
           (* Convert Atom entries to JSONFeed with extensions *)

     

       373
       373
       +
           let items_with_ext = List.map River_jsonfeed.item_of_atom entries in

     

       374
       374
       +
           let items = List.map (fun i -> i.River_jsonfeed.item) items_with_ext in

     

       375
       375
       +
       

     

       376
       376
       +
           (* Create feed extension *)

     

       377
       377
       +
           let feed_ext = {

     

       378
       378
       +
             River_jsonfeed.feed_subtitle = None;

     

       379
       379
       +
             feed_id = "urn:river:user:" ^ username;

     

       380
       380
       +
             feed_categories = [];

     

       381
       381
       +
             feed_contributors = [];

     

       382
       382
       +
             feed_generator = Some {

     

       383
       383
       +
               River_jsonfeed.generator_name = "River Feed Aggregator";

     

       384
       384
       +
               generator_uri = None;

     

       385
       385
       +
               generator_version = Some "1.0";

     

       386
       386
       +
             };

     

       387
       387
       +
             feed_rights = None;

     

       388
       388
       +
             feed_logo = None;

     

       389
       389
       +
           } in

     

       390
       390
       +
       

     

       391
       391
       +
           let jsonfeed_inner = Jsonfeed.create ~title:username ~items () in

     

       392
       392
       +
           let jsonfeed = { River_jsonfeed.feed = jsonfeed_inner; extension = Some feed_ext } in

     

       393
       393
       +
           save_jsonfeed state username jsonfeed

     

       316
       394
        
       end

     

       317
       395
        
       

     

       318
       396
        
       module Sync = struct