rework to match original bash function more closely, including options completion
This commit is contained in:
parent
1f0dd273f7
commit
2d58e69ef9
@ -57,8 +57,7 @@ sub get_package_suggestions {
|
|||||||
return @suggestion;
|
return @suggestion;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_function_suggestions {
|
sub get_functions {
|
||||||
my ( $func ) = @_;
|
|
||||||
|
|
||||||
my $perlfunc;
|
my $perlfunc;
|
||||||
for ( @INC, undef ) {
|
for ( @INC, undef ) {
|
||||||
@ -69,24 +68,51 @@ sub get_function_suggestions {
|
|||||||
|
|
||||||
open my $fh, '<', $perlfunc or return;
|
open my $fh, '<', $perlfunc or return;
|
||||||
|
|
||||||
my @suggestion;
|
my @functions;
|
||||||
my $nest_level = -1;
|
my $nest_level = -1;
|
||||||
while ( <$fh> ) {
|
while ( <$fh> ) {
|
||||||
next if 1 .. /^=head2 Alphabetical Listing of Perl Functions$/;
|
next if 1 .. /^=head2 Alphabetical Listing of Perl Functions$/;
|
||||||
++$nest_level if /^=over/;
|
++$nest_level if /^=over/;
|
||||||
--$nest_level if /^=back/;
|
--$nest_level if /^=back/;
|
||||||
next if $nest_level;
|
next if $nest_level;
|
||||||
push @suggestion, /^=item (-?\w+)/;
|
push @functions, /^=item (-?\w+)/;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $func_rx = qr/\A${\quotemeta $func}/;
|
return @functions;
|
||||||
|
|
||||||
return grep { /$func_rx/ } @suggestion;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
my ( $cmd, @arg ) = get_command_line();
|
sub filter {
|
||||||
my $word = pop @arg;
|
my ($word, @list) = @_;
|
||||||
|
|
||||||
print "$_\n" for ( @arg and @arg[-1] eq '-f' )
|
my $pattern = qr/\A${\quotemeta $word}/;
|
||||||
? get_function_suggestions( $word )
|
|
||||||
: get_package_suggestions( $word );
|
return grep { /$pattern/ } @list;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_suggestions {
|
||||||
|
my (@args) = @_;
|
||||||
|
my $word = pop @args;
|
||||||
|
|
||||||
|
if (@args) {
|
||||||
|
if ($args[-1] eq '-f') {
|
||||||
|
return filter(
|
||||||
|
$word,
|
||||||
|
get_functions
|
||||||
|
);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($word =~ /^-/) {
|
||||||
|
return filter(
|
||||||
|
$word,
|
||||||
|
qw/-h -D -t -u -m -l -F -i -v -V -T -r -d -o -M -w -n -X -L/
|
||||||
|
);
|
||||||
|
|
||||||
|
} else {
|
||||||
|
return get_package_suggestions($word);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my ($cmd, @args) = get_command_line();
|
||||||
|
|
||||||
|
print "$_\n" for get_suggestions(@args);
|
||||||
|
Loading…
x
Reference in New Issue
Block a user