#! /usr/bin/perl
use warnings;
use strict;
use Tk;
my $entryText = 1;
print "Perl-Version: $]\nTk-Version: $Tk::VERSION\n";
my $mw = MainWindow->new();
my $entry = $mw->Entry( -textvariable => \$entryText,
-validate => 'all',
-validatecommand => \&ValidateCmd,
)
->pack( -side => 'left' );
$mw->Button( -text => 'increase',
-command => sub { $entryText++ },
)
->pack( -side => 'right' );
MainLoop;
sub ValidateCmd {
my( $newValue ) = @_;
{ local $" = '] [';
no warnings 'uninitialized'; print "ARGS: [@_]\n";
}
# return error if value > 3 and don't change the content
if( $newValue > 3 ) {
print "Error: Too big: $newValue\n";
return 0;
} # if
return 1;
} # ValidateCmd
####
Perl-Version: 5.008003
Tk-Version: 800.024
ARGS: [1] [] [] [-1] [-1]
ARGS: [2] [] [1] [-1] [-1]
ARGS: [3] [] [2] [-1] [-1]
ARGS: [4] [] [3] [-1] [-1]
Error: Too big: 4
ARGS: [4] [] [3] [-1] [-1]
Error: Too big: 4
ARGS: [4] [] [3] [-1] [-1]
Error: Too big: 4
##
##
Perl-Version: 5.008008
Tk-Version: 804.027
ARGS: [1] [] [] [-1] [6]
ARGS: [2] [] [1] [-1] [6]
ARGS: [3] [] [2] [-1] [6]
ARGS: [4] [] [3] [-1] [6]
Error: Too big: 4
##
##
The validateCommand will turn itself off by setting validate to none
when an error occurs, for example when the validateCommand or
invalidCommand encounters an error in its script while evaluating, or
validateCommand does not return a valid boolean value.