Fix adjustment of format width to terminal

This commit is contained in:
Louis Gesbert 2024-05-04 17:45:22 +02:00
parent 0ee512b832
commit 3d1e9a56bf
3 changed files with 25 additions and 22 deletions

View File

@ -114,7 +114,7 @@ let with_in_channel filename f =
finally (fun () -> close_in oc) (fun () -> f oc)
let with_formatter_of_out_channel oc f =
let fmt = Message.formatter_of_out_channel oc in
let fmt = Message.formatter_of_out_channel oc () in
finally (fun () -> Format.pp_print_flush fmt ()) @@ fun () -> f fmt
let with_formatter_of_file filename f =
@ -186,15 +186,17 @@ let () =
let default = 80 in
let get_terminal_cols () =
let count =
try (* terminfo *)
process_out "tput" ["cols"] |> int_of_string
try
(* terminfo *)
process_out "tput" ["cols"] |> String.trim |> int_of_string
with Failure _ -> (
try
(* stty *)
process_out "stty" ["size"]
|> String.trim
|> fun s ->
let i = String.rindex s ' ' + 1 in
String.sub s (i + 1) (String.length s - i) |> int_of_string
String.sub s i (String.length s - i) |> int_of_string
with Failure _ | Not_found | Invalid_argument _ -> (
try int_of_string (Sys.getenv "COLUMNS")
with Not_found | Failure _ -> 0))

View File

@ -56,21 +56,22 @@ let has_color oc =
let formatter_of_out_channel oc =
let tty = lazy Unix.(isatty (descr_of_out_channel oc)) in
let ppf = Format.formatter_of_out_channel oc in
let ppf =
if has_color_raw ~tty then color_formatter ppf else unstyle_formatter ppf
lazy
(let ppf = Format.formatter_of_out_channel oc in
if has_color_raw ~tty then color_formatter ppf else unstyle_formatter ppf)
in
let out, flush = Format.pp_get_formatter_output_functions ppf () in
let flush () =
fun () ->
let ppf = Lazy.force ppf in
if Lazy.force tty then Format.pp_set_margin ppf (terminal_columns ());
flush ()
in
Format.pp_set_formatter_output_functions ppf out flush;
ppf
ppf
let std_ppf = lazy (formatter_of_out_channel stdout)
let err_ppf = lazy (formatter_of_out_channel stderr)
let ignore_ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()))
let std_ppf = formatter_of_out_channel stdout
let err_ppf = formatter_of_out_channel stderr
let ignore_ppf =
let ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ())) in
fun () -> Lazy.force ppf
let unformat (f : Format.formatter -> unit) : string =
let buf = Buffer.create 1024 in
@ -94,10 +95,10 @@ let unformat (f : Format.formatter -> unit) : string =
type level = Error | Warning | Debug | Log | Result
let get_ppf = function
| Result -> Lazy.force std_ppf
| Debug when not Global.options.debug -> Lazy.force ignore_ppf
| Warning when Global.options.disable_warnings -> Lazy.force ignore_ppf
| Error | Log | Debug | Warning -> Lazy.force err_ppf
| Result -> std_ppf ()
| Debug when not Global.options.debug -> ignore_ppf ()
| Warning when Global.options.disable_warnings -> ignore_ppf ()
| Error | Log | Debug | Warning -> err_ppf ()
(**{3 Markers}*)
@ -354,9 +355,9 @@ let make
~level =
match level with
| Debug when not Global.options.debug ->
Format.ikfprintf (fun _ -> cont [] level) (Lazy.force ignore_ppf)
Format.ikfprintf (fun _ -> cont [] level) (ignore_ppf ())
| Warning when Global.options.disable_warnings ->
Format.ikfprintf (fun _ -> cont [] level) (Lazy.force ignore_ppf)
Format.ikfprintf (fun _ -> cont [] level) (ignore_ppf ())
| _ ->
Format.kdprintf
@@ fun message ->

View File

@ -75,7 +75,7 @@ val set_terminal_width_function : (unit -> int) -> unit
(* {1 More general color-enabled formatting helpers}*)
val formatter_of_out_channel : out_channel -> Format.formatter
val formatter_of_out_channel : out_channel -> unit -> Format.formatter
(** Creates a new formatter from the given out channel, with correct handling of
the ocolor tags. Actual use of escape codes in the output depends on
[Cli.style_flag] -- and wether the channel is a tty if that is set to auto. *)