@ -218,7 +218,6 @@ module SectionMap = Caml.Map.Make (struct
- 1
else (* reverse order *)
String . compare s2 s1
end )
let help_sections_desc_lists =
@ -384,8 +383,10 @@ let mk_set var value ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(meta=
let setter () = var := value in
ignore
( mk ~ deprecated ~ long ? short ~ default : () ? parse_mode ? in_help ~ meta doc
~ default_to_string : ( fun () -> " " ) ~ decode_json : ( string_json_decoder ~ long )
~ mk_setter : ( fun _ _ -> setter () ) ~ mk_spec : ( fun _ -> Unit setter ) )
~ default_to_string : ( fun () -> " " )
~ decode_json : ( string_json_decoder ~ long )
~ mk_setter : ( fun _ _ -> setter () )
~ mk_spec : ( fun _ -> Unit setter ) )
let mk_with_reset value ~ reset_doc ? deprecated ~ long ? parse_mode mk =
@ -405,8 +406,9 @@ let mk_option ?(default= None) ?(default_to_string= fun _ -> "") ~f ?(mk_reset=
? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help ? ( meta = " string " ) doc =
let mk () =
mk ~ deprecated ~ long ? short ~ default ? parse_mode ? in_help ~ meta doc ~ default_to_string
~ decode_json : ( string_json_decoder ~ long ) ~ mk_setter : ( fun var str -> var := f str ) ~ mk_spec :
( fun set -> String set )
~ decode_json : ( string_json_decoder ~ long )
~ mk_setter : ( fun var str -> var := f str )
~ mk_spec : ( fun set -> String set )
in
if mk_reset then
let reset_doc = reset_doc_opt ~ long in
@ -470,8 +472,10 @@ let mk_bool_group ?(deprecated_no= []) ?(default= false) ?f:(f0 = Fn.id) ?(depre
let mk_int ~ default ? ( f = Fn . id ) ? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help ? ( meta = " int " )
doc =
mk ~ deprecated ~ long ? short ~ default ? parse_mode ? in_help ~ meta doc
~ default_to_string : string_of_int ~ mk_setter : ( fun var str -> var := f ( int_of_string str ) )
~ decode_json : ( string_json_decoder ~ long ) ~ mk_spec : ( fun set -> String set )
~ default_to_string : string_of_int
~ mk_setter : ( fun var str -> var := f ( int_of_string str ) )
~ decode_json : ( string_json_decoder ~ long )
~ mk_spec : ( fun set -> String set )
let mk_int_opt ? default ? f : ( f0 = Fn . id ) ? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help
@ -483,8 +487,10 @@ let mk_int_opt ?default ?f:(f0 = Fn.id) ?(deprecated= []) ~long ?short ?parse_mo
let mk_float ~ default ? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help ? ( meta = " float " ) doc =
mk ~ deprecated ~ long ? short ~ default ? parse_mode ? in_help ~ meta doc
~ default_to_string : string_of_float ~ mk_setter : ( fun var str -> var := float_of_string str )
~ decode_json : ( string_json_decoder ~ long ) ~ mk_spec : ( fun set -> String set )
~ default_to_string : string_of_float
~ mk_setter : ( fun var str -> var := float_of_string str )
~ decode_json : ( string_json_decoder ~ long )
~ mk_spec : ( fun set -> String set )
let mk_float_opt ? default ? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help ? ( meta = " float " ) doc =
@ -496,8 +502,10 @@ let mk_float_opt ?default ?(deprecated= []) ~long ?short ?parse_mode ?in_help ?(
let mk_string ~ default ? ( f = fun s -> s ) ? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help
? ( meta = " string " ) doc =
mk ~ deprecated ~ long ? short ~ default ? parse_mode ? in_help ~ meta doc
~ default_to_string : ( fun s -> s ) ~ mk_setter : ( fun var str -> var := f str )
~ decode_json : ( string_json_decoder ~ long ) ~ mk_spec : ( fun set -> String set )
~ default_to_string : ( fun s -> s )
~ mk_setter : ( fun var str -> var := f str )
~ decode_json : ( string_json_decoder ~ long )
~ mk_spec : ( fun set -> String set )
let mk_string_opt ? default ? ( f = fun s -> s ) ? mk_reset ? ( deprecated = [] ) ~ long ? short ? parse_mode
@ -512,9 +520,10 @@ let mk_string_list ?(default= []) ?(f= fun s -> s) ?(deprecated= []) ~long ?shor
? in_help ? ( meta = " string " ) doc =
let mk () =
mk ~ deprecated ~ long ? short ~ default ? parse_mode ? in_help ~ meta : ( " + " ^ meta ) doc
~ default_to_string : ( String . concat ~ sep : " , " ) ~ mk_setter : ( fun var str -> var := f str :: ! var )
~ decode_json : ( list_json_decoder ( string_json_decoder ~ long ) ) ~ mk_spec : ( fun set -> String set
)
~ default_to_string : ( String . concat ~ sep : " , " )
~ mk_setter : ( fun var str -> var := f str :: ! var )
~ decode_json : ( list_json_decoder ( string_json_decoder ~ long ) )
~ mk_spec : ( fun set -> String set )
in
let reset_doc = reset_doc_list ~ long in
mk_with_reset [] ~ reset_doc ~ long ? parse_mode mk
@ -539,7 +548,8 @@ let mk_path_helper ~setter ~default_to_string ~default ~deprecated ~long ~short
~ default_to_string
~ mk_setter : ( fun var str ->
let abs_path = normalize_path_in_args_being_parsed ~ is_anon_arg : false str in
setter var abs_path ) ~ mk_spec : ( fun set -> String set )
setter var abs_path )
~ mk_spec : ( fun set -> String set )
let mk_path ~ default ? ( f = Fn . id ) ? ( deprecated = [] ) ~ long ? short ? parse_mode ? in_help
@ -589,8 +599,10 @@ let mk_symbol ~default ~symbols ~eq ?(f= Fn.id) ?(deprecated= []) ~long ?short ?
let to_string sym = List . Assoc . find_exn ~ equal : eq sym_to_str sym in
let meta = Option . value meta ~ default : ( mk_symbols_meta symbols ) in
mk ~ deprecated ~ long ? short ~ default ? parse_mode ? in_help ~ meta doc
~ default_to_string : ( fun s -> to_string s ) ~ mk_setter : ( fun var str -> var := of_string str | > f )
~ decode_json : ( string_json_decoder ~ long ) ~ mk_spec : ( fun set -> Symbol ( strings , set ) )
~ default_to_string : ( fun s -> to_string s )
~ mk_setter : ( fun var str -> var := of_string str | > f )
~ decode_json : ( string_json_decoder ~ long )
~ mk_spec : ( fun set -> Symbol ( strings , set ) )
let mk_symbol_opt ~ symbols ? ( f = Fn . id ) ? ( mk_reset = true ) ? ( deprecated = [] ) ~ long ? short ? parse_mode
@ -600,8 +612,10 @@ let mk_symbol_opt ~symbols ?(f= Fn.id) ?(mk_reset= true) ?(deprecated= []) ~long
let meta = Option . value meta ~ default : ( mk_symbols_meta symbols ) in
let mk () =
mk ~ deprecated ~ long ? short ~ default : None ? parse_mode ? in_help ~ meta doc
~ default_to_string : ( fun _ -> " " ) ~ mk_setter : ( fun var str -> var := Some ( f ( of_string str ) ) )
~ decode_json : ( string_json_decoder ~ long ) ~ mk_spec : ( fun set -> Symbol ( strings , set ) )
~ default_to_string : ( fun _ -> " " )
~ mk_setter : ( fun var str -> var := Some ( f ( of_string str ) ) )
~ decode_json : ( string_json_decoder ~ long )
~ mk_spec : ( fun set -> Symbol ( strings , set ) )
in
if mk_reset then
let reset_doc = reset_doc_opt ~ long in
@ -619,8 +633,8 @@ let mk_symbol_seq ?(default= []) ~symbols ~eq ?(deprecated= []) ~long ?short ?pa
~ default_to_string : ( fun syms -> String . concat ~ sep : " " ( List . map ~ f : to_string syms ) )
~ mk_setter : ( fun var str_seq -> var := List . map ~ f : of_string ( String . split ~ on : ',' str_seq ) )
~ decode_json : ( fun ~ inferconfig_dir : _ json ->
[ dashdash long ; String . concat ~ sep : " , " ( YBU . convert_each YBU . to_string json ) ] ) ~ mk_spec :
(fun set -> String set )
[ dashdash long ; String . concat ~ sep : " , " ( YBU . convert_each YBU . to_string json ) ] )
~mk_spec : (fun set -> String set )
let mk_set_from_json ~ default ~ default_to_string ~ f ? ( deprecated = [] ) ~ long ? short ? parse_mode
@ -772,12 +786,14 @@ let mk_subcommand command ?on_unknown_arg:(on_unknown = `Reject) ~name ?deprecat
( match deprecated_long with
| Some long ->
ignore
( mk ~ long ~ default : () ? parse_mode ? in_help ~ meta : " " " " ~ default_to_string : ( fun () -> " " )
( mk ~ long ~ default : () ? parse_mode ? in_help ~ meta : " " " "
~ default_to_string : ( fun () -> " " )
~ decode_json : ( fun ~ inferconfig_dir : _ _ ->
raise ( Arg . Bad ( " Bad option in config file: " ^ long ) ) )
~ mk_setter : ( fun _ _ ->
warnf " WARNING: '%s' is deprecated. Please use '%s' instead.@ \n " ( dashdash long ) name ;
switch () ) ~ mk_spec : ( fun set -> Unit ( fun () -> set " " ) ) )
switch () )
~ mk_spec : ( fun set -> Unit ( fun () -> set " " ) ) )
| None ->
() ) ;
subcommands := ( command , ( command_doc , name , in_help ) ) :: ! subcommands ;
@ -1008,8 +1024,8 @@ let wrap_line indent_string wrap_length line0 =
let add_word_to_paragraph ( rev_lines , non_empty , line , line_length ) word =
let word_length =
let len = String . length word in
if String . is_prefix ~ prefix : " $(b, " word | | String . is_prefix ~ prefix : " $(i, " word then len - 4
(* length of formatting tag prefix *)
if String . is_prefix ~ prefix : " $(b, " word | | String . is_prefix ~ prefix : " $(i, " word then
len - 4 (* length of formatting tag prefix *)
- 1 (* APPROXIMATION: closing parenthesis that will come after the word, or maybe later *)
else len
in
@ -1059,8 +1075,9 @@ let show_manual ?internal_section format default_doc command_opt =
(* base indentation of documentation strings *)
in
` I ( Format . asprintf " $(b,%s)%a%a " ( dashdash long ) pp_short short pp_meta meta , doc_first_line )
:: List . concat_map ( List . concat_map ~ f : ( wrap_line indent_string width ) doc_other_lines ) ~ f :
( fun s -> [ ` Noblank ; ` Pre s ] )
:: List . concat_map
( List . concat_map ~ f : ( wrap_line indent_string width ) doc_other_lines )
~ f : ( fun s -> [ ` Noblank ; ` Pre s ] )
in
let option_blocks =
match command_doc . manual_options with
@ -1098,4 +1115,3 @@ let show_manual ?internal_section format default_doc command_opt =
in
Cmdliner . Manpage . print format Format . std_formatter ( command_doc . title , blocks ) ;
()