[PREV] [NEXT] [PREV Thread] [NEXT Thread] [Index]


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

[PREV] [NEXT] [PREV Thread] [NEXT Thread] [Index]