mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-20 00:41:05 +03:00
Fix adjustment of format width to terminal
This commit is contained in:
parent
0ee512b832
commit
3d1e9a56bf
@ -114,7 +114,7 @@ let with_in_channel filename f =
|
|||||||
finally (fun () -> close_in oc) (fun () -> f oc)
|
finally (fun () -> close_in oc) (fun () -> f oc)
|
||||||
|
|
||||||
let with_formatter_of_out_channel oc f =
|
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
|
finally (fun () -> Format.pp_print_flush fmt ()) @@ fun () -> f fmt
|
||||||
|
|
||||||
let with_formatter_of_file filename f =
|
let with_formatter_of_file filename f =
|
||||||
@ -186,15 +186,17 @@ let () =
|
|||||||
let default = 80 in
|
let default = 80 in
|
||||||
let get_terminal_cols () =
|
let get_terminal_cols () =
|
||||||
let count =
|
let count =
|
||||||
try (* terminfo *)
|
try
|
||||||
process_out "tput" ["cols"] |> int_of_string
|
(* terminfo *)
|
||||||
|
process_out "tput" ["cols"] |> String.trim |> int_of_string
|
||||||
with Failure _ -> (
|
with Failure _ -> (
|
||||||
try
|
try
|
||||||
(* stty *)
|
(* stty *)
|
||||||
process_out "stty" ["size"]
|
process_out "stty" ["size"]
|
||||||
|
|> String.trim
|
||||||
|> fun s ->
|
|> fun s ->
|
||||||
let i = String.rindex s ' ' + 1 in
|
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 _ -> (
|
with Failure _ | Not_found | Invalid_argument _ -> (
|
||||||
try int_of_string (Sys.getenv "COLUMNS")
|
try int_of_string (Sys.getenv "COLUMNS")
|
||||||
with Not_found | Failure _ -> 0))
|
with Not_found | Failure _ -> 0))
|
||||||
|
@ -56,21 +56,22 @@ let has_color oc =
|
|||||||
|
|
||||||
let formatter_of_out_channel oc =
|
let formatter_of_out_channel oc =
|
||||||
let tty = lazy Unix.(isatty (descr_of_out_channel oc)) in
|
let tty = lazy Unix.(isatty (descr_of_out_channel oc)) in
|
||||||
let ppf = Format.formatter_of_out_channel oc in
|
|
||||||
let ppf =
|
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
|
in
|
||||||
let out, flush = Format.pp_get_formatter_output_functions ppf () in
|
fun () ->
|
||||||
let flush () =
|
let ppf = Lazy.force ppf in
|
||||||
if Lazy.force tty then Format.pp_set_margin ppf (terminal_columns ());
|
if Lazy.force tty then Format.pp_set_margin ppf (terminal_columns ());
|
||||||
flush ()
|
ppf
|
||||||
in
|
|
||||||
Format.pp_set_formatter_output_functions ppf out flush;
|
|
||||||
ppf
|
|
||||||
|
|
||||||
let std_ppf = lazy (formatter_of_out_channel stdout)
|
let std_ppf = formatter_of_out_channel stdout
|
||||||
let err_ppf = lazy (formatter_of_out_channel stderr)
|
let err_ppf = formatter_of_out_channel stderr
|
||||||
let ignore_ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()))
|
|
||||||
|
let ignore_ppf =
|
||||||
|
let ppf = lazy (Format.make_formatter (fun _ _ _ -> ()) (fun () -> ())) in
|
||||||
|
fun () -> Lazy.force ppf
|
||||||
|
|
||||||
let unformat (f : Format.formatter -> unit) : string =
|
let unformat (f : Format.formatter -> unit) : string =
|
||||||
let buf = Buffer.create 1024 in
|
let buf = Buffer.create 1024 in
|
||||||
@ -94,10 +95,10 @@ let unformat (f : Format.formatter -> unit) : string =
|
|||||||
type level = Error | Warning | Debug | Log | Result
|
type level = Error | Warning | Debug | Log | Result
|
||||||
|
|
||||||
let get_ppf = function
|
let get_ppf = function
|
||||||
| Result -> Lazy.force std_ppf
|
| Result -> std_ppf ()
|
||||||
| Debug when not Global.options.debug -> Lazy.force ignore_ppf
|
| Debug when not Global.options.debug -> ignore_ppf ()
|
||||||
| Warning when Global.options.disable_warnings -> Lazy.force ignore_ppf
|
| Warning when Global.options.disable_warnings -> ignore_ppf ()
|
||||||
| Error | Log | Debug | Warning -> Lazy.force err_ppf
|
| Error | Log | Debug | Warning -> err_ppf ()
|
||||||
|
|
||||||
(**{3 Markers}*)
|
(**{3 Markers}*)
|
||||||
|
|
||||||
@ -354,9 +355,9 @@ let make
|
|||||||
~level =
|
~level =
|
||||||
match level with
|
match level with
|
||||||
| Debug when not Global.options.debug ->
|
| 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 ->
|
| Warning when Global.options.disable_warnings ->
|
||||||
Format.ikfprintf (fun _ -> cont [] level) (Lazy.force ignore_ppf)
|
Format.ikfprintf (fun _ -> cont [] level) (ignore_ppf ())
|
||||||
| _ ->
|
| _ ->
|
||||||
Format.kdprintf
|
Format.kdprintf
|
||||||
@@ fun message ->
|
@@ fun message ->
|
||||||
|
@ -75,7 +75,7 @@ val set_terminal_width_function : (unit -> int) -> unit
|
|||||||
|
|
||||||
(* {1 More general color-enabled formatting helpers}*)
|
(* {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
|
(** 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
|
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. *)
|
[Cli.style_flag] -- and wether the channel is a tty if that is set to auto. *)
|
||||||
|
Loading…
Reference in New Issue
Block a user