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]

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

Do not use Win32
[download]

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.

No, No, No, that's horrible :(

Check your load average with that change - it hard loops waiting for a character. My reading of Term::ReadKey says

my $char = ReadKey 0;
[download]

should be used, as this properly sleeps waiting for a character, and will not return undef.

Of course, I have no idea what it does on Win32, since I can't test it.

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.

Does this help understanding of the regexes that were used?

#!/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;
  }
[download]