package Tk::JOptionmenu;
require Tk::Menubutton;
require Tk::Menu;

@ISA = qw(Tk::Derived Tk::Menubutton);

Tk::Widget->Construct('JOptionmenu');

sub Populate
{
 my ($w,$args) = @_;
 $w->SUPER::Populate($args);
 $args->{-indicatoron} = 1;
 my $var = delete $args->{-textvariable};
 unless (defined $var)
  {
   my $gen = undef;
   $var = \$gen;
  }
 $w->menu(-tearoff => 0);
 $w->bind('<Down>' => "PostFirst");
 $w->configure(
	-highlightcolor => 'black',
	-highlightthickness => 2,
	-takefocus => 1,
	-relief => 'raised',
	-textvariable => $var);

 # Should we allow -menubackground etc. as in -label* of Frame ?

 $w->ConfigSpecs(-command => [CALLBACK,undef,undef,undef],
                 -options => [METHOD, undef, undef, undef] 
                );
}

sub setOption
{
 my ($w,$val) = @_;
 my $var = $w->cget(-textvariable);
 $$var = $val;
 $w->Callback(-command => $val);
}

sub options
{
 my ($w,$opts) = @_;
 if (@_ > 1)
  {
   my $menu = $w->menu;
   my $var = $w->cget(-textvariable);
   my $width = $w->cget('-width');
   my $val;
   foreach $val (@$opts)
    {
     my $len = length($val);
     my ($underlinepos) = ($val =~ s/^(.*)~/$1/) ? length($1): undef;
     $width = $len if (!defined($width) || $len > $width);
     if (defined($underlinepos) && $underlinepos >= 0)
     {
         $menu->command(
		-label => $val,
		-underline => $underlinepos,
		-command => [ $w , 'setOption', $val ]);
     }
     else
     {
         $menu->command(
		-label => $val,
		-command => [ $w , 'setOption', $val ]);
     }
     $w->setOption($val) unless (defined $$var);
    }
   $w->configure('-width' => $width);
  }
 else
  {
   return $w->_cget('-options');
  }
}

sub focusCurrent
{
 my ($w) = @_;
 $w->Tk::focus('-displayof');
}

1;