Note:

You are viewing a development version of the library. Goto the latest version.

let pp_print_help hext hsty fmt () =

  (* Print with a precise length *)
  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

  (* Print definition for the output style *)
  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