let pp_print_help hext hsty fmt () =
let pp_print_justified sz fmt str =
let ns =
String.make sz ' '
in
String.blit str 0 ns 0 (String.length str);
pp_print_string fmt ns
in
let pp_print_output_def sz fmt (term, def) =
pp_print_string fmt " ";
pp_print_justified sz fmt term;
pp_print_string fmt " ";
pp_open_box fmt 0;
pp_print_string_spaced fmt def;
pp_close_box fmt ();
pp_print_newline fmt ()
in
let pp_print_specs spec_help fmt specs =
let help_specs =
List.rev_append
(List.rev_map
(fun (cli, t, hlp) ->
let arg, hlp =
match OASISString.nsplit hlp ' ' with
| hd :: tl ->
hd, (String.concat " " tl)
| [] ->
"", ""
in
let arg =
match t with
| Arg.Symbol (lst, _) ->
"{"^(String.concat "|" lst)^"}"
| _ ->
arg
in
let term =
if arg <> "" then
cli^" "^arg
else
cli
in
term, hlp)
specs)
(if spec_help then
["-help|--help", s_ "Display this list of options"]
else
[])
in
let sz =
List.fold_left
(fun acc (s, _) -> max (String.length s) acc)
0
help_specs
in
let pp_print_spec fmt (term, hlp) =
match hsty with
| Markdown ->
pp_print_def fmt
("`"^term^"`")
[pp_print_string_spaced, hlp]
| Output ->
pp_print_output_def
sz fmt (term, hlp)
in
pp_print_list pp_print_spec "" fmt help_specs;
if hsty = Output then
pp_print_newline fmt ()
in
let pp_print_scmds fmt () =
let sz =
SubCommand.fold
(fun c sz ->
max sz (String.length c.scmd_name))
0
in
pp_print_para fmt (s_ "Available subcommands:");
SubCommand.fold
(fun c () ->
match hsty with
| Markdown ->
pp_print_def fmt ("`"^c.scmd_name^"`")
[pp_print_string_spaced, c.scmd_synopsis]
| Output ->
pp_print_output_def
sz fmt (c.scmd_name, c.scmd_synopsis))
();
if hsty = Output then
pp_print_newline fmt ()
in
let pp_print_scmd fmt ~global_options scmd =
pp_print_title 2 fmt
(Printf.sprintf (f_ "Subcommand %s") scmd.scmd_name);
pp_print_string fmt scmd.scmd_help;
pp_print_endblock
~check_last_char:scmd.scmd_help
fmt ();
fprintf fmt (f_ "Usage: oasis [global-options*] %s %s") scmd.scmd_name scmd.scmd_usage;
pp_print_endblock fmt ();
if global_options then
begin
pp_print_para fmt (s_ "Global options: ");
pp_print_specs true fmt specs
end;
if scmd.scmd_specs <> [] then
begin
pp_print_para fmt (s_ "Options: ");
pp_print_specs false fmt scmd.scmd_specs
end
in
begin
match hext with
| NoSubCommand | AllSubCommand ->
begin
pp_print_string fmt usage_msg;
pp_print_endblock fmt ();
pp_print_string fmt CLIData.main_mkd;
pp_print_endblock
~check_last_char:CLIData.main_mkd
fmt ();
pp_print_specs true fmt specs;
pp_print_scmds fmt ();
end
| SubCommand _ ->
()
end;
begin
match hext with
| NoSubCommand ->
()
| SubCommand nm ->
pp_print_scmd fmt
~global_options:true
(SubCommand.find nm)
| AllSubCommand ->
SubCommand.fold
(fun scmd () ->
pp_print_scmd fmt ~global_options:false scmd)
()
end