This might not be exactly what you want but it was fun anyways :)

Done without looking at hints or other code.

Runs in xterm on ArchLinux, don't know about other systems...

#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11150326
use warnings;
use List::Util qw( uniq );
use Term::ReadKey;

# dummy items to play with
my @animals = (qw( cow camel dog cat  ));
my @foods   = (qw( fish pasture meat  ));
my @places  = (qw( wood sea    desert ));

# commands
my $commands = {
    select => {
        completion_list => \@animals,
        commands => {
                        give => { completion_list => \@foods, },
                        take_to => { completion_list => \@places, },
        },
    },
    kill  => { completion_list => \@animals, }
};

my $completed = autocomplete( $commands, 'test autocomplete> ' );
print $completed ? "\nThe user entered: $completed\n" : "\nEscape\n";
exit;

######################################################################

sub autocomplete
  {
  my ($commands, $prompt) = @_;
  my $lines = join "\n", lines($commands), '';
  $prompt //= '> ';
  my $input = '';
  my $clearline = "\e[G\e[K";
  my $skip;
  $| = 1;
  ReadMode 'raw';
  eval
    {
    while()
      {
      $skip or print $clearline, $prompt, $input;
      $skip = 0;
      my $char = ReadKey;
      $char =~ tr/\e\cc// and $input = '', last;
      $char =~ tr/\n\r// and $lines =~ /^$input$/m ? last : next;
      $char eq "\b" and chop($input), next;
      if( $char eq "\t" )
        {
        my ($new, $letters) = extend($input, $lines);
        if( not defined $new )
          {
          # shorten to longest legal string
          $input = "$input\n$lines" =~ /^(.*).*\n(?:.*\n)*\1/ ? $1 : '
+';
          next;
          }
        $input = $new;
        my $info = (extend($input, $lines))[1] || '***Complete!';
        my $len = 2 + length $info;
        print $clearline, $prompt, $input, "  \e[92m$info\e[m\e[${len}
+D";
        $skip = 1;
        next;
        }
      $input .= $char;
      }
    };
  ReadMode 'restore';
  print "\n";
  return $input;
  }

sub extend
  {
  my ($in, $lines) = @_;
  my $match = join '', $lines =~ /^\Q$in\E.*\n/gm;
  my $extend = $match =~ /^(.*).*\n(?:\1.*\n)*\z/? $1 : undef;
  my $letters = join ' ', sort + uniq $lines =~ /^\Q$in\E(\S+)/gm;
  return $extend, $letters;
  }

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]

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.

the challange ended and, surprise!, we had two participants and three solutions plus my own one.

Results

• tybalt89 second - 125 points - gold medal - winner!
• tybalt89 first - 119 points - silver medal
• Anonymous Monk - 116 points - bronze medal

Notes about points

Anonymous Monk's solution has a minor defect: it allows also kill snake where snake is not among @animals and also select WHALE take_to desert so is more a relaxed version of what I intended, but I have accept it as valid. The backspace behaviour is implemented only on terms not on the whole line. The logic of the program is very neat and easy to understand: my ethernal gratitude :) 16 XP atm

tybalt89 first attempt is already very nice to see. It runs fine only on Linux (more on this below). The all-in-one-line interface is very appealing, as the use of colors. The backspace beahviour is missing (also more on this below): if you erase cow in select cow and then type doTAB you get back to select cow It has 19 XP atm.

tybalt89 second solution is really, really cute to see (on Linux again: maybe life is too short to support unfriendly OSs? ;): it is what I'd like to see in every interactive commandline utility. It also implements the backspace usage correctly so +10, and despite only 15 XP, because of this it wins the challange.

Notes about implementations

Dear Anonymous Monk maybe you do not want to signup in the monastery because of ... , but it is a pity for us not to be able to answer directly: infact I contacted the author of the Term::Completion module, addressing them to your comments and because of this they published their first github repository for the module. They seems very open to suggestions: feel free to contribute there :) Infact one of my best achivements here was to contribute to convince tybalt89 to abandon Anonymous Monk's cloak and finally signin. Programs proposed by tybalt89 are very smart as always and I will need to study them with a bit of patience before understanding them completely, but you always deserve my gratitude, no fear :)

