add pure perl perldoc completion helper
This commit is contained in:
Guillaume Rousse
parent
6d556ee5b7
commit
07b7ddd1dd
3
CHANGES
3
CHANGES
@ -1,4 +1,7 @@
|
||||
bash-completion (2.x)
|
||||
[ Guillaume Rousse ]
|
||||
* added pure-perl perldoc completion helper, using work from Aristotle
|
||||
Pagaltzis (pagaltzis@gmx.de)
|
||||
|
||||
[ David Paleino ]
|
||||
* Fixed "service" completion, thanks to John Hedges (Debian: #586210)
|
||||
|
||||
@ -2,5 +2,6 @@ AC_PREREQ([2.59])
|
||||
AC_INIT([bash-completion], [1.99])
|
||||
AM_INIT_AUTOMAKE([foreign dejagnu dist-bzip2 -Wall -Werror])
|
||||
AC_SUBST(bashcompdir, $sysconfdir/bash_completion.d)
|
||||
AC_CONFIG_FILES([Makefile contrib/Makefile test/Makefile])
|
||||
AC_SUBST(helpersdir, $datadir/bash-completion/helpers)
|
||||
AC_CONFIG_FILES([Makefile contrib/Makefile helpers/Makefile test/Makefile])
|
||||
AC_OUTPUT
|
||||
|
||||
127
contrib/perl
127
contrib/perl
@ -1,127 +0,0 @@
|
||||
# bash completion for perl
|
||||
|
||||
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=$'\t\n'
|
||||
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 -o filenames 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)
|
||||
COMPREPLY=( $( compgen -W 'chomp chop chr crypt hex index lc \
|
||||
lcfirst length oct ord pack q qq reverse rindex sprintf \
|
||||
substr tr uc ucfirst y m pos quotemeta s split study qr abs \
|
||||
atan2 cos exp hex int log oct rand sin sqrt srand pop push \
|
||||
shift splice unshift grep join map qw reverse sort unpack \
|
||||
delete each exists keys values binmode close closedir \
|
||||
dbmclose dbmopen die eof fileno flock format getc print \
|
||||
printf read readdir rewinddir say seek seekdir select syscall \
|
||||
sysread sysseek syswrite tell telldir truncate warn write \
|
||||
pack read syscall sysread syswrite unpack vec -X chdir chmod \
|
||||
chown chroot fcntl glob ioctl link lstat mkdir open opendir \
|
||||
readlink rename rmdir stat symlink umask unlink utime caller \
|
||||
continue do dump eval exit goto last next redo return \
|
||||
sub wantarray break caller import local my our state package \
|
||||
use defined formline reset scalar undef \
|
||||
alarm exec fork getpgrp getppid getpriority kill pipe qx \
|
||||
setpgrp setpriority sleep system times wait waitpid \
|
||||
import no package require use bless dbmclose dbmopen package \
|
||||
ref tie tied untie use accept bind connect getpeername \
|
||||
getsockname getsockopt listen recv send setsockopt shutdown \
|
||||
socket socketpair msgctl msgget msgrcv msgsnd semctl semget \
|
||||
semop shmctl shmget shmread shmwrite endgrent endhostent \
|
||||
endnetent endpwent getgrent getgrgid getgrnam getlogin \
|
||||
getpwent getpwnam getpwuid setgrent setpwent endprotoent \
|
||||
endservent gethostbyaddr gethostbyname gethostent \
|
||||
getnetbyaddr getnetbyname getnetent getprotobyname \
|
||||
getprotobynumber getprotoent getservbyname getservbyport \
|
||||
getservent sethostent setnetent setprotoent setservent \
|
||||
gmtime localtime time times lock' -- "$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:
|
||||
# mode: shell-script
|
||||
# sh-basic-offset: 4
|
||||
# sh-indent-comment: t
|
||||
# indent-tabs-mode: nil
|
||||
# End:
|
||||
# ex: ts=4 sw=4 et filetype=sh
|
||||
61
contrib/perl.in
Normal file
61
contrib/perl.in
Normal file
@ -0,0 +1,61 @@
|
||||
# bash completion for perl
|
||||
|
||||
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=$'\t\n'
|
||||
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 -o filenames perl
|
||||
|
||||
complete -C @helpersdir@/perldoc -o nospace -o default perldoc
|
||||
}
|
||||
|
||||
# Local variables:
|
||||
# mode: shell-script
|
||||
# sh-basic-offset: 4
|
||||
# sh-indent-comment: t
|
||||
# indent-tabs-mode: nil
|
||||
# End:
|
||||
# ex: ts=4 sw=4 et filetype=sh
|
||||
3
helpers/Makefile.am
Normal file
3
helpers/Makefile.am
Normal file
@ -0,0 +1,3 @@
|
||||
helpers_SCRIPTS = perldoc
|
||||
|
||||
EXTRA_DIST = $(helpers_SCRIPTS)
|
||||
102
helpers/perldoc
Executable file
102
helpers/perldoc
Executable file
@ -0,0 +1,102 @@
|
||||
#!/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_function_suggestions {
|
||||
my ( $func ) = @_;
|
||||
|
||||
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 @suggestion;
|
||||
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 @suggestion, /^=item (-?\w+)/;
|
||||
}
|
||||
|
||||
my $func_rx = qr/\A${\quotemeta $func}/;
|
||||
|
||||
return grep { /$func_rx/ } @suggestion;
|
||||
}
|
||||
|
||||
sub usage {
|
||||
die map "\n$_\n", (
|
||||
"To use, issue the following command in bash:",
|
||||
"\tcomplete -C perldoc-complete -o nospace -o default perldoc",
|
||||
"You probably want to put that line in your ~/.bashrc file.\n",
|
||||
);
|
||||
}
|
||||
|
||||
usage() if not exists $ENV{'COMP_LINE'};
|
||||
|
||||
my ( $cmd, @arg ) = get_command_line();
|
||||
my $word = pop @arg;
|
||||
|
||||
print "$_\n" for ( @arg and @arg[-1] eq '-f' )
|
||||
? get_function_suggestions( $word )
|
||||
: get_package_suggestions( $word );
|
||||
Loading…
x
Reference in New Issue
Block a user