From d650a60a57d30826f9f79f1f2377b492319ff132 Mon Sep 17 00:00:00 2001 From: Lukasz Stafiniak Date: Wed, 21 Feb 2024 13:21:00 +0100 Subject: [PATCH] Fixes #10: ANSI encoded hyperlinks for printbox-text --- src/printbox-text/PrintBox_text.ml | 66 ++++++++++++++++++++++-------- test/dune | 6 +++ test/test_text_uri.expected | 37 +++++++++++++++++ test/test_text_uri.ml | 23 +++++++++++ 4 files changed, 114 insertions(+), 18 deletions(-) create mode 100644 test/test_text_uri.expected create mode 100644 test/test_text_uri.ml diff --git a/src/printbox-text/PrintBox_text.ml b/src/printbox-text/PrintBox_text.ml index eceaef4..edd3dd2 100644 --- a/src/printbox-text/PrintBox_text.ml +++ b/src/printbox-text/PrintBox_text.ml @@ -11,6 +11,7 @@ type position = PrintBox.position = { module Style_ansi : sig val brackets : B.Style.t -> string * string + val hyperlink : uri:string -> B.Style.t -> string * string end = struct open B.Style @@ -55,6 +56,16 @@ end = struct Buffer.contents buf, "\x1b[0m" let brackets s = ansi_l_to_str_ (codes_of_style s) + + let hyperlink ~uri s = + let prefix, postfix = brackets s in + (* "\x1b]8;;http://example.com\x1b\\This is a link\x1b]8;;\x1b\\\n" *) + let buf = Buffer.create 16 in + Buffer.add_string buf "\x1b]8;;"; + Buffer.add_string buf uri; + Buffer.add_string buf "\x1b\\"; + Buffer.add_string buf prefix; + Buffer.contents buf, postfix ^ "\x1b]8;;\x1b\\" end module Pos = struct @@ -272,7 +283,7 @@ end module Box_inner : sig type t - val of_box : B.box -> t + val of_box : ansi:bool -> B.box -> t val render : ansi:bool -> Output.t -> t -> unit end = struct type 'a shape = @@ -280,6 +291,7 @@ end = struct | Text of { l: (string * int * int) list; (* list of lines *) style: B.Style.t; + link_with_uri: string option; } | Frame of 'a | Pad of position * 'a (* vertical and horizontal padding *) @@ -459,7 +471,7 @@ end = struct let size_of_shape = function | Empty -> Pos.origin - | Text { l; style = _ } -> + | Text { l; style = _; link_with_uri = _ } -> let width = List.fold_left (fun acc (s, i, len) -> max acc (str_display_width_ s i len)) @@ -500,7 +512,7 @@ end = struct lines_ s2 0 k; List.iter (fun s -> lines_ s 0 k) tl - let rec of_box (b : B.t) : t = + let rec of_box ~ansi (b : B.t) : t = let shape = match B.view b with | B.Empty -> Empty @@ -508,15 +520,33 @@ end = struct (* split into lines *) let acc = ref [] in lines_l_ l (fun s i len -> acc := (s, i, len) :: !acc); - Text { l = List.rev !acc; style } - | B.Frame t -> Frame (of_box t) - | B.Pad (dim, t) -> Pad (dim, of_box t) - | B.Align { h; v; inner } -> Align { h; v; inner = of_box inner } - | B.Grid (bars, m) -> Grid (bars, B.map_matrix of_box m) - | B.Tree (i, b, l) -> Tree (i, of_box b, Array.map of_box l) + Text { l = List.rev !acc; style; link_with_uri = None } + | B.Frame t -> Frame (of_box ~ansi t) + | B.Pad (dim, t) -> Pad (dim, of_box ~ansi t) + | B.Align { h; v; inner } -> Align { h; v; inner = of_box ~ansi inner } + | B.Grid (bars, m) -> Grid (bars, B.map_matrix (of_box ~ansi) m) + | B.Tree (i, b, l) -> Tree (i, of_box ~ansi b, Array.map (of_box ~ansi) l) + | B.Link { inner; uri } when ansi -> + (match B.view inner with + | B.Empty -> Empty + | B.Frame t -> Frame (of_box ~ansi (B.link ~uri t)) + | B.Pad (dim, t) -> Pad (dim, of_box ~ansi (B.link ~uri t)) + | B.Align { h; v; inner } -> Align { h; v; inner = of_box ~ansi (B.link ~uri inner)} + | B.Grid (bars, m) -> Grid (bars, B.map_matrix (of_box ~ansi) m) + | B.Tree (i, b, l) -> + Tree (i, of_box ~ansi (B.link ~uri b), + Array.map (fun b -> of_box ~ansi @@ B.link ~uri b) l) + | B.Link _ -> + (* Inner links override outer links. *) + (of_box ~ansi inner).shape + | B.Text _ -> + (match of_box ~ansi inner with + | {shape = Text { l; style; link_with_uri = _ }; size = _ } -> + Text { l; style; link_with_uri = Some uri } + | _ -> assert false)) | B.Link { inner; uri } -> (* just encode as a record *) - let self = of_box (B.v_record [ "uri", B.text uri; "inner", inner ]) in + let self = of_box ~ansi (B.v_record [ "uri", B.text uri; "inner", inner ]) in self.shape in { shape; size = lazy (size_of_shape shape) } @@ -552,12 +582,12 @@ end = struct let rec render_rec ~ansi ?(offset = offset) ?expected_size b pos = match shape b with | Empty -> conn_m.m - | Text { l; style } -> + | Text { l; style; link_with_uri } -> let ansi_prelude, ansi_suffix = - if ansi then - Style_ansi.brackets style - else - "", "" + match ansi, link_with_uri with + | false, _ -> "", "" + | true, None -> Style_ansi.brackets style + | true, Some uri -> Style_ansi.hyperlink ~uri style in let has_style = ansi_prelude <> "" || ansi_suffix <> "" in List.iteri @@ -759,20 +789,20 @@ end let to_string_with ~style b = let buf = Output.create () in - Box_inner.render ~ansi:style buf (Box_inner.of_box b); + Box_inner.render ~ansi:style buf (Box_inner.of_box ~ansi:style b); Output.to_string buf let to_string = to_string_with ~style:true let output ?(style = true) ?(indent = 0) oc b = let buf = Output.create () in - Box_inner.render ~ansi:style buf (Box_inner.of_box b); + Box_inner.render ~ansi:style buf (Box_inner.of_box ~ansi:style b); Output.to_chan ~indent oc buf; flush oc let pp_with ~style out b = let buf = Output.create () in - Box_inner.render ~ansi:style buf (Box_inner.of_box b); + Box_inner.render ~ansi:style buf (Box_inner.of_box ~ansi:style b); Output.pp out buf let pp = pp_with ~style:true diff --git a/test/dune b/test/dune index b2e3679..a1736e7 100644 --- a/test/dune +++ b/test/dune @@ -20,6 +20,12 @@ (package printbox-text) (libraries printbox printbox-text)) +(test + (name test_text_uri) + (modules test_text_uri) + (package printbox-text) + (libraries printbox printbox-text)) + (test (name test_html) (modules test_html) diff --git a/test/test_text_uri.expected b/test/test_text_uri.expected new file mode 100644 index 0000000..ec5e878 --- /dev/null +++ b/test/test_text_uri.expected @@ -0,0 +1,37 @@ +┌───────┐ +│]8;;https://example.com/1\child 1]8;;\│ +└───────┘ +──────────────────── +]8;;https://example.com/2\child 2]8;;\ +──────────────────── +┌──────────────────┐ +│──┬────────┐ │ +│ │]8;;https://example.com/4\header 3]8;;\│ │ +│ ├────────┘ │ +│ └─┬──────────┐ │ +│ │]8;;https://example.com/4\subchild 3]8;;\│ │ +│ └──────────┘ │ +└──────────────────┘ +──────────────────── +──┬────────┐ + │]8;;https://example.com/5\header 4]8;;\│ + ├────────┘ + └─┬──────────┐ + │]8;;https://example.com/5\subchild 4]8;;\│ + └──────────┘ +──────────────────── +┌───────┐ +│child 5│ +└───────┘ +──────────────────── +┌──────────────────┐ +│┌────────┐ │ +││]8;;https://example.com/6\header 6]8;;\│ │ +│├────────┘ │ +│└─┬───────┐ │ +│ │]8;;https://example.com/6\child 6]8;;\│ │ +│ ├───────┘ │ +│ └─┬──────────┐ │ +│ │]8;;https://example.com/7\subchild 6]8;;\│ │ +│ └──────────┘ │ +└──────────────────┘ diff --git a/test/test_text_uri.ml b/test/test_text_uri.ml new file mode 100644 index 0000000..4fdb683 --- /dev/null +++ b/test/test_text_uri.ml @@ -0,0 +1,23 @@ +let b = + let open PrintBox in + vlist + [ + link ~uri:"https://example.com/1" @@ frame @@ text "child 1"; + link ~uri:"https://example.com/2" @@ text "child 2"; + frame + @@ tree (link ~uri:"https://example.com/3" empty) + [ link ~uri:"https://example.com/4" @@ + tree (frame @@ text "header 3") [ frame @@ text "subchild 3" ] ]; + link ~uri:"https://example.com/5" @@ + tree empty + [ tree (frame @@ text "header 4") [ frame @@ text "subchild 4" ] ]; + frame @@ text "child 5"; + link ~uri:"https://example.com/6" @@ + frame + @@ tree + (frame @@ text "header 6") + [ tree (frame @@ text "child 6") + [ link ~uri:"https://example.com/7" @@ frame @@ text "subchild 6" ] ]; + ] + +let () = print_endline @@ PrintBox_text.to_string b