in reply to Re^3: Tk::Entry and double-Tab key weirdness
in thread Tk::Entry and double-Tab key weirdness
@zentara,
Thanks for this, will definitely check it out!
heh, lightpink should not be too hard to miss...
Edit:zentara, I checked out your code, there are a couple problems. The first is; I think in your validate sub, you left off the 2nd argument ($ref), b/c in yours it is trying to validate a HASH, not the value in the field. Am I right there?
The second is; if I use 'all' instead of 'focusout' for -validate, then it breaks again - I can tab or click out of the bad field. Is there some other piece missing for 'all' to work properly?
Edit 2:
Here's an updated version that I'm now trying out. It seems to work okay. It incorporates zentara's suggestion of using 'all' vs 'focusout' (though I'm not sure how/why it is working correctly...)
Also, to get it to evaluate all pre-populated fields when the app first fires up, I'm using eventGenerate to auto-Tab thru all the fields. It will stop on the first bad field it encounters, by virtue of the fact that I disable all other Entry widgets, if a problem is discovered. Once the field is validated, the other fields are re-enabled.
This works, but it feels very hacky though...(the auto-tabbing and widget-disabling parts).
#!/usr/bin/perl use strict; use warnings; use Tk; my $mw = MainWindow->new(-title => 'Mac Address Input Example'); my $fr = $mw->Frame()->pack(-expand => 1, -fill => 'both'); my $lb = $fr->Label(-text => 'MAC Address')->pack(-side => 'left'); # widget used to display Entry field errors my $errW = $fr->Label(-foreground=>'red')->pack(-side=>'bottom'); # hash to hold Entry widgets my %entries; # loop thru the number of Entry widgets desired for(1..6){ # create the Entry widget $entries{$_}{'entry'} = $fr->Entry( -textvariable => \$entries{$_}{'addy'}, -width => 3, ); # save default widget background $entries{$_}{'bg'} = $entries{$_}{'entry'}->cget('-bg'); # pack/display the widget $entries{$_}{'entry'}->pack(-side => 'left'); } # loop back thru the created widgets for(1..6){ # put some bogus values in for testing... $entries{$_}{'addy'} = ($_>1) ? $_.$_ : ''; $entries{$_}{'addy'} .= 'z' if($_ == 3 or $_ == 4); # configure the validation for the widget $entries{$_}{'entry'}->configure( # -validate => 'focusout', -validate => 'all', -validatecommand => [ \&validate,$_ ], -invalidcommand => [ \&show_invalid,$entries{$_}{'entry'},$_ ], ); } # put focus on initial Entry widget $entries{1}{'entry'}->focus(); # auto-tab thru all Entry widgets to perform validation on pre-populat +ed values for(1..6){ $mw->eventGenerate('<Tab>'); # $mw->idletasks; $mw->after(100); $mw->update; } MainLoop(); sub clear_err { my($num) = @_; $errW->configure(-text=>''); $entries{$num}{'entry'}->configure(-bg=>$entries{$num}{'bg'}); } # returns `1' if valid, and `0' if invalid sub validate { my($num,$val) = @_; unless($val){ print "Field $num has nothing to validate\n";return 1; +} my $valid = ($val =~ /^[0-9a-f]{1,2}$/i) ? 1 : 0; printf "Field %s, validating \`%s'...%s\n",$num,$val,$valid? "ok": " +FAILED"; if($valid){ # clear error widget &clear_err($num); # re-enable all other widgets for(1..6){ next if(/^$num$/); $entries{$_}{'entry'}->configure(-state=>'normal'); } }else{ # update the error widget with text indicating a problem with the +value $errW->configure(-text=>"Field $num value \`$val' is invalid"); } return $valid; } sub show_invalid { my($widget,$num) = @_; $widget->focus(); # turn the background of the problem field to red my $bg = $widget->cget('-bg'); $widget->configure(-bg => 'red'); $widget->update(); # temporarily disable focus on all other widgets for(1..6){ next if(/^$num$/); $entries{$_}{'entry'}->configure(-state=>'disabled'); } }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re^5: Tk::Entry and double-Tab key weirdness
by zentara (Cardinal) on May 29, 2012 at 20:28 UTC | |
by atreyu (Sexton) on May 30, 2012 at 14:35 UTC | |
by zentara (Cardinal) on May 31, 2012 at 10:57 UTC | |
by atreyu (Sexton) on Jun 01, 2012 at 17:49 UTC | |
by zentara (Cardinal) on Jun 02, 2012 at 10:07 UTC | |
|