aas@bergen.sn.no (Gisle Aas)
A better Optionmenu
A better Optionmenu
18 Apr 96 14:25:25 GMT
ptk@guest.wpi.edu mailing list gateway
- Newsgroups:
- comp.lang.perl.tk
This patch to Optionmenu allows us to have values associated with the
selections that are not nessecary the same as the labels. It also
adds a new option (-variable) that will contain the current selection.
It allows me to do this:
$top->Optionmenu(-options => [[no => 'Norway'],
[se => 'Sweden'],
[dk => 'Denmark']],
-variable => \$a,
);
This Optionmenu is backwads compatible with the one in Tk-b11.
--- Tk-b11/Tk/Optionmenu.pm Fri Mar 1 17:25:05 1996
+++ Tk/Optionmenu.pm Thu Apr 18 16:16:21 1996
@@ -23,15 +23,18 @@
# Should we allow -menubackground etc. as in -label* of Frame ?
$w->ConfigSpecs(-command => [CALLBACK,undef,undef,undef],
- -options => [METHOD, undef, undef, undef]
+ -options => [METHOD, undef, undef, undef],
+ -variable=> [PASSIVE, undef, undef, undef],
);
}
sub setOption
{
- my ($w,$val) = @_;
+ my ($w, $val, $label) = @_;
my $var = $w->cget(-textvariable);
- $$var = $val;
+ $$var = $label;
+ $var = $w->cget(-variable);
+ $$var = $val if $var;
$w->Callback(-command => $val);
}
@@ -43,13 +46,18 @@
my $menu = $w->menu;
my $var = $w->cget(-textvariable);
my $width = $w->cget('-width');
- my $val;
+ my($val, $label);
foreach $val (@$opts)
{
- my $len = length($val);
+ if (ref $val) {
+ ($val, $label) = @$val;
+ } else {
+ $label = $val;
+ }
+ my $len = length($label);
$width = $len if (!defined($width) || $len > $width);
- $menu->command(-label => $val, -command => [ $w , 'setOption', $val ]);
- $w->setOption($val) unless (defined $$var);
+ $menu->command(-label => $label, -command => [ $w , 'setOption', $val, $label ]);
+ $w->setOption($val, $label) unless (defined $$var);
}
$w->configure('-width' => $width);
}
--
This article was gatewayed from the ptk@guest.wpi.edu mailing list.
Problems? refay@carbon.cudenver.edu. Subscriptions: majordomo@guest.wpi.edu