NateTut has asked for the wisdom of the Perl Monks concerning the following question:

I've got some Tk Entry objects like:
   my($frame_Limit) = $root->Frame (
      -relief  => 'raised',
      -borderwidth => '3',
   );
   my($label_Limit) = $root->Label (
      -font => '-*-MS Sans Serif-Bold-R-Normal-*-*-120-*-*-*-*-*-*',
      -relief => 'flat',
      -text => 'Operand Limit',
   );
   my($entry_Limit) = $root->Entry (
      -justify => 'left',
      -textvariable => \$Limit,
      -validate => 'focusout',
      -validatecommand => \&Validate_Number,
   );

[download]
There are several entries like the code above,
My Validation routines are: 
#
# is_a_positive_integer
#
# Validate Numbers
#
# Arguments: $Number
#
# Returns: $Number or undef on Failure
#
sub is_a_positive_integer ($)
{
   my $Number = shift;

   if(!Data::Validate::is_integer($Number))
      {
      return undef;
      }
   elsif(!Data::Validate::is_greater_than($Number, 0))
      {
      return undef;
      }
   else
      {
      return $Number;
      }
}

#
# Validate_Number
#
# Tk validateCommand Callback
#
# Arguments: $NewValue, $CharChange, $CurrentValue, $Index, $ActionTyp
+e
#
# Returns: 0 on Failure to Validate 1 Otherwise
#
sub Validate_Number ($$$$$)
{
   my $NewValue     = shift;
   my $CharChange   = shift;
   my $CurrentValue = shift;
   my $Index        = shift;
   my $ActionType   = shift;

   if(defined(is_a_positive_integer($NewValue)))
      {
      return(1);
      }
   else
      {
      return(0);
      }
}

[download]
is_a_positive_integer was written for an earlier console version. Validate_Number is a wrapper for it for use by the Tk -validateCommand callback. This all runs fine under "use strict & use warnings.

The problem is that I need to know which entry is making the call so I can take appropriate action. Tk doesn't provide any calling routine information just values.

Any thoughts?

Replies are listed 'Best First'.
Re: Tk validateCommand Help
by davidrw (Prior) on Jun 07, 2005 at 01:43 UTC
    I think you can do something like this (untested), where you have the callback just be a wrapper that passed an extra param to say where it came from: 
       my($entry_Limit) = $root->Entry (
      -justify => 'left',
      -textvariable => \$Limit,
      -validate => 'focusout',
      -validatecommand => sub { Validate_Number 'entry_Limit', @_ },
   );

sub Validate_Number ($$$$$)
{
   my $caller = shift;
   my $NewValue     = shift;
   ...
}

    [download]
[reply]
[d/l]
Re: Tk validateCommand Help
by zentara (Cardinal) on Jun 07, 2005 at 12:53 UTC
    Tk has no standard for the first element being passed to a sub. Only the bind method will pass itself as a widget reference as $_[0] by default. So you have to work out your own system. You have a couple of options. You can pass it like davidrw showed you, or you can use a different syntax like 
    -validatecommand => [\&Validate_Number, $entry_limit]

    [download]
    You can also use the caller method to get which widget called the sub like in the example below. You can use the caller in conjunction with hashes, to do some complex switching. You could put each entry's specifications into a hoh like 
    my %entry =(
  1=>{ 'object' =>undef,
           'upperlim => 42,
           'lowerlim  =>0
         },
  
   2=>{ 'object' =>undef,
           'upperlim => 99,
           'lowerlim  =>-23
         },
);

    [download]
    Then in your validate callback, just pass the entry number like 
    -validatecommand => [\&Validate_Number, 1]

    [download]

    Here is an example using button to demonstrate the caller function. 

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

my $mw = MainWindow->new;

for(0..4){
$mw->Button(-text => "Hello World$_",
                     -command=>[\&change])->pack;
}
MainLoop;

sub change {
print "sub-input->@_\n";
my $caller = $Tk::widget;
print "$caller   ";
print $caller->{'_TkValue_'},'     ';
my $text = $caller->cget('-text');
print "$text\n";
$caller->configure(-text=>"Hello Stranger");
}

    [download]
    I'm not really a human, but I play one on earth. flash japh
[reply]
[d/l]
[select]
      Thanks to both of you for your excellent advice.
[reply]

Back to Seekers of Perl Wisdom