use same indentation convention as for bash code
This commit is contained in:
parent
de51dd3a89
commit
83fc41d5b1
@ -5,91 +5,91 @@ use File::Spec::Functions qw( rel2abs catdir catfile no_upwards );
|
|||||||
sub uniq { my %seen; grep { not $seen{$_}++ } @_ }
|
sub uniq { my %seen; grep { not $seen{$_}++ } @_ }
|
||||||
|
|
||||||
sub get_command_line {
|
sub get_command_line {
|
||||||
my $comp = substr $ENV{'COMP_LINE'}, 0, $ENV{'COMP_POINT'};
|
my $comp = substr $ENV{'COMP_LINE'}, 0, $ENV{'COMP_POINT'};
|
||||||
return split /[ \t]+/, $comp, -1; # if not good enough, use Text::ParseWords
|
return split /[ \t]+/, $comp, -1; # if not good enough, use Text::ParseWords
|
||||||
}
|
}
|
||||||
|
|
||||||
sub slurp_dir {
|
sub slurp_dir {
|
||||||
opendir my $dir, shift or return;
|
opendir my $dir, shift or return;
|
||||||
no_upwards readdir $dir;
|
no_upwards readdir $dir;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub suggestion_from_name {
|
sub suggestion_from_name {
|
||||||
my ( $file_rx, $path, $name ) = @_;
|
my ( $file_rx, $path, $name ) = @_;
|
||||||
return if not $name =~ /$file_rx/;
|
return if not $name =~ /$file_rx/;
|
||||||
return $name.'::' if -d catdir $path, $name;
|
return $name.'::' if -d catdir $path, $name;
|
||||||
return $1;
|
return $1;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub suggestions_from_path {
|
sub suggestions_from_path {
|
||||||
my ( $file_rx, $path ) = @_;
|
my ( $file_rx, $path ) = @_;
|
||||||
map { suggestion_from_name $file_rx, $path, $_ } slurp_dir $path;
|
map { suggestion_from_name $file_rx, $path, $_ } slurp_dir $path;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_package_suggestions {
|
sub get_package_suggestions {
|
||||||
my ( $pkg ) = @_;
|
my ( $pkg ) = @_;
|
||||||
|
|
||||||
my @segment = split /::|:\z/, $pkg, -1;
|
my @segment = split /::|:\z/, $pkg, -1;
|
||||||
my $file_rx = qr/\A(${\quotemeta pop @segment}\w*)(?:\.pm|\.pod)?\z/;
|
my $file_rx = qr/\A(${\quotemeta pop @segment}\w*)(?:\.pm|\.pod)?\z/;
|
||||||
|
|
||||||
my $home = rel2abs $ENV{'HOME'};
|
my $home = rel2abs $ENV{'HOME'};
|
||||||
my $cwd = rel2abs do { require Cwd; Cwd::cwd() };
|
my $cwd = rel2abs do { require Cwd; Cwd::cwd() };
|
||||||
|
|
||||||
my @suggestion =
|
my @suggestion =
|
||||||
map { suggestions_from_path $file_rx, $_ }
|
map { suggestions_from_path $file_rx, $_ }
|
||||||
uniq map { catdir $_, @segment }
|
uniq map { catdir $_, @segment }
|
||||||
grep { $home ne $_ and $cwd ne $_ }
|
grep { $home ne $_ and $cwd ne $_ }
|
||||||
map { $_, ( catdir $_, 'pod' ) }
|
map { $_, ( catdir $_, 'pod' ) }
|
||||||
map { rel2abs $_ }
|
map { rel2abs $_ }
|
||||||
@INC;
|
@INC;
|
||||||
|
|
||||||
# fixups
|
# fixups
|
||||||
if ( $pkg eq '' ) {
|
if ( $pkg eq '' ) {
|
||||||
my $total = @suggestion;
|
my $total = @suggestion;
|
||||||
@suggestion = grep { not /^perl/ } @suggestion;
|
@suggestion = grep { not /^perl/ } @suggestion;
|
||||||
my $num_hidden = $total - @suggestion;
|
my $num_hidden = $total - @suggestion;
|
||||||
push @suggestion, "perl* ($num_hidden hidden)" if $num_hidden;
|
push @suggestion, "perl* ($num_hidden hidden)" if $num_hidden;
|
||||||
}
|
}
|
||||||
elsif ( $pkg =~ /(?<!:):\z/ ) {
|
elsif ( $pkg =~ /(?<!:):\z/ ) {
|
||||||
@suggestion = map { ":$_" } @suggestion;
|
@suggestion = map { ":$_" } @suggestion;
|
||||||
}
|
}
|
||||||
|
|
||||||
return @suggestion;
|
return @suggestion;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_function_suggestions {
|
sub get_function_suggestions {
|
||||||
my ( $func ) = @_;
|
my ( $func ) = @_;
|
||||||
|
|
||||||
my $perlfunc;
|
my $perlfunc;
|
||||||
for ( @INC, undef ) {
|
for ( @INC, undef ) {
|
||||||
return if not defined;
|
return if not defined;
|
||||||
$perlfunc = catfile $_, qw( pod perlfunc.pod );
|
$perlfunc = catfile $_, qw( pod perlfunc.pod );
|
||||||
last if -r $perlfunc;
|
last if -r $perlfunc;
|
||||||
}
|
}
|
||||||
|
|
||||||
open my $fh, '<', $perlfunc or return;
|
open my $fh, '<', $perlfunc or return;
|
||||||
|
|
||||||
my @suggestion;
|
my @suggestion;
|
||||||
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 @suggestion, /^=item (-?\w+)/;
|
||||||
}
|
}
|
||||||
|
|
||||||
my $func_rx = qr/\A${\quotemeta $func}/;
|
my $func_rx = qr/\A${\quotemeta $func}/;
|
||||||
|
|
||||||
return grep { /$func_rx/ } @suggestion;
|
return grep { /$func_rx/ } @suggestion;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub usage {
|
sub usage {
|
||||||
die map "\n$_\n", (
|
die map "\n$_\n", (
|
||||||
"To use, issue the following command in bash:",
|
"To use, issue the following command in bash:",
|
||||||
"\tcomplete -C perldoc-complete -o nospace -o default perldoc",
|
"\tcomplete -C perldoc-complete -o nospace -o default perldoc",
|
||||||
"You probably want to put that line in your ~/.bashrc file.\n",
|
"You probably want to put that line in your ~/.bashrc file.\n",
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|
||||||
usage() if not exists $ENV{'COMP_LINE'};
|
usage() if not exists $ENV{'COMP_LINE'};
|
||||||
@ -98,5 +98,5 @@ my ( $cmd, @arg ) = get_command_line();
|
|||||||
my $word = pop @arg;
|
my $word = pop @arg;
|
||||||
|
|
||||||
print "$_\n" for ( @arg and @arg[-1] eq '-f' )
|
print "$_\n" for ( @arg and @arg[-1] eq '-f' )
|
||||||
? get_function_suggestions( $word )
|
? get_function_suggestions( $word )
|
||||||
: get_package_suggestions( $word );
|
: get_package_suggestions( $word );
|
||||||
|
Loading…
x
Reference in New Issue
Block a user