Cli_entries: export formatter setup functions
This commit is contained in:
Benjamin Canou
parent
a830c29185
commit
2c2f0a1818
@ -731,201 +731,217 @@ let group_commands commands =
|
|||||||
ref l ]))
|
ref l ]))
|
||||||
|
|
||||||
let print_group print_command ppf ({ title ; _ }, commands) =
|
let print_group print_command ppf ({ title ; _ }, commands) =
|
||||||
Format.fprintf ppf "@{<title>%s@}@,@{<section>%a@}"
|
Format.fprintf ppf "@{<title>%s@}@,@{<list>%a@}"
|
||||||
title
|
title
|
||||||
(Format.pp_print_list print_command) commands
|
(Format.pp_print_list print_command) commands
|
||||||
|
|
||||||
let setup_ppf ppf format verbosity =
|
type formatter_state =
|
||||||
|
Format.formatter_out_functions *
|
||||||
|
Format.formatter_tag_functions *
|
||||||
|
bool
|
||||||
|
|
||||||
|
let setup_formatter ppf ~format ~verbosity =
|
||||||
let skip = ref false in
|
let skip = ref false in
|
||||||
let orig_out_functions =
|
let orig_out_functions, _, _ as orig_state =
|
||||||
Format.pp_get_formatter_out_functions ppf () in
|
Format.pp_get_formatter_out_functions ppf (),
|
||||||
Format.pp_set_formatter_out_functions ppf
|
Format.pp_get_formatter_tag_functions ppf (),
|
||||||
{ out_string =
|
Format.pp_get_print_tags ppf () in
|
||||||
(fun s b a ->
|
begin
|
||||||
if s = "\000\000\000" then skip := true
|
Format.pp_set_formatter_out_functions ppf
|
||||||
else if s = "\255\255\255" then skip := false
|
{ out_string =
|
||||||
else if not !skip then orig_out_functions.out_string s b a) ;
|
(fun s b a ->
|
||||||
out_spaces = (fun n -> if not !skip then orig_out_functions.out_spaces n) ;
|
if s = "\000\000\000" then skip := true
|
||||||
out_newline = (fun () -> if not !skip then orig_out_functions.out_newline ()) ;
|
else if s = "\255\255\255" then skip := false
|
||||||
out_flush = (fun () -> if not !skip then orig_out_functions.out_flush ()) } ;
|
else if not !skip then orig_out_functions.out_string s b a) ;
|
||||||
let levels = ref [] in
|
out_spaces = (fun n -> if not !skip then orig_out_functions.out_spaces n) ;
|
||||||
let setup_level level =
|
out_newline = (fun () -> if not !skip then orig_out_functions.out_newline ()) ;
|
||||||
match verbosity, level with
|
out_flush = (fun () -> if not !skip then orig_out_functions.out_flush ()) } ;
|
||||||
| (`Full, (`Terse | `Short | `Args | `Full))
|
let levels = ref [] in
|
||||||
| (`Args, (`Terse | `Short | `Args))
|
let setup_level level =
|
||||||
| (`Short, (`Terse | `Short))
|
match verbosity, level with
|
||||||
| `Terse, `Terse -> Format.fprintf ppf "@<0>%s" "\255\255\255"
|
| (`Full, (`Terse | `Short | `Args | `Full))
|
||||||
| _ -> Format.fprintf ppf "@<0>%s" "\000\000\000" in
|
| (`Args, (`Terse | `Short | `Args))
|
||||||
let push_level level =
|
| (`Short, (`Terse | `Short))
|
||||||
levels := level :: !levels ;
|
| `Terse, `Terse -> Format.fprintf ppf "@<0>%s" "\255\255\255"
|
||||||
setup_level level in
|
| _ -> Format.fprintf ppf "@<0>%s" "\000\000\000" in
|
||||||
let pop_level _ =
|
let push_level level =
|
||||||
match !levels with
|
levels := level :: !levels ;
|
||||||
| _ :: level :: rest -> levels := level :: rest ; setup_level level
|
setup_level level in
|
||||||
| [ _ ] | [] -> Pervasives.failwith "Cli_entries: unclosed verbosity tag" in
|
let pop_level _ =
|
||||||
push_level `Terse ;
|
match !levels with
|
||||||
match format with
|
| _ :: level :: rest -> levels := level :: rest ; setup_level level
|
||||||
| `Ansi ->
|
| [ _ ] | [] -> Pervasives.failwith "Cli_entries: unclosed verbosity tag" in
|
||||||
let color_num = function
|
push_level `Terse ;
|
||||||
| `Black -> None
|
match format with
|
||||||
| `Red -> Some 1
|
| `Ansi ->
|
||||||
| `Green -> Some 2
|
let color_num = function
|
||||||
| `Yellow -> Some 3
|
| `Black -> None
|
||||||
| `Blue -> Some 4
|
| `Red -> Some 1
|
||||||
| `Magenta -> Some 5
|
| `Green -> Some 2
|
||||||
| `Cyan -> Some 6
|
| `Yellow -> Some 3
|
||||||
| `White -> Some 7 in
|
| `Blue -> Some 4
|
||||||
let ansi_format ppf (fg, bg, b, u) =
|
| `Magenta -> Some 5
|
||||||
Format.fprintf ppf "@<0>%s" "\027[0m" ;
|
| `Cyan -> Some 6
|
||||||
match
|
| `White -> Some 7 in
|
||||||
(match color_num fg with Some n -> [ string_of_int (30 + n) ] | None -> []) @
|
let ansi_format ppf (fg, bg, b, u) =
|
||||||
(match color_num bg with Some n -> [ string_of_int (40 + n) ] | None -> []) @
|
Format.fprintf ppf "@<0>%s" "\027[0m" ;
|
||||||
(if b then [ "1" ] else []) @
|
match
|
||||||
(if u then [ "4" ] else [])
|
(match color_num fg with Some n -> [ string_of_int (30 + n) ] | None -> []) @
|
||||||
with
|
(match color_num bg with Some n -> [ string_of_int (40 + n) ] | None -> []) @
|
||||||
| [] -> ()
|
(if b then [ "1" ] else []) @
|
||||||
| l -> Format.fprintf ppf "@<0>%s" ("\027[" ^ String.concat ";" l ^ "m") in
|
(if u then [ "4" ] else [])
|
||||||
Format.pp_set_formatter_tag_functions ppf
|
with
|
||||||
{ mark_open_tag = (fun _ -> "") ;
|
| [] -> ()
|
||||||
mark_close_tag = (fun _ -> "") ;
|
| l -> Format.fprintf ppf "@<0>%s" ("\027[" ^ String.concat ";" l ^ "m") in
|
||||||
print_open_tag = begin function
|
Format.pp_set_formatter_tag_functions ppf
|
||||||
| "title" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, true, true)
|
{ mark_open_tag = (fun _ -> "") ;
|
||||||
| "commandline" -> Format.fprintf ppf "@[<hov 4>"
|
mark_close_tag = (fun _ -> "") ;
|
||||||
| "commanddoc" -> Format.fprintf ppf " @[<v 0>"
|
print_open_tag = begin function
|
||||||
| "opt" -> Format.fprintf ppf "@<0>%a" ansi_format (`Green, `Black, false, false)
|
| "title" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, true, true)
|
||||||
| "arg" -> Format.fprintf ppf "@<0>%a<" ansi_format (`Yellow, `Black, false, false)
|
| "commandline" -> Format.fprintf ppf "@[<hov 4>"
|
||||||
| "kwd" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, false, true)
|
| "commanddoc" -> Format.fprintf ppf " @[<v 0>"
|
||||||
| "hilight" -> Format.fprintf ppf "@<0>%a" ansi_format (`Black, `Yellow, false, true)
|
| "opt" -> Format.fprintf ppf "@<0>%a" ansi_format (`Green, `Black, false, false)
|
||||||
| "section" -> Format.fprintf ppf " @[<v 0>"
|
| "arg" -> Format.fprintf ppf "@<0>%a<" ansi_format (`Yellow, `Black, false, false)
|
||||||
| "command" -> Format.fprintf ppf "@[<v 0>"
|
| "kwd" -> Format.fprintf ppf "@<0>%a" ansi_format (`White, `Black, false, true)
|
||||||
| "full" -> push_level `Full
|
| "hilight" -> Format.fprintf ppf "@<0>%a" ansi_format (`Black, `Yellow, false, true)
|
||||||
| "args" -> push_level `Args
|
| "list" -> Format.fprintf ppf " @[<v 0>"
|
||||||
| "short" -> push_level `Short
|
| "command" -> Format.fprintf ppf "@[<v 0>"
|
||||||
| "terse" -> push_level `Terse
|
| "full" -> push_level `Full
|
||||||
| "document" -> Format.fprintf ppf "@[<v 0>"
|
| "args" -> push_level `Args
|
||||||
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
| "short" -> push_level `Short
|
||||||
end ;
|
| "terse" -> push_level `Terse
|
||||||
print_close_tag = begin function
|
| "document" -> Format.fprintf ppf "@[<v 0>"
|
||||||
| "title" -> Format.fprintf ppf ":@<0>%s" "\027[0m"
|
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
||||||
| "commandline" -> Format.fprintf ppf "@]"
|
end ;
|
||||||
| "commanddoc" -> Format.fprintf ppf "@]"
|
print_close_tag = begin function
|
||||||
| "opt" -> Format.fprintf ppf "@<0>%s" "\027[0m"
|
| "title" -> Format.fprintf ppf ":@<0>%s" "\027[0m"
|
||||||
| "arg" -> Format.fprintf ppf ">@<0>%s" "\027[0m"
|
| "commandline" -> Format.fprintf ppf "@]"
|
||||||
| "kwd" -> Format.fprintf ppf "@<0>%s" "\027[0m"
|
| "commanddoc" -> Format.fprintf ppf "@]"
|
||||||
| "hilight" -> Format.fprintf ppf "@<0>%s" "\027[0m"
|
| "opt" -> Format.fprintf ppf "@<0>%s" "\027[0m"
|
||||||
| "command" | "section" -> Format.fprintf ppf "@]"
|
| "arg" -> Format.fprintf ppf ">@<0>%s" "\027[0m"
|
||||||
| "full" -> pop_level `Full
|
| "kwd" -> Format.fprintf ppf "@<0>%s" "\027[0m"
|
||||||
| "args" -> pop_level `Args
|
| "hilight" -> Format.fprintf ppf "@<0>%s" "\027[0m"
|
||||||
| "short" -> pop_level `Short
|
| "command" | "list" -> Format.fprintf ppf "@]"
|
||||||
| "terse" -> pop_level `Terse
|
| "full" -> pop_level `Full
|
||||||
| "document" -> Format.fprintf ppf "@]"
|
| "args" -> pop_level `Args
|
||||||
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
| "short" -> pop_level `Short
|
||||||
end } ;
|
| "terse" -> pop_level `Terse
|
||||||
Format.pp_set_print_tags ppf true
|
| "document" -> Format.fprintf ppf "@]"
|
||||||
| `Plain ->
|
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
||||||
Format.pp_set_formatter_tag_functions ppf
|
end } ;
|
||||||
{ mark_open_tag = (fun _ -> "") ;
|
Format.pp_set_print_tags ppf true
|
||||||
mark_close_tag = (fun _ -> "") ;
|
| `Plain ->
|
||||||
print_open_tag = begin function
|
Format.pp_set_formatter_tag_functions ppf
|
||||||
| "title" -> ()
|
{ mark_open_tag = (fun _ -> "") ;
|
||||||
| "commandline" -> Format.fprintf ppf "@[<hov 4>"
|
mark_close_tag = (fun _ -> "") ;
|
||||||
| "commanddoc" -> Format.fprintf ppf " @[<v 0>"
|
print_open_tag = begin function
|
||||||
| "opt" -> ()
|
| "title" -> ()
|
||||||
| "arg" -> Format.fprintf ppf "<"
|
| "commandline" -> Format.fprintf ppf "@[<hov 4>"
|
||||||
| "kwd" -> ()
|
| "commanddoc" -> Format.fprintf ppf " @[<v 0>"
|
||||||
| "hilight" -> ()
|
| "opt" -> ()
|
||||||
| "section" -> Format.fprintf ppf " @[<v 0>"
|
| "arg" -> Format.fprintf ppf "<"
|
||||||
| "command" -> Format.fprintf ppf "@[<v 0>"
|
| "kwd" -> ()
|
||||||
| "full" -> push_level `Full
|
| "hilight" -> ()
|
||||||
| "args" -> push_level `Args
|
| "list" -> Format.fprintf ppf " @[<v 0>"
|
||||||
| "short" -> push_level `Short
|
| "command" -> Format.fprintf ppf "@[<v 0>"
|
||||||
| "terse" -> push_level `Terse
|
| "full" -> push_level `Full
|
||||||
| "document" -> Format.fprintf ppf "@[<v 0>"
|
| "args" -> push_level `Args
|
||||||
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
| "short" -> push_level `Short
|
||||||
end ;
|
| "terse" -> push_level `Terse
|
||||||
print_close_tag = begin function
|
| "document" -> Format.fprintf ppf "@[<v 0>"
|
||||||
| "title" -> Format.fprintf ppf ":"
|
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
||||||
| "commandline" -> Format.fprintf ppf "@]"
|
end ;
|
||||||
| "commanddoc" -> Format.fprintf ppf "@]"
|
print_close_tag = begin function
|
||||||
| "opt" -> ()
|
| "title" -> Format.fprintf ppf ":"
|
||||||
| "arg" -> Format.fprintf ppf ">"
|
| "commandline" -> Format.fprintf ppf "@]"
|
||||||
| "kwd" -> ()
|
| "commanddoc" -> Format.fprintf ppf "@]"
|
||||||
| "hilight" -> ()
|
| "opt" -> ()
|
||||||
| "command" | "section" -> Format.fprintf ppf "@]"
|
| "arg" -> Format.fprintf ppf ">"
|
||||||
| "full" -> pop_level `Full
|
| "kwd" -> ()
|
||||||
| "args" -> pop_level `Args
|
| "hilight" -> ()
|
||||||
| "short" -> pop_level `Short
|
| "command" | "list" -> Format.fprintf ppf "@]"
|
||||||
| "terse" -> pop_level `Terse
|
| "full" -> pop_level `Full
|
||||||
| "document" -> Format.fprintf ppf "@]"
|
| "args" -> pop_level `Args
|
||||||
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
| "short" -> pop_level `Short
|
||||||
end } ;
|
| "terse" -> pop_level `Terse
|
||||||
Format.pp_set_print_tags ppf true
|
| "document" -> Format.fprintf ppf "@]"
|
||||||
| `Html ->
|
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
||||||
Format.pp_set_formatter_tag_functions ppf
|
end } ;
|
||||||
{ mark_open_tag = (fun _ -> "") ;
|
Format.pp_set_print_tags ppf true
|
||||||
mark_close_tag = (fun _ -> "") ;
|
| `Html ->
|
||||||
print_open_tag = begin function
|
Format.pp_set_formatter_tag_functions ppf
|
||||||
| "title" -> Format.fprintf ppf "\003h3\004"
|
{ mark_open_tag = (fun _ -> "") ;
|
||||||
| "commandline" -> Format.fprintf ppf "\003div class='cmdline'\004@[<h>"
|
mark_close_tag = (fun _ -> "") ;
|
||||||
| "commanddoc" -> Format.fprintf ppf "\003div class='cmddoc'\004"
|
print_open_tag = begin function
|
||||||
| "opt" -> Format.fprintf ppf "\003span class='opt'\004"
|
| "title" -> Format.fprintf ppf "\003h3\004"
|
||||||
| "arg" -> Format.fprintf ppf "\003span class='arg'\004"
|
| "commandline" -> Format.fprintf ppf "\003div class='cmdline'\004@[<h>"
|
||||||
| "kwd" -> Format.fprintf ppf "\003span class='kwd'\004"
|
| "commanddoc" -> Format.fprintf ppf "\003div class='cmddoc'\004"
|
||||||
| "hilight" -> ()
|
| "opt" -> Format.fprintf ppf "\003span class='opt'\004"
|
||||||
| "section" -> Format.fprintf ppf "\003ul\004@\n"
|
| "arg" -> Format.fprintf ppf "\003span class='arg'\004"
|
||||||
| "command" -> Format.fprintf ppf "\003li\004@\n"
|
| "kwd" -> Format.fprintf ppf "\003span class='kwd'\004"
|
||||||
| "full" -> push_level `Full
|
| "hilight" -> ()
|
||||||
| "args" -> push_level `Args
|
| "list" -> Format.fprintf ppf "\003ul\004@\n"
|
||||||
| "short" -> push_level `Short
|
| "command" -> Format.fprintf ppf "\003li\004@\n"
|
||||||
| "terse" -> push_level `Terse
|
| "full" -> push_level `Full
|
||||||
| "document" ->
|
| "args" -> push_level `Args
|
||||||
Format.fprintf ppf
|
| "short" -> push_level `Short
|
||||||
"@[<v 0>\003style\004\
|
| "terse" -> push_level `Terse
|
||||||
.cmdline { font-family: monospace }\
|
| "document" ->
|
||||||
.cmddoc { white-space: pre-wrap ; font-family: monospace; line-height: 170%%; margin: 0 0 20px 0 }\
|
Format.fprintf ppf
|
||||||
.cmdline { background: #343131; padding: 2px 8px; border-radius:10px; color: white; margin: 5px; }\
|
"@[<v 0>\003style\004\
|
||||||
.cmdline+.cmddoc { margin: -5px 5px 0 20px; padding: 5px }\
|
.cmdline { font-family: monospace }\
|
||||||
.opt,.arg { background: #343131; font-weight: bold; padding: 2px 4px; border-radius:5px; }\
|
.cmddoc { white-space: pre-wrap ; font-family: monospace; line-height: 170%%; margin: 0 0 20px 0 }\
|
||||||
.kwd { font-weight: bold; } .opt { color:#CF0; background: #460; } .arg { color: #CEF; background: #369; }\
|
.cmdline { background: #343131; padding: 2px 8px; border-radius:10px; color: white; margin: 5px; }\
|
||||||
\003/style\004@\n" ;
|
.cmdline+.cmddoc { margin: -5px 5px 0 20px; padding: 5px }\
|
||||||
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
.opt,.arg { background: #343131; font-weight: bold; padding: 2px 4px; border-radius:5px; }\
|
||||||
end ;
|
.kwd { font-weight: bold; } .opt { color:#CF0; background: #460; } .arg { color: #CEF; background: #369; }\
|
||||||
print_close_tag = begin function
|
\003/style\004@\n" ;
|
||||||
| "title" -> Format.fprintf ppf "\003/h3\004@\n"
|
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
||||||
| "commandline" -> Format.fprintf ppf "@]\003/div\004@\n"
|
end ;
|
||||||
| "commanddoc" -> Format.fprintf ppf "\003/div\004@\n"
|
print_close_tag = begin function
|
||||||
| "opt" -> Format.fprintf ppf "\003/span\004"
|
| "title" -> Format.fprintf ppf "\003/h3\004@\n"
|
||||||
| "arg" -> Format.fprintf ppf "\003/span\004"
|
| "commandline" -> Format.fprintf ppf "@]\003/div\004@\n"
|
||||||
| "kwd" -> Format.fprintf ppf "\003/span\004"
|
| "commanddoc" -> Format.fprintf ppf "\003/div\004@\n"
|
||||||
| "hilight" -> ()
|
| "opt" -> Format.fprintf ppf "\003/span\004"
|
||||||
| "section" -> Format.fprintf ppf "\003/ul\004@\n"
|
| "arg" -> Format.fprintf ppf "\003/span\004"
|
||||||
| "command" -> Format.fprintf ppf "\003/li\004@\n"
|
| "kwd" -> Format.fprintf ppf "\003/span\004"
|
||||||
| "full" -> pop_level `Full
|
| "hilight" -> ()
|
||||||
| "args" -> pop_level `Args
|
| "list" -> Format.fprintf ppf "\003/ul\004@\n"
|
||||||
| "short" -> pop_level `Short
|
| "command" -> Format.fprintf ppf "\003/li\004@\n"
|
||||||
| "terse" -> pop_level `Terse
|
| "full" -> pop_level `Full
|
||||||
| "document" -> Format.fprintf ppf "@]"
|
| "args" -> pop_level `Args
|
||||||
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
| "short" -> pop_level `Short
|
||||||
end } ;
|
| "terse" -> pop_level `Terse
|
||||||
let orig_out_functions =
|
| "document" -> Format.fprintf ppf "@]"
|
||||||
Format.pp_get_formatter_out_functions ppf () in
|
| _ -> Pervasives.failwith "Cli_entries: invalid semantic tag"
|
||||||
Format.pp_set_formatter_out_functions ppf
|
end } ;
|
||||||
{ orig_out_functions with
|
let orig_out_functions =
|
||||||
out_string = (fun s i j ->
|
Format.pp_get_formatter_out_functions ppf () in
|
||||||
let buf = Buffer.create (j - i) in
|
Format.pp_set_formatter_out_functions ppf
|
||||||
for n = i to j - 1 do match String.get s n with
|
{ orig_out_functions with
|
||||||
| '\003' -> Buffer.add_char buf '<'
|
out_string = (fun s i j ->
|
||||||
| '\004' -> Buffer.add_char buf '>'
|
let buf = Buffer.create (j - i) in
|
||||||
| '>' -> Buffer.add_string buf ">"
|
for n = i to j - 1 do match String.get s n with
|
||||||
| '<' -> Buffer.add_string buf "<"
|
| '\003' -> Buffer.add_char buf '<'
|
||||||
| c -> Buffer.add_char buf c
|
| '\004' -> Buffer.add_char buf '>'
|
||||||
done ;
|
| '>' -> Buffer.add_string buf ">"
|
||||||
let s' = Buffer.contents buf in
|
| '<' -> Buffer.add_string buf "<"
|
||||||
orig_out_functions.out_string s' 0 (String.length s'))} ;
|
| c -> Buffer.add_char buf c
|
||||||
Format.pp_set_print_tags ppf true
|
done ;
|
||||||
|
let s' = Buffer.contents buf in
|
||||||
|
orig_out_functions.out_string s' 0 (String.length s'))} ;
|
||||||
|
Format.pp_set_print_tags ppf true
|
||||||
|
end ;
|
||||||
|
orig_state
|
||||||
|
|
||||||
|
let restore_formatter ppf (out_functions, tag_functions, tags) =
|
||||||
|
Format.pp_set_formatter_out_functions ppf out_functions ;
|
||||||
|
Format.pp_set_formatter_tag_functions ppf tag_functions ;
|
||||||
|
Format.pp_set_print_tags ppf tags
|
||||||
|
|
||||||
|
|
||||||
let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
|
let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
|
||||||
setup_ppf ppf format verbosity ;
|
ignore (setup_formatter ppf ~format ~verbosity) ;
|
||||||
let usage ppf (by_group, options) =
|
let usage ppf (by_group, options) =
|
||||||
let exe = Filename.basename Sys.executable_name in
|
let exe = Filename.basename Sys.executable_name in
|
||||||
let print_groups =
|
let print_groups =
|
||||||
@ -940,7 +956,7 @@ let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
|
|||||||
| Some (Argument { spec ; _ })->
|
| Some (Argument { spec ; _ })->
|
||||||
Format.fprintf ppf
|
Format.fprintf ppf
|
||||||
"@[<v>@{<title>Usage@}@,\
|
"@[<v>@{<title>Usage@}@,\
|
||||||
@{<section>\
|
@{<list>\
|
||||||
@{<command>@{<commandline>\
|
@{<command>@{<commandline>\
|
||||||
%s [@{<opt>global options@}] command @{<opt>[command options]@}@}@}@,\
|
%s [@{<opt>global options@}] command @{<opt>[command options]@}@}@}@,\
|
||||||
@{<command>@{<commandline>\
|
@{<command>@{<commandline>\
|
||||||
@ -949,7 +965,7 @@ let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
|
|||||||
%s [@{<opt>global options@}] command @{<opt>-help@} (for command options)@}@}\
|
%s [@{<opt>global options@}] command @{<opt>-help@} (for command options)@}@}\
|
||||||
@}@,@,\
|
@}@,@,\
|
||||||
@{<title>To browse the documentation@}@,\
|
@{<title>To browse the documentation@}@,\
|
||||||
@{<section>\
|
@{<list>\
|
||||||
@{<command>@{<commandline>\
|
@{<command>@{<commandline>\
|
||||||
%s [@{<opt>global options@}] man (for a list of commands)@}@}@,\
|
%s [@{<opt>global options@}] man (for a list of commands)@}@}@,\
|
||||||
@{<command>@{<commandline>\
|
@{<command>@{<commandline>\
|
||||||
@ -968,7 +984,7 @@ let usage ppf ?global_options ?(highlights=[]) commands format verbosity =
|
|||||||
Format.fprintf ppf "@}"
|
Format.fprintf ppf "@}"
|
||||||
|
|
||||||
let command_usage ppf commands format verbosity =
|
let command_usage ppf commands format verbosity =
|
||||||
setup_ppf ppf format verbosity ;
|
ignore (setup_formatter ppf ~format ~verbosity) ;
|
||||||
let exe = Filename.basename Sys.executable_name in
|
let exe = Filename.basename Sys.executable_name in
|
||||||
let prefix ppf () =
|
let prefix ppf () =
|
||||||
Format.fprintf ppf "@{<kwd>%s@} @{<opt>[global options]@} " exe in
|
Format.fprintf ppf "@{<kwd>%s@} @{<opt>[global options]@} " exe in
|
||||||
@ -1147,13 +1163,13 @@ let handle_cli_errors ~stdout ~stderr ~global_options = function
|
|||||||
| Error [ e ] -> (* Should only be one error here *)
|
| Error [ e ] -> (* Should only be one error here *)
|
||||||
begin match e with
|
begin match e with
|
||||||
| Extra_arguments (_, cmd) ->
|
| Extra_arguments (_, cmd) ->
|
||||||
setup_ppf stderr (if Unix.isatty Unix.stderr then `Ansi else `Plain) `Terse ;
|
ignore (setup_formatter stderr ~format:(if Unix.isatty Unix.stderr then `Ansi else `Plain) ~verbosity:`Terse) ;
|
||||||
Format.fprintf stderr
|
Format.fprintf stderr
|
||||||
"Extra arguments provided for command:@;<1 2>@[%a@]@."
|
"Extra arguments provided for command:@;<1 2>@[%a@]@."
|
||||||
(print_command ?prefix:None ~highlights:[]) cmd;
|
(print_command ?prefix:None ~highlights:[]) cmd;
|
||||||
return 1
|
return 1
|
||||||
| Not_enough_args (_, cmds) ->
|
| Not_enough_args (_, cmds) ->
|
||||||
setup_ppf stderr (if Unix.isatty Unix.stderr then `Ansi else `Plain) `Terse ;
|
ignore (setup_formatter stderr ~format:(if Unix.isatty Unix.stderr then `Ansi else `Plain) ~verbosity:`Terse) ;
|
||||||
Format.fprintf stderr
|
Format.fprintf stderr
|
||||||
"@[<v 2>Unterminated command, here are possible completions:@,%a@]@."
|
"@[<v 2>Unterminated command, here are possible completions:@,%a@]@."
|
||||||
(Format.pp_print_list
|
(Format.pp_print_list
|
||||||
|
|||||||
@ -252,7 +252,7 @@ val dispatch:
|
|||||||
|
|
||||||
(** Parse the global options, and return their value, with the rest of
|
(** Parse the global options, and return their value, with the rest of
|
||||||
the command to be parsed. *)
|
the command to be parsed. *)
|
||||||
val parse_global_options :
|
val parse_initial_options :
|
||||||
('a, 'ctx) options ->
|
('a, 'ctx) options ->
|
||||||
'ctx ->
|
'ctx ->
|
||||||
string list ->
|
string list ->
|
||||||
@ -262,4 +262,41 @@ val map_command: ('a -> 'b) -> ('b, 'c) command -> ('a, 'c) command
|
|||||||
|
|
||||||
(** {2 Output formatting} *)
|
(** {2 Output formatting} *)
|
||||||
|
|
||||||
val setup_ppf : Format.formatter -> [< `Plain ] -> [< `LOL ] -> unit
|
(** Used to restore the formatter state after [setup_formatter]. *)
|
||||||
|
type formatter_state
|
||||||
|
|
||||||
|
(** Updates the formatter's functions to interprete some semantic tags
|
||||||
|
used in manual production. Returns the previous state of the
|
||||||
|
formatter to restore it afterwards if needed.
|
||||||
|
|
||||||
|
Toplevel structure tags:
|
||||||
|
|
||||||
|
* [<document>]: a toplevel group
|
||||||
|
* [<title>]: a section title (just below a [<document])
|
||||||
|
* [<list>]: a list section (just below a [<document])
|
||||||
|
|
||||||
|
Structure tags used internally for generating the manual:
|
||||||
|
|
||||||
|
* [<command>]: wraps the full documentation bloc for a command
|
||||||
|
* [<commandline>]: wraps the command line in a [<command>]
|
||||||
|
* [<commanddoc>]: wraps everything but the command line in a [<command>]
|
||||||
|
|
||||||
|
Cosmetic tags for hilighting text:
|
||||||
|
|
||||||
|
* [<opt>]: optional arguments * [<arg>]: positional arguments
|
||||||
|
* [<kwd>]: positional keywords * [<hilight>]: search results
|
||||||
|
|
||||||
|
Verbosity levels, in order, and how they are used in the manual:
|
||||||
|
|
||||||
|
* [<terse>]: always displayed (titles commands lines)
|
||||||
|
* [<args>]: displayed if [verbosity >= `Args] (lists of arguments)
|
||||||
|
* [<short>]: displayed if [verbosity >= `Short] (single line descriptions)
|
||||||
|
* [<full>]: only displayed if [verbosity = `Full] (long descriptions) *)
|
||||||
|
val setup_formatter :
|
||||||
|
Format.formatter ->
|
||||||
|
format: [< `Ansi | `Html | `Plain ] ->
|
||||||
|
verbosity: [> `Terse | `Short | `Args | `Full ] ->
|
||||||
|
formatter_state
|
||||||
|
|
||||||
|
(** Restore the formatter state after [setup_formatter]. *)
|
||||||
|
val restore_formatter : Format.formatter -> formatter_state -> unit
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user