http://qs321.pair.com?node_id=1154653


in reply to Re: Tk::LabEntry - how to reach the configuration of label via callback?
in thread Tk::LabEntry - how to reach the configuration of label via callback?

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.

Replies are listed 'Best First'.
Re^3: Tk::LabEntry - how to reach the configuration of label via callback?
by capfan (Sexton) on Feb 10, 2016 at 20:53 UTC

    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).