From 3955b6a61d9883b7f1852741c0f82d74b54566da Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Wed, 17 Jan 2018 20:17:28 +0100 Subject: [PATCH] Client: add colors to client help screens --- src/lib_stdlib_lwt/cli_entries.ml | 147 +++++++++++++++++++++++------- 1 file changed, 112 insertions(+), 35 deletions(-) diff --git a/src/lib_stdlib_lwt/cli_entries.ml b/src/lib_stdlib_lwt/cli_entries.ml index b48fb602d..ba4188890 100644 --- a/src/lib_stdlib_lwt/cli_entries.ml +++ b/src/lib_stdlib_lwt/cli_entries.ml @@ -250,11 +250,13 @@ type ('arg, 'ret) command = group : group option } -> ('arg, 'ret) command +type format = [ `Plain | `Ansi ] + type error += Extra_arguments : string list * (_, _) command -> error type error += Not_enough_args : string list * ('a, 'b) command list -> error type error += Command_not_found : string list * ('a, 'b) command list -> error type error += Help_flag : ('a, 'b) command list -> error (* when -help appears in input *) -type error += Help_cmd : string list * ('a, 'b) command list * bool * bool -> error (* ./tezos-client help *) +type error += Help_cmd : string list * ('a, 'b) command list * format * bool * bool -> error (* ./tezos-client help *) type error += Bare_help : error (* ./tezos-client or ./tezos-client -help *) type error += Autocomplete_command : string list -> error @@ -320,15 +322,25 @@ let rec help_commands commands = Will display only the commands by default, \ unless [-verbose] is passed or the list \ of matching commands if less than 3." - (args2 + (args3 (switch ~doc:"Print terse output, regardless of number of commands returned" ~parameter:"-terse") (switch ~doc:"Print detailed output, regardless of number of commands returned" - ~parameter:"-verbose")) + ~parameter:"-verbose") + (default_arg + ~doc:"Select the manual's output format" + ~parameter: "-format" + ~default: (if Unix.isatty Unix.stdout then "colors" else "plain") + (parameter + ~autocomplete: (fun _ -> return [ "colors" ; "plain" ]) + (fun _ arg -> match arg with + | "colors" -> return `Ansi + | "plain" -> return `Plain + | _ -> failwith "Unknown manual format")))) (prefix "man" @@ seq_of_param (string ~name:"keyword" ~desc:"Keyword to search for")) - (fun (terse, details) keywords _ -> + (fun (terse, details, format) keywords _ -> if terse && details then fail (Invalid_options_combination "Cannot specify both -verbose and -terse.") else @@ -337,6 +349,7 @@ let rec help_commands commands = (fun commands keyword -> List.filter (search_command keyword) commands) (help_commands [] @ commands) keywords, + format, terse, details))) ] @@ -513,13 +526,13 @@ let print_options_detailed (type ctx) = let help_option : type a.Format.formatter -> (a, ctx) arg -> unit = fun ppf -> function | Arg { parameter ; doc } -> - Format.fprintf ppf "@[%s _@,@[%a@]@]" + Format.fprintf ppf "@[@{%s _@}:@,@[%a@]@]" parameter Format.pp_print_text doc | DefArg { parameter ; doc ; default } -> - Format.fprintf ppf "@[%s _ (default: %s)@,@[%a@]@]" + Format.fprintf ppf "@[@{%s _@} (default %s):@,@[%a@]@]" parameter default Format.pp_print_text doc | Switch { parameter ; doc } -> - Format.fprintf ppf "@[%s@,@[%a@]@]" + Format.fprintf ppf "@[@{%s@}:@,@[%a@]@]" parameter Format.pp_print_text doc in let rec help : type b. Format.formatter -> (b, ctx) args -> unit = fun ppf -> function @@ -541,11 +554,11 @@ let print_options_brief (type ctx) = type a. Format.formatter -> (a, ctx) arg -> unit = fun ppf -> function | DefArg { parameter } -> - Format.fprintf ppf "[%s _]" parameter + Format.fprintf ppf "[@{%s _@}]" parameter | Arg { parameter } -> - Format.fprintf ppf "[%s _]" parameter + Format.fprintf ppf "[@{%s _@}]" parameter | Switch { parameter } -> - Format.fprintf ppf "[%s]" parameter + Format.fprintf ppf "[@{%s@}]" parameter in let rec help : type b. Format.formatter -> (b, ctx) args -> unit = fun ppf -> function | NoArgs -> () @@ -568,7 +581,7 @@ let print_highlight highlight_strings formatter str = (function | Str.Text text -> Format.fprintf formatter "%s" text | Str.Delim delimiter -> - Format.fprintf formatter "\x1b[103m%s\x1b[0m" delimiter) + Format.fprintf formatter "@{%s@}" delimiter) list end in print_string (List.map Str.regexp_string highlight_strings) @@ -579,18 +592,18 @@ let print_commandline ppf (highlights, options, args) = fun ppf -> function | Stop -> Format.fprintf ppf "%a" print_options_brief options | Seq (n, _, _) when not (has_args options) -> - Format.fprintf ppf "[(%s)...]" n + Format.fprintf ppf "[@{%s@}...]" n | Seq (n, _, _) -> - Format.fprintf ppf "[(%s)...] %a" n print_options_brief options + Format.fprintf ppf "[@{%s@}...] %a" n print_options_brief options | Prefix (n, Stop) when not (has_args options) -> - Format.fprintf ppf "%a" (print_highlight highlights) n + Format.fprintf ppf "@{%a@}" (print_highlight highlights) n | Prefix (n, next) -> - Format.fprintf ppf "%a %a" + Format.fprintf ppf "@{%a@} %a" (print_highlight highlights) n print next | Param (n, _, _, Stop) when not (has_args options) -> - Format.fprintf ppf "(%s)" n + Format.fprintf ppf "@{%s@}" n | Param (n, _, _, next) -> - Format.fprintf ppf "(%s) %a" n print next in + Format.fprintf ppf "@{%s@} %a" n print next in Format.fprintf ppf "@[%a@]" print args let rec print_params_detailed @@ -598,7 +611,7 @@ let rec print_params_detailed = fun spec ppf -> function | Stop -> print_options_detailed ppf spec | Seq (n, desc, _) -> - Format.fprintf ppf "@[(%s)@,@[%a@]@]" + Format.fprintf ppf "@[@{%s@}:@,@[%a@]@]" n Format.pp_print_text (trim desc) ; begin match spec with | NoArgs -> () @@ -607,14 +620,14 @@ let rec print_params_detailed | Prefix (_, next) -> print_params_detailed spec ppf next | Param (n, desc, _, Stop) -> - Format.fprintf ppf "@[(%s)@,@[%a@]@]" + Format.fprintf ppf "@[@{%s@}:@,@[%a@]@]" n Format.pp_print_text (trim desc); begin match spec with | NoArgs -> () | _ -> Format.fprintf ppf "@,%a" print_options_detailed spec end | Param (n, desc, _, next) -> - Format.fprintf ppf "@[(%s)@,@[%a@]@]@,%a" + Format.fprintf ppf "@[@{%s@}:@,@[%a@]@]@,%a" n Format.pp_print_text (trim desc) (print_params_detailed spec) next let contains_params_args : @@ -671,21 +684,82 @@ let group_commands commands = ref l ])) let print_group print_command ppf ({ title }, commands) = - Format.fprintf ppf "@[%s:@,%a@]" + Format.fprintf ppf "@[@{%s@}@,%a@]" title (Format.pp_print_list print_command) commands +let setup_ppf ppf = function + | `Ansi -> + let color_num = function + | `Black -> None + | `Red -> Some 1 + | `Green -> Some 2 + | `Yellow -> Some 3 + | `Blue -> Some 4 + | `Magenta -> Some 5 + | `Cyan -> Some 6 + | `White -> Some 7 in + let ansi_format ppf (fg, bg, b, u) = + Format.fprintf ppf "@<0>%s" "\027[0m" ; + match + (match color_num fg with Some n -> [ string_of_int (30 + n) ] | None -> []) @ + (match color_num bg with Some n -> [ string_of_int (40 + n) ] | None -> []) @ + (if b then [ "1" ] else []) @ + (if u then [ "4" ] else []) + with + | [] -> () + | l -> Format.fprintf ppf "@<0>%s" ("\027[" ^ String.concat ";" l ^ "m") in + Format.pp_set_formatter_tag_functions ppf + { mark_open_tag = (fun _ -> "") ; + mark_close_tag = (fun _ -> "") ; + print_open_tag = begin function + | "title" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, true, true) + | "opt" -> Format.fprintf ppf "@<0>%a" ansi_format (`Green, `Black, false, false) + | "arg" -> Format.fprintf ppf "@<0>%a<" ansi_format (`Yellow, `Black, false, false) + | "cmd" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, false, true) + | _ -> Pervasives.failwith "Cli_entries: invalid semantic tag" + end ; + print_close_tag = begin function + | "title" -> Format.fprintf ppf ":@<0>%s" "\027[0m" + | "opt" -> Format.fprintf ppf "@<0>%s" "\027[0m" + | "arg" -> Format.fprintf ppf ">@<0>%s" "\027[0m" + | "cmd" -> Format.fprintf ppf "@<0>%s" "\027[0m" + | _ -> Pervasives.failwith "Cli_entries: invalid semantic tag" + end } ; + Format.pp_set_print_tags ppf true + | `Plain -> + Format.pp_set_formatter_tag_functions ppf + { mark_open_tag = (fun _ -> "") ; + mark_close_tag = (fun _ -> "") ; + print_open_tag = begin function + | "title" -> () + | "opt" -> () + | "arg" -> Format.fprintf ppf "<" + | "cmd" -> () + | _ -> Pervasives.failwith "Cli_entries: invalid semantic tag" + end ; + print_close_tag = begin function + | "title" -> Format.fprintf ppf ":" + | "opt" -> () + | "arg" -> Format.fprintf ppf ">" + | "cmd" -> () + | _ -> Pervasives.failwith "Cli_entries: invalid semantic tag" + end } ; + Format.pp_set_print_tags ppf true + let usage ppf ?global_options ~details ?(highlights=[]) commands = let usage ppf (by_group, options) = + let exe = Filename.basename Sys.executable_name in let print_groups = Format.pp_print_list ~pp_sep: (fun ppf () -> Format.fprintf ppf "@,@,") (print_group (if details - then print_command ?prefix:None ~highlights + then + print_command ?prefix:None ~highlights else fun ppf (Command { params ; options=Argument { spec }}) -> print_commandline ppf (highlights, spec, params))) in @@ -695,16 +769,15 @@ let usage "@[<v>%a@]" print_groups by_group | Some (Argument { spec })-> - let exe = Filename.basename Sys.executable_name in Format.fprintf ppf - "@[<v>@[<v 2>Usage:@,\ - %s [global options] command [command options]@,\ - %s -help (for global options)@,\ - %s [global options] command -help (for command options)@]@,@,\ - @[<v 2>To browse the documentation:@,\ - %s [global options] man (for a list of commands)@,\ - %s [global options] man -details (for the full manual)@]@,@,\ - @[<v 2>Global options (must come before the command):@,@[<v 0>%a@]@]%a\ + "@[<v>@[<v 2>@{<title>Usage@}@,\ + %s @{<opt>[global options]@} command @{<opt>[command options]@}@,\ + %s @{<opt>-help@} (for global options)@,\ + %s @{<opt>[global options]@} command @{<opt>-help@} (for command options)@]@,@,\ + @[<v 2>@{<title>To browse the documentation@}@,\ + %s @{<opt>[global options]@} man (for a list of commands)@,\ + %s @{<opt>[global options]@} man @{<opt>-details@} (for the full manual)@]@,@,\ + @[<v 2>@{<title>Global options (must come before the command)@}@,@[<v 0>%a@]@]%a\ %a@]" exe exe exe exe exe print_options_detailed spec @@ -712,7 +785,7 @@ let usage print_groups by_group in Format.fprintf ppf "@[<v 0>%a" usage (group_commands commands, global_options) ; if not details then - Format.fprintf ppf "@,@,Use option [-verbose] for command options." ; + Format.fprintf ppf "@,@,Use option [@{<opt>-verbose@}] for command options." ; Format.fprintf ppf "@]" let command_usage @@ -894,11 +967,13 @@ let handle_cli_errors ~stdout ~stderr ~global_options = function | Error [ e ] -> (* Should only be one error here *) begin match e with | Extra_arguments (_, cmd) -> + setup_ppf stderr (if Unix.isatty Unix.stderr then `Ansi else `Plain) ; Format.fprintf stderr "Extra arguments provided for command:@;<1 2>@[%a@]@." (print_command ?prefix:None ~highlights:[]) cmd; return 1 | Not_enough_args (_, cmds) -> + setup_ppf stderr (if Unix.isatty Unix.stderr then `Ansi else `Plain) ; Format.fprintf stderr "@[<v 2>Unterminated command, here are possible completions:@,%a@]@." (Format.pp_print_list @@ -935,10 +1010,10 @@ let handle_cli_errors ~stdout ~stderr ~global_options = function | Invalid_options_combination message -> Format.fprintf stderr "%s@." message ; return 1 - | Help_cmd ([ highlight ], [], _, _) -> + | Help_cmd ([ highlight ], [], _, _, _) -> Format.fprintf stderr "No command found that match %s.@." highlight ; return 0 - | Help_cmd (highlight :: highlights, [], _, _) -> + | Help_cmd (highlight :: highlights, [], _, _, _) -> Format.fprintf stderr "No command found that match %a%s and %s.@." (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ", ") @@ -946,7 +1021,7 @@ let handle_cli_errors ~stdout ~stderr ~global_options = function (match highlights with [ _ ] | [] -> "" | _::_ -> ",") highlight ; return 0 - | Help_cmd (highlights, commands, terse, details) -> + | Help_cmd (highlights, commands, format, terse, details) -> let details = if terse || details then details @@ -954,10 +1029,12 @@ let handle_cli_errors ~stdout ~stderr ~global_options = function List.length commands <= 3 in let global_options = if details && highlights = [] then Some global_options else None in + setup_ppf stdout format ; Format.fprintf stdout "%a@." (usage ?global_options ~details ~highlights) commands; return 0 | Bare_help -> + setup_ppf stdout (if Unix.isatty Unix.stdout then `Ansi else `Plain) ; Format.fprintf stdout "%a@." (usage ~global_options ~details:true ?highlights:None) [] ; return 0