simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 11:15:31 -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

105
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,76 +404,60 @@ 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 | `Green -> 2
| `Green -> 2 | `Yellow -> 3
| `Yellow -> 3 | `Blue -> 4
| `Blue -> 4 | `Magenta -> 5
| `Magenta -> 5 | `Cyan -> 6
| `Cyan -> 6 | `White -> 7
| `White -> 7
let code_of_style : style -> int = function let code_of_style : style -> int = function
| `FG c -> 30 + int_of_color_ c | `FG c -> 30 + int_of_color_ c
| `BG c -> 40 + int_of_color_ c | `BG c -> 40 + int_of_color_ c
| `Bold -> 1 | `Bold -> 1
| `Reset -> 0 | `Reset -> 0
| `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 reset = string_of_style `Reset
let string_of_style a = spf "\x1b[%dm" (code_of_style a) let string_of_style_list = function
| [] -> reset
| [ a ] -> string_of_style a
| [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b)
| [ a; b; c ] ->
spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b) (code_of_style c)
| l ->
let buf = Buffer.create 32 in
let pp_num c = Buffer.add_string buf (string_of_int (code_of_style c)) in
Buffer.add_string buf "\x1b[";
List.iteri
(fun i c ->
if i > 0 then Buffer.add_char buf ';';
pp_num c)
l;
Buffer.add_string buf "m";
Buffer.contents buf
let reset = string_of_style `Reset (* TODO: handle nested styles *)
let ext_style_ : style list Ext.t =
let string_of_style_list = function {
| [] -> reset pre = (fun out l -> Out.string out (string_of_style_list l));
| [ a ] -> string_of_style a post = (fun out _l -> Out.string out reset);
| [ a; b ] -> spf "\x1b[%d;%dm" (code_of_style a) (code_of_style b) }
| [ a; b; c ] ->
spf "\x1b[%d;%d;%dm" (code_of_style a) (code_of_style b)
(code_of_style c)
| l ->
let buf = Buffer.create 32 in
let pp_num c =
Buffer.add_string buf (string_of_int (code_of_style c))
in
Buffer.add_string buf "\x1b[";
List.iteri
(fun i c ->
if i > 0 then Buffer.add_char buf ';';
pp_num c)
l;
Buffer.add_string buf "m";
Buffer.contents buf
(* TODO: handle nested styles *)
let ext_style_ : style list Ext.t =
{
pre = (fun out l -> Out.string out (string_of_style_list l));
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