package Tk::SepOptionmenu;
use base ('Tk::Optionmenu', 'Tk::Derived');

use strict;
use warnings;
use Carp;

our $VERSION = '1.0';

Construct Tk::Widget 'SepOptionmenu';

sub ClassInit {
    my ($class, $mw) = @_;

    $class->SUPER::ClassInit($mw);
}



sub addOptions
{
 my $w     = shift;
 my $menu  = $w->menu;
 my $tvar  = $w->cget(-textvariable);
 my $vvar  = $w->cget(-variable);
 my $oldt  = $$tvar;
 my $width = $w->cget('-width');
 my %hash;
 my $first;
 while (@_)
  {
   my $val = shift;
   my $label = $val;
   if (ref $val)
    {
     if ($vvar == $tvar)
      {
       my $new = $label;
       $w->configure(-textvariable => ($tvar = \$new));
      }
     ($label, $val) = @$val;
    }
   my $len = length($label);
   $width = $len if (!defined($width) || $len > $width);
   
   if ( $label eq '-') {
       $menu->separator();
   } else {
       $menu->command(-label => $label, -command => [ $w , 'setOption', $label, $val ]);
   }
   

   $hash{$label} = $val;
   $first = $label unless defined $first;
  }
 if (!defined($oldt) || !exists($hash{$oldt}))
  {
   $w->setOption($first, $hash{$first}) if defined $first;
  }
 $w->configure('-width' => $width);
}

1;
__END__

=pod

=head1 NAME

Tk::SepOptionmenu - A perl/tk Optionmenu widget that can include separators.

=head1 SYNOPSIS



    use Optionmenu;

    $sopt = $w->Optionmenu(
			-options => REFERENCE_to_OPTIONLIST,
			-command => CALLBACK,
			-variable => SCALAR_REF,
			);

    $sopt->addOptions( OPTIONLIST );

    # OPTION LIST is
    #   a)  $val1, $val2, $val3,...
    #   b)  [ $lab1=>$val1], [$lab2=>val2], ... ]
    #   c)  combination of a) and b), e.g.,
    #       val1, [$lab2=>val2], val3, val4, [...], ...
    #       
    #   In a), any value may be '-' to indicate a separator.
    #   If using b) style option list, you must still specify 
    #   separators as follows: [ [$lab1=>$val1], '-', [$lab2=>$val2], ... ];

=head1 DESCRIPTION

This "I<IS A>" Optionmenu widget that can include separator menu items in its menu.  

=head1 METHODS

=over 4

=item addOptions

Adds OPTION_LIST to the already available options. OPTION_LIST may include an item C<'-'> to indicate a separator. 

=back


=head1 EXAMPLE

 use Tk;
 my $mw = MainWindow->new();

 my ($var, $tvar);
 my $opt = $mw->SepOptionmenu(
        -options => [[jan=>1], [feb=>2], '-', [mar=>3], [apr=>4]],
        -command => sub { print "got: ", shift, "\n" },
        -variable => \$var,
        -textvariable => \$tvar
       )->pack;

 $opt->addOptions('-',[may=>5],[jun=>6],'-',[jul=>7],[aug=>8]);

 my $f = $mw->Frame(-relief=>'groove', -borderwidth => 2)->pack;
 $f->Label(-textvariable=>\$tvar)->pack(-side => 'left');
 $f->Label(-text => " -> ")->pack(-side => 'left');
 $f->Label(-textvariable=>\$var)->pack(-side => 'left');

 $mw->Button(-text=>'Exit', -command=>sub{$mw->destroy})->pack;

 MainLoop;


=head1 SEE ALSO

L<Tk::Optionmenu>

=cut