Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

Re^6: Tk::Entry and double-Tab key weirdness

by atreyu (Sexton)
on May 30, 2012 at 14:35 UTC ( [id://973298]=note: print w/replies, xml ) Need Help??


in reply to Re^5: Tk::Entry and double-Tab key weirdness
in thread Tk::Entry and double-Tab key weirdness

I said, I showed you the way, and it was up to you to perfect it. :-)

i am spoiled, zentara. i have copied more of your code examples than I can remember and it had always works flawlessly before... ;)

I would enlarge the font and make a white background color if I were you.

Good suggestion - my "final product" code has the white background in the fields, but thanks for noting. i've used fontCreate before, but I'm lazy and use the -font => '{arial} 18 {bold}' syntax a lot. Could you tell me what the difference is there, if there is one (other than you can re-use 'big' as a font in your code, which is ultimately easier)?

Replies are listed 'Best First'.
Re^7: Tk::Entry and double-Tab key weirdness
by zentara (Archbishop) on May 31, 2012 at 10:57 UTC
    Could you tell me what the difference is there,

    The -font => '{arial} 18 {bold}' syntax seems pretty clean, but from my experience, setting the font with fontCreate always resulted in fewer glitches. I'm an old timer, and started Tk when you needed to specify fonts with stuff like:

    -font => '-Adobe-Courier-Bold-O-Normal--*-120-*-*-*-*-*-*';
    Yuck!. Also see Tk Font Manipulation. When you use fontCreate to create the font, you can more easily manipulate them later.

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
      The -font => '{arial} 18 {bold}' syntax seems pretty clean, but from my experience, setting the font with fontCreate always resulted in fewer glitches.

      got it, thanks, zentara.

      All,

      I have changed up the code considerably, though the intent remains the same: validate text input intended for a MAC address. The most significant change is that I did away with using Tk::Entry validation, and instead am using bind subroutines to validate. I did this b/c I didn't like how if the user enters invalid text, it would not appear in the field (and I couldn't figure out how to insert it w/out breaking validation). Not only would users not see the invalid character that was entered, but they would have to back-space and delete the last visible character in the field in order to re-engage validation, even though the last displayed character in the field IS valid.

      I've also added a Save button which will validate all the individual Entry fields in one fell swoop. If all the MAC input fields validate, then the new MAC is printed in a separate ROText widget.

      Also, I've added a drop-down (Tk::Optionmenu) widget to allow selecting b/t multiple NICs; whichever is selected is the "current" NIC, as far as the MAC input fields are concerned.

      For the most part, I happy, but after all my changes, I now have two new Tab issues, neither of which I've been able to solve, so here I am.

      Problem 1:
      When the app first starts up, I use eventGenerate bindings (to Tab and KeyRelease) to automatically tab thru all the MAC input fields and "auto-validate" the initial values. It works great, but if a bad octet is discovered, it will still continue to validate all the subsequent octets. That is not to say that the focus will tab thru the rest of the input fields, focus will properly halt on the input field with the bad value - it is just that the auto-validation attempts to continue in the background (i.e., if octet #3 is bad, it will have validation checked 4 times - as shown in the terminal when run). I can't figure out how to make it stop after the first failed validation (if any are discovered).

      Problem 2:
      I can't keep the Tab order in the way I want it. It should go:

      NIC-Oct1->O2->O3->O4->O5->O6->Save

      but instead, it goes:

      NIC->Save->Oct1->O2->O3->O4->O5->O6

      I have tried using this convention:
      my %after = ( $NIC => $O1, $O1 => $O2, $O2 => $O3, $O3 => $O4, $O4 => $O5, $O5 => $O6, $O6 => $Save, ); $mw->bind('all','<Tab>',sub{($after{$_[0]})->focus;Tk::break()});
      But that breaks validation. I'm sure it has something to do with the way I am willy nilly disabled/enabling the -state and -takefocus options of the widgets, but I can't see the light.

      <<<<<<>>>>>>>

      Here's the new code:
      #!/usr/bin/perl use strict; use warnings; use Tk; use Tk::ROText; # set to `0' if you do not want the actual MACs of detected NICs to be + used # if set to `1', will gracefully/silently be ignored if no NICs are de +tected my $use_real_macs = 1; # get NICs available to system opendir(DIR,'/sys/class/net') or die "can't opendir '/sys/class/net': +$!\n"; my @nics = sort grep{!/lo/ && !/^\.\.?$/} readdir(DIR); closedir(DIR); # define some NICs (for display purposes) if none are found unless($#nics>=0){ @nics = ('eth0','eth1'); $use_real_macs = 0; } my $mw = MainWindow->new(-title => 'MAC Address Tool'); $mw->fontCreate('sans_8', -family => 'sans', -weight => 'normal', -size => 8, ); $mw->fontCreate('mono', -family => 'mono', -weight => 'bold', -size => 12, ); my $fr1 = $mw->Frame()->pack(-expand => 1, -fill => 'both'); my $lb1 = $fr1->Label(-text => 'Select NIC')->pack(-side=>'left'); # hash to store MAC addresses saved, per NIC my %macs = (); # default val of the text variable that represents the currently selec +ted NIC my $nic = $nics[0]; # NIC drop-down menu my $nicWidget = $fr1->Optionmenu( -font => '{verdana} 10 {normal}', -bg => 'white', -foreground => 'Gray50', -activebackground => 'white', -options => [@nics], -anchor => 'w', -relief => 'sunken', -bd => 2, -padx => 1, -takefocus => 1, -textvariable => \$nic, )->pack(-side=>'left'); my $fr = $mw->Frame()->pack(-expand => 1, -fill => 'both'); my $lb = $fr->Label(-text => 'Enter MAC Address')->grid(-row=>0,-colum +n=>0); my $okBtn = $fr->Button( -text => 'Save', -font => 'sans_8', -state => 'disabled', -bd => 1, -takefocus => 0, -pady => 5, ); my %rot; my $row = 3; for(@nics){ $fr->Label(-text=>$_.' MAC Address:')->grid(-row=>$row,-column=>0); $row++; $rot{$_} = $fr->ROText( -relief => 'solid', -height => 1, -width => 18, -bg => 'white', -font => 'mono', -foreground => 'black', -bd => 1, -takefocus => 0, -highlightthickness => 0, -state => 'disabled', ); } # widget used to display Entry field errors my $errW = $fr->Label(-foreground=>'red'); # exit button my $exitBtn = $fr->Button( -text => 'Exit', -command => sub {exit(0);}, -font => 'sans_8', -state => 'normal', -bd => 1, -takefocus => 0, -pady => 5, ); # 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( -font => '{verdana} 12 {normal}', -textvariable => \$entries{$_}{'addy'}, -width => 3, -bg => 'white', ); # validate using bind $entries{$_}{'entry'}->bind('<KeyRelease>',[\&validation,$_,\%entrie +s]); # save default widget background $entries{$_}{'bg'} = $entries{$_}{'entry'}->cget('-bg'); # what type of validation will be done in this value $entries{$_}{'type'} = 'mac'; # pack/display the widget $entries{$_}{'entry'}->grid(-row=>0,-column=>$_); } # see if we should use the actual MAC addresses if($use_real_macs){ # look up real MAC addresses for(@nics){ my $file = '/sys/class/net/'.$_.'/address'; open(FH,'<',$file) or die "can't open '$file': $!\n"; my $address = readline(*FH); close(FH); die "Failed to get MAC for $_\n" unless($address); chomp($address); print "Real MAC address for $_: $address\n"; my @address = split(/:/,$address); for(my $i=0;$i<=$#address;$i++){ my $oct = $address[$i]; $macs{$_}{$i+1} = $oct; } } }else{ # create some bogus MAC values (make values invalid to test validati +on) for(sort keys %entries){ $macs{$nic}{$_} = ($_>1) ? $_.$_ : ''; $macs{$nic}{$_} .= 'z' if($_ == 3 or $_ == 4); } } # update MAC input fields at application start-up &update_mac_fields; # update MAC input fields whenever a new NIC is selected $nicWidget->configure(-command => [\&update_mac_fields]); # the Save button will validate *all* Entries $okBtn->configure(-command => [ \&validate_all,\%entries ]); # pack widgets based upon number of Entries $errW->grid(-row=>1,-column=>1,-columnspan=>scalar keys %entries); $okBtn->grid(-row=>2,-column=>(scalar keys %entries)-1,-columnspan=>2, +-pady=>5); $row = 3; for(@nics){ $rot{$_}->grid(-row=>$row,-column=>1,-columnspan=>scalar keys %entri +es); $row++; } $exitBtn->grid(-row=>$row,-column=>(scalar keys %entries)-1,-columnspa +n=>2,-pady=>5); # auto-tab thru all Entry widgets to perform validation on pre-populat +ed values for(1..(scalar keys %entries) + 1){ $mw->eventGenerate('<Tab>'); $mw->eventGenerate('<KeyRelease>'); # $mw->idletasks; $mw->after(100); $mw->update; } MainLoop(); sub update_mac_fields { for(sort keys %entries){ $entries{$_}{'addy'} = $macs{$nic}{$_} ? $macs{$nic}{$_} : ''; $entries{$_}{'entry'}->configure(-state=>'normal'); $entries{$_}{'entry'}->configure(-bg=>$entries{$_}{'bg'}); } $errW->configure(-text=>''); $okBtn->configure(-state=>'normal'); $nicWidget->focus(); } sub validate_all { my($ref) = @_; my $failed; my $empty; my $newmac; print "\nValidating all entries: \n"; for(sort keys %$ref){ # make sure field validates unless(&validation(undef,$_,$ref)){ $failed = 1; last; } # make sure validated field is not empty my $octet = $ref->{$_}{'entry'}->get; unless($octet){ $failed = 1; $empty = $_; last; } # concatenate the new MAC address $newmac .= ($newmac) ? ':'.$octet : $octet; # save to hash $macs{$nic}{$_} = $octet; } if($failed){ if(defined($empty)){ &validation_failed($empty,$ref,"Field \`$empty' cannot be empty" +); } }else{ $failed = 0; $rot{$nic}->configure(-state=>'normal'); $rot{$nic}->delete('1.0','end'); $rot{$nic}->insert('end',$newmac); $rot{$nic}->configure(-state=>'disabled'); } return $failed; } # returns `1' if valid, and `0' if invalid sub validation { my($self,$id,$ref) = @_; my $widget = defined($self) ? $self : $ref->{$id}{'entry'}; my $value = $ref->{$id}{'addy'}; my $type = $ref->{$id}{'type'}; # boolean, 1 if validation is successful, 0 if fails my $valid; # see if any value was entered in the Entry widget field if($value){ # get the index number of the last character in the value my $index = -1; if($self){$index++ while $value =~ /./g} print "Field $id ($type) index $index, val is \`",$value,"', valid +ating..."; # MAC address octet validation if($type eq 'mac'){ if($index == 0){ if($value =~ /^[0-9a-f]$/i){ $valid = 1; }else{ $valid = 0; } }elsif(($index == 1)||($index == -1)){ if($value =~ /^[0-9a-f]{2}$/i){ $valid = 1; }else{ $valid = 0; } }else{ $valid = 0; } # place-holder for other validation data types that are not define +d yet }else{ $valid = 1; } printf("%s\n",($valid) ? "ok" : "FAILED"); # field must have been cleared or is empty (this is valid), clear ou +t errors }else{ print "Field $id ($type) has no value, resetting field...\n"; $valid = 1; } if($valid){ $widget->configure(-bg=>'white'); # clear error widget &clear_err($id,$ref); # re-enable all other widgets for(sort keys %$ref){ next if(/^$id$/); $ref->{$_}{'entry'}->configure(-state=>'normal'); } # allow focus to NIC widget $nicWidget->configure(-takefocus=>1); # enable the Save button # uncomment commented lines to implement a check for non-empty fields +first # my $empty; # for(sort keys %$ref){ # unless($ref->{$_}{'entry'}->get){ # $empty = 1; # last; # } # } # unless($empty){ $okBtn->configure(-state=>'normal'); $okBtn->configure(-takefocus=>1); # } }else{ &validation_failed($id,$ref); } return $valid; } sub validation_failed { my($id,$ref,$errmsg) = @_; my $widget = $ref->{$id}{'entry'}; my $value = $ref->{$id}{'addy'}; $errmsg = "Field $id value \`$value' is invalid" unless($errmsg); # turn the background of the problem field to red $widget->configure(-bg=>'red'); $widget->update(); # update the error widget with text indicating a problem with the va +lue $errW->configure(-text=>$errmsg); # temporarily disable focus on all other widgets for(sort keys %$ref){ next if(/^$id$/); $ref->{$_}{'entry'}->configure(-state=>'disabled'); } # disable the Save button $okBtn->configure(-state=>'disabled'); $okBtn->configure(-takefocus=>0); # unfocus the Select NIC widget $nicWidget->configure(-takefocus=>0); $widget->focus(); } sub clear_err { my($id,$ref) = @_; $errW->configure(-text=>''); $ref->{$id}{'entry'}->configure(-bg=>$ref->{$id}{'bg'}); }

      Edit:
      zentara,
      I have a funny feeling that you are the only one still seeing this thread (i.e., the only monk I'm bugging)...maybe i'm just not good w/the forum views. can u tell me how I can view recently updated threads, or how do others know when a thread has been updated, if they aren't currently "subscribed" to it? Or is there no such thing?
      Thanks!

        Hi again,

        Problem 1: When the app first starts up, I use eventGenerate bindings (to Tab and KeyRelease) to automatically tab thru all the MAC input fields and "auto-validate" the initial values. It works great, but if a bad octet is discovered, it will still continue to validate all the subsequent octets.

        Instead of eventGenerate, maybe try looping thru all Entries using $entry->focusForce?

        Problem 2: I can't keep the Tab order in the way I want it.

        Try this code:

        #!/usr/bin/perl use Tk; use strict; use warnings; my $win = MainWindow->new(); $win->Button(-text=>'Other Window',-command=>\&otherwindow)->pack; sub otherwindow { my $otherwin = $win->Toplevel; my $foo = $otherwin->Entry->pack; my $bar = $otherwin->Entry->pack; my $baz = $otherwin->Entry->pack; # &defineOrder($foo, $bar, $baz); &defineOrder($baz, $bar, $foo); } sub defineOrder { my $widget; for (my $i=0; defined( $_[$i+1] ); $i++) { $_[$i]->bind('<Key-Return>', [\&focus, $_[$i+1]]); } # Uncomment this line if you want to wrap around #$_[$#_]->bind('<Key-Return>', [\&focus, $_[0]]); $_[0]->focus; } sub focus { my ($tk, $self) = @_; $self->focus; } MainLoop();

        I have a funny feeling that you are the only one still seeing this thread (i.e., the only monk I'm bugging)...maybe i'm just not good w/the forum views. can u tell me how I can view recently updated threads, or how do others know when a thread has been updated, if they aren't currently "subscribed" to it? Or is there no such thing?

        Monks usually look thru the Notes section, below SOPW, and see if there is a reply which they are interested in. Maybe Perlmonks could do a Facebook-like hack and charge $2 bucks to keep your reply to the top of the list. :-)

        Your best bet to get more monks to look at your problem, especially after making major code modifications, is to post a new SOPW node, and mention this node as a reference.

        I mentioned that entry validation is very hard to deal with correctly, and your code now has become quite complex. That probably scares off the casual monk. You should try to make smaller examples which only demonstrate one of the glitches you are running into, if you want more viewers.

        P.S. As I was considering all your difficulties, and musing how I might tackle it, I came up with an idea which may help you. Instead of relying totally on the validated entry widget to hold all the correct entry data, why not put a parallel set of read-only Entry widgets( or properly packed set of Label widgets ) aligned right on top of your current widget set. The idea would be that as valid entry text is detected, the corresponding Label would change, and you would be focused to the next invalid Label and it's corresponding validation Entry widget. You would put all your -textvariable data into the Labels, and test them for validity with your own routine, and change bg color for each invalid value. Then you would use the validation Entries solely for entering values to be placed in the Labels, if valid. The user would know they are done, when all the Labels have white background instead of hotpink. :-)

        I hope I got the idea across. It would free you up from being confined to all the internal bindings of the validation Entry.


        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://973298]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2024-03-29 06:56 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found