While testing my other post Re: [challenge] Nested autocompletion I noticed I was always typing one letter and then a tab. So why not auto-tab? Here it is: maximum effect for least effort :)

The only tricky part was getting backspace to work, because it usually has to back up more than one letter.

#!/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 : '';
      $input = $lines =~ s/^(?!\Q$input\E).*\n//gmr =~
        /^(.*).*\n(?:\1.*\n)*\z/ ? $1 : '';
      my $words = join ' ', sort + uniq $lines =~ /^\Q$input\E ?(\S+)/
+gm;
      $lines =~ /^$input\n/m and $words = '*** Completed!';
      my $backup = "\e[" . ( 2 + length $words ) . "D";
      print "$clearline$prompt$input  $color$words$reset$backup";
      my $char = ReadKey;
      $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 );
        $input = "$input\n$lines" =~
          /^(.*).*\n(?:(?:(?!\1).*\n)*\1.*\n){$match}/ ? $1 : '';
        }
      }
    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;
  }
[download]

This should become another entry in my (never to be written) Master Work: The Only Data Structure Needed Is A Multi-Line String.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.