[Bash-completion-commits] [SCM] bash-completion branch, master, updated. fd8ade00774b26ccfb3466f58c4d67cd09b2af15
Guillaume Rousse
Guillaume.Rousse at inria.fr
Sun Nov 7 00:16:25 UTC 2010
The following commit has been merged in the master branch:
commit fd8ade00774b26ccfb3466f58c4d67cd09b2af15
Author: Guillaume Rousse <Guillaume.Rousse at inria.fr>
Date: Sun Nov 7 01:13:14 2010 +0100
rename perldoc helper to perl, as it is now a generic perl completion
handler, and use it for perl completion as well
diff --git a/completions/helpers/Makefile.am b/completions/helpers/Makefile.am
index 991cfce..98fccef 100644
--- a/completions/helpers/Makefile.am
+++ b/completions/helpers/Makefile.am
@@ -1,3 +1,3 @@
-helpers_SCRIPTS = perldoc
+helpers_SCRIPTS = perl
EXTRA_DIST = $(helpers_SCRIPTS)
diff --git a/completions/helpers/perl b/completions/helpers/perl
new file mode 100755
index 0000000..a046844
--- /dev/null
+++ b/completions/helpers/perl
@@ -0,0 +1,197 @@
+#!/usr/bin/env perl
+use strict;
+use File::Spec::Functions qw( rel2abs catdir catfile no_upwards splitpath );
+
+sub uniq { my %seen; grep { not $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 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;
+}
+
+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;
+ }
+
+ # only add eventual prefix on first segment
+ if ($prefix && !@segment) {
+ @suggestion = map { $prefix . $_ } @suggestion;
+ }
+
+ return @suggestion;
+}
+
+sub get_file_suggestions {
+ my ($path) = @_;
+
+ my $dir;
+ if ($path) {
+ (undef, $dir, undef) = splitpath($path);
+ $dir = '.' if !$dir;
+ } else {
+ $dir = '.';
+ }
+
+ 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);
+
+ if ($prefix) {
+ @suggestions = map { $prefix . $_ } @suggestions;
+ }
+
+ return @suggestions;
+}
+
+sub get_functions {
+
+ my $perlfunc;
+ for ( @INC, undef ) {
+ return if not defined;
+ $perlfunc = catfile $_, qw( pod perlfunc.pod );
+ last if -r $perlfunc;
+ }
+
+ 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+)/;
+ }
+
+ return @functions;
+}
+
+sub filter {
+ my ($word, @list) = @_;
+
+ my $pattern = qr/\A${\quotemeta $word}/;
+
+ return grep { /$pattern/ } @list;
+}
+
+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/helpers/perldoc b/completions/helpers/perldoc
deleted file mode 100755
index 6d91dbd..0000000
--- a/completions/helpers/perldoc
+++ /dev/null
@@ -1,118 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use File::Spec::Functions qw( rel2abs catdir catfile no_upwards );
-
-sub uniq { my %seen; grep { not $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 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;
-}
-
-sub get_package_suggestions {
- my ( $pkg ) = @_;
-
- 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;
- }
-
- return @suggestion;
-}
-
-sub get_functions {
-
- my $perlfunc;
- for ( @INC, undef ) {
- return if not defined;
- $perlfunc = catfile $_, qw( pod perlfunc.pod );
- last if -r $perlfunc;
- }
-
- 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+)/;
- }
-
- return @functions;
-}
-
-sub filter {
- my ($word, @list) = @_;
-
- my $pattern = qr/\A${\quotemeta $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);
diff --git a/completions/perl b/completions/perl
index dc71742..61d0913 100644
--- a/completions/perl
+++ b/completions/perl
@@ -2,55 +2,9 @@
have perl &&
{
-_perlmodules()
-{
- COMPREPLY=( $( compgen -P "$prefix" -W "$( perl -e 'sub mods { my ($base,$dir)=@_; return if $base !~ /^\Q$ENV{cur}/; chdir($dir) or return; for (glob(q[*.pm])) {s/\.pm$//; print qq[$base$_\n]}; mods(/^(?:[.\d]+|$Config{archname}-$Config{osname}|auto)$/ ? undef : qq[${base}${_}::],qq[$dir/$_]) for grep {-d} glob(q[*]); } mods(undef,$_) for @INC;' )" -- "$cur" ) )
- __ltrim_colon_completions "$1"
-}
-
-_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
-
- # 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
+complete -C ${BASH_SOURCE[0]%/*}/helpers/perl -o nospace -o default perl
-complete -C ${BASH_SOURCE[0]%/*}/helpers/perldoc -o nospace -o default perldoc
+complete -C ${BASH_SOURCE[0]%/*}/helpers/perl -o nospace -o default perldoc
}
# Local variables:
--
bash-completion
More information about the Bash-completion-commits
mailing list