I'm not sure I understand your code, but it looks like you are directly modifying the Optionmenu widget code. This approach is best avoided. What you should be doing is subclassing the Optionmenu. I've attached my complete SepOptionmenu class file for you to see how I did it. The advantages of subclassing are many, but the biggest is that you won't have scripts mysteriously breaking when Optionmenu gets upgraded.

As far as adding options to an existing widget, I would modify addOptions to handle some sort of nested data structure. Perhaps where each element in the list is a menu item, vanilla items (that just set a value) could be plain text strings, while other times would be an array ref of (type, label, data). Type could be 'command' or 'cascade'. If type is command, the data item would be a callback. If cascade data would be another item list like the one being parsed. 

$menuItems = [
   'foo',
   'bar',
   [ 'command', 'baz', [ \&BazRoutine, $bazarg0, $bazarg1 ] ],
   [ 'cascade', 'qux', [
       'huzzah',
       'fizzle',
       [ 'command', 'bagel', \&BagelRoutine ],
   ],
   'frank',
];

[download]

As for accessing information about the menu itself, you can use the $om->menu method to get access to the Tk::Menu widget. Once you have the menu widget, you can use the index method to find out about what items are in the menu.

You may want to add additional methods to your subclass that support particular tasks, like adding or removing cascaded items to a particular index.

Finally, here's the subclassing example. If you aren't familiar with subclassing and inheritance, check out perlboot and perltoot. This code is licensed under the same terms as perl.

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 separ
+ators.

=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 inc
+lude 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

[download]


TGI says moo

In reply to Re^3: Tk: cascade widget != menu by TGI
in thread Tk: cascade widget != menu by yike

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.