#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11150326
use warnings; # constant autocomplete
use List::Util qw( uniq );
use Term::ReadKey;
$| = 1;
my @animals = (qw( cow camel dog cat ));
my @foods = (qw( fish pasture meat ));
my @places = (qw( wood sea desert ));
my $commands = {
select => {
completion_list => \@animals,
commands => {
give => { completion_list => \@foods, },
take_to => { completion_list => \@places, },
},
},
kill => { completion_list => \@animals, }
};
my $completed = autocomplete( $commands, 'auto> ' );
print $completed ? "\nThe user entered: $completed\n" : "\nEscape\n";
exit;
######################################################################
sub autocomplete
{
my $commands = shift;
my $prompt = shift // '> ';
my $lines = ref $commands ? join "\n", lines($commands), '' : $comma
+nds;
my $input = '';
my ($clearline, $color, $reset) = ("\e[G\e[K", "\e[32m", "\e[m");
ReadMode 'raw';
eval
{
while()
{
$input = "$input\n$lines" =~ /^(.*).*\n(?:.*\n)*\1/ ? $1 : '';
#Trims back $input so it only contains a string that exists in one of
#the valid lines. It's looking for the longest initial string that als
+o
#starts one of the other lines. The (?:.*\n)* allows for skipping over
#any lines that do not match.
$input = $lines =~ s/^(?!\Q$input\E).*\n//gmr =~
#Removes from $lines any line that does not start with $input. Returns
#a multiline string where every line starts with $input.
/^(.*).*\n(?:\1.*\n)*\z/ ? $1 : '';
#Finds the longest initial substring that starts every line. This will
#extend the match until the next decision point that requires user inp
+ut.
my $words = join ' ', sort + uniq $lines =~ /^\Q$input\E ?(\S+)/
+gm;
#Finds the next word after the matching part of each valid line.
$lines =~ /^$input\n/m and $words = '*** Completed!';
#Matches $input against each valid line looking for a complete line ma
+tch.
my $backup = "\e[" . ( 2 + length $words ) . "D";
print "$clearline$prompt$input $color$words$reset$backup";
my $char = ReadKey 0;
$char =~ tr/\e\cc// and $input = '', last;
$char =~ tr/\n\r// and $lines =~ /^$input$/m ? last : next;
$char =~ tr/ -~// and $input .= $char;
if( $char =~ tr/\b\x7f// ) # backspace
{
my $match = 1 + ( () = $lines =~ /^\Q$input\E/gm );
#Counts how many lines are still valid matches, that is they are still
#possibilities that require a user decision at this point. Adds 1
#because we need to go back to the previous decision point which will
#(by definition) have at least one more valid match.
$input = "$input\n$lines" =~
/^(.*).*\n(?:(?:(?!\1).*\n)*\1.*\n){$match}/ ? $1 : '';
#Finds the longest initial substring that also is the initial substrin
+g
#of $match following lines. Lines that do not start with the candidate
#initial match are skipped by (?:(?!\1).*\n)* . This longest initial
#substring is the previous decision point, and is then stored into $in
+put.
}
}
1;
};
my $error = $@;
ReadMode 'restore';
print "$error\n";
return $input;
}
sub lines
{
my $cmd = shift or return '';
map s/ +$//r, map { my $key = $_; # fun triple map nesting
map { my $prev = $_;
map "$key $_ $prev", @{ $cmd->{$key}{completion_list} };
} lines( $cmd->{$key}{commands} )
} keys %$cmd;
}
|