1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
let pp_list ?(sep = format_of_string ",@ ") ?(terminal = format_of_string "") ppf fmt l =
let rec list_ppf_aux ppf fmt l =
match l with
| [] -> ()
| [ a ] -> Format.fprintf fmt ("%a" ^^ terminal) ppf a
| a :: tl ->
let () = Format.fprintf fmt ("%a" ^^ sep) ppf a in
list_ppf_aux ppf fmt tl
in
Format.fprintf fmt "%a" (list_ppf_aux ppf) l
let pp_list_i ?(sep = format_of_string ",@ ") ?(terminal = format_of_string "") ppf fmt l =
let rec list_ppf_aux i ppf fmt l =
match l with
| [] -> ()
| [ a ] -> Format.fprintf fmt ("%a" ^^ terminal) ppf (i, a)
| a :: tl ->
let () = Format.fprintf fmt ("%a" ^^ sep) ppf (i, a) in
list_ppf_aux (i+1) ppf fmt tl
in
Format.fprintf fmt "%a" (list_ppf_aux 1 ppf) l
let pp_text fmt text =
let words = String.split_on_char ' ' text in
pp_list ~sep:"@ " Format.pp_print_string fmt words
let resize_formatter ?width ?(formatter=Format.std_formatter) () =
let terminal_width =
match width with
| Some w -> w
| None ->
begin
match ANSITerminal.size () with
| w, _h when Out_channel.isatty stdout -> w
| exception (Failure f)
when (Str.(string_match (regexp "ANSITerminal.size") f 0)) -> Format.pp_infinity - 1
| _ -> Format.pp_infinity -1
end in
Format.pp_set_margin formatter terminal_width
let no_pp ?(formatter=Format.std_formatter) () =
Format.(pp_set_margin formatter (pp_infinity - 1))
let fformat formatter format = Format.fprintf formatter format
let format format = fformat Format.std_formatter format [@@warning "-unused-value-declaration"]
let format_of_list fmter sep to_string = function
| [] -> ()
| [ a ] -> fformat fmter "@[%s@]" (to_string a)
| a :: tl ->
let () = fformat fmter "@[%s@]" (to_string a) in
List.iter (fun s -> fformat fmter "%s@,@[%s@]" sep (to_string s)) tl
let app_pp = Tags.app_pp
let err_pp = Tags.err_pp
let warn_pp = Tags.warn_pp
let info_pp = Tags.info_pp
let debug_pp = Tags.debug_pp
let fun_pp = Tags.fun_pp
let sig_pp = Tags.sig_pp
let lex_pp = Tags.lex_pp
let term_pp = Tags.term_pp
let arg_pp = Tags.arg_pp
let binary_pp = Tags.binary_pp