perl/Tk Entry validation

[Anonymous Monk]

Dear all. I use the following code to force a default value for the entry if the input value is rejected by -validatecommand.

use strict;
use Tk;
my $xVConsSflEmbMax0 = 1.0;
my $xVConsSflEmbMax = $xVConsSflEmbMax0;
    my $emb1Entry = $embCanvas->Entry(
      -textvariable     => \$xVConsSflEmbMax,
      -width            => 3,
      -validate         => 'focusout',
      -validatecommand  => sub {$_[0] =~ /^\d*\.?\d+$/},
      -invalidcommand   => sub {$xVConsSflEmbMax=$xVConsSflEmbMax0},
    );

It works fine but only once! If the user tries to modify the entry a second time with a wrong input the validate command is ineffective. Would you have any advice to make it work? Thanks a lot

[zentara]

Would you have any advice to make it work?

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 }
}

[[e-mail]]

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 }
}

[choroba]

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.

[choroba]

For some reason I cannot see at the moment, validation is turned off (probably related to this part of the documentation:

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.

). An easy workaround is to reset the -validate in the invalidcommand:

#!/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');
}