jagdish.eashwar has asked for the wisdom of the Perl Monks concerning the following question:

I want to monitor if the value of an entry box has been changed. So on the FocusIn event, I am storing the present value in $variable1_previous by binding a sub, and on the FocusOut event, I am comparing the values of $variable1 and $variable1_previous again through a bound sub. 

use strict;
use warnings;

use Tk;

my ($mw,$EntryBox1,$EntryBox2,$variable1,$variable1_previous,$variable
+2);

$mw = MainWindow->new;
$EntryBox1 = $mw->Entry(-textvariable => \$variable1,
        )
        ->place(-relx => 0.06, -rely => 0.03);

$EntryBox2 = $mw->Entry(-textvariable => \$variable2,
        )
        ->place(-relx => 0.06, -rely => 0.20);

$EntryBox1->bind("<FocusIn>",\&save_previous_value);
$EntryBox1->bind("<FocusOut>",\&compare_values);

MainLoop;

sub save_previous_value {
$variable1_previous = $variable1;
      }

sub compare_values {
if ($variable1 ne $variable1_previous) {
$mw->messageBox(-message => "The value has been changed.",-type => "ok
+");
       }
       }

[download]

Is this the way to do it? When the number of entry boxes to be so monitored are large, will it be necessary to write a sub for each entry box? Is it possible to write a common sub which I can bind to all of them? Can the concerned variables be referred to in a generic fashion rather than be named each time? Like something which refers to the variable of the entry box that was the subject of the FocusIn or FocusOut event?

Replies are listed 'Best First'.
Re: perl Tk
by Anonymous Monk on Sep 03, 2009 at 07:12 UTC
    Hi,

    it is possible to do something similar using the -validate option:

      
$parent->Entry( -validate=>'key',
                -validatecommand=>['entry_validation',$self],
           );
#### snip
sub entry_validation{
  my $self = shift();
  my @args = @_;
  $self->set_changed unless ($args[4]== -1);#triggered on user interac
+tion only
  return 1; #allow changes
}

    [download]

    This will trigger on paste events as well. - I'm not checking for changed content here. I think it would be possible - take a look at the documentation for -validatecommand


    Cheers, Christoph
[reply]
[d/l]
[select]

      I found something on the net at http://forums.devshed.com/perl-programming-6/perl-tk-how-to-call-the-event-s-object-entry-630717.html, and also got some confirmation from pg 273 of the book Learning Perl/Tk. Instead of specifying the individual entry boxes, one should use the Tk::Entry class. 

      use strict;
use warnings;

use Tk;

my ($mw,$EntryBox1,$EntryBox2,$variable1,$variable2,$entry,$variable_p
+revious,$variable_current);

$mw = MainWindow->new;
$EntryBox1 = $mw->Entry(-textvariable => \$variable1,
        )
        ->place(-relx => 0.06, -rely => 0.03);

$EntryBox2 = $mw->Entry(-textvariable => \$variable2,
        )
        ->place(-relx => 0.06, -rely => 0.20);

$mw->bind("Tk::Entry","<FocusIn>",\&save_previous_value);
$mw->bind("Tk::Entry","<FocusOut>",\&compare_values);

MainLoop;

sub save_previous_value {
$entry = shift;
print "$entry\n";
# i was hoping this would print '$EntryBox1' or '$EntryBox2'
# instead it gives me 'Tk::Entry=HASH(0x1bf2f7c)'
# or 'Tk::Entry=HASH(0x1bfa9a4)'
$variable_previous = $entry->get();
      }

sub compare_values {
$entry = shift;
$variable_current = $entry->get();
if ($variable_current ne $variable_previous) {
$mw->messageBox(-message => "The value has been changed.",-type => "ok
+");
       }
       }

      [download]

      Now the common sub works for all the entry widgets in the main window. I would however like to know the name of the concerned entry widget. Is there some way of finding that out?

[reply]
[d/l]
        Hi,

        what would you need that name for? If you want per instance behavior, you need to set up bindings per instance (I would prefer that) or stuff additional data into your widgets instance

        my %entries;
$entries{MyEntriesName} = $parent->Entry();
$entries{MyEntriesName}->privateData('MyPrivateDataSlot')->{Name}='MyE
+ntriesName';

        [download]

        Cheers, Christoph
[reply]
[d/l]

Back to Seekers of Perl Wisdom