Re: ConfigSpecs in Porting Tk MegaWidgets to Tkx

[Gisle Aas]

On Jan 21, 2009, at 6:51 , E.R. Uber wrote:

I have successfully ported a couple of Tk MegaWidgets to Tkx

Cool!

but my solutions I fear are not as elegant as they could be with  
regard to widget
configuration. After reading perldoc Tkx::MegaConfig I have two  
questions:
1. I understand the METHOD and PASSIVE $where specs; however, does  
the .foo
$where spec format mean the config option gets delegated to the  
child widget
that has been created using -name => 'foo' since the period in .foo  
can
delegate to the megawidget root??

That's correct.  I'll try to revise the documentation to make it more  
clear what's going on.  I've attached a sample program to try to  
demonstrate.

Perhaps I am confusing names and paths. Or
even worse. :)

The "." in the $where argument is really just there to create a  
separate namespace.  It's supposed to always work like a relative path  
name.

2. What is the best approach to take with a Tk ConfigSpec that looks  
like
this:

                         -background  => [['SELF', 'CHILDREN'],
qw/background Background/],

My initial solution is to comment it out!! :)

Currently you have to implement it with 'METHOD' as demonstrated in  
the attached sample program, but I can't see a reason to not make  
Tkx::MegaConfig support the same kind of syntax directly.  Since  
'SELF' is written '.' it seems logical to make '.*' denote 'CHILDREN'  
and perhaps to make '.**' denote Tk's 'DESCENDANTS'.  Patches accepted!

BTW, I just commited[1] a patch to Tkx so that you can say:

    for my $kid ($w->_kids) {
         $kid->configure(...);
    }

instead of the horrible expression I used in the attached sample.

--Gisle


[1] http://github.com/gisle/tkx/commit/f24d257a3482bc0d1695cf7021939ba6907bc749
use Tkx;

package Foo;
use base qw(Tkx::widget Tkx::MegaConfig);

__PACKAGE__->_Mega("foo");
__PACKAGE__->_Config(
   -bg1 => [['.', '-background']],
   -bg2 => [['.inner', '-background']],
   -background => ['METHOD'],
   -foo => ['PASSIVE'],
);

sub _Populate {
    my($class, $widget, $path, %opt) = @_;
    my $parent = $class->new($path)->_parent;
    my $self = $parent->new_frame(-name => $path, %opt);
    my $inner = $self->new_frame(-name => "inner", %opt);
    Tkx::pack($inner, -padx => 10, -pady => 10);
    $self->_class($class);
    $self;
}

sub _config_background {
    my $self = shift;
    return $self->Tkx::widget::m_cget(-background) unless @_;
    $self->Tkx::widget::m_configure(-background, @_);
    for (map Tkx::widget->new($_), Tkx::SplitList($self->g_winfo_children)) {
        $_->m_configure(-background, @_);
    }
    return;
}

package main;

my $mw = Tkx::widget->new(".");
my $foo = $mw->new_foo(-background => "red", -width => 100, -height => 100);
Tkx::pack($foo);

$foo->configure(-bg1 => "blue");
$foo->configure(-bg2 => "yellow");

my $i;
Tkx::pack($mw->new_button(
   -text => "Press me",
   -command => sub {
       print $foo->cget('-background'), "\n";
       $foo->configure(-background => "wheat");
       $foo->configure(-bg2 => ("yellow", "red")[++$i % 2]);
   },
));


Tkx::MainLoop();