From 4254f3a4a5b94d1de17d9c27d8552f19ea1483f9 Mon Sep 17 00:00:00 2001 From: Guillaume Rousse Date: Sun, 7 Nov 2010 20:01:41 +0100 Subject: [PATCH] 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 --- completions/helpers/perl | 201 ++++++++------------------------------- completions/perl | 93 +++++++++++++++++- 2 files changed, 133 insertions(+), 161 deletions(-) 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: