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!


In reply to Re^8: Tk::Entry and double-Tab key weirdness by atreyu
in thread Tk::Entry and double-Tab key weirdness by atreyu

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.