#!/usr/bin/env perl
use English;
use Tk;
use strict;
my $MW = MainWindow->new;
# Create and pack the expandable LabeledEntryLabeledRadiobutton widget. Then
# globally configure the advertised Frame, Label and Radiobutton widgets.
# Lastly, specifically configure the radiobutton widget labeled 'RL3', a tiny
# widget inside the advertised composite LabeledRadiobutton widget, the
# entry widget in the advertised composite LabeledEntry widget, and then
# create some key bindings.
my $entry_var = 'Frogs lacking lipophores are blue.';
my $radio_var = '';
my $cw = $MW->LabeledEntryLabeledRadiobutton(
'Name' => 'frog',
-entry_label => 'Entry Label',
-entry_variable => \$entry_var,
-radio_label => 'Radio Label',
-radio_variable => \$radio_var,
-radiobuttons => [qw(RL1 RL2 RL3 RL4 RL5)],
);
$cw->pack(-expand => 1, -fill => 'both');
print "Check out composite widget hierarchy ...\n";
$cw->Walk(sub {print " subwidget=", shift->PathName, "\n";});
$cw->Walk(
sub {
my($w, $class) = @_;
$w->configure(-relief => 'ridge', -bd => 5) if $class eq $w->class;
}, 'Frame',
);
$cw->Walk(
sub {
my($w, $class) = @_;
$w->configure(-relief => 'flat', -bg => 'azure') if $class eq $w->class;
}, 'Label',
);
$cw->Walk(
sub {
my($w, $class) = @_;
$w->configure(-selectcolor => 'red', -indicatoron => 0, -bg => 'green')
if $class eq $w->class;
}, 'Radiobutton',
);
my $r = $cw->Subwidget('labeled_radiobutton')->Subwidget('RL3');
$r->configure(-bg => 'pink', -command =>
sub {print "radiobutton 'RL3' selected!\n";}
);
$cw->bind('<Return>' => \&process_return );
$cw->Subwidget('labeled_entry')->configure(-bg => 'orange');
# Create and pack a button that demonstrates how to reconfigure the entire
# composite widget by invoking the `configure' method on the composite
# widget rather than on specific subwidgets, or classes of widgets.
my $b;
$b = $MW->Button(-text => 'Reconfigure subwidgets', -command =>
sub {
$cw->configure(
-background => 'cyan',
-foreground => 'blue',
-borderwidth => 0,
-relief => 'ridge',
-highlightthickness => 0,
-indicatoron => 1
);
$b->packForget;
}
);
$b->pack(-side => 'top', -expand => 1, -fill => 'both');
# Create and pack the Quit button.
my $q = $MW->Button(-text => 'Quit', -command => sub{exit});
$q->pack(-side => 'top', -expand => 1, -fill => 'both');
MainLoop;
sub process_return {
my($objref) = @_;
print "In entry callback, objref=$objref, \$entry_var=\'$entry_var\'.\n";
} # end process_return