The unpac monorepo manager self-hosting as a monorepo using unpac
Cleanup and move more completion logic to Cmdliner_completion.
Incidentally we also get to complete --version and --help by
using the complete Cmd_info.t value.
+247
-178
+15
-15
vendor/opam/cmdliner/src/cmdliner_cline.ml
+15
-15
vendor/opam/cmdliner/src/cmdliner_cline.ml
···
30
30
31
31
exception Completion_requested of Cmdliner_def.Complete.t
32
32
33
-
let comp_request ?after_dashdash cline ~prefix kind =
34
-
let comp = Cmdliner_def.Complete.make ?after_dashdash cline ~prefix kind in
33
+
let comp_request ?after_dashdash cline ~token kind =
34
+
let comp = Cmdliner_def.Complete.make ?after_dashdash cline ~token kind in
35
35
raise (Completion_requested comp)
36
36
37
37
(* Command lines *)
···
144
144
| v :: rest when for_completion && has_complete_prefix v ->
145
145
let v = get_token_to_complete v in
146
146
if is_opt v then (* not an option value *) None, args else
147
-
comp_request cline ~prefix:v (Opt_value arg_info)
147
+
comp_request cline ~token:v (Opt_value arg_info)
148
148
| v :: rest ->
149
149
if is_opt v then None, args else Some v, rest
150
150
···
162
162
(* This is actually a parse error, flags have no value. We
163
163
make it an option completion but the completions will
164
164
eventually be empty (the prefix won't match) *)
165
-
comp_request cline ~prefix:(name ^ v) Opt_name
165
+
comp_request cline ~token:(name ^ v) Opt_name
166
166
| None ->
167
167
(* We have in fact a fully completed flag turn it into an
168
168
option completion. *)
169
-
comp_request cline ~prefix:name Opt_name
169
+
comp_request cline ~token:name Opt_name
170
170
end
171
171
| _ ->
172
172
begin match value with
173
-
| Some prefix -> comp_request cline ~prefix (Opt_value arg_info)
173
+
| Some token -> comp_request cline ~token (Opt_value arg_info)
174
174
| None ->
175
175
(* We have a fully completed option name, we don't try to
176
176
lookup what happens in the next argument which should
177
177
hold the value if any, we just turn it into an option
178
178
completion. *)
179
-
comp_request cline ~prefix:name Opt_name
179
+
comp_request cline ~token:name Opt_name
180
180
end
181
181
182
182
let parse_opt_args
···
213
213
an argument this may confuse positional args but there's
214
214
not much we can do. *)
215
215
then loop errs (k + 1) cline pargs args else
216
-
let prefix = name ^ Option.value ~default:"" value in
217
-
comp_request cline ~prefix Opt_name
216
+
let token = name ^ Option.value ~default:"" value in
217
+
comp_request cline ~token Opt_name
218
218
| Error `Not_found when peek_opts ->
219
219
loop errs (k + 1) cline pargs args
220
220
| Error `Not_found ->
···
269
269
let args =
270
270
match take_range ~for_completion start stop pargs with
271
271
| `Range args -> args
272
-
| `Complete prefix ->
272
+
| `Complete token ->
273
273
let kind = Cmdliner_def.Complete.Opt_name_or_pos_value a in
274
-
comp_request ~after_dashdash:has_dashdash cline ~prefix kind
274
+
comp_request ~after_dashdash:has_dashdash cline ~token kind
275
275
in
276
276
let max_spec = max stop max_spec in
277
277
let cline = Cmdliner_def.Arg_info.Map.add a (P args : arg) cline in
···
285
285
let consume_excess () =
286
286
match take_range ~for_completion (max_spec + 1) last pargs with
287
287
| `Range args -> args
288
-
| `Complete prefix ->
289
-
comp_request ~after_dashdash:has_dashdash cline ~prefix Opt_name
288
+
| `Complete token ->
289
+
comp_request ~after_dashdash:has_dashdash cline ~token Opt_name
290
290
in
291
291
if misses <> [] then begin
292
292
let _ : string list = consume_excess () in
···
319
319
| Some arg ->
320
320
match maybe_token_to_complete ~for_completion:true arg with
321
321
| None -> assert false
322
-
| Some prefix ->
322
+
| Some token ->
323
323
comp_request
324
-
~after_dashdash:has_dashdash cline ~prefix Opt_name
324
+
~after_dashdash:has_dashdash cline ~token Opt_name
325
325
end
326
326
| Error (errs, cline, has_dashdash, pargs) ->
327
327
let _ : _ result =
+1
-1
vendor/opam/cmdliner/src/cmdliner_cmd.ml
+1
-1
vendor/opam/cmdliner/src/cmdliner_cmd.ml
···
20
20
21
21
let get_info = function Cmd (info, _) | Group (info, _) -> info
22
22
let get_children_infos = function
23
-
| Cmd _ -> assert false | Group (_, (_, cs)) -> List.map get_info cs
23
+
| Cmd _ -> [] | Group (_, (_, cs)) -> List.map get_info cs
24
24
25
25
let group ?default info cmds =
26
26
let args, parser = match default with
+39
-20
vendor/opam/cmdliner/src/cmdliner_completion.ml
+39
-20
vendor/opam/cmdliner/src/cmdliner_completion.ml
···
34
34
Cmdliner_base.Fmt.pf ppf "@[<v>%d@,%a@]" vnum
35
35
Cmdliner_base.Fmt.(list ~sep:nop pp_dir) dirs
36
36
37
-
let add_subcommands_group ~err_ppf ~subst cmd comp directives =
37
+
let add_subcommands_group ~err_ppf ~subst eval comp directives =
38
38
if not (Cmdliner_def.Complete.subcmds comp) then directives else
39
-
let prefix = Cmdliner_def.Complete.prefix comp in
39
+
let prefix = Cmdliner_def.Complete.token comp in
40
40
let maybe_item cmd =
41
41
let name = Cmdliner_def.Cmd_info.name cmd in
42
42
if not (Cmdliner_base.string_starts_with ~prefix name) then None else
···
44
44
let doc = Cmdliner_def.Cmd_info.styled_doc ~errs:err_ppf ~subst cmd in
45
45
Some (name, doc)
46
46
in
47
-
let subcmds = Cmdliner_cmd.get_children_infos cmd in
48
-
(Group ("Subcommands", List.filter_map maybe_item subcmds)) :: directives
47
+
let subcmds = Cmdliner_def.Eval.subcmds eval in
48
+
Group ("Subcommands", List.filter_map maybe_item subcmds) :: directives
49
49
50
-
let add_options_group ~err_ppf ~subst cmd comp directives =
51
-
let prefix = Cmdliner_def.Complete.prefix comp in
50
+
let add_options_group ~err_ppf ~subst eval comp directives =
51
+
let prefix = Cmdliner_def.Complete.token comp in
52
52
let maybe_items arg_info =
53
53
let names = Cmdliner_def.Arg_info.opt_names arg_info in
54
54
let subst = Cmdliner_def.Arg_info.doclang_subst ~subst arg_info in
···
62
62
let maybe_opt = prefix = "" || prefix.[0] = '-' in
63
63
if Cmdliner_def.Complete.after_dashdash comp || not maybe_opt
64
64
then directives else
65
-
let info = Cmdliner_cmd.get_info cmd in
66
-
let set = Cmdliner_def.Cmd_info.args info in
65
+
let cmd_info = Cmdliner_def.Eval.cmd eval in
66
+
let set = Cmdliner_def.Cmd_info.args cmd_info in
67
67
if Cmdliner_def.Arg_info.Set.is_empty set then directives else
68
68
let options = Cmdliner_def.Arg_info.Set.elements set in
69
69
Group ("Options", List.concat (List.map maybe_items options)) :: directives
70
70
71
-
let add_argument_value_directives directives comp =
72
-
let Directives (pp, ds) = Cmdliner_def.Complete.directives comp in
73
-
match ds with
71
+
let add_argument_value_directives directives eval arg_info comp =
72
+
let (Conv conv) =
73
+
let arg_infos = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd eval) in
74
+
Option.get (Cmdliner_def.Arg_info.Set.find_opt arg_info arg_infos)
75
+
in
76
+
let value_dirs =
77
+
let completion = Cmdliner_def.Arg_conv.completion conv in
78
+
match Cmdliner_def.Arg_completion.complete completion with
79
+
| Complete (ctx, func) ->
80
+
let ctx = match ctx with
81
+
| None -> None
82
+
| Some ctx ->
83
+
let cline = Cmdliner_def.Complete.cline comp in
84
+
match (Cmdliner_term.parser ctx) eval cline with
85
+
| Ok ctx -> Some ctx
86
+
| Error _ -> None
87
+
| exception exn -> None
88
+
in
89
+
func ctx ~token:(Cmdliner_def.Complete.token comp)
90
+
in
91
+
match value_dirs with
74
92
| Error msg -> `Directives [Message msg]
75
93
| Ok ds ->
94
+
let pp = Cmdliner_def.Arg_conv.pp conv in
76
95
let rec loop values msgs ~files ~dirs ~restart ~raw = function
77
96
| [] ->
78
97
begin match raw with
···
103
122
in
104
123
loop [] [] ~files:false ~dirs:false ~restart:false ~raw:None ds
105
124
106
-
let output ~out_ppf ~err_ppf ei cmd_args_info cmd comp =
107
-
let subst = Cmdliner_def.Eval.doclang_subst ei in
108
-
let dirs = add_subcommands_group ~err_ppf ~subst cmd comp [] in
125
+
let output ~out_ppf ~err_ppf eval comp =
126
+
let subst = Cmdliner_def.Eval.doclang_subst eval in
127
+
let dirs = add_subcommands_group ~err_ppf ~subst eval comp [] in
109
128
let res = match Cmdliner_def.Complete.kind comp with
110
-
| Opt_value _arg_info ->
111
-
add_argument_value_directives dirs comp
112
-
| Opt_name_or_pos_value _arg_info ->
113
-
let dirs = add_options_group ~err_ppf ~subst cmd comp dirs in
114
-
add_argument_value_directives dirs comp
129
+
| Opt_value arg_info ->
130
+
add_argument_value_directives dirs eval arg_info comp
131
+
| Opt_name_or_pos_value arg_info ->
132
+
let dirs = add_options_group ~err_ppf ~subst eval comp dirs in
133
+
add_argument_value_directives dirs eval arg_info comp
115
134
| Opt_name ->
116
-
`Directives (add_options_group ~err_ppf ~subst cmd comp dirs)
135
+
`Directives (add_options_group ~err_ppf ~subst eval comp dirs)
117
136
in
118
137
match res with
119
138
| `Raw raw -> Cmdliner_base.Fmt.pf out_ppf "%s@?" raw
-2
vendor/opam/cmdliner/src/cmdliner_completion.mli
-2
vendor/opam/cmdliner/src/cmdliner_completion.mli
+12
-20
vendor/opam/cmdliner/src/cmdliner_def.ml
+12
-20
vendor/opam/cmdliner/src/cmdliner_def.ml
···
241
241
and eval = (* information about the evaluation context. *)
242
242
{ cmd : cmd; (* cmd being evaluated. *)
243
243
ancestors : cmd list; (* ancestors of cmd, root is last. *)
244
+
subcmds : cmd list; (* subcommands (if any) *)
244
245
env : string -> string option; (* environment variable lookup. *)
245
246
err_ppf : Format.formatter (* error formatter *) }
246
247
···
327
328
module Eval = struct
328
329
type t = Arg_info.eval
329
330
330
-
let make ~cmd ~ancestors ~env ~err_ppf : t = { cmd; ancestors; env; err_ppf }
331
+
let make ~ancestors ~cmd ~subcmds ~env ~err_ppf : t =
332
+
{ ancestors; cmd; subcmds; env; err_ppf }
331
333
332
334
let cmd (i : t) = i.cmd
333
335
let ancestors (i : t) = i.ancestors
336
+
let subcmds (i : t) = i.subcmds
334
337
let env_var (i : t) v = i.env v
335
338
let err_ppf (i : t) = i.err_ppf
336
339
let main (i : t) = match List.rev i.ancestors with [] -> i.cmd | m :: _ -> m
···
470
473
| Opt_name_or_pos_value of Arg_info.t
471
474
| Opt_name
472
475
473
-
type directives =
474
-
Directives :
475
-
'a Cmdliner_base.Fmt.t *
476
-
('a Arg_completion.directive list, string) result -> directives
477
-
478
476
type t =
479
-
{ context : Cline.t;
480
-
prefix : string;
477
+
{ cline : Cline.t;
478
+
token : string;
481
479
after_dashdash : bool;
482
480
subcmds : bool; (* Note this is adjusted in Cmdliner_eval *)
483
-
kind : kind;
484
-
directives : directives }
481
+
kind : kind }
485
482
486
-
let make ?(after_dashdash = false) ?(subcmds = false) context ~prefix kind =
487
-
{ context; prefix; after_dashdash; subcmds; kind;
488
-
directives = Directives (Cmdliner_base.Fmt.nop, Ok []) }
483
+
let make ?(after_dashdash = false) ?(subcmds = false) cline ~token kind =
484
+
{ cline; token; after_dashdash; subcmds; kind; }
489
485
490
-
let add_subcmds c = { c with subcmds = true }
491
-
let add_directives pp directives c =
492
-
{ c with directives = Directives (pp, directives) }
493
-
494
-
let context c = c.context
495
-
let prefix c = c.prefix
486
+
let cline c = c.cline
487
+
let token c = c.token
496
488
let after_dashdash c = c.after_dashdash
497
489
let subcmds c = c.subcmds
498
490
let kind c = c.kind
499
-
let directives c = c.directives
491
+
let add_subcmds c = { c with subcmds = true }
500
492
end
+6
-16
vendor/opam/cmdliner/src/cmdliner_def.mli
+6
-16
vendor/opam/cmdliner/src/cmdliner_def.mli
···
185
185
module Eval : sig
186
186
type t
187
187
val make :
188
-
cmd:Cmd_info.t -> ancestors:Cmd_info.t list ->
188
+
ancestors:Cmd_info.t list -> cmd:Cmd_info.t -> subcmds:Cmd_info.t list ->
189
189
env:(string -> string option) -> err_ppf:Format.formatter -> t
190
190
191
191
val cmd : t -> Cmd_info.t
192
192
val main : t -> Cmd_info.t
193
193
val ancestors : t -> Cmd_info.t list (* root is last *)
194
+
val subcmds : t -> Cmd_info.t list
194
195
val env_var : t -> string -> string option
195
196
val err_ppf : t -> Format.formatter
196
197
val with_cmd : t -> Cmd_info.t -> t
···
264
265
val none : 'a t
265
266
end
266
267
267
-
268
268
(** Complete instruction. *)
269
269
module Complete : sig
270
270
type kind =
···
272
272
| Opt_name_or_pos_value of Arg_info.t
273
273
| Opt_name
274
274
275
-
type directives =
276
-
| Directives :
277
-
'a Cmdliner_base.Fmt.t *
278
-
('a Arg_completion.directive list, string) result -> directives
279
-
280
275
type t
281
276
282
277
val make :
283
-
?after_dashdash:bool -> ?subcmds:bool -> Cline.t -> prefix:string ->
278
+
?after_dashdash:bool -> ?subcmds:bool -> Cline.t -> token:string ->
284
279
kind -> t
285
280
286
-
val context : t -> Cline.t
287
-
val add_subcmds : t -> t
288
-
val add_directives :
289
-
'a Cmdliner_base.Fmt.t ->
290
-
('a Arg_completion.directive list, string) result -> t -> t
291
-
292
-
val prefix : t -> string
281
+
val cline : t -> Cline.t
282
+
val token : t -> string
293
283
val after_dashdash : t -> bool
294
284
val subcmds : t -> bool
295
285
val kind : t -> kind
296
-
val directives : t -> directives
286
+
val add_subcmds : t -> t
297
287
end
+68
-104
vendor/opam/cmdliner/src/cmdliner_eval.ml
+68
-104
vendor/opam/cmdliner/src/cmdliner_eval.ml
···
7
7
type eval_error = [ `Parse | `Term | `Exn ]
8
8
type 'a eval_exit = [ `Ok of 'a | `Exit of Cmdliner_def.Exit.code ]
9
9
10
-
type 'a complete =
11
-
Cmdliner_def.Eval.t * Cmdliner_def.Arg_info.Set.t * 'a Cmdliner_cmd.t *
12
-
Cmdliner_def.Complete.t
13
-
14
10
type eval_result_error =
15
11
[ Cmdliner_term.term_escape
16
12
| `Exn of exn * Printexc.raw_backtrace
···
19
15
| `Std_version ]
20
16
21
17
type 'a eval_result =
22
-
('a, [ eval_result_error | `Complete of 'a complete]) result
18
+
('a, [ eval_result_error | `Complete of Cmdliner_def.Complete.t]) result
23
19
24
20
let err_help s = "Term error, help requested for unknown command " ^ s
25
21
let err_argv = "argv array must have at least one element"
26
22
27
-
let add_stdopts ei =
28
-
let docs = Cmdliner_def.Cmd_info.stdopts_docs (Cmdliner_def.Eval.cmd ei) in
23
+
let add_stdopts eval =
24
+
let docs = Cmdliner_def.Cmd_info.stdopts_docs (Cmdliner_def.Eval.cmd eval) in
29
25
let vargs, vers =
30
-
match Cmdliner_def.Cmd_info.version (Cmdliner_def.Eval.main ei) with
26
+
match Cmdliner_def.Cmd_info.version (Cmdliner_def.Eval.main eval) with
31
27
| None -> Cmdliner_def.Arg_info.Set.empty, None
32
28
| Some _ ->
33
29
let vers = Cmdliner_arg.stdopt_version ~docs in
···
37
33
let args =
38
34
Cmdliner_def.Arg_info.Set.union vargs (Cmdliner_term.argset help)
39
35
in
40
-
let cmd = Cmdliner_def.Cmd_info.add_args (Cmdliner_def.Eval.cmd ei) args in
41
-
help, vers, Cmdliner_def.Eval.with_cmd ei cmd
36
+
let cmd = Cmdliner_def.Cmd_info.add_args (Cmdliner_def.Eval.cmd eval) args in
37
+
help, vers, Cmdliner_def.Eval.with_cmd eval cmd
42
38
43
-
let run_parser ~catch ei cl f =
44
-
try (f ei cl :> ('a, eval_result_error) result) with
39
+
let run_parser ~catch eval cl f =
40
+
try (f eval cl :> ('a, eval_result_error) result) with
45
41
| exn when catch ->
46
42
let bt = Printexc.get_raw_backtrace () in
47
43
Error (`Exn (exn, bt))
48
44
49
-
let run_parser_for_completion_context ei cline ctx =
50
-
let parser = Cmdliner_term.parser ctx in
51
-
match (parser ei cline :> ('a, eval_result_error) result) with
52
-
| Ok ctx -> Some ctx
53
-
| Error _ -> None
54
-
| exception exn -> None
55
-
56
-
let try_eval_stdopts ~catch ei cl help version : 'a eval_result option =
57
-
match run_parser ~catch ei cl (Cmdliner_term.parser help) with
45
+
let try_eval_stdopts ~catch eval cline help version : 'a eval_result option =
46
+
match run_parser ~catch eval cline (Cmdliner_term.parser help) with
58
47
| Ok (Some fmt) -> Some (Error (`Std_help fmt))
59
48
| Error (`Parse _) ->
60
49
(* only [FMT] errored, there was a `--help`, show help anyways *)
···
64
53
match version with
65
54
| None -> None
66
55
| Some version ->
67
-
match (run_parser ~catch ei cl (Cmdliner_term.parser version))
56
+
match (run_parser ~catch eval cline (Cmdliner_term.parser version))
68
57
with
69
58
| Ok false -> None
70
59
| Ok true -> Some (Error (`Std_version))
71
60
| Error _ as err -> (Some err :> 'a eval_result option)
72
61
73
-
let do_help ~env help_ppf err_ppf ei fmt cmd_name =
74
-
let ei = match cmd_name with
62
+
let do_help ~env help_ppf err_ppf eval fmt cmd_name =
63
+
let eval = match cmd_name with
75
64
| None (* help of main command requested *) ->
76
65
let env _ = assert false in
77
-
let cmd = Cmdliner_def.Eval.main ei in
78
-
let ei' = Cmdliner_def.Eval.make ~cmd ~ancestors:[] ~env ~err_ppf in
79
-
begin match Cmdliner_def.Eval.ancestors ei with
80
-
| [] -> (* [ei] is an evaluation of main, [cmd] has stdopts *) ei'
81
-
| _ -> let _, _, ei = add_stdopts ei' in ei
66
+
let cmd = Cmdliner_def.Eval.main eval in
67
+
let subcmds = Cmdliner_def.Eval.subcmds eval in
68
+
let eval' =
69
+
Cmdliner_def.Eval.make ~ancestors:[] ~cmd ~subcmds ~env ~err_ppf
70
+
in
71
+
begin match Cmdliner_def.Eval.ancestors eval with
72
+
| [] -> (* [ei] is an evaluation of main, [cmd] has stdopts *) eval'
73
+
| _ -> let _, _, eval' = add_stdopts eval' in eval'
82
74
end
83
75
| Some cmd ->
84
76
try
85
77
(* For now we simply keep backward compat. [cmd] should be
86
78
a name from main's children. *)
87
-
let main = Cmdliner_def.Eval.main ei in
79
+
let main = Cmdliner_def.Eval.main eval in
88
80
let is_cmd t = Cmdliner_def.Cmd_info.name t = cmd in
89
81
let children = Cmdliner_def.Cmd_info.children main in
90
82
let cmd = List.find is_cmd children in
91
-
let _, _, ei = add_stdopts (Cmdliner_def.Eval.with_cmd ei cmd) in
92
-
ei
83
+
let _, _, eval = add_stdopts (Cmdliner_def.Eval.with_cmd eval cmd) in
84
+
eval
93
85
with Not_found -> invalid_arg (err_help cmd)
94
86
in
95
-
Cmdliner_docgen.pp_man ~env ~errs:err_ppf fmt help_ppf ei
87
+
Cmdliner_docgen.pp_man ~env ~errs:err_ppf fmt help_ppf eval
96
88
97
-
let do_result ~env help_ppf err_ppf ei = function
89
+
let do_result ~env help_ppf err_ppf eval = function
98
90
| Ok v -> Ok (`Ok v)
99
91
| Error res ->
100
92
match res with
101
93
| `Std_help fmt ->
102
-
Cmdliner_docgen.pp_man ~env ~errs:err_ppf fmt help_ppf ei; Ok `Help
94
+
Cmdliner_docgen.pp_man ~env ~errs:err_ppf fmt help_ppf eval; Ok `Help
103
95
| `Std_version ->
104
-
Cmdliner_msg.pp_version help_ppf ei; Ok `Version
96
+
Cmdliner_msg.pp_version help_ppf eval; Ok `Version
105
97
| `Parse err ->
106
-
Cmdliner_msg.pp_usage_and_err err_ppf ei ~err; Error `Parse
107
-
| `Complete (ei, cmd_args_info, cmd, comp) ->
108
-
(* TODO quick hack this should not happen here *)
109
-
let comp =
110
-
let token = Cmdliner_def.Complete.prefix comp in
111
-
let arg_info = match Cmdliner_def.Complete.kind comp with
112
-
| Opt_value arg_info -> Some arg_info
113
-
| Opt_name_or_pos_value arg_info -> Some arg_info
114
-
| _ -> None
115
-
in
116
-
match arg_info with
117
-
| None -> comp
118
-
| Some arg_info ->
119
-
match Cmdliner_def.Arg_info.Set.find_opt
120
-
arg_info cmd_args_info with
121
-
| None -> comp
122
-
| Some (Conv c) ->
123
-
let completion = Cmdliner_def.Arg_conv.completion c in
124
-
match Cmdliner_def.Arg_completion.complete completion with
125
-
| Complete (ctx, func) ->
126
-
let cline = Cmdliner_def.Complete.context comp in
127
-
let ctx = match ctx with
128
-
| None -> None
129
-
| Some ctx ->
130
-
run_parser_for_completion_context ei cline ctx
131
-
in
132
-
let dirs = func ctx ~token in
133
-
Cmdliner_def.Complete.add_directives
134
-
(Cmdliner_def.Arg_conv.pp c) dirs comp
135
-
in
136
-
Cmdliner_completion.output
137
-
~out_ppf:help_ppf ~err_ppf ei cmd_args_info cmd comp; Ok `Help
98
+
Cmdliner_msg.pp_usage_and_err err_ppf eval ~err; Error `Parse
99
+
| `Complete comp ->
100
+
Cmdliner_completion.output ~out_ppf:help_ppf ~err_ppf eval comp;
101
+
Ok `Help
138
102
| `Help (fmt, cmd_name) ->
139
-
do_help ~env help_ppf err_ppf ei fmt cmd_name; Ok `Help
103
+
do_help ~env help_ppf err_ppf eval fmt cmd_name; Ok `Help
140
104
| `Exn (e, bt) ->
141
-
Cmdliner_msg.pp_backtrace err_ppf ei e bt; (Error `Exn)
105
+
Cmdliner_msg.pp_backtrace err_ppf eval e bt; (Error `Exn)
142
106
| `Error (usage, err) ->
143
107
(if usage
144
-
then Cmdliner_msg.pp_usage_and_err err_ppf ei ~err
145
-
else Cmdliner_msg.pp_err err_ppf ei ~err);
108
+
then Cmdliner_msg.pp_usage_and_err err_ppf eval ~err
109
+
else Cmdliner_msg.pp_err err_ppf eval ~err);
146
110
Error `Term
147
111
148
-
let do_deprecated_msgs ~env err_ppf cl ei =
149
-
let cmd_info = Cmdliner_def.Eval.cmd ei in
112
+
let do_deprecated_msgs ~env err_ppf cl eval =
113
+
let cmd_info = Cmdliner_def.Eval.cmd eval in
150
114
let deprecated = Cmdliner_cline.deprecated ~env cl in
151
115
match Cmdliner_def.Cmd_info.deprecated cmd_info, deprecated with
152
116
| None, [] -> ()
···
155
119
let pp_sep ppf () =
156
120
if Option.is_some depr_cmd && deprs <> [] then Fmt.cut ppf ();
157
121
in
158
-
let subst = Cmdliner_def.Eval.doclang_subst ei in
122
+
let subst = Cmdliner_def.Eval.doclang_subst eval in
159
123
let pp_cmd_msg ppf cmd =
160
124
match
161
125
Cmdliner_def.Cmd_info.styled_deprecated ~subst ~errs:err_ppf cmd
···
168
132
in
169
133
let pp_deprs = Fmt.list (Cmdliner_cline.pp_deprecated ~subst) in
170
134
Fmt.pf err_ppf "@[%a @[<v>%a%a%a@]@]@."
171
-
Cmdliner_msg.pp_exec_msg ei pp_cmd_msg cmd_info pp_sep () pp_deprs deprs
135
+
Cmdliner_msg.pp_exec_msg eval pp_cmd_msg cmd_info
136
+
pp_sep () pp_deprs deprs
172
137
173
138
let find_cmd_and_parser ~legacy_prefixes ~for_completion args cmd =
174
139
(* This finds the command to use if it's a group and [for_completion]
···
243
208
let ancestors, cmd, args, parser =
244
209
find_cmd_and_parser ~legacy_prefixes ~for_completion args cmd
245
210
in
246
-
let help, version, ei =
247
-
let cmd_info = Cmdliner_cmd.get_info cmd in
248
-
let ei = Cmdliner_def.Eval.make ~cmd:cmd_info ~ancestors ~env ~err_ppf in
249
-
add_stdopts ei
211
+
let help, version, eval =
212
+
let subcmds = Cmdliner_cmd.get_children_infos cmd in
213
+
let cmd = Cmdliner_cmd.get_info cmd in
214
+
let eval = Cmdliner_def.Eval.make ~ancestors ~cmd ~subcmds ~env ~err_ppf in
215
+
add_stdopts eval
250
216
in
251
-
let cmd_args_info = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd ei) in
252
217
let cline =
253
-
Cmdliner_cline.create ~legacy_prefixes ~for_completion cmd_args_info args
218
+
let args_info = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd eval) in
219
+
Cmdliner_cline.create ~legacy_prefixes ~for_completion args_info args
254
220
in
255
221
let res = match parser with
256
222
| Error (`Parse (try_stdopts, msg)) ->
257
223
(* Command lookup error, we may still prioritize stdargs *)
258
224
begin match cline with
259
-
| `Complete comp -> Error (`Complete (ei, cmd_args_info, cmd, comp))
225
+
| `Complete comp -> Error (`Complete comp)
260
226
| `Error (_, cl) | `Ok cl ->
261
227
let stdopts =
262
-
if try_stdopts then try_eval_stdopts ~catch ei cl help version else
263
-
None
228
+
if try_stdopts
229
+
then try_eval_stdopts ~catch eval cl help version else None
264
230
in
265
231
begin match stdopts with
266
232
| None -> Error (`Error (true, msg))
···
271
237
begin match cline with
272
238
| `Complete comp ->
273
239
let comp = Cmdliner_def.Complete.add_subcmds comp in
274
-
Error (`Complete (ei, cmd_args_info, cmd, comp))
240
+
Error (`Complete comp)
275
241
| `Ok _ | `Error _ -> assert false
276
242
end
277
243
| Ok parser ->
278
244
begin match cline with
279
-
| `Complete comp -> Error (`Complete (ei, cmd_args_info, cmd, comp))
245
+
| `Complete comp -> Error (`Complete comp)
280
246
| `Error (e, cl) ->
281
-
begin match try_eval_stdopts ~catch ei cl help version with
247
+
begin match try_eval_stdopts ~catch eval cl help version with
282
248
| Some e -> e
283
249
| None -> Error (`Error (true, e))
284
250
end
285
251
| `Ok cl ->
286
-
match try_eval_stdopts ~catch ei cl help version with
252
+
match try_eval_stdopts ~catch eval cl help version with
287
253
| Some e -> e
288
254
| None ->
289
-
do_deprecated_msgs ~env err_ppf cl ei;
290
-
(run_parser ~catch ei cl parser :> 'a eval_result)
255
+
do_deprecated_msgs ~env err_ppf cl eval;
256
+
(run_parser ~catch eval cl parser :> 'a eval_result)
291
257
end
292
258
in
293
-
do_result ~env help_ppf err_ppf ei res
259
+
do_result ~env help_ppf err_ppf eval res
294
260
295
261
let eval_peek_opts
296
262
?(version_opt = false) ?(env = Sys.getenv_opt) ?(argv = Sys.argv) t
···
304
270
let cmd_info = Cmdliner_def.Cmd_info.make ?version "dummy" in
305
271
Cmdliner_def.Cmd_info.add_args cmd_info args, parser
306
272
in
307
-
let help, version, ei =
273
+
let help, version, eval =
308
274
let err_ppf = Format.make_formatter (fun _ _ _ -> ()) (fun () -> ()) in
309
-
let ancestors = [] in
310
-
let ei = Cmdliner_def.Eval.make ~cmd:cmd_info ~ancestors ~env ~err_ppf in
311
-
add_stdopts ei
275
+
let ancestors = [] and cmd = cmd_info and subcmds = [] in
276
+
let eval = Cmdliner_def.Eval.make ~ancestors ~cmd ~subcmds ~env ~err_ppf in
277
+
add_stdopts eval
312
278
in
313
-
let cmd_arg_infos = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd ei) in
314
279
let cline =
280
+
let arg_infos = Cmdliner_def.Cmd_info.args (Cmdliner_def.Eval.cmd eval) in
315
281
Cmdliner_cline.create
316
-
~peek_opts:true ~legacy_prefixes ~for_completion cmd_arg_infos args
282
+
~peek_opts:true ~legacy_prefixes ~for_completion arg_infos args
317
283
in
318
284
let v, ret = match cline with
319
-
| `Complete comp ->
320
-
let cmd = Cmdliner_cmd.make cmd_info t in
321
-
None, (Error (`Complete (ei, cmd_arg_infos, cmd, comp)))
285
+
| `Complete comp -> None, (Error (`Complete comp))
322
286
| `Error (e, cl) ->
323
-
begin match try_eval_stdopts ~catch:true ei cl help version with
287
+
begin match try_eval_stdopts ~catch:true eval cl help version with
324
288
| Some e -> None, e
325
289
| None -> None, Error (`Error (true, e))
326
290
end
327
291
| `Ok cl ->
328
-
let ret = run_parser ~catch:true ei cl parser in
292
+
let ret = run_parser ~catch:true eval cl parser in
329
293
let v = match ret with Ok v -> Some v | Error _ -> None in
330
-
begin match try_eval_stdopts ~catch:true ei cl help version with
294
+
begin match try_eval_stdopts ~catch:true eval cl help version with
331
295
| Some e -> v, e
332
296
| None -> v, (ret :> 'a eval_result)
333
297
end
+106
vendor/opam/cmdliner/test/test_completion.ml
+106
vendor/opam/cmdliner/test/test_completion.ml
···
23
23
complete ["--__complete="] @@ __POS_OF__
24
24
"1\n\
25
25
group\n\
26
+
Options\n\
27
+
item\n\
28
+
--version\n\
29
+
Show version information.\n\
30
+
item-end\n\
31
+
item\n\
32
+
--help\n\
33
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
34
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
35
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
36
+
item-end\n\
37
+
group\n\
26
38
Subcommands\n\
27
39
item\n\
28
40
birds\n\
···
60
72
--can-fly\n\
61
73
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
62
74
item-end\n\
75
+
item\n\
76
+
--version\n\
77
+
Show version information.\n\
78
+
item-end\n\
79
+
item\n\
80
+
--help\n\
81
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
82
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
83
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
84
+
item-end\n\
63
85
group\n\
64
86
Subcommands\n\
65
87
item\n\
···
81
103
item\n\
82
104
--speed\n\
83
105
Movement \u{001B}[04mSPEED\u{001B}[m in m/s\n\
106
+
item-end\n\
107
+
item\n\
108
+
--version\n\
109
+
Show version information.\n\
110
+
item-end\n\
111
+
item\n\
112
+
--help\n\
113
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
114
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
115
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
84
116
item-end\n";
85
117
complete ["birds"; "fly"; "--"; "--__complete="] @@ __POS_OF__
86
118
"1\n";
···
104
136
--can-fly\n\
105
137
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
106
138
item-end\n\
139
+
item\n\
140
+
--version\n\
141
+
Show version information.\n\
142
+
item-end\n\
143
+
item\n\
144
+
--help\n\
145
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
146
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
147
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
148
+
item-end\n\
107
149
group\n\
108
150
Subcommands\n";
109
151
complete ["birds"; "--__complete=--"] @@ __POS_OF__
···
117
159
item\n\
118
160
--can-fly\n\
119
161
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
162
+
item-end\n\
163
+
item\n\
164
+
--version\n\
165
+
Show version information.\n\
166
+
item-end\n\
167
+
item\n\
168
+
--help\n\
169
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
170
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
171
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
120
172
item-end\n";
121
173
()
122
174
···
163
215
item\n\
164
216
--can-fly\n\
165
217
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
218
+
item-end\n\
219
+
item\n\
220
+
--version\n\
221
+
Show version information.\n\
222
+
item-end\n\
223
+
item\n\
224
+
--help\n\
225
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
226
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
227
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
166
228
item-end\n";
167
229
complete ["birds"; "--can-fly"; "true"; "--__complete="] @@ __POS_OF__
168
230
"1\n\
···
179
241
item\n\
180
242
--can-fly\n\
181
243
\u{001B}[04mBOOL\u{001B}[m indicates if the entity can fly.\n\
244
+
item-end\n\
245
+
item\n\
246
+
--version\n\
247
+
Show version information.\n\
248
+
item-end\n\
249
+
item\n\
250
+
--help\n\
251
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
252
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
253
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
182
254
item-end\n";
183
255
()
184
256
···
221
293
item\n\
222
294
--kind\n\
223
295
\u{001B}[04mENUM\u{001B}[m restricts the animal kind. Must be either \u{001B}[01mbird\u{001B}[m or \u{001B}[01mfish\u{001B}[m\n\
296
+
item-end\n\
297
+
item\n\
298
+
--version\n\
299
+
Show version information.\n\
300
+
item-end\n\
301
+
item\n\
302
+
--help\n\
303
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
304
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
305
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
224
306
item-end\n";
225
307
complete ["lookup"; "-kfish"; "--__complete=s"] @@ __POS_OF__
226
308
"1\n\
···
279
361
item\n\
280
362
--verbose\n\
281
363
\n\
364
+
item-end\n\
365
+
item\n\
366
+
--help\n\
367
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
368
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
369
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
282
370
item-end\n";
283
371
complete ["--__complete=g"] @@ __POS_OF__
284
372
"1\n\
···
296
384
item\n\
297
385
--verbose\n\
298
386
\n\
387
+
item-end\n\
388
+
item\n\
389
+
--help\n\
390
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
391
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
392
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
299
393
item-end\n";
300
394
complete ["--"; "git"; "--__complete="] @@ __POS_OF__
301
395
"1\n\
···
323
417
item\n\
324
418
--verbose\n\
325
419
\n\
420
+
item-end\n\
421
+
item\n\
422
+
--help\n\
423
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
424
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
425
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
326
426
item-end\n";
327
427
(* The following two do not restart because -- is missing *)
328
428
complete ["--__complete=gi"] @@ __POS_OF__
···
334
434
item\n\
335
435
--verbose\n\
336
436
\n\
437
+
item-end\n\
438
+
item\n\
439
+
--help\n\
440
+
Show this help in format \u{001B}[04mFMT\u{001B}[m. The value \u{001B}[04mFMT\u{001B}[m must be one of \u{001B}[01mauto\u{001B}[m, \u{001B}[01mpager\u{001B}[m, \u{001B}[01mgroff\u{001B}[m\n\
441
+
or \u{001B}[01mplain\u{001B}[m. With \u{001B}[01mauto\u{001B}[m, the format is \u{001B}[01mpager\u{001B}[m or \u{001B}[01mplain\u{001B}[m whenever the \u{001B}[01mTERM\u{001B}[m env var\n\
442
+
is \u{001B}[01mdumb\u{001B}[m or undefined.\n\
337
443
item-end\n";
338
444
(* These must restart *)
339
445
complete ["--"; "--__complete=gi"] @@ __POS_OF__