diff --git a/.ocamlformat b/.ocamlformat index 2124d7d..7818345 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version = 0.24.1 +version = 0.26.2 profile=conventional margin=80 if-then-else=k-r diff --git a/Makefile b/Makefile index 14764cb..361b2d6 100644 --- a/Makefile +++ b/Makefile @@ -6,6 +6,8 @@ build: test: @dune runtest --no-buffer --force +test-autopromote: + @dune runtest --no-buffer --force --auto-promote install: build @dune install @@ -22,7 +24,8 @@ update_next_tag: sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/**/*.ml) $(wildcard src/**/*.mli) sed -i "s/NEXT_RELEASE/$(VERSION)/g" $(wildcard src/*.ml) $(wildcard src/*.mli) +WATCH?="@all" watch: - @dune build @all -w + @dune build $(WATCH) -w .PHONY: all build test clean doc watch diff --git a/src/PrintBox.ml b/src/PrintBox.ml index 161c335..25ea16c 100644 --- a/src/PrintBox.ml +++ b/src/PrintBox.ml @@ -44,7 +44,10 @@ type view = l: string list; style: Style.t; } - | Frame of t + | Frame of { + sub: t; + stretch: bool; + } | Pad of position * t (* vertical and horizontal padding *) | Align of { h: [ `Left | `Center | `Right ]; @@ -103,7 +106,7 @@ let bool x = line_ (string_of_bool x) let int_ = int let float_ = float let bool_ = bool -let[@inline] frame b = Frame b +let[@inline] frame ?(stretch = false) b = Frame { sub = b; stretch } let pad' ~col ~lines b = assert (col >= 0 || lines >= 0); @@ -128,9 +131,9 @@ let grid ?(pad = fun b -> b) ?(bars = true) m = let m = map_matrix pad m in Grid ( (if bars then - `Bars - else - `None), + `Bars + else + `None), m ) let grid_l ?pad ?bars l = @@ -199,7 +202,6 @@ let mk_tree ?indent f root = make root let link ~uri inner : t = Link { uri; inner } - let anchor ~id inner : t = Anchor { id; inner } (** {2 Simple Structural Interface} *) diff --git a/src/PrintBox.mli b/src/PrintBox.mli index 0782a4a..1cde757 100644 --- a/src/PrintBox.mli +++ b/src/PrintBox.mli @@ -109,6 +109,7 @@ type t @since 0.3 added [Align] @since 0.5 added [Link] @since 0.11 added [Anchor] + @since NEXT_RELEASE added [Stretch] *) type view = private | Empty @@ -116,7 +117,10 @@ type view = private l: string list; style: Style.t; } - | Frame of t + | Frame of { + sub: t; + stretch: bool; + } | Pad of position * t (* vertical and horizontal padding *) | Align of { h: [ `Left | `Center | `Right ]; @@ -175,8 +179,10 @@ val bool : bool -> t val float : float -> t (** @since 0.2 *) -val frame : t -> t -(** Put a single frame around the box *) +val frame : ?stretch:bool -> t -> t +(** Put a single frame around the box. + @param stretch if true (default false), the frame expands to + fill the available space. Present since NEXT_RELEASE *) val pad : t -> t (** Pad the given box with some free space *) diff --git a/src/printbox-html/PrintBox_html.ml b/src/printbox-html/PrintBox_html.ml index 4419841..939349a 100644 --- a/src/printbox-html/PrintBox_html.ml +++ b/src/printbox-html/PrintBox_html.ml @@ -113,9 +113,9 @@ let sep_spans sep l = x :: (if i < len - 1 then - [ sep () ] - else - [])) + [ sep () ] + else + [])) l let br_lines ~bold l = @@ -170,7 +170,7 @@ let to_html_rec ~config (b : B.t) = | B.Pad (_, b) -> (* FIXME: not implemented yet *) to_html_summary b - | B.Frame b -> + | B.Frame { sub = b; stretch = _ } -> H.span ~a:[ H.a_style "border:thin solid" ] [ to_html_summary b ] | B.Align { h = `Right; inner = b; v = _ } -> H.span ~a:[ H.a_class [ "align-right" ] ] [ to_html_summary b ] @@ -203,12 +203,12 @@ let to_html_rec ~config (b : B.t) = | _ -> raise Summary_not_supported) | B.Tree _ | B.Link _ -> raise Summary_not_supported in - let loop - : 'tags. - (B.t -> - ([< Html_types.flow5 > `Pre `Span `Div `Ul `Table `P ] as 'tags) html) -> - B.t -> - 'tags html = + let loop : + 'tags. + (B.t -> + ([< Html_types.flow5 > `Pre `Span `Div `Ul `Table `P ] as 'tags) html) -> + B.t -> + 'tags html = fun fix b -> match B.view b with | B.Empty -> @@ -219,7 +219,8 @@ let to_html_rec ~config (b : B.t) = | B.Pad (_, b) -> (* FIXME: not implemented yet *) fix b - | B.Frame b -> H.div ~a:[ H.a_style "border:thin solid" ] [ fix b ] + | B.Frame { sub = b; _ } -> + H.div ~a:[ H.a_style "border:thin solid" ] [ fix b ] | B.Align { h = `Right; inner = b; v = _ } -> H.div ~a:[ H.a_class [ "align-right" ] ] [ fix b ] | B.Align { h = `Center; inner = b; v = _ } -> diff --git a/src/printbox-md/PrintBox_md.ml b/src/printbox-md/PrintBox_md.ml index a63a21b..95534e3 100644 --- a/src/printbox-md/PrintBox_md.ml +++ b/src/printbox-md/PrintBox_md.ml @@ -241,7 +241,7 @@ let rec multiline_heuristic c b = | B.Text { l = [ s ]; _ } -> String.contains s '\n' | B.Text _ -> true | B.Frame _ when c.Config.frames = `As_table -> true - | B.Frame b -> multiline_heuristic c b + | B.Frame { sub = b; _ } -> multiline_heuristic c b | B.Pad (_, _) -> true | B.Align { inner; _ } -> multiline_heuristic c inner | B.Grid (_, [| _ |]) when c.Config.hlists = `As_table -> true @@ -277,7 +277,7 @@ let rec line_of_length_heuristic_exn c b = String.length s + from_bold + from_code | B.Text _ -> raise Not_found | B.Frame _ when c.Config.frames = `As_table -> raise Not_found - | B.Frame b -> + | B.Frame { sub = b; _ } -> (* "> " or "[]" *) line_of_length_heuristic_exn c b + 2 | B.Pad (_, _) -> raise Not_found @@ -310,7 +310,7 @@ let is_native_table c rows = let rec header h = match B.view h with | B.Text { l = [ _ ]; style = { B.Style.bold = true; _ } } -> true - | B.Frame b -> header b + | B.Frame { sub = b; _ } -> header b | _ -> false in Array.for_all header rows.(0) @@ -322,7 +322,7 @@ let rec remove_bold b = match B.view b with | B.Empty | B.Text { l = []; _ } -> B.empty | B.Text { l; style } -> B.lines_with_style (B.Style.set_bold false style) l - | B.Frame b -> B.frame @@ remove_bold b + | B.Frame { sub = b; stretch } -> B.frame ~stretch @@ remove_bold b | B.Pad (pos, b) -> B.pad' ~col:pos.B.x ~lines:pos.B.y @@ remove_bold b | B.Align { h; v; inner } -> B.align ~h ~v @@ remove_bold inner | B.Grid _ -> assert false @@ -362,7 +362,7 @@ let pp c out b = preformat out l; if code_block then fprintf out "@,%s```@,%s" prefix prefix; pp_print_string out sty_post - | B.Frame fb -> + | B.Frame { sub = fb; _ } -> (match c.Config.frames, c.Config.tables, no_block with | `As_table, `Html, _ -> (* Don't indent in case there's an embedded multiline preformatted text. *) diff --git a/src/printbox-text/PrintBox_text.ml b/src/printbox-text/PrintBox_text.ml index 12a1d7c..1e485f0 100644 --- a/src/printbox-text/PrintBox_text.ml +++ b/src/printbox-text/PrintBox_text.ml @@ -28,9 +28,9 @@ end = struct let codes_of_style (self : t) : int list = let { bold; fg_color; bg_color; preformatted = _ } = self in (if bold then - [ 1 ] - else - []) + [ 1 ] + else + []) @ (match bg_color with | None -> [] | Some c -> [ 40 + int_of_color_ c ]) @@ -78,6 +78,9 @@ module Pos = struct let origin = { x = 0; y = 0 } let[@inline] move pos x y = { x = pos.x + x; y = pos.y + y } + + (* let[@inline] min p1 p2 = { x = min p1.x p2.x; y = min p1.y p2.y } *) + let[@inline] max p1 p2 = { x = max p1.x p2.x; y = max p1.y p2.y } let[@inline] ( + ) pos1 pos2 = move pos1 pos2.x pos2.y let[@inline] ( - ) pos1 pos2 = move pos1 (-pos2.x) (-pos2.y) let[@inline] ( * ) n pos = { x = n * pos.x; y = n * pos.y } @@ -293,7 +296,10 @@ end = struct style: B.Style.t; link_with_uri: string option; } - | Frame of 'a + | Frame of { + sub: 'a; + stretch: bool; + } | Pad of position * 'a (* vertical and horizontal padding *) | Align of { h: [ `Left | `Center | `Right ]; @@ -478,7 +484,7 @@ end = struct 0 l in { x = width; y = List.length l } - | Frame t -> Pos.move (size t) 2 2 + | Frame { sub = t; _ } -> Pos.move (size t) 2 2 | Pad (dim, b') -> Pos.(size b' + (2 * dim)) | Align { inner = b'; _ } -> size b' | Grid (style, m) -> @@ -521,7 +527,7 @@ end = struct let acc = ref [] in lines_l_ l (fun s i len -> acc := (s, i, len) :: !acc); Text { l = List.rev !acc; style; link_with_uri = None } - | B.Frame t -> Frame (of_box ~ansi t) + | B.Frame { sub = t; stretch } -> Frame { sub = of_box ~ansi t; stretch } | 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) @@ -530,7 +536,8 @@ end = struct let loop = B.link ~uri in (match B.view inner with | B.Empty -> Empty - | B.Frame t -> Frame (of_box ~ansi (loop t)) + | B.Frame { sub = t; stretch } -> + Frame { stretch; sub = of_box ~ansi (loop t) } | B.Pad (dim, t) -> Pad (dim, of_box ~ansi (loop t)) | B.Align { h; v; inner } -> Align { h; v; inner = of_box ~ansi (loop inner) } @@ -588,7 +595,7 @@ end = struct done; conn_map.m <- create_or_update ?ct ~left:true (Pos.move_x pos n) conn_map.m - (* render given box on the output, starting with upper left corner + (** render given box on the output, starting with upper left corner at the given position. [expected_size] is the size of the available surrounding space. [offset] is the offset of the box w.r.t the surrounding box *) @@ -614,8 +621,23 @@ end = struct Output.put_sub_string out (Pos.move_y pos line_idx) s s_i len) l; conn_m.m - | Frame b' -> - let { x; y } = size b' in + | Frame { sub = b'; stretch } -> + let p' = size b' in + + (* do we expand? *) + let { x; y }, expected_size' = + match expected_size with + | Some exp_p when stretch -> + (* remove space for bars, but otherwise expand to [exp_p] *) + let exp_p' = Pos.move exp_p (-2) (-2) in + let p' = Pos.max p' exp_p' in + p', Some exp_p' + | Some _exp_p -> + (* ignore surrounding size (#45) *) + p', Some p' + | None -> p', None + in + conn_m.m <- create_or_update ~right:true ~bottom:true pos conn_m.m; conn_m.m <- create_or_update ~left:true ~top:true @@ -633,12 +655,7 @@ end = struct write_hline_ conn_m (Pos.move pos 1 (y + 1)) x; write_vline_ conn_m (Pos.move_y pos 1) y; write_vline_ conn_m (Pos.move pos (x + 1) 1) y; - let expected_size = - match expected_size with - | Some p -> Some (Pos.move p (-2) (-2)) (* remove space for bars *) - | None -> None - in - render_rec ~ansi ?expected_size b' (Pos.move pos 1 1) + render_rec ~ansi ?expected_size:expected_size' b' (Pos.move pos 1 1) | Pad (dim, b') -> let expected_size = match expected_size with diff --git a/test/dune b/test/dune index a1736e7..0f86c79 100644 --- a/test/dune +++ b/test/dune @@ -45,3 +45,9 @@ (mode promote) (action (copy %{deps} %{targets}))) + +(test + (name reg_45) + (modules reg_45) + (package printbox-text) + (libraries printbox printbox-text)) diff --git a/test/reg_45.expected b/test/reg_45.expected new file mode 100644 index 0000000..5560d5f --- /dev/null +++ b/test/reg_45.expected @@ -0,0 +1,36 @@ +┌─────────┐ +│123456789│ +├─────────┤ +│┌─┐ │ +││.│ │ +│├─┤ │ +││.│ │ +│└─┘ │ +└─────────┘ +┌─────────┐ +│123456789│ +├─────────┤ +│┌────┐ │ +││....│ │ +│├────┤ │ +││. │ │ +│└────┘ │ +└─────────┘ +┌─────────┐ +│123456789│ +├─────────┤ +│┌───────┐│ +││ .││ +│├───────┤│ +││. ││ +│└───────┘│ +└─────────┘ +┌─────────┐ +│123456789│ +├─────────┤ +│┌───────┐│ +││ ....││ +│├───────┤│ +││. ││ +│└───────┘│ +└─────────┘ diff --git a/test/reg_45.ml b/test/reg_45.ml new file mode 100644 index 0000000..185b4da --- /dev/null +++ b/test/reg_45.ml @@ -0,0 +1,47 @@ +let () = + PrintBox.( + PrintBox_text.output stdout + @@ frame + (vlist + [ + text "123456789"; + frame (vlist [ text "." |> align ~h:`Right ~v:`Top; text "." ]); + ])); + print_endline "" + +let () = + PrintBox.( + PrintBox_text.output stdout + @@ frame + (vlist + [ + text "123456789"; + frame (vlist [ text "...." |> align ~h:`Right ~v:`Top; text "." ]); + ])); + print_endline "" + +(* now with stretch *) + +let () = + PrintBox.( + PrintBox_text.output stdout + @@ frame + (vlist + [ + text "123456789"; + frame ~stretch:true + (vlist [ text "." |> align ~h:`Right ~v:`Top; text "." ]); + ])); + print_endline "" + +let () = + PrintBox.( + PrintBox_text.output stdout + @@ frame + (vlist + [ + text "123456789"; + frame ~stretch:true + (vlist [ text "...." |> align ~h:`Right ~v:`Top; text "." ]); + ])); + print_endline ""