use same indentation convention as for bash code

This commit is contained in:
Guillaume Rousse 2010-11-06 23:42:22 +01:00
parent de51dd3a89
commit 83fc41d5b1

View File

@ -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 );