Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Tk::LabEntry - how to reach the configuration of label via callback?

by vagabonding electron (Curate)
on Feb 07, 2016 at 13:28 UTC ( #1154603=perlquestion: print w/replies, xml ) Need Help??

vagabonding electron has asked for the wisdom of the Perl Monks concerning the following question:

Hi All,

I try to validate the content of entry in Tk::LabEntry widget. I would like to change the configuration of the label part if the content is not a number (simply to color it red). I can do this with the background of the entry (code below), however an attempt to reach the option -labelBackground produces an error message "unknown option".

I know that Tk::LabEntry is a Mega-Widget. I cannot find a way to reach its configuration (that is, the label part) via callback. It would work if I call the widget by name (that is,  $le->configure(-labelBackground => 'red'); would do the job in the code below). I would like to stick with callback however since I have several such widgets in the real application.

Please give me an advice. Thank you!

#!/perl use strict; use warnings FATAL => qw(all); use Tk; use Tk::LabEntry; use List::Util qw(first); use Scalar::Util qw(looks_like_number); my $mw = MainWindow->new(); $mw->title("Test"); my $test = 8; my $width = 250; my $length = 125; $mw->minsize($width, $length); my $FONT = $mw->fontCreate(-family => 'verdana', -size => 14, -weight => 'normal'); my $le = $mw->LabEntry(-label => 'Value', -labelPack => [qw/-side left -anchor w/], -labelFont => '9x15bold', -font => $FONT, -relief => 'ridge', -textvariable => \$test, -width => 2, )->pack(); $le->bind('<Key>' => sub { labelCheck($_[0]);}); MainLoop; sub labelCheck { my $x = $_[0]->get(); if ( !(looks_like_number($x)) or ($x < 0) ) { $_[0]->delete(0, 'end'); $_[0]->configure( -background => 'red'); # $_[0]->configure( -labelBackground => 'red'); } else { $_[0]->configure( -background => '#f0f0f0',); # $_[0]->configure( -labelBackground => '#f0f0f0'); do_something(); } return 1; } sub do_something { print $test, $/; }

Replies are listed 'Best First'.
Re: Tk::LabEntry - how to reach the configuration of label via callback?
by beech (Parson) on Feb 07, 2016 at 21:43 UTC

    If you add a few print/warn statements, you can see that $le is Tk::LabEntry=HASH(0x10b7f8c) but that the bind callback gets a Tk::Entry=HASH(0x10d47cc)

    You could use Tk::Widget method parent to get back to LabEntry, like this  $_[0]->parent->configure( -labelBackground => 'red');

      This works as expected, thank you very much!

Re: Tk::LabEntry - how to reach the configuration of label via callback?
by capfan (Sexton) on Feb 08, 2016 at 13:33 UTC

    Hi! Yuu could also use the subwidget command on the LabEntry:

    #!/perl use strict; use warnings FATAL => qw(all); use Tk; use Tk::LabEntry; use List::Util qw(first); use Scalar::Util qw(looks_like_number); my $mw = MainWindow->new(); $mw->title("Test"); my $test = 8; my $width = 250; my $length = 125; $mw->minsize($width, $length); my $FONT = $mw->fontCreate(-family => 'verdana', -size => 14, -weight => 'normal'); my $le = $mw->LabEntry(-label => 'Value', -labelPack => [qw/-side left -anchor w/], -labelFont => '9x15bold', -font => $FONT, -relief => 'ridge', -textvariable => \$test, -width => 2, )->pack(); $le->bind('<Key>' => sub { labelCheck($_[0]);}); MainLoop; sub labelCheck { my $x = $_[0]->get(); if ( !(looks_like_number($x)) or ($x < 0) ) { $_[0]->delete(0, 'end'); my $label = $le->Subwidget('label'); $label->configure( -background => 'red'); # $_[0]->configure( -labelBackground => 'red'); } else { $_[0]->configure( -background => '#f0f0f0',); # $_[0]->configure( -labelBackground => '#f0f0f0'); do_something(); } return 1; } sub do_something { print $test, $/; }

      Hi capfan and thank you very much for your help. The code works. However it calls the certain LabEntry from within the callback (with $le->Subwidget('label')). What I am trying to do is to create the same behavior for several LabEntry's, therefore I do not want to call the specific widget by name. The proposal of beech with $_[0]->parent->configure seems to meet this requirement.

        Yeah, that was just lazyness, sorry. You can substitute the $le by $_[0]->parent.

        You can see what is inside $_[0] by checking @_:

        #!/perl use strict; use warnings FATAL => qw(all); use Tk; use Tk::LabEntry; use Data::Dumper qw/Dumper/; use List::Util qw(first); use Scalar::Util qw(looks_like_number); my $mw = MainWindow->new(); $mw->title("Test"); my $test = 8; my $width = 250; my $length = 125; $mw->minsize($width, $length); my $FONT = $mw->fontCreate(-family => 'verdana', -size => 14, -weight => 'normal'); my $le = $mw->LabEntry(-label => 'Value', -labelPack => [qw/-side left -anchor w/], -labelFont => '9x15bold', -font => $FONT, -relief => 'ridge', -textvariable => \$test, -width => 2, )->pack(); $le->bind('<Key>' => sub { labelCheck($_[0]);}); MainLoop; sub labelCheck { print Dumper \@_; my $x = $_[0]->get(); if ( !(looks_like_number($x)) or ($x < 0) ) { $_[0]->delete(0, 'end'); my $label = $_[0]->parent->Subwidget('label'); $label->configure( -background => 'red'); # $_[0]->configure( -labelBackground => 'red'); } else { $_[0]->configure( -background => '#f0f0f0',); # $_[0]->configure( -labelBackground => '#f0f0f0'); do_something(); } return 1; } sub do_something { print $test, $/; }

        For me, this returned:

        $VAR1 = [ bless( { '_TkValue_' => '.labentry.entry', '_XEvent_' => bless( do{\(my $o = ' $  +  T  t  A  a  A ( \ +' a "Ԍ')}, 'XEvent' ) }, 'Tk::Entry' ) ];

        It's a Tk::Entry inside a LabEntry (cf. .labentry.entry).

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1154603]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (3)
As of 2022-11-26 11:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?