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

Hello, all, I'm muddling my way through building a Tk Construct for the first time, and I have a question. The object I'm making has two subwidgets, and I would like to be able to specify a different class for each of them. The way I currently have it set up, when creating the object, you'd send an arg in the hash table like this: `-classes => 'foo', 'bar'' and the first subwidget should be created with class 'foo', and the second with class 'bar'. The odd thing is that this seems to be halfway happening. The big problem seems to lie in the passive colors. An width, or activebackground color will work fine, but the default colors that appear when there is no mouse activity is always the default off-white. This is the object I've written
sub Populate { my($cw, $args) = @_; $cw->SUPER::Populate($args); my($lclass, $oclass) = @{delete $args->{'-classes'}}; my($l) = $cw->Label(-class => $lclass)->pack(-side => 'left', -fil +l => 'both', -expand => 1); my($o) = $cw->Optionmenu(-class => $oclass)->pack(-side => 'right' +, -fill => 'both', -expand => 1); $cw->Advertise('label' => $l); $cw->Advertise('optionmenu' => $o); $cw->ConfigSpecs( '-text' => [$l, undef, undef, undef], '-textvariable' => [$l, undef, undef, undef], '-options' => [$o, undef, undef, undef], DEFAULT => [SELF, undef, undef, undef] ); }
What is it that I'm doing wrong here? TIA.

Replies are listed 'Best First'.
Re: Specifying the -class of Tk subwidgets
by lamprecht (Friar) on Jul 04, 2009 at 08:07 UTC
    Hi,

    could you demonstrate your problem with a small runnable example like below? I doubt that it is caused by creating a composite but rather by the combination of Widgets / Options you use. (What exactly are your Options to specify 'passive colors').

    use strict; use warnings; use Tk; my $mw = tkinit; $mw->optionAdd('*Custom*Background' => 'red'); my $f = $mw->Entry(-class => 'Custom', -text => 'hello world!', )->pack; MainLoop;

    Cheers, Christoph

      use Tk; use lib '/genesis/oscripts/misc_scr/lib'; use OwegoCAM::GUI::GUIBuilder::LabelOption; my($mw) = MainWindow->new; my($fileloc) = "/genesis/oscripts/misc_scr/lib/OwegoCAM/GUI/GUIBuilder +/.Xdefaults.ocd"; $mw->optionReadfile($fileloc) if (-e $fileloc); my(%foo) = ('bar' => [qw/yes no maybe/]); my($bah) = $mw->LabelOption(-class => 'Lab2', -options => $foo{'bar'}, -label => 'Is it safe?', -labelPack => [-side => 'left'] )->pack(); MainLoop;
      And here's an excerpt from the .Xdefaults:
      *Lab2*optionmenu*activeForeground:#000000 *Lab2*optionmenu*activeBackground:tan3 *Lab2*optionmenu*background:tan3 *Lab2*optionmenu*font:-adobe-helvetica-bold-r-normal--*-120-*-*-*-*-*- +* *Lab2*optionmenu*foreground:#000000 *Lab2*optionmenu*relief:raised *Lab2*optionmenu*cursor:right_ptr *Lab2*optionmenu*width:15 *Lab2*optionmenu*anchor:w *Lab2*label*background:wheat1 *Lab2*label*font:-adobe-helvetica-bold-r-normal--*-120-*-*-*-*-*-* *Lab2*label*foreground:black *Lab2*label*relief:flat *Lab2*label*width:15 *Lab2*label*anchor:w
      The only thing that actually gets a color set is the option menu background when the mouse is over it, and the optionmenu's width. Thanks, -Peter Oh, sorry. Rereading the original post, I've since changed the original module that I was using. The Tk widget code now looks like this (mostly lifted from Mastering Perl/Tk):
      package LabelOption; use Tk::widgets qw /Optionmenu/; use base qw/Tk::Frame/; use strict; Construct Tk::Widget 'LabelOption'; sub ClassInit { my($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate { my($self, $args) = @_; $self->SUPER::Populate($args); my($o) = $self->Optionmenu->pack(); $self->Advertise('optionmenu' => $o); $self->ConfigSpecs('DEFAULT' => [$o]); $self->Delegates('DEFAULT' => $o); } 1;
        Hi monksp,

        Here is a possible solution: First you need to direct -bg/-fg to 'SELF' otherwise these options propagate down the Descendants hierarchy of your composite overriding anything else. Then there is a problem with the Label created by Frames -labelPack option which you inherit in your Composite. I didn't dig into it further, but you can work around by creating your own Label (see below).

        use strict; use warnings; package LabelOption; use Tk::widgets qw /Optionmenu/; use base qw/Tk::Frame/; use strict; Construct Tk::Widget 'LabelOption'; sub ClassInit { my($class, $mw) = @_; $class->SUPER::ClassInit($mw); } sub Populate { my($self, $args) = @_; $self->SUPER::Populate($args); my $l = $self->Label()->pack(-side => 'left'); my $o = $self->Optionmenu->pack(-side => 'left'); $self->Advertise('optionmenu' => $o); $self->ConfigSpecs(-options => [$o], -class => [$self], -background => 'SELF', -foreground => 'SELF', -label => [{-text=> $l}], 'DEFAULT' => [$self], ); $self->Delegates('DEFAULT' => $self); } package main; use Tk; use Tk::Optionmenu; my $mw = tkinit; my $fileloc = "Xdefaults.ocd"; $mw->optionReadfile($fileloc) if -e ($fileloc); my(%foo) = ('bar' => [qw/yes no maybe/]); my $bah = $mw->LabelOption(-class => 'Lab2', -options => $foo{'bar'}, -label => 'Is it safe?', # -labelPack => [-side => 'left'], )->pack(); print join("\n" ,map {$_->PathName} $mw->Descendants); MainLoop;
        Cheers, Christoph