| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Complete::Getopt::Long; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY |
|
4
|
|
|
|
|
|
|
our $DATE = '2020-09-09'; # DATE |
|
5
|
|
|
|
|
|
|
our $DIST = 'Complete-Getopt-Long'; # DIST |
|
6
|
|
|
|
|
|
|
our $VERSION = '0.480'; # VERSION |
|
7
|
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
9507
|
use 5.010001; |
|
|
1
|
|
|
|
|
4
|
|
|
9
|
1
|
|
|
1
|
|
5
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
21
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
23
|
|
|
11
|
1
|
|
|
1
|
|
6
|
use Log::ger; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
4
|
|
|
12
|
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
require Exporter; |
|
14
|
|
|
|
|
|
|
our @ISA = qw(Exporter); |
|
15
|
|
|
|
|
|
|
our @EXPORT_OK = qw( |
|
16
|
|
|
|
|
|
|
complete_cli_arg |
|
17
|
|
|
|
|
|
|
); |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
our %SPEC; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
our $COMPLETE_GETOPT_LONG_TRACE=$ENV{COMPLETE_GETOPT_LONG_TRACE} // 0; |
|
22
|
|
|
|
|
|
|
our $COMPLETE_GETOPT_LONG_DEFAULT_ENV = $ENV{COMPLETE_GETOPT_LONG_DEFAULT_ENV} // 1; |
|
23
|
|
|
|
|
|
|
our $COMPLETE_GETOPT_LONG_DEFAULT_FILE = $ENV{COMPLETE_GETOPT_LONG_DEFAULT_FILE} // 1; |
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub _default_completion { |
|
26
|
1
|
|
|
1
|
|
725
|
require Complete::Env; |
|
27
|
1
|
|
|
|
|
1554
|
require Complete::File; |
|
28
|
1
|
|
|
|
|
2195
|
require Complete::Util; |
|
29
|
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
9
|
my %args = @_; |
|
31
|
1
|
|
50
|
|
|
8
|
my $word = $args{word} // ''; |
|
32
|
|
|
|
|
|
|
|
|
33
|
1
|
|
|
|
|
2
|
my $fres; |
|
34
|
1
|
50
|
|
|
|
5
|
log_trace('[compgl] entering default completion routine') if $COMPLETE_GETOPT_LONG_TRACE; |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# try completing '$...' with shell variables |
|
37
|
1
|
0
|
33
|
|
|
5
|
if ($word =~ /\A\$/ && $COMPLETE_GETOPT_LONG_DEFAULT_ENV) { |
|
38
|
0
|
0
|
|
|
|
0
|
log_trace('[compgl] completing shell variable') if $COMPLETE_GETOPT_LONG_TRACE; |
|
39
|
|
|
|
|
|
|
{ |
|
40
|
0
|
|
|
|
|
0
|
my $compres = Complete::Env::complete_env( |
|
|
0
|
|
|
|
|
0
|
|
|
41
|
|
|
|
|
|
|
word=>$word); |
|
42
|
0
|
0
|
|
|
|
0
|
last unless @$compres; |
|
43
|
0
|
|
|
|
|
0
|
$fres = {words=>$compres, esc_mode=>'shellvar'}; |
|
44
|
0
|
|
|
|
|
0
|
goto RETURN_RES; |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
# if empty, fallback to searching file |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# try completing '~foo' with user dir (appending / if user's home exists) |
|
50
|
1
|
0
|
33
|
|
|
4
|
if ($word =~ m!\A~([^/]*)\z! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) { |
|
51
|
0
|
0
|
|
|
|
0
|
log_trace("[compgl] completing userdir, user=%s", $1) if $COMPLETE_GETOPT_LONG_TRACE; |
|
52
|
|
|
|
|
|
|
{ |
|
53
|
0
|
|
|
|
|
0
|
eval { require Unix::Passwd::File }; |
|
|
0
|
|
|
|
|
0
|
|
|
|
0
|
|
|
|
|
0
|
|
|
54
|
0
|
0
|
|
|
|
0
|
last if $@; |
|
55
|
0
|
|
|
|
|
0
|
my $res = Unix::Passwd::File::list_users(detail=>1); |
|
56
|
0
|
0
|
|
|
|
0
|
last unless $res->[0] == 200; |
|
57
|
|
|
|
|
|
|
my $compres = Complete::Util::complete_array_elem( |
|
58
|
0
|
0
|
|
|
|
0
|
array=>[map {"~" . $_->{user} . ((-d $_->{home}) ? "/":"")} |
|
59
|
0
|
|
|
|
|
0
|
@{ $res->[2] }], |
|
|
0
|
|
|
|
|
0
|
|
|
60
|
|
|
|
|
|
|
word=>$word, |
|
61
|
|
|
|
|
|
|
); |
|
62
|
0
|
0
|
|
|
|
0
|
last unless @$compres; |
|
63
|
0
|
|
|
|
|
0
|
$fres = {words=>$compres, path_sep=>'/'}; |
|
64
|
0
|
|
|
|
|
0
|
goto RETURN_RES; |
|
65
|
|
|
|
|
|
|
} |
|
66
|
|
|
|
|
|
|
# if empty, fallback to searching file |
|
67
|
|
|
|
|
|
|
} |
|
68
|
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# try completing '~/blah' or '~foo/blah' as if completing file, but do not |
|
70
|
|
|
|
|
|
|
# expand ~foo (this is supported by complete_file(), so we just give it off |
|
71
|
|
|
|
|
|
|
# to the routine) |
|
72
|
1
|
0
|
33
|
|
|
4
|
if ($word =~ m!\A(~[^/]*)/! && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) { |
|
73
|
0
|
0
|
|
|
|
0
|
log_trace("[compgl] completing file, path=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE; |
|
74
|
0
|
|
|
|
|
0
|
$fres = Complete::Util::hashify_answer( |
|
75
|
|
|
|
|
|
|
Complete::File::complete_file(word=>$word), |
|
76
|
|
|
|
|
|
|
{path_sep=>'/'} |
|
77
|
|
|
|
|
|
|
); |
|
78
|
0
|
|
|
|
|
0
|
goto RETURN_RES; |
|
79
|
|
|
|
|
|
|
} |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# try completing something that contains wildcard with glob. for |
|
82
|
|
|
|
|
|
|
# convenience, we add '*' at the end so that when user type [AB] it is |
|
83
|
|
|
|
|
|
|
# treated like [AB]*. |
|
84
|
1
|
|
|
|
|
582
|
require String::Wildcard::Bash; |
|
85
|
1
|
0
|
33
|
|
|
1232
|
if (String::Wildcard::Bash::contains_wildcard($word) && $COMPLETE_GETOPT_LONG_DEFAULT_FILE) { |
|
86
|
0
|
0
|
|
|
|
0
|
log_trace("[compgl] completing with wildcard glob, glob=<%s>", "$word*") if $COMPLETE_GETOPT_LONG_TRACE; |
|
87
|
|
|
|
|
|
|
{ |
|
88
|
0
|
|
|
|
|
0
|
my $compres = [glob("$word*")]; |
|
|
0
|
|
|
|
|
0
|
|
|
89
|
0
|
0
|
|
|
|
0
|
last unless @$compres; |
|
90
|
0
|
|
|
|
|
0
|
for (@$compres) { |
|
91
|
0
|
0
|
|
|
|
0
|
$_ .= "/" if (-d $_); |
|
92
|
|
|
|
|
|
|
} |
|
93
|
0
|
|
|
|
|
0
|
$fres = {words=>$compres, path_sep=>'/'}; |
|
94
|
0
|
|
|
|
|
0
|
goto RETURN_RES; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
# if empty, fallback to searching file |
|
97
|
|
|
|
|
|
|
} |
|
98
|
|
|
|
|
|
|
|
|
99
|
1
|
50
|
|
|
|
27
|
if ($COMPLETE_GETOPT_LONG_DEFAULT_FILE) { |
|
100
|
1
|
50
|
|
|
|
6
|
log_trace("[compgl] completing with file, file=<%s>", $word) if $COMPLETE_GETOPT_LONG_TRACE; |
|
101
|
1
|
|
|
|
|
5
|
$fres = Complete::Util::hashify_answer( |
|
102
|
|
|
|
|
|
|
Complete::File::complete_file(word=>$word), |
|
103
|
|
|
|
|
|
|
{path_sep=>'/'} |
|
104
|
|
|
|
|
|
|
); |
|
105
|
|
|
|
|
|
|
} |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
RETURN_RES: |
|
108
|
1
|
50
|
|
|
|
14840
|
log_trace("[compgl] leaving default completion routine, result=%s", $fres) if $COMPLETE_GETOPT_LONG_TRACE; |
|
109
|
1
|
|
|
|
|
6
|
$fres; |
|
110
|
|
|
|
|
|
|
} |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
# return the possible options. if there is only one candidate (unambiguous |
|
113
|
|
|
|
|
|
|
# expansion) then scalar will be returned. otherwise, an array of candidates |
|
114
|
|
|
|
|
|
|
# will be returned. |
|
115
|
|
|
|
|
|
|
sub _matching_opts { |
|
116
|
41
|
|
|
41
|
|
89
|
my ($opt, $opts) = @_; |
|
117
|
41
|
|
|
|
|
64
|
my %candidates; |
|
118
|
41
|
|
|
|
|
227
|
for (sort {length($a)<=>length($b)} keys %$opts) { |
|
|
1116
|
|
|
|
|
1575
|
|
|
119
|
269
|
100
|
|
|
|
516
|
next unless index($_, $opt) == 0; |
|
120
|
108
|
|
|
|
|
198
|
$candidates{$_} = $opts->{$_}; |
|
121
|
108
|
100
|
|
|
|
207
|
last if $opt eq $_; |
|
122
|
|
|
|
|
|
|
} |
|
123
|
41
|
|
|
|
|
111
|
\%candidates; |
|
124
|
|
|
|
|
|
|
} |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# mark an option (and all its aliases) as seen |
|
127
|
|
|
|
|
|
|
sub _mark_seen { |
|
128
|
48
|
|
|
48
|
|
104
|
my ($seen_opts, $opt, $opts) = @_; |
|
129
|
48
|
|
|
|
|
82
|
my $opthash = $opts->{$opt}; |
|
130
|
48
|
50
|
|
|
|
92
|
return unless $opthash; |
|
131
|
48
|
|
|
|
|
80
|
my $ospec = $opthash->{ospec}; |
|
132
|
48
|
|
|
|
|
160
|
for (keys %$opts) { |
|
133
|
632
|
|
|
|
|
843
|
my $v = $opts->{$_}; |
|
134
|
632
|
100
|
|
|
|
1252
|
$seen_opts->{$_}++ if $v->{ospec} eq $ospec; |
|
135
|
|
|
|
|
|
|
} |
|
136
|
|
|
|
|
|
|
} |
|
137
|
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
$SPEC{complete_cli_arg} = { |
|
139
|
|
|
|
|
|
|
v => 1.1, |
|
140
|
|
|
|
|
|
|
summary => 'Complete command-line argument using '. |
|
141
|
|
|
|
|
|
|
'Getopt::Long specification', |
|
142
|
|
|
|
|
|
|
description => <<'_', |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
This routine can complete option names, where the option names are retrieved |
|
145
|
|
|
|
|
|
|
from specification. If you provide completion routine in |
|
146
|
|
|
|
|
|
|
`completion`, you can also complete _option values_ and _arguments_. |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Note that this routine does not use (it does its own parsing) |
|
149
|
|
|
|
|
|
|
and currently is not affected by Getopt::Long's configuration. Its behavior |
|
150
|
|
|
|
|
|
|
mimics Getopt::Long under these configuration: `no_ignore_case`, `bundling` (or |
|
151
|
|
|
|
|
|
|
`no_bundling` if the `bundling` option is turned off). Which I think is the |
|
152
|
|
|
|
|
|
|
sensible default. This routine also does not currently support `auto_help` and |
|
153
|
|
|
|
|
|
|
`auto_version`, so you'll need to add those options specifically if you want to |
|
154
|
|
|
|
|
|
|
recognize `--help/-?` and `--version`, respectively. |
|
155
|
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
_ |
|
157
|
|
|
|
|
|
|
args => { |
|
158
|
|
|
|
|
|
|
getopt_spec => { |
|
159
|
|
|
|
|
|
|
summary => 'Getopt::Long specification', |
|
160
|
|
|
|
|
|
|
schema => 'array*', |
|
161
|
|
|
|
|
|
|
req => 1, |
|
162
|
|
|
|
|
|
|
}, |
|
163
|
|
|
|
|
|
|
completion => { |
|
164
|
|
|
|
|
|
|
summary => |
|
165
|
|
|
|
|
|
|
'Completion routine to complete option value/argument', |
|
166
|
|
|
|
|
|
|
schema => 'code*', |
|
167
|
|
|
|
|
|
|
description => <<'_', |
|
168
|
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
Completion code will receive a hash of arguments (`%args`) containing these |
|
170
|
|
|
|
|
|
|
keys: |
|
171
|
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
* `type` (str, what is being completed, either `optval`, or `arg`) |
|
173
|
|
|
|
|
|
|
* `word` (str, word to be completed) |
|
174
|
|
|
|
|
|
|
* `cword` (int, position of words in the words array, starts from 0) |
|
175
|
|
|
|
|
|
|
* `opt` (str, option name, e.g. `--str`; undef if we're completing argument) |
|
176
|
|
|
|
|
|
|
* `ospec` (str, Getopt::Long option spec, e.g. `str|S=s`; undef when completing |
|
177
|
|
|
|
|
|
|
argument) |
|
178
|
|
|
|
|
|
|
* `argpos` (int, argument position, zero-based; undef if type='optval') |
|
179
|
|
|
|
|
|
|
* `nth` (int, the number of times this option has seen before, starts from 0 |
|
180
|
|
|
|
|
|
|
that means this is the first time this option has been seen; undef when |
|
181
|
|
|
|
|
|
|
type='arg') |
|
182
|
|
|
|
|
|
|
* `seen_opts` (hash, all the options seen in `words`) |
|
183
|
|
|
|
|
|
|
* `parsed_opts` (hash, options parsed the standard/raw way) |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
as well as all keys from `extras` (but these won't override the above keys). |
|
186
|
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
and is expected to return a completion answer structure as described in |
|
188
|
|
|
|
|
|
|
`Complete` which is either a hash or an array. The simplest form of answer is |
|
189
|
|
|
|
|
|
|
just to return an array of strings. The various `complete_*` function like those |
|
190
|
|
|
|
|
|
|
in or the other `Complete::*` modules are suitable to use |
|
191
|
|
|
|
|
|
|
here. |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Completion routine can also return undef to express declination, in which case |
|
194
|
|
|
|
|
|
|
the default completion routine will then be consulted. The default routine |
|
195
|
|
|
|
|
|
|
completes from shell environment variables (`$FOO`), Unix usernames (`~foo`), |
|
196
|
|
|
|
|
|
|
and files/directories. |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Example: |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
use Complete::Unix qw(complete_user); |
|
201
|
|
|
|
|
|
|
use Complete::Util qw(complete_array_elem); |
|
202
|
|
|
|
|
|
|
complete_cli_arg( |
|
203
|
|
|
|
|
|
|
getopt_spec => [ |
|
204
|
|
|
|
|
|
|
'help|h' => sub{...}, |
|
205
|
|
|
|
|
|
|
'format=s' => \$format, |
|
206
|
|
|
|
|
|
|
'user=s' => \$user, |
|
207
|
|
|
|
|
|
|
], |
|
208
|
|
|
|
|
|
|
completion => sub { |
|
209
|
|
|
|
|
|
|
my %args = @_; |
|
210
|
|
|
|
|
|
|
my $word = $args{word}; |
|
211
|
|
|
|
|
|
|
my $ospec = $args{ospec}; |
|
212
|
|
|
|
|
|
|
if ($ospec && $ospec eq 'format=s') { |
|
213
|
|
|
|
|
|
|
complete_array_elem(array=>[qw/json text xml yaml/], word=>$word); |
|
214
|
|
|
|
|
|
|
} else { |
|
215
|
|
|
|
|
|
|
complete_user(word=>$word); |
|
216
|
|
|
|
|
|
|
} |
|
217
|
|
|
|
|
|
|
}, |
|
218
|
|
|
|
|
|
|
); |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
_ |
|
221
|
|
|
|
|
|
|
}, |
|
222
|
|
|
|
|
|
|
words => { |
|
223
|
|
|
|
|
|
|
summary => 'Command line arguments, like @ARGV', |
|
224
|
|
|
|
|
|
|
description => <<'_', |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
See function `parse_cmdline` in on how to produce this (if |
|
227
|
|
|
|
|
|
|
you're using bash). |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
_ |
|
230
|
|
|
|
|
|
|
schema => 'array*', |
|
231
|
|
|
|
|
|
|
req => 1, |
|
232
|
|
|
|
|
|
|
}, |
|
233
|
|
|
|
|
|
|
cword => { |
|
234
|
|
|
|
|
|
|
summary => |
|
235
|
|
|
|
|
|
|
"Index in words of the word we're trying to complete", |
|
236
|
|
|
|
|
|
|
description => <<'_', |
|
237
|
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
See function `parse_cmdline` in on how to produce this (if |
|
239
|
|
|
|
|
|
|
you're using bash). |
|
240
|
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
_ |
|
242
|
|
|
|
|
|
|
schema => 'int*', |
|
243
|
|
|
|
|
|
|
req => 1, |
|
244
|
|
|
|
|
|
|
}, |
|
245
|
|
|
|
|
|
|
extras => { |
|
246
|
|
|
|
|
|
|
summary => 'Add extra arguments to completion routine', |
|
247
|
|
|
|
|
|
|
schema => 'hash', |
|
248
|
|
|
|
|
|
|
description => <<'_', |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
The keys from this `extras` hash will be merged into the final `%args` passed to |
|
251
|
|
|
|
|
|
|
completion routines. Note that standard keys like `type`, `word`, and so on as |
|
252
|
|
|
|
|
|
|
described in the function description will not be overwritten by this. |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
_ |
|
255
|
|
|
|
|
|
|
}, |
|
256
|
|
|
|
|
|
|
bundling => { |
|
257
|
|
|
|
|
|
|
schema => 'bool*', |
|
258
|
|
|
|
|
|
|
default => 1, |
|
259
|
|
|
|
|
|
|
'summary.alt.bool.not' => 'Turn off bundling', |
|
260
|
|
|
|
|
|
|
description => <<'_', |
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
If you turn off bundling, completion of short-letter options won't support |
|
263
|
|
|
|
|
|
|
bundling (e.g. `-b` won't add more single-letter options), but single-dash |
|
264
|
|
|
|
|
|
|
multiletter options can be recognized. Currently only those specified with a |
|
265
|
|
|
|
|
|
|
single dash will be completed. For example if you have `-foo=s` in your option |
|
266
|
|
|
|
|
|
|
specification, `-f` can complete it. |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
This can be used to complete old-style programs, e.g. emacs which has options |
|
269
|
|
|
|
|
|
|
like `-nw`, `-nbc` etc (but also have double-dash options like |
|
270
|
|
|
|
|
|
|
`--no-window-system` or `--no-blinking-cursor`). |
|
271
|
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
_ |
|
273
|
|
|
|
|
|
|
}, |
|
274
|
|
|
|
|
|
|
}, |
|
275
|
|
|
|
|
|
|
result_naked => 1, |
|
276
|
|
|
|
|
|
|
result => { |
|
277
|
|
|
|
|
|
|
schema => ['any*' => of => ['hash*', 'array*']], |
|
278
|
|
|
|
|
|
|
description => <<'_', |
|
279
|
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
You can use `format_completion` function in module to format |
|
281
|
|
|
|
|
|
|
the result of this function for bash. |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
_ |
|
284
|
|
|
|
|
|
|
}, |
|
285
|
|
|
|
|
|
|
}; |
|
286
|
|
|
|
|
|
|
sub complete_cli_arg { |
|
287
|
35
|
|
|
35
|
1
|
112644
|
require Complete::Util; |
|
288
|
35
|
|
|
|
|
6583
|
require Getopt::Long::Util; |
|
289
|
|
|
|
|
|
|
|
|
290
|
35
|
|
|
|
|
1972
|
my %args = @_; |
|
291
|
|
|
|
|
|
|
|
|
292
|
35
|
|
|
|
|
70
|
my $fname = __PACKAGE__ . "::complete_cli_arg"; # XXX use __SUB__ |
|
293
|
35
|
|
|
|
|
56
|
my $fres; |
|
294
|
|
|
|
|
|
|
|
|
295
|
35
|
50
|
|
|
|
96
|
$args{words} or die "Please specify words"; |
|
296
|
35
|
|
|
|
|
54
|
my @words = @{ $args{words} }; |
|
|
35
|
|
|
|
|
88
|
|
|
297
|
35
|
50
|
|
|
|
97
|
defined(my $cword = $args{cword}) or die "Please specify cword"; |
|
298
|
35
|
50
|
|
|
|
91
|
my $gospec = $args{getopt_spec} or die "Please specify getopt_spec"; |
|
299
|
35
|
|
|
|
|
48
|
my $comp = $args{completion}; |
|
300
|
35
|
|
100
|
|
|
150
|
my $extras = $args{extras} // {}; |
|
301
|
35
|
|
100
|
|
|
117
|
my $bundling = $args{bundling} // 1; |
|
302
|
35
|
|
|
|
|
58
|
my %parsed_opts; |
|
303
|
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# backward compatibility: gospec was expected to be a hash, now an array |
|
305
|
35
|
100
|
|
|
|
90
|
if (ref $gospec eq 'HASH') { |
|
306
|
1
|
|
|
|
|
2
|
my $ary_gospec = []; |
|
307
|
1
|
|
|
|
|
4
|
for (keys %$gospec) { |
|
308
|
2
|
|
|
|
|
4
|
push @$ary_gospec, $_; |
|
309
|
2
|
50
|
|
|
|
9
|
push @$ary_gospec, $gospec->{$_} if ref $gospec->{$_}; |
|
310
|
|
|
|
|
|
|
} |
|
311
|
1
|
|
|
|
|
2
|
$gospec = $ary_gospec; |
|
312
|
|
|
|
|
|
|
} |
|
313
|
|
|
|
|
|
|
|
|
314
|
35
|
50
|
|
|
|
80
|
log_trace('[compgl] entering %s(), words=%s, cword=%d, word=<%s>', |
|
315
|
|
|
|
|
|
|
$fname, \@words, $cword, $words[$cword]) if $COMPLETE_GETOPT_LONG_TRACE; |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# strip hash storage from getopt_spec |
|
318
|
35
|
100
|
|
|
|
83
|
shift @$gospec if ref $gospec->[0] eq 'HASH'; |
|
319
|
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# parse all options first & supply default completion routine |
|
321
|
35
|
|
|
|
|
47
|
my %opts; |
|
322
|
35
|
|
|
|
|
50
|
my $i = -1; |
|
323
|
35
|
|
|
|
|
53
|
while (++$i <= $#{$gospec}) { |
|
|
248
|
|
|
|
|
564
|
|
|
324
|
213
|
|
|
|
|
426
|
my $ospec = $gospec->[$i]; |
|
325
|
213
|
100
|
100
|
|
|
311
|
my $dest = $i+1 <= $#{$gospec} && ref $gospec->[$i+1] ? |
|
326
|
|
|
|
|
|
|
splice(@$gospec, $i+1, 1) : undef; |
|
327
|
|
|
|
|
|
|
|
|
328
|
213
|
50
|
|
|
|
514
|
my $res = Getopt::Long::Util::parse_getopt_long_opt_spec($ospec) |
|
329
|
|
|
|
|
|
|
or die "Can't parse option spec '$ospec'"; |
|
330
|
213
|
50
|
|
|
|
10313
|
next if $res->{is_arg}; |
|
331
|
213
|
100
|
66
|
|
|
915
|
$res->{min_vals} //= $res->{type} ? 1 : 0; |
|
332
|
213
|
100
|
100
|
|
|
1095
|
$res->{max_vals} //= $res->{type} || $res->{opttype} ? 1:0; |
|
|
|
|
66
|
|
|
|
|
|
333
|
213
|
|
|
|
|
301
|
for my $o0 (@{ $res->{opts} }) { |
|
|
213
|
|
|
|
|
459
|
|
|
334
|
363
|
100
|
100
|
|
|
1143
|
my @ary = $res->{is_neg} && length($o0) > 1 ? |
|
335
|
|
|
|
|
|
|
([$o0, 0], ["no$o0",1], ["no-$o0",1]) : ([$o0,0]); |
|
336
|
363
|
|
|
|
|
628
|
for my $elem (@ary) { |
|
337
|
411
|
|
|
|
|
621
|
my $o = $elem->[0]; |
|
338
|
411
|
|
|
|
|
586
|
my $is_neg = $elem->[1]; |
|
339
|
|
|
|
|
|
|
my $k = length($o)==1 || |
|
340
|
411
|
100
|
100
|
|
|
1448
|
(!$bundling && $res->{dash_prefix} eq '-') ? |
|
341
|
|
|
|
|
|
|
"-$o" : "--$o"; |
|
342
|
411
|
|
|
|
|
1987
|
$opts{$k} = { |
|
343
|
|
|
|
|
|
|
name => $k, |
|
344
|
|
|
|
|
|
|
ospec => $ospec, |
|
345
|
|
|
|
|
|
|
dest => $dest, |
|
346
|
|
|
|
|
|
|
parsed => $res, |
|
347
|
|
|
|
|
|
|
is_neg => $is_neg, |
|
348
|
|
|
|
|
|
|
}; |
|
349
|
|
|
|
|
|
|
} |
|
350
|
|
|
|
|
|
|
} |
|
351
|
|
|
|
|
|
|
} |
|
352
|
35
|
|
|
|
|
460
|
my @optnames = sort keys %opts; |
|
353
|
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
my $code_get_summary = sub { |
|
355
|
|
|
|
|
|
|
# currently we only extract summaries from Rinci metadata and |
|
356
|
|
|
|
|
|
|
# Perinci::CmdLine object |
|
357
|
169
|
50
|
|
169
|
|
290
|
return unless $extras; |
|
358
|
169
|
|
|
|
|
240
|
my $ggls_res = $extras->{ggls_res}; |
|
359
|
169
|
50
|
|
|
|
480
|
return unless $ggls_res; |
|
360
|
0
|
|
|
|
|
0
|
my $cmdline = $extras->{cmdline}; |
|
361
|
0
|
0
|
|
|
|
0
|
return unless $cmdline; |
|
362
|
0
|
|
|
|
|
0
|
my $r = $extras->{r}; |
|
363
|
0
|
0
|
|
|
|
0
|
return unless $r; |
|
364
|
|
|
|
|
|
|
|
|
365
|
0
|
|
|
|
|
0
|
my $optname = shift; |
|
366
|
0
|
|
|
|
|
0
|
my $ospec = $opts{$optname}{ospec}; |
|
367
|
0
|
0
|
|
|
|
0
|
return unless $ospec; # shouldn't happen |
|
368
|
0
|
|
|
|
|
0
|
my $specmeta = $ggls_res->[3]{'func.specmeta'}; |
|
369
|
0
|
|
|
|
|
0
|
my $ospecmeta = $specmeta->{$ospec}; |
|
370
|
|
|
|
|
|
|
|
|
371
|
0
|
0
|
|
|
|
0
|
return $ospecmeta->{summary} if defined $ospecmeta->{summary}; |
|
372
|
|
|
|
|
|
|
|
|
373
|
0
|
0
|
|
|
|
0
|
if ($ospecmeta->{is_alias}) { |
|
374
|
0
|
|
|
|
|
0
|
my $real_ospecmeta = $specmeta->{ $ospecmeta->{alias_for} }; |
|
375
|
0
|
|
|
|
|
0
|
my $real_opt = $real_ospecmeta->{parsed}{opts}[0]; |
|
376
|
0
|
0
|
|
|
|
0
|
$real_opt = length($real_opt) == 1 ? "-$real_opt" : "--$real_opt"; |
|
377
|
0
|
|
|
|
|
0
|
return "Alias for $real_opt"; |
|
378
|
|
|
|
|
|
|
} |
|
379
|
|
|
|
|
|
|
|
|
380
|
0
|
0
|
|
|
|
0
|
if (defined(my $coptname = $ospecmeta->{common_opt})) { |
|
381
|
|
|
|
|
|
|
# it's a common Perinci::CmdLine option |
|
382
|
0
|
|
|
|
|
0
|
my $coptspec = $cmdline->{common_opts}{$coptname}; |
|
383
|
|
|
|
|
|
|
#use DD; dd $coptspec; |
|
384
|
0
|
0
|
|
|
|
0
|
return unless $coptspec; |
|
385
|
|
|
|
|
|
|
|
|
386
|
0
|
|
|
|
|
0
|
my $summ; |
|
387
|
|
|
|
|
|
|
# XXX translate |
|
388
|
0
|
0
|
|
|
|
0
|
if ($opts{$optname}{is_neg}) { |
|
389
|
0
|
|
|
|
|
0
|
$summ = $coptspec->{"summary.alt.bool.not"}; |
|
390
|
0
|
0
|
|
|
|
0
|
return $summ if defined $summ; |
|
391
|
0
|
|
|
|
|
0
|
my $pos_opt = $ospecmeta->{pos_opts}[0]; |
|
392
|
0
|
0
|
|
|
|
0
|
$pos_opt = length($pos_opt) == 1 ? "-$pos_opt" : "--$pos_opt"; |
|
393
|
0
|
|
|
|
|
0
|
return "The opposite of $pos_opt"; |
|
394
|
|
|
|
|
|
|
} else { |
|
395
|
0
|
|
|
|
|
0
|
$summ = $coptspec->{"summary.alt.bool.yes"}; |
|
396
|
0
|
0
|
|
|
|
0
|
return $summ if defined $summ; |
|
397
|
0
|
|
|
|
|
0
|
$summ = $coptspec->{"summary"}; |
|
398
|
0
|
0
|
|
|
|
0
|
return $summ if defined $summ; |
|
399
|
|
|
|
|
|
|
} |
|
400
|
|
|
|
|
|
|
} else { |
|
401
|
|
|
|
|
|
|
# it's option from function argument |
|
402
|
0
|
|
|
|
|
0
|
my $arg = $ospecmeta->{arg}; |
|
403
|
0
|
|
|
|
|
0
|
my $argspec = $extras->{r}{meta}{args}{$arg}; |
|
404
|
|
|
|
|
|
|
#use DD; dd $argspec; |
|
405
|
|
|
|
|
|
|
|
|
406
|
0
|
|
|
|
|
0
|
my $summ; |
|
407
|
|
|
|
|
|
|
# XXX translate |
|
408
|
|
|
|
|
|
|
#use DD; dd {optname=>$optname, ospecmeta=>$ospecmeta}; |
|
409
|
0
|
0
|
|
|
|
0
|
if ($ospecmeta->{is_neg}) { |
|
410
|
0
|
|
|
|
|
0
|
$summ = $argspec->{"summary.alt.bool.not"}; |
|
411
|
0
|
0
|
|
|
|
0
|
return $summ if defined $summ; |
|
412
|
0
|
|
|
|
|
0
|
my $pos_opt = $ospecmeta->{pos_opts}[0]; |
|
413
|
0
|
0
|
|
|
|
0
|
$pos_opt = length($pos_opt) == 1 ? "-$pos_opt" : "--$pos_opt"; |
|
414
|
0
|
|
|
|
|
0
|
return "The opposite of $pos_opt"; |
|
415
|
|
|
|
|
|
|
} else { |
|
416
|
0
|
|
|
|
|
0
|
$summ = $argspec->{"summary.alt.bool.yes"}; |
|
417
|
0
|
0
|
|
|
|
0
|
return $summ if defined $summ; |
|
418
|
0
|
|
|
|
|
0
|
$summ = $argspec->{"summary"}; |
|
419
|
0
|
0
|
|
|
|
0
|
return $summ if defined $summ; |
|
420
|
|
|
|
|
|
|
} |
|
421
|
|
|
|
|
|
|
} |
|
422
|
|
|
|
|
|
|
|
|
423
|
0
|
|
|
|
|
0
|
return; |
|
424
|
35
|
|
|
|
|
317
|
}; |
|
425
|
|
|
|
|
|
|
|
|
426
|
35
|
|
|
|
|
75
|
my %seen_opts; |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
# for each word (each element in this array), we try to find out whether |
|
429
|
|
|
|
|
|
|
# it's supposed to complete option name, or option value, or argument, or |
|
430
|
|
|
|
|
|
|
# separator (or more than one of them). plus some other information. |
|
431
|
|
|
|
|
|
|
# |
|
432
|
|
|
|
|
|
|
# each element is a hash. if hash contains 'optname' key then it expects an |
|
433
|
|
|
|
|
|
|
# option name. if hash contains 'optval' key then it expects an option |
|
434
|
|
|
|
|
|
|
# value. |
|
435
|
|
|
|
|
|
|
# |
|
436
|
|
|
|
|
|
|
# 'short_only' means that the word is not to be completed with long option |
|
437
|
|
|
|
|
|
|
# name, only (bundle of) one-letter option names. |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
my @expects; |
|
440
|
|
|
|
|
|
|
|
|
441
|
35
|
|
|
|
|
57
|
$i = -1; |
|
442
|
35
|
|
|
|
|
50
|
my $argpos = 0; |
|
443
|
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
WORD: |
|
445
|
35
|
|
|
|
|
48
|
while (1) { |
|
446
|
80
|
100
|
|
|
|
212
|
last WORD if ++$i >= @words; |
|
447
|
48
|
|
|
|
|
93
|
my $word = $words[$i]; |
|
448
|
|
|
|
|
|
|
#say "D:i=$i, word=$word, ~~\@words=",~~@words; |
|
449
|
|
|
|
|
|
|
|
|
450
|
48
|
50
|
66
|
|
|
112
|
if ($word eq '--' && $i != $cword) { |
|
451
|
0
|
|
|
|
|
0
|
$expects[$i] = {separator=>1}; |
|
452
|
0
|
|
|
|
|
0
|
while (1) { |
|
453
|
0
|
|
|
|
|
0
|
$i++; |
|
454
|
0
|
0
|
|
|
|
0
|
last WORD if $i >= @words; |
|
455
|
0
|
|
|
|
|
0
|
$expects[$i] = {arg=>1, argpos=>$argpos++}; |
|
456
|
|
|
|
|
|
|
} |
|
457
|
|
|
|
|
|
|
} |
|
458
|
|
|
|
|
|
|
|
|
459
|
48
|
100
|
|
|
|
217
|
if ($word =~ /\A-/) { |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
# check if it is a (bundle) of short option names |
|
462
|
|
|
|
|
|
|
SHORT_OPTS: |
|
463
|
|
|
|
|
|
|
{ |
|
464
|
|
|
|
|
|
|
# it's not a known short option |
|
465
|
41
|
100
|
|
|
|
65
|
last unless $opts{"-".substr($word,1,1)}; |
|
|
41
|
|
|
|
|
148
|
|
|
466
|
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# not a bundle, regard as only a single short option name |
|
468
|
12
|
100
|
|
|
|
51
|
last unless $bundling; |
|
469
|
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
# expand bundle |
|
471
|
11
|
|
|
|
|
18
|
my $j = $i; |
|
472
|
11
|
|
|
|
|
22
|
my $rest = substr($word, 1); |
|
473
|
11
|
|
|
|
|
17
|
my @inswords; |
|
474
|
|
|
|
|
|
|
my $encounter_equal_sign; |
|
475
|
|
|
|
|
|
|
EXPAND: |
|
476
|
11
|
|
|
|
|
21
|
while (1) { |
|
477
|
27
|
100
|
|
|
|
94
|
$rest =~ s/(.)// or last; |
|
478
|
20
|
|
|
|
|
53
|
my $opt = "-$1"; |
|
479
|
20
|
|
|
|
|
37
|
my $opthash = $opts{$opt}; |
|
480
|
20
|
50
|
|
|
|
38
|
unless ($opthash) { |
|
481
|
|
|
|
|
|
|
# we encounter an unknown option, doubt that this is a |
|
482
|
|
|
|
|
|
|
# bundle of short option name, it could be someone |
|
483
|
|
|
|
|
|
|
# typing --long as -long |
|
484
|
0
|
|
|
|
|
0
|
@inswords = (); |
|
485
|
0
|
|
|
|
|
0
|
$expects[$i]{short_only} = 0; |
|
486
|
0
|
|
|
|
|
0
|
$rest = $word; |
|
487
|
0
|
|
|
|
|
0
|
last EXPAND; |
|
488
|
|
|
|
|
|
|
} |
|
489
|
20
|
100
|
|
|
|
46
|
if ($opthash->{parsed}{max_vals}) { |
|
490
|
|
|
|
|
|
|
# stop after an option that requires value |
|
491
|
4
|
|
|
|
|
12
|
_mark_seen(\%seen_opts, $opt, \%opts); |
|
492
|
|
|
|
|
|
|
|
|
493
|
4
|
100
|
|
|
|
23
|
if ($i == $j) { |
|
494
|
2
|
|
|
|
|
6
|
$words[$i] = $opt; |
|
495
|
|
|
|
|
|
|
} else { |
|
496
|
2
|
|
|
|
|
5
|
push @inswords, $opt; |
|
497
|
2
|
|
|
|
|
4
|
$j++; |
|
498
|
|
|
|
|
|
|
} |
|
499
|
|
|
|
|
|
|
|
|
500
|
4
|
|
|
|
|
5
|
my $expand; |
|
501
|
4
|
100
|
|
|
|
11
|
if (length $rest) { |
|
502
|
2
|
|
|
|
|
3
|
$expand++; |
|
503
|
|
|
|
|
|
|
# complete -Sfoo^ is completing option value |
|
504
|
2
|
100
|
|
|
|
10
|
$expects[$j > $i ? $j+1 : $j+2]{do_complete_optname} = 0; |
|
505
|
2
|
100
|
|
|
|
8
|
$expects[$j > $i ? $j+1 : $j+2]{optval} = $opt; |
|
506
|
|
|
|
|
|
|
} else { |
|
507
|
|
|
|
|
|
|
# complete -S^ as [-S] to add space |
|
508
|
2
|
100
|
|
|
|
11
|
$expects[$j > $i ? $j-1 : $j]{optname} = $opt; |
|
509
|
|
|
|
|
|
|
$expects[$j > $i ? $j-1 : $j]{comp_result} = [ |
|
510
|
2
|
100
|
|
|
|
23
|
substr($word, 0, length($word)-length($rest))]; |
|
511
|
|
|
|
|
|
|
} |
|
512
|
|
|
|
|
|
|
|
|
513
|
4
|
50
|
|
|
|
14
|
if ($rest =~ s/\A=//) { |
|
514
|
0
|
|
|
|
|
0
|
$encounter_equal_sign++; |
|
515
|
|
|
|
|
|
|
} |
|
516
|
|
|
|
|
|
|
|
|
517
|
4
|
100
|
|
|
|
10
|
if ($expand) { |
|
518
|
2
|
|
|
|
|
7
|
push @inswords, "=", $rest; |
|
519
|
2
|
|
|
|
|
4
|
$j+=2; |
|
520
|
|
|
|
|
|
|
} |
|
521
|
4
|
|
|
|
|
19
|
last EXPAND; |
|
522
|
|
|
|
|
|
|
} |
|
523
|
|
|
|
|
|
|
# continue splitting |
|
524
|
16
|
|
|
|
|
51
|
_mark_seen(\%seen_opts, $opt, \%opts); |
|
525
|
16
|
100
|
|
|
|
44
|
if ($i == $j) { |
|
526
|
9
|
|
|
|
|
19
|
$words[$i] = $opt; |
|
527
|
|
|
|
|
|
|
} else { |
|
528
|
7
|
|
|
|
|
16
|
push @inswords, $opt; |
|
529
|
|
|
|
|
|
|
} |
|
530
|
16
|
|
|
|
|
29
|
$j++; |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
#use DD; print "D:inswords: "; dd \@inswords; |
|
534
|
|
|
|
|
|
|
|
|
535
|
11
|
50
|
|
|
|
33
|
my $prefix = $encounter_equal_sign ? '' : |
|
536
|
|
|
|
|
|
|
substr($word, 0, length($word)-length($rest)); |
|
537
|
11
|
|
|
|
|
27
|
splice @words, $i+1, 0, @inswords; |
|
538
|
11
|
|
|
|
|
34
|
for (0..@inswords) { |
|
539
|
24
|
|
|
|
|
64
|
$expects[$i+$_]{prefix} = $prefix; |
|
540
|
24
|
|
|
|
|
54
|
$expects[$i+$_]{word} = $rest; |
|
541
|
|
|
|
|
|
|
} |
|
542
|
11
|
|
|
|
|
20
|
$cword += @inswords; |
|
543
|
11
|
|
|
|
|
17
|
$i += @inswords; |
|
544
|
11
|
|
|
|
|
21
|
$word = $words[$i]; |
|
545
|
11
|
|
50
|
|
|
44
|
$expects[$i]{short_only} //= 1; |
|
546
|
|
|
|
|
|
|
} # SHORT_OPTS |
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
# split --foo=val -> --foo, =, val |
|
549
|
|
|
|
|
|
|
SPLIT_EQUAL: |
|
550
|
|
|
|
|
|
|
{ |
|
551
|
41
|
100
|
|
|
|
68
|
if ($word =~ /\A(--?[^=]+)(=)(.*)/) { |
|
|
41
|
|
|
|
|
109
|
|
|
552
|
4
|
|
|
|
|
25
|
splice @words, $i, 1, $1, $2, $3; |
|
553
|
4
|
|
|
|
|
12
|
$word = $1; |
|
554
|
4
|
50
|
|
|
|
11
|
$cword += 2 if $cword >= $i; |
|
555
|
|
|
|
|
|
|
} |
|
556
|
|
|
|
|
|
|
} |
|
557
|
|
|
|
|
|
|
|
|
558
|
41
|
|
|
|
|
73
|
my $opt = $word; |
|
559
|
41
|
|
|
|
|
93
|
my $matching_opts = _matching_opts($opt, \%opts); |
|
560
|
|
|
|
|
|
|
|
|
561
|
41
|
100
|
|
|
|
126
|
if (keys(%$matching_opts) == 1) { |
|
562
|
28
|
|
|
|
|
67
|
my $opthash = $matching_opts->{ (keys %$matching_opts)[0] }; |
|
563
|
28
|
|
|
|
|
59
|
$opt = $opthash->{name}; |
|
564
|
28
|
|
|
|
|
83
|
$expects[$i]{optname} = $opt; |
|
565
|
28
|
|
100
|
|
|
84
|
my $nth = $seen_opts{$opt} // 0; |
|
566
|
28
|
|
|
|
|
54
|
$expects[$i]{nth} = $nth; |
|
567
|
28
|
|
|
|
|
66
|
_mark_seen(\%seen_opts, $opt, \%opts); |
|
568
|
|
|
|
|
|
|
|
|
569
|
28
|
|
|
|
|
72
|
my $min_vals = $opthash->{parsed}{min_vals}; |
|
570
|
28
|
|
|
|
|
45
|
my $max_vals = $opthash->{parsed}{max_vals}; |
|
571
|
|
|
|
|
|
|
#say "D:min_vals=$min_vals, max_vals=$max_vals"; |
|
572
|
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
# detect = after --opt |
|
574
|
28
|
100
|
100
|
|
|
99
|
if ($i+1 < @words && $words[$i+1] eq '=') { |
|
575
|
3
|
|
|
|
|
4
|
$i++; |
|
576
|
3
|
|
|
|
|
14
|
$expects[$i] = {separator=>1, optval=>$opt, word=>'', nth=>$nth}; |
|
577
|
|
|
|
|
|
|
# force expecting a value due to = |
|
578
|
3
|
|
|
|
|
5
|
$min_vals = 1; |
|
579
|
3
|
100
|
|
|
|
9
|
$max_vals = $min_vals if $max_vals < $min_vals; |
|
580
|
|
|
|
|
|
|
} |
|
581
|
|
|
|
|
|
|
|
|
582
|
28
|
|
|
|
|
67
|
for (1 .. $min_vals) { |
|
583
|
16
|
|
|
|
|
24
|
$i++; |
|
584
|
16
|
100
|
|
|
|
68
|
last WORD if $i >= @words; |
|
585
|
13
|
|
|
|
|
53
|
$expects[$i]{optval} = $opt; |
|
586
|
13
|
|
|
|
|
26
|
$expects[$i]{nth} = $nth; |
|
587
|
13
|
|
|
|
|
17
|
push @{ $parsed_opts{$opt} }, $words[$i]; |
|
|
13
|
|
|
|
|
67
|
|
|
588
|
|
|
|
|
|
|
} |
|
589
|
25
|
|
|
|
|
149
|
for (1 .. $max_vals-$min_vals) { |
|
590
|
1
|
50
|
|
|
|
6
|
last if $i+$_ >= @words; |
|
591
|
1
|
50
|
|
|
|
5
|
last if $words[$i+$_] =~ /\A-/; # a new option |
|
592
|
1
|
|
|
|
|
5
|
$expects[$i+$_]{optval} = $opt; # but can also be optname |
|
593
|
1
|
|
|
|
|
2
|
$expects[$i]{nth} = $nth; |
|
594
|
1
|
|
|
|
|
4
|
push @{ $parsed_opts{$opt} }, $words[$i+$_]; |
|
|
1
|
|
|
|
|
7
|
|
|
595
|
|
|
|
|
|
|
} |
|
596
|
|
|
|
|
|
|
} else { |
|
597
|
|
|
|
|
|
|
# an unknown or still ambiguous option, assume it doesn't |
|
598
|
|
|
|
|
|
|
# require argument, unless it's --opt= or --opt=foo |
|
599
|
13
|
|
|
|
|
24
|
$opt = undef; |
|
600
|
13
|
|
|
|
|
35
|
$expects[$i]{optname} = $opt; |
|
601
|
13
|
|
|
|
|
84
|
my $possible_optnames = [sort keys %$matching_opts]; |
|
602
|
13
|
|
|
|
|
31
|
$expects[$i]{possible_optnames} = $possible_optnames; |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
# detect = after --opt |
|
605
|
13
|
100
|
100
|
|
|
77
|
if ($i+1 < @words && $words[$i+1] eq '=') { |
|
606
|
1
|
|
|
|
|
3
|
$i++; |
|
607
|
1
|
|
|
|
|
6
|
$expects[$i] = {separator=>1, optval=>undef, possible_optnames=>$possible_optnames, word=>''}; |
|
608
|
1
|
50
|
|
|
|
5
|
if ($i+1 < @words) { |
|
609
|
1
|
|
|
|
|
2
|
$i++; |
|
610
|
1
|
|
|
|
|
13
|
$expects[$i]{optval} = $opt; |
|
611
|
1
|
|
|
|
|
7
|
$expects[$i]{possible_optnames} = $possible_optnames; |
|
612
|
|
|
|
|
|
|
} |
|
613
|
|
|
|
|
|
|
} |
|
614
|
|
|
|
|
|
|
} |
|
615
|
|
|
|
|
|
|
} else { |
|
616
|
7
|
|
|
|
|
22
|
$expects[$i]{optname} = ''; |
|
617
|
7
|
|
|
|
|
13
|
$expects[$i]{arg} = 1; |
|
618
|
7
|
|
|
|
|
15
|
$expects[$i]{argpos} = $argpos++; |
|
619
|
|
|
|
|
|
|
} |
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
35
|
|
|
|
|
61
|
my $exp = $expects[$cword]; |
|
623
|
35
|
|
100
|
|
|
131
|
my $word = $exp->{word} // $words[$cword]; |
|
624
|
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
#use DD; say "D:opts: "; dd \%opts; |
|
626
|
|
|
|
|
|
|
#use DD; print "D:words: "; dd \@words; |
|
627
|
|
|
|
|
|
|
#say "D:cword: $cword"; |
|
628
|
|
|
|
|
|
|
#use DD; print "D:expects: "; dd \@expects; |
|
629
|
|
|
|
|
|
|
#use DD; print "D:seen_opts: "; dd \%seen_opts; |
|
630
|
|
|
|
|
|
|
#use DD; print "D:parsed_opts: "; dd \%parsed_opts; |
|
631
|
|
|
|
|
|
|
#use DD; print "D:exp: "; dd $exp; |
|
632
|
|
|
|
|
|
|
#use DD; say "D:word:<$word>"; |
|
633
|
|
|
|
|
|
|
|
|
634
|
35
|
|
|
|
|
61
|
my @answers; |
|
635
|
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# complete option names |
|
637
|
|
|
|
|
|
|
{ |
|
638
|
35
|
100
|
|
|
|
92
|
last if $word =~ /\A[^-]/; |
|
639
|
33
|
100
|
|
|
|
67
|
last unless exists $exp->{optname}; |
|
640
|
|
|
|
|
|
|
last if defined($exp->{do_complete_optname}) && |
|
641
|
26
|
50
|
33
|
|
|
72
|
!$exp->{do_complete_optname}; |
|
642
|
26
|
100
|
|
|
|
49
|
if ($exp->{comp_result}) { |
|
643
|
2
|
|
|
|
|
5
|
push @answers, $exp->{comp_result}; |
|
644
|
2
|
|
|
|
|
4
|
last; |
|
645
|
|
|
|
|
|
|
} |
|
646
|
|
|
|
|
|
|
#say "D:completing option names"; |
|
647
|
24
|
|
|
|
|
40
|
my $opt = $exp->{optname}; |
|
648
|
24
|
|
|
|
|
59
|
my @o; |
|
649
|
|
|
|
|
|
|
my @osumms; |
|
650
|
24
|
|
|
|
|
0
|
my $o_has_summaries; |
|
651
|
24
|
|
|
|
|
46
|
for my $optname (@optnames) { |
|
652
|
247
|
|
|
|
|
354
|
my $repeatable = 0; |
|
653
|
247
|
100
|
100
|
|
|
596
|
next if $exp->{short_only} && $optname =~ /\A--/; |
|
654
|
197
|
100
|
|
|
|
362
|
if ($seen_opts{$optname}) { |
|
655
|
34
|
|
|
|
|
53
|
my $opthash = $opts{$optname}; |
|
656
|
34
|
|
|
|
|
54
|
my $parsed = $opthash->{parsed}; |
|
657
|
34
|
|
|
|
|
48
|
my $dest = $opthash->{dest}; |
|
658
|
34
|
100
|
66
|
|
|
128
|
if (ref $dest eq 'ARRAY') { |
|
|
|
100
|
|
|
|
|
|
|
659
|
1
|
|
|
|
|
3
|
$repeatable = 1; |
|
660
|
|
|
|
|
|
|
} elsif ($parsed->{desttype} || $parsed->{is_inc}) { |
|
661
|
3
|
|
|
|
|
5
|
$repeatable = 1; |
|
662
|
|
|
|
|
|
|
} |
|
663
|
|
|
|
|
|
|
} |
|
664
|
|
|
|
|
|
|
# skip options that have been specified and not repeatable |
|
665
|
|
|
|
|
|
|
#use DD; dd {'$_'=>$_, seen=>$seen_opts{$_}, repeatable=>$repeatable, opt=>$opt}; |
|
666
|
|
|
|
|
|
|
next if $seen_opts{$optname} && !$repeatable && ( |
|
667
|
|
|
|
|
|
|
# long option has been specified |
|
668
|
|
|
|
|
|
|
(!$opt || $opt ne $optname) || |
|
669
|
|
|
|
|
|
|
# short option (in a bundle) has been specified |
|
670
|
|
|
|
|
|
|
(defined($exp->{prefix}) && |
|
671
|
197
|
100
|
100
|
|
|
503
|
index($exp->{prefix}, substr($opt, 1, 1)) >= 0)); |
|
|
|
|
66
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
672
|
169
|
100
|
|
|
|
275
|
if (defined $exp->{prefix}) { |
|
673
|
18
|
|
|
|
|
26
|
my $o = $optname; $o =~ s/\A-//; |
|
|
18
|
|
|
|
|
48
|
|
|
674
|
18
|
|
|
|
|
45
|
push @o, "$exp->{prefix}$o"; |
|
675
|
|
|
|
|
|
|
} else { |
|
676
|
151
|
|
|
|
|
246
|
push @o, $optname; |
|
677
|
|
|
|
|
|
|
} |
|
678
|
169
|
|
50
|
|
|
278
|
my $summ = $code_get_summary->($optname) // ''; |
|
679
|
169
|
50
|
|
|
|
274
|
if (length $summ) { |
|
680
|
0
|
|
|
|
|
0
|
$o_has_summaries = 1; |
|
681
|
0
|
|
|
|
|
0
|
push @osumms, $summ; |
|
682
|
|
|
|
|
|
|
} else { |
|
683
|
169
|
|
|
|
|
291
|
push @osumms, ''; |
|
684
|
|
|
|
|
|
|
} |
|
685
|
|
|
|
|
|
|
} |
|
686
|
|
|
|
|
|
|
#use DD; dd \@o; |
|
687
|
|
|
|
|
|
|
#use DD; dd \@osumms; |
|
688
|
24
|
|
|
|
|
100
|
my $compres = Complete::Util::complete_array_elem( |
|
689
|
|
|
|
|
|
|
array => \@o, word => $word, |
|
690
|
|
|
|
|
|
|
(summaries => \@osumms) x !!$o_has_summaries, |
|
691
|
|
|
|
|
|
|
); |
|
692
|
24
|
50
|
|
|
|
4069
|
log_trace('[compgl] adding result from option names, '. |
|
693
|
|
|
|
|
|
|
'matching options=%s', $compres) if $COMPLETE_GETOPT_LONG_TRACE; |
|
694
|
24
|
|
|
|
|
44
|
push @answers, $compres; |
|
695
|
24
|
100
|
100
|
|
|
124
|
if (!exists($exp->{optval}) && !exists($exp->{arg})) { |
|
696
|
17
|
|
|
|
|
56
|
$fres = {words=>$compres, esc_mode=>'option'}; |
|
697
|
17
|
|
|
|
|
270
|
goto RETURN_RES; |
|
698
|
|
|
|
|
|
|
} |
|
699
|
|
|
|
|
|
|
} |
|
700
|
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
# complete option value |
|
702
|
|
|
|
|
|
|
{ |
|
703
|
35
|
100
|
|
|
|
46
|
last unless exists($exp->{optval}); |
|
|
18
|
|
|
|
|
45
|
|
|
704
|
|
|
|
|
|
|
#say "D:completing option value"; |
|
705
|
10
|
|
|
|
|
23
|
my $opt = $exp->{optval}; |
|
706
|
10
|
100
|
|
|
|
15
|
my $opthash; $opthash = $opts{$opt} if $opt; |
|
|
10
|
|
|
|
|
24
|
|
|
707
|
|
|
|
|
|
|
my %compargs = ( |
|
708
|
|
|
|
|
|
|
%$extras, |
|
709
|
|
|
|
|
|
|
type=>'optval', words=>\@words, cword=>$args{cword}, |
|
710
|
|
|
|
|
|
|
word=>$word, opt=>($opt // $exp->{possible_optnames}), ospec=>$opthash->{ospec}, |
|
711
|
10
|
|
66
|
|
|
109
|
argpos=>undef, nth=>$exp->{nth}, seen_opts=>\%seen_opts, |
|
712
|
|
|
|
|
|
|
parsed_opts=>\%parsed_opts, |
|
713
|
|
|
|
|
|
|
); |
|
714
|
10
|
|
|
|
|
20
|
my $compres; |
|
715
|
10
|
50
|
|
|
|
26
|
if ($comp) { |
|
716
|
10
|
50
|
|
|
|
25
|
log_trace("[compgl] invoking routine supplied from 'completion' argument to complete option value, option=<%s>", $opt) if $COMPLETE_GETOPT_LONG_TRACE; |
|
717
|
10
|
|
|
|
|
70
|
$compres = $comp->(%compargs); |
|
718
|
|
|
|
|
|
|
Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix}) |
|
719
|
10
|
100
|
|
|
|
339
|
if defined $exp->{prefix}; |
|
720
|
10
|
50
|
|
|
|
70
|
log_trace('[compgl] adding result from routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE; |
|
721
|
|
|
|
|
|
|
} |
|
722
|
10
|
50
|
33
|
|
|
38
|
if (!$compres || !$comp) { |
|
723
|
0
|
|
|
|
|
0
|
$compres = _default_completion(%compargs); |
|
724
|
|
|
|
|
|
|
Complete::Util::modify_answer(answer=>$compres, prefix=>$exp->{prefix}) |
|
725
|
0
|
0
|
|
|
|
0
|
if defined $exp->{prefix}; |
|
726
|
0
|
0
|
|
|
|
0
|
log_trace('[compgl] adding result from default '. |
|
727
|
|
|
|
|
|
|
'completion routine') if $COMPLETE_GETOPT_LONG_TRACE; |
|
728
|
|
|
|
|
|
|
} |
|
729
|
10
|
|
|
|
|
41
|
push @answers, $compres; |
|
730
|
|
|
|
|
|
|
} |
|
731
|
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
# complete argument |
|
733
|
|
|
|
|
|
|
{ |
|
734
|
18
|
100
|
|
|
|
30
|
last unless exists($exp->{arg}); |
|
|
18
|
|
|
|
|
25
|
|
|
|
18
|
|
|
|
|
53
|
|
|
735
|
|
|
|
|
|
|
my %compargs = ( |
|
736
|
|
|
|
|
|
|
%$extras, |
|
737
|
|
|
|
|
|
|
type=>'arg', words=>\@words, cword=>$args{cword}, |
|
738
|
|
|
|
|
|
|
word=>$word, opt=>undef, ospec=>undef, |
|
739
|
7
|
|
|
|
|
73
|
argpos=>$exp->{argpos}, seen_opts=>\%seen_opts, |
|
740
|
|
|
|
|
|
|
parsed_opts=>\%parsed_opts, |
|
741
|
|
|
|
|
|
|
); |
|
742
|
7
|
50
|
|
|
|
29
|
log_trace('[compgl] invoking \'completion\' routine '. |
|
743
|
|
|
|
|
|
|
'to complete argument') if $COMPLETE_GETOPT_LONG_TRACE; |
|
744
|
7
|
100
|
|
|
|
13
|
my $compres; $compres = $comp->(%compargs) if $comp; |
|
|
7
|
|
|
|
|
35
|
|
|
745
|
7
|
100
|
|
|
|
34
|
if (!defined $compres) { |
|
746
|
1
|
|
|
|
|
9
|
$compres = _default_completion(%compargs); |
|
747
|
1
|
50
|
|
|
|
5
|
log_trace('[compgl] adding result from default '. |
|
748
|
|
|
|
|
|
|
'completion routine: %s', $compres) if $COMPLETE_GETOPT_LONG_TRACE; |
|
749
|
|
|
|
|
|
|
} |
|
750
|
7
|
|
|
|
|
24
|
push @answers, $compres; |
|
751
|
|
|
|
|
|
|
} |
|
752
|
|
|
|
|
|
|
|
|
753
|
18
|
50
|
|
|
|
39
|
log_trace("[compgl] combining result from %d source(s)", scalar @answers) if $COMPLETE_GETOPT_LONG_TRACE; |
|
754
|
18
|
|
50
|
|
|
56
|
$fres = Complete::Util::combine_answers(@answers) // []; |
|
755
|
|
|
|
|
|
|
|
|
756
|
35
|
50
|
|
|
|
1166
|
RETURN_RES: |
|
757
|
|
|
|
|
|
|
log_trace("[compgl] leaving %s(), result=%s", $fname, $fres) if $COMPLETE_GETOPT_LONG_TRACE; |
|
758
|
35
|
|
|
|
|
905
|
$fres; |
|
759
|
|
|
|
|
|
|
} |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
1; |
|
762
|
|
|
|
|
|
|
# ABSTRACT: Complete command-line argument using Getopt::Long specification |
|
763
|
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
__END__ |