#!/usr/bin/env perl
my
$MW
= MainWindow->new;
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'
);
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'
);
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"
;
}