#!/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'); my %entries; for(1..6){ $entries{$_}{'entry'} = $fr->Entry(); $entries{$_}{'entry'}->configure( -textvariable => \$entries{$_}{'addy'}, -width => 3, # -validate => 'focusout', # -validatecommand => [ \&validate,$_,\%entries ], # -invalidcommand => [ \&show_invalid,$entries{$_}{'entry'},$_ ], ); $entries{$_}{'entry'}->pack(-side => 'left'); } for(1..6){ $entries{$_}{'addy'} = 'zz'.$_ if($_ == 3); $entries{$_}{'entry'}->configure( #-validate => 'focusout', -validate => 'all', -validatecommand => [ \&validate,$_,\%entries ], -invalidcommand => [ \&show_invalid,$entries{$_}{'entry'},$_ ], ); } $mw->waitVisibility; $mw->after(100,sub{$entries{3}{'entry'}->focusForce}); MainLoop(); # 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"; return $valid; } sub show_invalid { my($widget) = @_; # print "@_\n"; $widget->focus(); # background of the problem field in red my $bg = $widget->cget('-bg'); $widget->configure(-bg => 'lightpink'); $widget->update(); }