Re^2: 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.

Comment on Re^2: Tk::LabEntry - how to reach the configuration of label via callback? Select or Download Code

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, $/; }
[download]

For me, this returned:

$VAR1 = [
          bless( {
                   '_TkValue_' => '.labentry.entry',
                   '_XEvent_' => bless( do{\(my $o = '   $   ÿÿÿÿü˜ï
+¬
œ¿ê    Tç®       t  û      A      a                  A   (ø \
+'ààï ù a   ¼èˆ ä"¶ÔŒ')}, 'XEvent' )
                 }, 'Tk::Entry' )
        ];
[download]

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

[reply]
[d/l]
[select]


laziness, impatience, and hubris
	PerlMonks