What do you make of this? Its not unlike megawidgets
#!/usr/bin/perl --
use strict;
use warnings;
use Tkx;
Main( @ARGV );
exit( 0 );
sub Main {
$Tkx::TRACE = 64;
my $mw = Tkx::widget->new( "." );
my $f = $mw->new_ttk__frame();
my $textvar = RadiosEntry( $f, 'good', 'morning', 'sunshine' );
$f->g_pack;
undef $f;
$f = $mw->new_ttk__frame();
my $b = $f->new_button( -text => "Selection" );
$b->configure( -command => [ \&OnButtonTextFromTextvar, $b, $textv
+ar ] );
$b->g_pack;
$f->new_ttk__label( -text, 'yo', -anchor => "center" )->g_pack;
$f->new_ttk__label( -textvariable => $textvar, -anchor => "center"
+ )
->g_pack;
$f->g_pack;
Tkx::MainLoop();
} ## end sub Main
sub OnButtonTextFromTextvar {
warn "OnButtonTextFromTextvar @_";
my( $button, $textvar ) = @_;
$button->configure( -text => join " ", 'Selection = ', $$textvar )
+;
}
sub RadiosEntry {
my( $parent, @radios ) = @_;
my $textvar = "";
my $selected;
for my $radio ( @radios ) {
my $button = $parent->new_ttk__radiobutton(
-text => $radio,
-value => $radio,
);
$button->configure(
-command => [
\&OnRadioButtonSetTextSetSelected,
, $button, \$textvar, \$selected
],
);
$button->g_pack;
$radio = $button; ## modify @radios
} ## end for my $radio ( @radios)
my $ent = $parent->new_ttk__entry( -text => "", );
$ent->g_pack;
$ent->g_bind(
'<Key>', [
\&OnEntryConfigureRadioValueInvokeSelected,
$ent, $radios[-1], \$selected
]
);
return \$textvar;
} ## end sub RadiosEntry
sub OnEntryConfigureRadioValueInvokeSelected {
warn "OnEntryConfigureRadioValueInvokeSelected @_";
my( $ent, $radio, $selected ) = @_;
$radio->configure( -value, $ent->get );
$selected and $$selected->invoke;
}
sub OnRadioButtonSetTextSetSelected {
my( $button, $textvar, $selected ) = @_;
$$textvar = $button->configure( '-value' )->[-1];
$$selected = $button;
warn "OnRadioButtonSetTextSetSelected @_ $textvar $selected\n";
}
__END__
See also https://www.tcl.tk/man/tcl/TkCmd/ttk_radiobutton.htm