Both programs by tybalt89 show a rare beahviour on Win32: in effect the backspace works well on terms and on the whole line too, but the output is pested of errors emitted by Term::ReadKey complaining with Use of uninitialized value in subroutine entry at C:/perl5.26.64bit/perl/site/lib/Term/ReadKey.pm line 476.

Line 476 of the file on my pc is Win32PeekChar($File, $_[0]); but is not the same line on cpan, even for the very same 2.38 version. Only calling the program as perl autocompletion-nested-tybalt89.pl 2> nul I get the program running correctly.

I looked at the source of Term::ReadKey but I flew away puzzled very soon.

The nasty error comes out with ReadMode 'cbreak' 'raw' 'ultra-raw' so 3,4,5 and here you have the minimal code to reproduce it:

use strict;
use warnings;

use Term::ReadKey;
$| = 1;

ReadMode 'raw';

while(){
    my $char = ReadKey; 
    # infinite, unbreakable looop without this check
    if ( $char eq 'x' ){
        # broken console on Linux without this!
        ReadMode 'restore';
        last;
    }
    print "[$char]";
}
[download]

What is happening on Win32?

Conclusion

It was very fun for me to see your solutions, as always an answer leads to many other questions.

The prize is a bottle of organic red wine and it can be received here in Roma without any time limit :)

Thanks!

L*

I do not see the backspace behavior you claim. What I have found is that "xterm" and "linux console" return different values for the backspace key. The fix for that is to replace

$char eq "\b" and chop($input), next;
[download]

with

$char =~ tr/\b\x7f// and chop($input), next;
[download]

Note that "tybalt89 second" already has that fix.

About Win32: I do not have a Win32 system to test on, however I do have a fix for that:

Do not use Win32
[download]


Thanks for the challenge and I hope you enjoyed the regexes in "tybalt89 second", particularly the "backspace" one.

Hello again tybalt89 and all,

I need to stop trusting code by others, even if by experienced programmers like you :)

It comes out ReadKey.pm is generated from ReadKey.pm.PL and generates different output on different systems: so on linux it checks for undefined values while on win32 it does not. To me this is bug so I created an issue.

The docs of Term::ReadKey say you need to pass a MODE to the ReadKey function.

So instead of my $char = ReadKey; you need instead my $char = ReadKey(-1); next unless defined $char;

For future convenience here is the patched version of your second program, fixed for win32:

Read more... (3 kB)

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Hello tybalt89,

yes you are right: I've tested both your programs in the "linux console" not in "xterm" and because of this I noticed the wrong backspace behaviour. So your first program deserved 10 points more jumping to 129 and to the gold medal..

As the second program had the fix already applied I got nice backspace effect under "linux console" and I gave it +10 points.

I'm somehow happy for my error because I like the second program a lot.

I enjoyed your regexes but I have to admit they are very hard to understand for me, and the whole program too.

For the Win32 definitive fix ( Do not use Win32 ;) I can understand and accept your position, but supporting such a big market share is a plus for perl: I will hammer here and there to get rid of the warning emitted by Term::ReadKey

Message me to get the prize when you come in the Ethernal City :)

Thanks!

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

As far as I understand the complication is in the grammar and not in the auto-completion and you are shying away from implementing/maintaining a state-machine.

From your description I understand this (pseudo syntax)

• [ select | kill ] @animals [ give @foods | take_to @places ]

• [ kill @animals | select @animals [ give @foods | take_to @places ] ]

It's also not clear if give and take_to can be followed by further commands

• [ kill @animals | select @animals [ give @foods | take_to @places ] ]? # quantifier ? one-or-more commands

Or if you can have multiple items:

• [ kill @animals | select @animals [ give (@foods)? | take_to @places ] ] # ? one-or-more food items

select camel give fish #???

hence we need

• ... select @animals [ give ( @{$foods{$select}} )? ... # updated

The next question is validation , what happens if a someone manually types select horse ... which isn't in the animal-list, shouldn't that be rejected?

My naïve approach would be to implement/translate that grammar to a nested regex and input that doesn't match is rejected.

Typing TAB after a command displays the completion list.²

But I have a hunch there are already better ways to implement such grammars on CPAN.

²) from what I remember this can be done with Term::ReadLine by adding call backs for evaluation and expansion.

Hurray, challenge on Monday! And I'm mad alright thank-you, so I qualify. Haven't seen OP's code nor spoilers, so maybe I didn't quite get it. Basic logic would be: