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

I'm trying to create a new Tk widget derived from a Tk::Label. It works okay for the most part, but I discovered that the -foreground option doesn't seem to be getting passed. I've simplified the code to the following: 
package Tk::Foon;

use base qw(Tk::Derived Tk::Label);
Construct Tk::Widget 'Foon';

sub ClassInit  
{
  my($class, $mw) = @_;
  $class->SUPER::ClassInit($mw);
}

sub Populate
{
  my($self, $args) = @_;
  $self->SUPER::Populate($args);
  $self->ConfigSpecs('DEFAULT' => [ 'SELF' ]); 
}

[download]

And some test code: 

#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::Foon;

my $mw = MainWindow->new;
my $l = $mw->Foon(-background =>'blue', -foreground => 'red')->pack;
  
$l->configure(-text => 'happy');
 
MainLoop;

[download]

Running this, I get the background of the label blue as requested, but the foreground appears black rather than red. Any ideas?

Thanks!

Daniel Ashbrook

Replies are listed 'Best First'.
Re: Tk widget derivation problems
by JamesNC (Chaplain) on Aug 02, 2003 at 20:39 UTC
    I re-arranged the order that the base classes are called and it works... try this:
    package Tk::Foon;

use base qw(Tk::Label Tk::Derived); #<= changed order
Construct Tk::Widget 'Foon';

sub ClassInit  
{
  my($class, $mw) = @_;
  $class->SUPER::ClassInit($mw);
}

sub Populate
{
  my($self, $args) = @_;
  $self->SUPER::Populate($args);
  $self->ConfigSpecs('DEFAULT' => [ 'SELF' ]); 
}

    [download]
    Cheers,
    JamesNC
[reply]
[d/l]
      Very strange... I worry about doing that, however, because the man page for Tk::derived says: 

      Tk::Derived should precede any Tk widgets in the class's @ISA.

      Update: And the reason for this appears to be so that you can pass your own arguments. If I switch the order so List appears first and Derived second, then when I create my new object with some option that I want to handle, like my $x = $mw->Foon(-taco => 'bell', -foreground => 'brown');, all the options go to the Label first, which doesn't understand -taco.

      Daniel Ashbrook

[reply]
[d/l]
[select]
Re: Tk widget derivation problems
by Anonymous Monk on Aug 02, 2003 at 15:33 UTC
    Based on these four lines, you aren't picking up the whole list, just the first element.

      my($class, $mw) = @_;
  $class->SUPER::ClassInit($mw);
  my($self, $args) = @_;
  $self->SUPER::Populate($args);

    [download]
    Try: 
      my($class, @mw) = @_;
  $class->SUPER::ClassInit(@mw);
  my($self, @args) = @_;
  $self->SUPER::Populate(@args);

    [download]
[reply]
[d/l]
[select]

      $arg is a hashref to the aruments, as shown with Data::Dumper 

      sub Populate
{
  my($self, $args) = @_;
  print Dumper($args);
  $self->SUPER::Populate($args);
  $self->ConfigSpecs('DEFAULT' => [ 'SELF' ]); 
}

      [download]
      which prints: 
      $VAR1 = {
          '-background' => 'blue',
          '-foreground' => 'red'
        };

      [download]

      Also, changing the order of background and foreground has no effect. It seems that something is swallowing -foreground before it gets to the Label in the derived widget, since a Label given the same arguments has the expected effect. Perhaps configuring the Label individually inside Foon might work.

      --Bob Niederman, http://bob-n.com
[reply]
[d/l]
[select]
Re: Tk widget derivation problems
by converter (Priest) on Aug 03, 2003 at 07:54 UTC

    I recall reading somewhere that the -background and -foreground options are special-cased in a few places in the Tk code and that this can cause unpredictable behavior in some cases (or something to that effect). Adding entries for the options to the call to ConfigSpecs should solve the problem: 

      $self->ConfigSpecs(
      -background   => [qw/SELF Background background/],
      -foreground   => [qw/SELF Foreground foreground/],
      'DEFAULT'     => [ 'SELF' ],
  );

    [download]

    converter

[reply]
[d/l]
      That does it, all right. I actually just got a similar reply on the ptk mailing list; the person said that -foreground and -background are a little funny because they're aliased to -fg and -bg.

      Thanks a lot!

      Daniel Ashbrook

[reply]
[d/l]
[select]
        Interesting, in Derived.pm and Widget.pm you see a similar constructs only opposite 
        $specs->{'-foreground'} = \@fg,'foreground','Foreground',BLACK];

        [download]

        Widget.pm 
         $cw->ConfigSpecs('-scrollbars' => ['METHOD','scrollbars','Scrollbars'
+,'se'],
                  '-background' => [$w,'background','Background'],
                  '-foreground' => [$w,'foreground','Foreground'],

        [download]
        I think it would be interesting to know what this is doing...
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom