This should give you a start:
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
my $mw = MainWindow->new();
my $content = 'go ';
my $entry = $mw->Entry(
-bg => 'white',
-font => 24,
-textvariable => \$content ,
-validate => 'key' ,
-validatecommand => sub {
my $newvalue = shift;
my $changedchars = shift;
my $currentvalue = shift;
my $index = shift;
my $type = shift;
print "newval-> $newvalue\nchangedchars-> $changed
+chars\n".
"curvalue-> $currentvalue\n index-> $index\n
+";
if( ($index == 0) and ($newvalue ne 'g')){return 0
+}
if( ($index == 1) and ($newvalue ne 'go')){return
+0}
if( ($index == 2) and ($newvalue ne 'go ')){return
+ 0}
return 1;
},
-invalidcommand => sub { print "ERROR.\n", $mw->bell() }
)->pack() ;
$entry->icursor(3);
$entry->focus;
MainLoop;
|