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
This commit is contained in:
Guillaume Rousse
parent
fd8ade0077
commit
4254f3a4a5
@ -1,103 +1,50 @@
|
|||||||
#!/usr/bin/env perl
|
#!/usr/bin/env perl
|
||||||
use strict;
|
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 {
|
sub print_modules_real {
|
||||||
my $comp = substr $ENV{'COMP_LINE'}, 0, $ENV{'COMP_POINT'};
|
my ($base, $dir, $word) = @_;
|
||||||
return split /[ \t]+/, $comp, -1; # if not good enough, use Text::ParseWords
|
|
||||||
|
# returns immediatly if the base doesn't match
|
||||||
|
return if $base && $base !~ /^\Q$word/;
|
||||||
|
|
||||||
|
chdir($dir) or return;
|
||||||
|
|
||||||
|
# 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";
|
||||||
}
|
}
|
||||||
|
|
||||||
sub slurp_dir {
|
# recurse in each subdirectory
|
||||||
opendir my $dir, shift or return;
|
foreach my $directory (grep { -d } glob('*')) {
|
||||||
no_upwards readdir $dir;
|
my $subdir = $dir . '/' . $directory;
|
||||||
}
|
if ($directory =~ /^(?:[.\d]+|$Config{archname}|auto)$/) {
|
||||||
|
# exclude subdirectory name from base
|
||||||
sub suggestion_from_name {
|
print_modules_real(undef, $subdir, $word);
|
||||||
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 {
|
} else {
|
||||||
$dir = '.';
|
# add subdirectory name to base
|
||||||
|
print_modules_real($base . $directory . '::', $subdir, $word);
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
my $dh;
|
sub print_modules {
|
||||||
return unless opendir ($dh, $dir);
|
my ($word) = @_;
|
||||||
my @files = readdir($dh);
|
|
||||||
closedir $dh;
|
|
||||||
|
|
||||||
@files = map { catfile $dir, $_ } @files if $dir ne '.';
|
foreach my $directory (@INC) {
|
||||||
|
print_modules_real(undef, $directory, $word);
|
||||||
return filter($path, @files);
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
sub get_directory_suggestions {
|
sub print_functions {
|
||||||
my ($path, $prefix) = @_;
|
my ($word) = @_;
|
||||||
|
|
||||||
my @suggestions =
|
|
||||||
grep { -d $_}
|
|
||||||
get_file_suggestions($path);
|
|
||||||
|
|
||||||
if ($prefix) {
|
|
||||||
@suggestions = map { $prefix . $_ } @suggestions;
|
|
||||||
}
|
|
||||||
|
|
||||||
return @suggestions;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_functions {
|
|
||||||
|
|
||||||
my $perlfunc;
|
my $perlfunc;
|
||||||
for ( @INC, undef ) {
|
for ( @INC, undef ) {
|
||||||
@ -108,90 +55,26 @@ sub get_functions {
|
|||||||
|
|
||||||
open my $fh, '<', $perlfunc or return;
|
open my $fh, '<', $perlfunc or return;
|
||||||
|
|
||||||
my @functions;
|
|
||||||
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 @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 $type = shift;
|
||||||
my ($word, @list) = @_;
|
my $word = shift;
|
||||||
|
|
||||||
my $pattern = qr/\A${\quotemeta $word}/;
|
if ($type eq 'functions') {
|
||||||
|
print_functions($word);
|
||||||
return grep { /$pattern/ } @list;
|
} 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) :
|
|
||||||
() ;
|
|
||||||
|
|
||||||
|
|||||||
@ -2,9 +2,98 @@
|
|||||||
|
|
||||||
have perl &&
|
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:
|
# Local variables:
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user