[Bash-completion-commits] [SCM] bash-completion branch, master, updated. 6a517905066612360854eb47a72ea3bc0c82a864
Guillaume Rousse
Guillaume.Rousse at inria.fr
Sun Nov 7 19:19:18 UTC 2010
The following commit has been merged in the master branch:
commit 4254f3a4a5b94d1de17d9c27d8552f19ea1483f9
Author: Guillaume Rousse <Guillaume.Rousse at inria.fr>
Date: Sun Nov 7 20:01:41 2010 +0100
Switch back to a shell completion function for perl and perldoc
completions, using an external helper just for functions and modules
completions. This is overally slower, as our helper outputs all available
modules at once, rather than just one piece of namespace, but this is
more in line with other completions
diff --git a/completions/helpers/perl b/completions/helpers/perl
index a046844..dc44d71 100755
--- a/completions/helpers/perl
+++ b/completions/helpers/perl
@@ -1,103 +1,50 @@
#!/usr/bin/env perl
use strict;
-use File::Spec::Functions qw( rel2abs catdir catfile no_upwards splitpath );
+use Config;
+use File::Spec::Functions;
-sub uniq { my %seen; grep { not $seen{$_}++ } @_ }
+my %seen;
-sub get_command_line {
- my $comp = substr $ENV{'COMP_LINE'}, 0, $ENV{'COMP_POINT'};
- return split /[ \t]+/, $comp, -1; # if not good enough, use Text::ParseWords
-}
-
-sub slurp_dir {
- opendir my $dir, shift or return;
- no_upwards readdir $dir;
-}
+sub print_modules_real {
+ my ($base, $dir, $word) = @_;
-sub suggestion_from_name {
- my ( $file_rx, $path, $name ) = @_;
- return if not $name =~ /$file_rx/;
- return $name.'::' if -d catdir $path, $name;
- return $1;
-}
-
-sub suggestions_from_path {
- my ( $file_rx, $path ) = @_;
- map { suggestion_from_name $file_rx, $path, $_ } slurp_dir $path;
-}
+ # returns immediatly if the base doesn't match
+ return if $base && $base !~ /^\Q$word/;
-sub get_package_suggestions {
- my ( $pkg, $prefix ) = @_;
-
- my @segment = split /::|:\z/, $pkg, -1;
- my $file_rx = qr/\A(${\quotemeta pop @segment}\w*)(?:\.pm|\.pod)?\z/;
-
- my $home = rel2abs $ENV{'HOME'};
- my $cwd = rel2abs do { require Cwd; Cwd::cwd() };
-
- my @suggestion =
- map { suggestions_from_path $file_rx, $_ }
- uniq map { catdir $_, @segment }
- grep { $home ne $_ and $cwd ne $_ }
- map { $_, ( catdir $_, 'pod' ) }
- map { rel2abs $_ }
- @INC;
-
- # fixups
- if ( $pkg eq '' ) {
- my $total = @suggestion;
- @suggestion = grep { not /^perl/ } @suggestion;
- my $num_hidden = $total - @suggestion;
- push @suggestion, "perl* ($num_hidden hidden)" if $num_hidden;
- }
- elsif ( $pkg =~ /(?<!:):\z/ ) {
- @suggestion = map { ":$_" } @suggestion;
- }
+ chdir($dir) or return;
- # only add eventual prefix on first segment
- if ($prefix && !@segment) {
- @suggestion = map { $prefix . $_ } @suggestion;
+ # print each file
+ foreach my $file (glob('*.pm')) {
+ $file =~ s/\.pm$//;
+ my $module = $base . $file;
+ next if $module !~ /^\Q$word/;
+ next if $seen{$module}++;
+ print $module . "\n";
}
- return @suggestion;
-}
-
-sub get_file_suggestions {
- my ($path) = @_;
-
- my $dir;
- if ($path) {
- (undef, $dir, undef) = splitpath($path);
- $dir = '.' if !$dir;
- } else {
- $dir = '.';
+ # recurse in each subdirectory
+ foreach my $directory (grep { -d } glob('*')) {
+ my $subdir = $dir . '/' . $directory;
+ if ($directory =~ /^(?:[.\d]+|$Config{archname}|auto)$/) {
+ # exclude subdirectory name from base
+ print_modules_real(undef, $subdir, $word);
+ } else {
+ # add subdirectory name to base
+ print_modules_real($base . $directory . '::', $subdir, $word);
+ }
}
-
- my $dh;
- return unless opendir ($dh, $dir);
- my @files = readdir($dh);
- closedir $dh;
-
- @files = map { catfile $dir, $_ } @files if $dir ne '.';
-
- return filter($path, @files);
}
-sub get_directory_suggestions {
- my ($path, $prefix) = @_;
-
- my @suggestions =
- grep { -d $_}
- get_file_suggestions($path);
+sub print_modules {
+ my ($word) = @_;
- if ($prefix) {
- @suggestions = map { $prefix . $_ } @suggestions;
+ foreach my $directory (@INC) {
+ print_modules_real(undef, $directory, $word);
}
-
- return @suggestions;
}
-sub get_functions {
+sub print_functions {
+ my ($word) = @_;
my $perlfunc;
for ( @INC, undef ) {
@@ -108,90 +55,26 @@ sub get_functions {
open my $fh, '<', $perlfunc or return;
- my @functions;
my $nest_level = -1;
while ( <$fh> ) {
next if 1 .. /^=head2 Alphabetical Listing of Perl Functions$/;
++$nest_level if /^=over/;
--$nest_level if /^=back/;
next if $nest_level;
- push @functions, /^=item (-?\w+)/;
+ next unless /^=item (-?\w+)/;
+ my $function = $1;
+ next if $function !~ /^\Q$word/;
+ next if $seen{$function}++;
+ print $function . "\n";
}
- return @functions;
}
-sub filter {
- my ($word, @list) = @_;
-
- my $pattern = qr/\A${\quotemeta $word}/;
+my $type = shift;
+my $word = shift;
- return grep { /$pattern/ } @list;
+if ($type eq 'functions') {
+ print_functions($word);
+} elsif ($type eq 'modules') {
+ print_modules($word);
}
-
-sub get_perldoc_suggestions {
- my (@args) = @_;
- my $cur = pop @args;
- my $prev = pop @args;
-
- if ($prev) {
- if ($prev eq '-f') {
- return filter(
- $cur,
- get_functions
- );
- }
- }
-
- if ($cur =~ /^-/) {
- return filter(
- $cur,
- 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($cur);
- }
-}
-
-sub get_perl_suggestions {
- my (@args) = @_;
- my $cur = pop @args;
- my $prev = pop @args;
- my $prefix;
-
- if ($cur =~ /^(-\S)(\S*)/) {
- $prev = $1;
- $cur = $2;
- $prefix = $prev;
- }
-
- if ($prev) {
- if ($prev eq '-I' || $prev eq '-x') {
- return get_directory_suggestions($cur, $prefix);
- }
- if ($prev eq '-m' || $prev eq '-M') {
- return get_package_suggestions($cur, $prefix);
- }
- }
-
- if ($cur =~ /^-/) {
- return filter(
- $cur,
- qw/
- -C -s -T -u -U -W -X -h -v -V -c -w -d -D
- -p -n -a -F -l -0 -I -m -M -P -S -x -i -e
- /
- );
- } else {
- return get_file_suggestions($cur);
- }
-}
-
-my ($cmd, @args) = get_command_line();
-
-print "$_\n" for
- $cmd eq 'perl' ? get_perl_suggestions(@args) :
- $cmd eq 'perldoc' ? get_perldoc_suggestions(@args) :
- () ;
-
diff --git a/completions/perl b/completions/perl
index 61d0913..1aa9d2f 100644
--- a/completions/perl
+++ b/completions/perl
@@ -2,9 +2,98 @@
have perl &&
{
-complete -C ${BASH_SOURCE[0]%/*}/helpers/perl -o nospace -o default perl
+_perlmodules()
+{
+ COMPREPLY=( $( compgen -P "$prefix" -W "$( ${BASH_SOURCE[0]%/*}/helpers/perl modules $cur )" -- "$cur" ) )
+ __ltrim_colon_completions "$1"
+}
+
+_perlfunctions()
+{
+ COMPREPLY=( $( compgen -P "$prefix" -W "$( ${BASH_SOURCE[0]%/*}/helpers/perl functions $cur )" -- "$cur" ) )
+}
+
+_perl()
+{
+ local cur prev prefix temp
+ local optPrefix optSuffix
+
+ COMPREPLY=()
+ _get_comp_words_by_ref -n : cur prev
+ prefix=""
+
+ # If option not followed by whitespace, reassign prev and cur
+ if [[ "$cur" == -?* ]]; then
+ temp=$cur
+ prev=${temp:0:2}
+ cur=${temp:2}
+ optPrefix=-P$prev
+ optSuffix=-S/
+ prefix=$prev
+ fi
-complete -C ${BASH_SOURCE[0]%/*}/helpers/perl -o nospace -o default perldoc
+ # only handle module completion for now
+ case $prev in
+ -I|-x)
+ local IFS=$'\n'
+ _compopt_o_filenames
+ COMPREPLY=( $( compgen -d $optPrefix $optSuffix -- "$cur" ) )
+ return 0
+ ;;
+ -m|-M)
+ _perlmodules "$cur"
+ return 0
+ ;;
+ esac
+
+ if [[ "$cur" == -* ]]; then
+ COMPREPLY=( $( compgen -W '-C -s -T -u -U -W -X -h -v -V -c -w -d \
+ -D -p -n -a -F -l -0 -I -m -M -P -S -x -i -e ' -- "$cur" ) )
+ else
+ _filedir
+ fi
+}
+complete -F _perl -o nospace perl
+
+_perldoc()
+{
+ local cur prev prefix temp
+
+ COMPREPLY=()
+ _get_comp_words_by_ref -n : cur prev
+ prefix=""
+
+ # completing an option (may or may not be separated by a space)
+ if [[ "$cur" == -?* ]]; then
+ temp=$cur
+ prev=${temp:0:2}
+ cur=${temp:2}
+ prefix=$prev
+ fi
+
+ # complete builtin perl functions
+ case $prev in
+ -f)
+ _perlfunctions "$cur"
+ return 0
+ ;;
+ esac
+
+ if [[ "$cur" == -* ]]; then
+ COMPREPLY=( $( compgen -W '-h -v -t -u -m -l -F -X -f -q' -- "$cur" ))
+ else
+ # return available modules (unless it is clearly a file)
+ if [[ "$cur" != */* ]]; then
+ _perlmodules "$cur"
+ COMPREPLY=( "${COMPREPLY[@]}" $( compgen -W \
+ '$( PAGER=/bin/cat man perl | \
+ sed -ne "/perl.*Perl overview/,/perlwin32/p" | \
+ awk "\$NF=2 { print \$1}" | command grep perl )' -- "$cur" ) )
+ fi
+ _filedir '@(pl|PL|pm|PM|pod|POD)'
+ fi
+}
+complete -F _perldoc -o bashdefault perldoc
}
# Local variables:
--
bash-completion
More information about the Bash-completion-commits
mailing list