diff --git a/completions/helpers/perl b/completions/helpers/perl index a0468440..dc44d71f 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 print_modules_real { + my ($base, $dir, $word) = @_; -sub slurp_dir { - opendir my $dir, shift or return; - no_upwards readdir $dir; -} + # returns immediatly if the base doesn't match + return if $base && $base !~ /^\Q$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; -} + chdir($dir) or return; -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 =~ /(? ) { 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 $type = shift; +my $word = shift; - my $pattern = qr/\A${\quotemeta $word}/; - - 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 61d09137..1aa9d2f1 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" +} -complete -C ${BASH_SOURCE[0]%/*}/helpers/perl -o nospace -o default perldoc +_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 + + # 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: