simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

compat, reformat

Browse source
This commit is contained in:
Simon Cruanes 2023-04-07 11:05:52 -04:00
parent c2952e0ce6
commit 74e3a9e875
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 45 additions and 79 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/pp/containers_pp.ml
View file

@ -343,7 +343,6 @@ let int x : t = text (string_of_int x)
let float x : t = text (string_of_float x) let float x : t = text (string_of_float x)
let float_hex x : t = textpf "%h" x let float_hex x : t = textpf "%h" x
let text_quoted s : t = text (Printf.sprintf "%S" s) let text_quoted s : t = text (Printf.sprintf "%S" s)
let text_zero_width s : t = { view = Text_zero_width s; wfl = 0 } let text_zero_width s : t = { view = Text_zero_width s; wfl = 0 }
let append_l ?(sep = nil) l = let append_l ?(sep = nil) l =
@ -393,9 +392,7 @@ let of_seq ?(sep = nil) f seq : t =
loop true seq loop true seq
let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r) let bracket l d r : t = group (text l ^ nest (String.length l) d ^ text r)
let bracket2 l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r) let bracket2 l d r : t = group (text l ^ nest 2 (nl ^ d) ^ nl ^ text r)
let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')')) let sexp_l l : t = char '(' ^ nest 1 (group (append_nl l ^ char ')'))
let sexp_apply a l : t = sexp_l (text a :: l) let sexp_apply a l : t = sexp_l (text a :: l)
@ -407,25 +404,15 @@ end
module Term_color = struct module Term_color = struct
type color = type color =
[ `Black [ `Black | `Red | `Yellow | `Green | `Blue | `Magenta | `Cyan | `White ]
| `Red
| `Yellow
| `Green
| `Blue
| `Magenta
| `Cyan
| `White
]
type style = type style =
[ `FG of color (* foreground *) [ `FG of color (* foreground *)
| `BG of color (* background *) | `BG of color (* background *)
| `Bold | `Bold
| `Reset | `Reset
| `Underline | `Underline ]
]
open struct
let int_of_color_ = function let int_of_color_ = function
| `Black -> 0 | `Black -> 0
| `Red -> 1 | `Red -> 1
@ -444,9 +431,7 @@ module Term_color = struct
| `Underline -> 4 | `Underline -> 4
let spf = Printf.sprintf let spf = Printf.sprintf
let string_of_style a = spf "\x1b[%dm" (code_of_style a) let string_of_style a = spf "\x1b[%dm" (code_of_style a)
let reset = string_of_style `Reset let reset = string_of_style `Reset
let string_of_style_list = function let string_of_style_list = function
@ -454,13 +439,10 @@ module Term_color = struct
| [ a ] -> string_of_style a | [ a ] -> string_of_style a
| [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b) | [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
| [ a; b; c ] -> | [ a; b; c ] ->
spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b) spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b) (code_of_style c)
(code_of_style c)
| l -> | l ->
let buf = Buffer.create 32 in let buf = Buffer.create 32 in
let pp_num c = let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in
Buffer.add_string buf (string_of_int (code_of_style c))
in
Buffer.add_string buf "\x1b["; Buffer.add_string buf "\x1b[";
List.iteri List.iteri
(fun i c -> (fun i c ->
@ -476,7 +458,6 @@ module Term_color = struct
pre = (fun out l -> Out.string out (string_of_style_list l)); pre = (fun out l -> Out.string out (string_of_style_list l));
post = (fun out _l -> Out.string out reset); post = (fun out _l -> Out.string out reset);
} }
end
(** Set the foreground color. *) (** Set the foreground color. *)
let color (c : color) (d : t) : t = ext ext_style_ [ `FG c ] d let color (c : color) (d : t) : t = ext ext_style_ [ `FG c ] d

19
src/pp/containers_pp.mli
View file

@ -244,25 +244,10 @@ end
(** Simple colors in terminals *) (** Simple colors in terminals *)
module Term_color : sig module Term_color : sig
type color = type color =
[ `Black [ `Black | `Blue | `Cyan | `Green | `Magenta | `Red | `White | `Yellow ]
| `Blue
| `Cyan
| `Green
| `Magenta
| `Red
| `White
| `Yellow
]
type style = type style = [ `BG of color | `Bold | `FG of color | `Reset | `Underline ]
[ `BG of color
| `Bold
| `FG of color
| `Reset
| `Underline
]
val color : color -> t -> t val color : color -> t -> t
val style_l : style list -> t -> t val style_l : style list -> t -> t
end end