On Tuesday, May 13, 2003, at 08:30 US/Eastern, Steve Lidie wrote:

>  -- forwarded message --
>  Path:  
>  Lehigh.EDU!att541!att542!ip.att.net!swen.emba.uvm.edu!news.cc.utah.edu! 
>  xmission!logbridge.uoregon.edu!uio.no!uninett.no!not-for-mail
>  From: Heiko Klein <Heiko.Klein@[...].net>
>  Newsgroups: comp.lang.perl.tk
>  Subject: Problem with configure and inherited Button
>  Date: Thu, 08 May 2003 14:06:20 +0200
> 
>  Hi,
> 
>  I'm still running Tk800.0023, so it might be possible that this problem
>  has been solved already.
> 
>  I wanted to add some special features to a Button. So I created a
>  subclass of Button (here a much simplified form):
> 
>  ----------------------------------------------
>  package Tk::RedButton;
> 
>  use 5.00500;
>  use strict;
>  use base qw(Tk::Derived Tk::Button);
> 
>  Construct Tk::Widget 'RedButton';
> 
>  sub ClassInit {
>       my ($class, $mw) = @_;
>       $class->SUPER::ClassInit($mw);
>  }
> 
>  sub Populate {
>       my ($cw, $args) = @_;
>       delete $args->{-background};
>       $cw->SUPER::Populate($args);
> 
>       $cw->configure(-background => "#ff0000");
>  }
>  ----------------------------------------------
> 
>  When I run this, all my RedButtons are grey. To be able to configure my
>  RedButton from within Populate, I have to do the following:
> 
>  $cw->after(1, sub {$cw->configure(-background => "#ff0000")});
> 
>  I had this problem with some other classes, too. (I.e. I wanted to
>  destroy an inherited toplevel, $cw->destroy complained about unknown
>  function, while $cw->after(1,sub {$cw->destroy}) worked.)
> 
>  Is this a bug (solved already?), or am I thinking wrong, do I miss a
>  feature of Tk?


The #1 rule of mega-widget writing is:

Do not manually call configure()!  (;

Use a ConfigSpecs() call as shown below:


package Tk::RedButton;

use 5.00500;
use strict;
use base qw(Tk::Derived Tk::Button);

Construct Tk::Widget 'RedButton';

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

sub Populate {
     my ($cw, $args) = @_;
     delete $args-> {-background};
     $cw-> SUPER::Populate($args);

#     $cw-> configure(-background => "#ff0000");     # use 'red' rather  
than a hex umber
     $cw-> ConfigSpecs(
         -background =>  [SELF => qw/button Button red/],
     );
}

package main;
use Tk;
use strict;

my $mw = MainWindow-> new;
my $rb = $mw-> RedButton(-text => "Am I a red Buton?")->pack;

MainLoop;

-++**==--++**==--++**==--++**==--++**==--++**==--++**==
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the
message body of "unsubscribe ptk" to majordomo@lists.stanford.edu