# Copyright (C) 2011-2012 Rocky Bernstein <rocky@cpan.org>
use warnings; use strict;
use Exporter;
package Devel::Trepan::Complete;
use vars qw(@ISA @EXPORT); @ISA = qw(Exporter);
@EXPORT = qw(complete_token complete_token_with_next
next_token signal_complete
complete_token_filtered_with_next);
# Return an Array of String found from Array of String
# +complete_ary+ which start out with String +prefix+.
sub complete_token($$)
{
my ($complete_ary, $prefix) = @_;
my @result = ();
for my $cmd (@$complete_ary) {
push @result, $cmd if 0 == index($cmd, $prefix);
}
sort @result;
}
sub complete_token_with_next($$;$)
{
my ($complete_hash, $prefix, $cmd_prefix) = @_;
$cmd_prefix ='' if scalar(@_) < 3;
my $cmd_prefix_len = length($cmd_prefix);
my @result = ();
while (my ($cmd_name, $cmd_obj) = each %{$complete_hash}) {
if (0 == index($cmd_name, $cmd_prefix . $prefix)) {
push @result, [substr($cmd_name, $cmd_prefix_len), $cmd_obj]
}
}
sort {$a->[0] cmp $b->[0]} @result;
}
# Find all starting matches in Hash +aliases+ that start with +prefix+,
# but filter out any matches already in +expanded+.
sub complete_token_filtered($$$)
{
my ($aliases, $prefix, $expanded) = @_;
my @complete_ary = keys %{$aliases};
my @result = ();
for my $cmd (@complete_ary) {
push @result, $cmd if
0 == index($cmd, $prefix) && !exists $expanded->{$aliases->{$cmd}};
}
sort @result;
}
# Find all starting matches in Hash +aliases+ that start with +prefix+,
# but filter out any matches already in +expanded+.
sub complete_token_filtered_with_next($$$$)
{
my ($aliases, $prefix, $expanded, $commands) = @_;
# require Enbugger; Enbugger->stop;
my @complete_ary = keys %{$aliases};
my %expanded = %{$expanded};
my @result = ();
for my $cmd (@complete_ary) {
if (0 == index($cmd, $prefix) && !exists $expanded{$aliases->{$cmd}}) {
push @result, [$cmd, $commands->{$aliases->{$cmd}}];
}
}
@result;
}
# Find the next token in str string from start_pos. We return
# the token and the next blank position after the token or
# length($str) if this is the last token. Tokens are delimited by
# white space.
sub next_token($$)
{
my ($str, $start_pos) = @_;
my $look_at = substr($str, $start_pos);
my $strlen = length($look_at);
return (1, '') if 0 == $strlen;
my $next_nonblank_pos = $start_pos;
my $next_blank_pos;
if ($look_at =~ /^(\s*)(\S+)\s*/) {
$next_nonblank_pos += length($1);
$next_blank_pos = $next_nonblank_pos+length($2);
} elsif ($look_at =~ /^(\s+)$/) {
return ($start_pos + length($1), '');
} elsif ($look_at =~/^(\S+)\s*/) {
$next_blank_pos = $next_nonblank_pos + length($1);
} else {
die "Something is wrong in next_token";
}
my $token_size = $next_blank_pos - $next_nonblank_pos;
return ($next_blank_pos, substr($str, $next_nonblank_pos, $token_size));
}
# From Term::ReadLine::readline.pm
##
## For use in passing to completion_matches(), returns a list of
## filenames that begin with the given pattern. The user of this package
## can set $rl_completion_function to 'rl_filename_list' to restore the
## default of filename matching if they'd changed it earlier, either
## directly or via &rl_basic_commands.
##
sub filename_list(;$$)
{
my ($pattern, $add_suffix) = @_;
$pattern = '' unless defined $pattern;
$add_suffix = 0 unless defined $add_suffix;
# $pattern = glob($pattern) if substr($pattern, 0, 1) = '~';
my @files = (<$pattern*>);
if ($add_suffix) {
foreach (@files) {
if (-l $_) {
$_ .= '@';
} elsif (-d _) {
$_ .= '/';
} elsif (-x _) {
$_ .= '*';
} elsif (-S _ || -p _) {
$_ .= '=';
}
}
}
return @files;
}
# Custom completion routines
my @signal_complete_completions=();
sub signal_complete($) {
my ($prefix) = @_;
unless(@signal_complete_completions) {
@signal_complete_completions = keys %SIG;
my $last_sig = scalar @signal_complete_completions;
push(@signal_complete_completions,
map({lc $_} @signal_complete_completions));
my @nums = (-$last_sig .. $last_sig);
push @signal_complete_completions, @nums;
}
complete_token(\@signal_complete_completions, $prefix);
}
unless (caller) {
my $hash_ref = {'ab' => 1, 'aac' => 2, 'aa' => 3, 'b' => 4};
my @cmds = keys %{$hash_ref};
printf("complete_token(@cmds, '') => %s\n",
join(', ', complete_token(\@cmds, '')));
printf("complete_token(@cmds, 'a') => %s\n",
join(', ', complete_token(\@cmds, 'a')));
printf("complete_token(@cmds, 'b') => %s\n",
join(', ', complete_token(\@cmds, 'b')));
printf("complete_token(@cmds, 'c') => %s\n",
join(', ', complete_token(\@cmds, 'c')));
my @ary = complete_token_with_next($hash_ref, 'a');
my @ary_str = map "($_->[0], $_->[1])", @ary;
printf("complete_token_with_next(\$hash_ref, 'a') => %s\n",
join(', ', @ary_str));
print "0 1 \n";
print "0123456789012345678\n";
my $x = ' now is the time';
print "$x\n";
for my $pos (0, 2, 5, 6, 8, 9, 13, 18, 19) {
my @ary = next_token($x, $pos);
printf "next_token($pos) = %d, '%s'\n", $ary[0], $ary[1];
}
print "List of filenames:\n";
print join(', ', filename_list), "\n";
print "List of filenames beginning with C:\n";
print join(', ', filename_list('C')), "\n";
print join(', ', signal_complete('C')), "\n";
# FIXME: We don't handle ~ expansion right now.
# print "List of filenames expanded from ~\n";
}
1;