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.

#!/usr/bin/perl
use warnings;
use strict;

use Tk;

my $embCanvas = MainWindow->new;
my $xVConsSflEmbMax0 = 1;
my $xVConsSflEmbMax = $xVConsSflEmbMax0;
my $emb1Entry = $embCanvas->Entry(
      -textvariable     => \$xVConsSflEmbMax,
      -width            => 3,
      -validate         => 'focusout',
      -validatecommand  => sub { warn "@_\n"; $_[0] =~ /^\d*\.?\d+$/ }
+,
      -invalidcommand   => \&invalid,
    )->pack;
my $qb = $embCanvas->Button(
        -text    => 'Quit',
        -command => sub { exit }
        )->pack;

MainLoop();

sub invalid {
    $xVConsSflEmbMax = $xVConsSflEmbMax0;
    $emb1Entry->configure(-validate => 'focusout');
}
[download]

Yes, show a complete example which demonstrates the problem. It look off the top of my head, that you may have a problem in the return value from -validatecommand .... it should return a 1 or 0. Look how this works.

#!/usr/bin/perl
use strict;
use warnings;
use Tk;


my $top = MainWindow->new();
$top->geometry('200x200');

my %entries;

for(1..4){
 $entries{$_}{'value'} ||= 0;
 $entries{$_}{'entry'} = $top->Entry(
     -textvariable => \$entries{$_}{'value'},
     -width        => 5,
     -bg           => 'white',   
     -validate     => 'key',
     -vcmd         => \&validate,
  )->pack;
}

MainLoop;

#have to make sure empty value has numeric context
sub validate{
  my $val = shift;
  $val ||= 0;
  #get alphas and punctuation out
  if( $val !~ /^\d+$/ ){ return 0 }
  if (($val >= 0) and ($val <= 100)) {return 1}
    else{ return 0 }
}

[download]

Sorry for this lack of courtesy. Posting the complete example is indeed a good practice. I'll stick to it. Based on your example I tried the following code to add the boundaries as arguments of the validate subroutine. I cannot figure out how to reference the input value in the -validatecommand. I have tried $_, $_[0] and $xVConsSflEmbMax but none seems to work...

use strict;
use Tk;

my $xVConsSflEmbMax0 = 1.0;
my $xVConsSflEmbMax = $xVConsSflEmbMax0;

my $mw = new MainWindow();
my $entry = $mw->Entry(
  -textvariable     => \$xVConsSflEmbMax,
  -width            => 3,
  -validate         => 'focusout',
  -validatecommand  => [\&validSub,$_[0],0,1],
  -invalidcommand   => sub {$xVConsSflEmbMax=$xVConsSflEmbMax0},
) -> pack;

MainLoop;

sub validSub {
  my ($val,$min,$max) = @_;
  $val ||= 0;
  $min ||= -1E10;
  $max ||= 1E10;
  if( $val !~ /^\d*\.?\d+$/ ) { return 0 }
  elsif (($val >= $min) and ($val <= $max)) {return 1}
  else { return 0 }
}
[download]

As you might have noticed in the documentation or in the example above, you do not have to send any arguments to validatecommand. They are sent automatically.

This node was taken out by the NodeReaper on Aug 06, 2012 at 11:52 UTC
Reason: [choroba]: Reap: duplicate of Re^2: perl/Tk Entry validation

You may view the original node and the consideration vote tally.