Commit 9199fd2e authored by mattiasdrp's avatar mattiasdrp
Browse files

Final refactoring of text styling

Text styling contains the functions that allow to prettify a formatter and add
semantic tags marking or printing to a formatter

Each semantic tag handler module should implement its own marker that will then
be used by Terminal_styling from a list of options that need to be applied
parent 07a76456
......@@ -128,7 +128,7 @@ let update_terminal_width () =
with
| _ -> ()
let ansi_terminal () =
let ansi_terminal l =
if
!color
&&
......@@ -137,10 +137,10 @@ let ansi_terminal () =
| (exception Not_found) ->
false
| _ -> true
then Ansi_terminal.marker
else TextStyling.Empty
then `ANSI :: l
else l
let prettify () = !prettify
let prettify l = if !prettify then `UTF8 :: l else []
let setup_term_watcher () =
if Sys.os_type <> "Unix" && Sys.os_type <> "Cygwin" then ()
......@@ -259,14 +259,12 @@ let toploop () =
let main () =
parse_argv ();
let marker = ansi_terminal () in
let assoc =
[
(* Euclidian Products *)
("->", Pretty_utf8.create 0x2192 (* → *));
("Empty", Pretty_utf8.create 0x01D7D8 (* 𝟘 *));
("Any", Pretty_utf8.create 0x01D7D9 (* 𝟙 *));
("\\\\", Pretty_utf8.create 0x00005C (* \ *));
("&", Pretty_utf8.create 0x0022C2 (* ⋂ *));
("|", Pretty_utf8.create 0x0022C3 (* ⋃ *));
(* Type Variables *)
......@@ -285,10 +283,9 @@ let main () =
]
in
List.iter (fun (s, sym) -> Pretty_utf8.register_utf8_binding s sym) assoc;
TextStyling.add_stag_handlers marker ~prettify:(prettify ())
Format.std_formatter;
TextStyling.add_stag_handlers marker ~prettify:(prettify ())
Format.err_formatter;
let stylings = [] |> ansi_terminal |> prettify in
Terminal_styling.set_formatter stylings Format.std_formatter;
Terminal_styling.set_formatter stylings Format.err_formatter;
at_exit (fun () -> Stats.dump Format.std_formatter);
Cduce_loc.set_viewport (Html.create false);
let m = mode () in
......
......@@ -19,7 +19,6 @@ let () =
("->", Pretty_utf8.create 0x2192 (* → *));
("Empty", Pretty_utf8.create 0x01D7D8 (* 𝟘 *));
("Any", Pretty_utf8.create 0x01D7D9 (* 𝟙 *));
("\\\\", Pretty_utf8.create 0x00005C (* \ *));
("&", Pretty_utf8.create 0x0022C2 (* ⋂ *));
("|", Pretty_utf8.create 0x0022C3 (* ⋃ *));
(* Type Variables *)
......@@ -38,10 +37,8 @@ let () =
]
in
List.iter (fun (s, sym) -> Pretty_utf8.register_utf8_binding s sym) assoc;
TextStyling.add_stag_handlers TextStyling.Empty ~prettify:true
Format.str_formatter;
TextStyling.add_stag_handlers TextStyling.Empty ~prettify:true
Format.err_formatter
Terminal_styling.set_formatter [ `UTF8 ] Format.str_formatter;
Terminal_styling.set_formatter [ `UTF8 ] Format.err_formatter
let test s =
let t1 = parse_type s in
......
......@@ -30,10 +30,9 @@ let pp_ansi_value ppf s =
let enclosing = { enc_open = "\x1B["; enc_close = "m" }
let marker =
TextStyling.Mark
{
open_enclosing = enclosing;
close_enclosing = enclosing;
pp_stag = pp_ansi_value;
pp_sep = (fun ppf () -> Format.fprintf ppf ";");
}
{
open_enclosing = enclosing;
close_enclosing = enclosing;
pp_stag = pp_ansi_value;
pp_sep = (fun ppf () -> Format.fprintf ppf ";");
}
......@@ -5,7 +5,7 @@
- [Format.fprintf ppf "@{<semantic_tag1; semantic_tag2>...@}" ...]
*)
val marker : TextStyling.stag_marker
val marker : TextStyling.marker
(** [marker] will allow {!TextStyling.add_stag_handlers} to add ansi markings to a formatter.
The current handled tags are the following:
......
......@@ -126,6 +126,7 @@ let empty_string_of_styles ?(close = false) stag =
let prettify_formatter formatter =
let open Format in
pp_set_mark_tags formatter true;
let old_of = pp_get_formatter_out_functions formatter () in
let out_string string pos nb_chars =
let new_string, new_nb_chars =
......@@ -134,6 +135,13 @@ let prettify_formatter formatter =
in
old_of.out_string new_string pos new_nb_chars
in
let old_fs = Format.pp_get_formatter_stag_functions formatter () in
pp_set_formatter_stag_functions formatter
{
old_fs with
mark_open_stag = empty_string_of_styles;
mark_close_stag = empty_string_of_styles ~close:true;
};
pp_set_formatter_out_functions formatter { old_of with out_string }
type enclosing = {
......@@ -149,61 +157,40 @@ type marker = {
}
type stag_marker =
| Empty
| Mark of marker
| Print of marker
| Mark
| Print
let add_stag_handlers marker ~prettify formatter =
if prettify then prettify_formatter formatter;
let add_stag_handlers m_type marker formatter =
let open Format in
(* Handle stags as marks (0 length) or prints (normal length) *)
(match marker with
| Empty -> if prettify then pp_set_mark_tags formatter true
| Mark _ -> pp_set_mark_tags formatter true
| Print _ -> pp_set_print_tags formatter true);
(match m_type with
| Mark -> pp_set_mark_tags formatter true
| Print -> pp_set_print_tags formatter true);
let old_fs = pp_get_formatter_stag_functions formatter () in
let handlers =
match marker with
| Mark marker
| Print marker ->
let open_stag =
let close = false in
Styling.(
create_mark ~close
(pp_styles ~close ~enc_open:marker.open_enclosing.enc_open
~pp_stag:marker.pp_stag
~enc_close:marker.open_enclosing.enc_close
~pp_sep:marker.pp_sep))
in
let close_stag =
let close = true in
Styling.(
create_mark ~close
(pp_styles ~close ~enc_open:marker.close_enclosing.enc_open
~pp_stag:marker.pp_stag
~enc_close:marker.close_enclosing.enc_close
~pp_sep:marker.pp_sep))
in
Some (open_stag, close_stag)
| _ -> None
let open_stag =
let close = false in
Styling.(
create_mark ~close
(pp_styles ~close ~enc_open:marker.open_enclosing.enc_open
~pp_stag:marker.pp_stag ~enc_close:marker.open_enclosing.enc_close
~pp_sep:marker.pp_sep))
in
match (marker, handlers) with
| Mark _, Some (open_stag, close_stag) ->
let close_stag =
let close = true in
Styling.(
create_mark ~close
(pp_styles ~close ~enc_open:marker.close_enclosing.enc_open
~pp_stag:marker.pp_stag ~enc_close:marker.close_enclosing.enc_close
~pp_sep:marker.pp_sep))
in
match m_type with
| Mark ->
let mark_open_stag = Format.asprintf "%a" open_stag in
let mark_close_stag = Format.asprintf "%a" close_stag in
pp_set_formatter_stag_functions formatter
{ old_fs with mark_open_stag; mark_close_stag }
| Print _, Some (open_stag, close_stag) ->
| Print ->
let print_open_stag = Format.fprintf formatter "%a" open_stag in
let print_close_stag = Format.fprintf formatter "%a" close_stag in
pp_set_formatter_stag_functions formatter
{ old_fs with print_open_stag; print_close_stag }
| Empty, None when prettify ->
pp_set_formatter_stag_functions formatter
{
old_fs with
mark_open_stag = empty_string_of_styles;
mark_close_stag = empty_string_of_styles ~close:true;
}
| Empty, None -> ()
| _ -> assert false
......@@ -51,11 +51,13 @@ type marker = {
}
type stag_marker =
| Empty
| Mark of marker
| Print of marker
| Mark
| Print
val add_stag_handlers : stag_marker -> prettify:bool -> Format.formatter -> unit
val prettify_formatter : Format.formatter -> unit
(** [prettify_formatter formatter] adds UTF8 prettifying to [formatter] *)
val add_stag_handlers : stag_marker -> marker -> Format.formatter -> unit
(** [add_marking ppf ~mark_open ~pp_stag ~mark_close ~pp_sep] will redefine semantic tag operations for mark opening and closing (print opening and closing are left untouched).
@param ppf the formatter that will handle semantic tags
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment