colorize output filenames

This commit is contained in:
Jeremie Dimino 2017-02-24 12:02:57 +00:00
parent b3cf69c3d8
commit 4f161894ff
3 changed files with 58 additions and 16 deletions

View File

@ -3,17 +3,44 @@ open Import
include struct
[@@@warning "-37"]
type color =
| Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Default
| Bright_black | Bright_red | Bright_green | Bright_yellow | Bright_blue
| Bright_magenta | Bright_cyan | Bright_white
| Black
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| White
| Default
| Bright_black
| Bright_red
| Bright_green
| Bright_yellow
| Bright_blue
| Bright_magenta
| Bright_cyan
| Bright_white
type style =
| Reset | Bold | Underlined | Dim | Blink | Inverse | Hidden
| Bold_off | Underlined_off | Dim_off | Blink_off | Inverse_off | Hidden_off
| Reset
| Bold
| Underlined
| Dim
| Blink
| Inverse
| Hidden
| Bold_off
| Underlined_off
| Dim_off
| Blink_off
| Inverse_off
| Hidden_off
| Foreground of color
| Background of color
end
type styles = style list
let ansi_code_of_style = function
| Reset -> "0"
| Bold -> "1"
@ -137,6 +164,15 @@ let setup_env_for_ocaml_colors = lazy(
end
)
let styles_of_tag = function
| "loc" -> [Bold]
| "error" -> [Bold; Foreground Red]
| "warning" -> [Bold; Foreground Magenta]
| "kwd" -> [Bold; Foreground Blue]
| "id" -> [Bold; Foreground Yellow]
| "prompt" -> [Bold; Foreground Green]
| _ -> []
let setup_err_formatter_colors () =
let open Format in
if Lazy.force stderr_supports_colors then begin
@ -146,15 +182,8 @@ let setup_err_formatter_colors () =
pp_set_formatter_tag_functions ppf
{ funcs with
mark_close_tag = (fun _ -> ansi_escape_of_styles [Reset])
; mark_open_tag = (fun tag ->
ansi_escape_of_styles
(match tag with
| "loc" -> [Bold]
| "error" -> [Bold; Foreground Red]
| "warning" -> [Bold; Foreground Magenta]
| "kwd" -> [Bold; Foreground Blue]
| "id" -> [Bold; Foreground Yellow]
| "prompt" -> [Bold; Foreground Green]
| _ -> []))
; mark_open_tag = (fun tag -> ansi_escape_of_styles (styles_of_tag tag))
}
end
let output_filename = [Bold; Foreground Green]

View File

@ -1,4 +1,5 @@
val colorize : key:string -> string -> string
val strip : string -> string
val stderr_supports_colors : bool Lazy.t
val setup_env_for_ocaml_colors : unit Lazy.t
@ -8,3 +9,9 @@ val strip_colors_for_stderr : string -> string
(** Enable the interpretation of color tags for [Format.err_formatter] *)
val setup_err_formatter_colors : unit -> unit
type styles
val output_filename : styles
val apply_string : styles -> string -> string

View File

@ -228,10 +228,16 @@ module Scheduler = struct
before ^ Ansi_color.colorize ~key key ^ after
end
let rec colorize_args = function
| [] -> []
| "-o" :: fn :: rest ->
"-o" :: Ansi_color.(apply_string output_filename) fn :: colorize_args rest
| x :: rest -> x :: colorize_args rest
let command_line { prog; args; dir; stdout_to; _ } =
let quote = quote_for_shell in
let prog = colorize_prog (quote prog) in
let s = String.concat (prog :: List.map args ~f:quote) ~sep:" " in
let s = String.concat (prog :: colorize_args (List.map args ~f:quote)) ~sep:" " in
let s =
match stdout_to with
| None -> s