changing the options available in native option menu

I used the example in MTK (pages 276 onwards) to successfully implement
native option menus with columns of the choices available.
 
I now want to be able to change the choices that are available.
 
Below is my test code.
 
The simple GUI has:
1.	a pull down (native option) menu which initial has colours with
red shown;
2.	a button which tries to change the options - this calls the sub
change_options_cb which in turn calls change_options_nativemenu that
does the work.
 
change_options_nativemenu is based on the sub native_optionmenu that was
originally used to create the native option menu.
 
The changes to the choices are carried out successfully.  However, I
have two problems.
 
The first is that I had to store as a global variable the name of the
Menubutton that was used when first creating the native option menu
button so that I could display the first item of the new choices.
 
The second is that when I select one of the new choices it is not shown
on the native option menu button (this works before I altered the
options).
 
The first is not too much of a problem but it would be much better if I
could find what this is without having to resort to another variable
that is carried around.  However I have to solve the second and I am not
sure how to do this.  I suspect if may be something to do with the first
issue but I m not at all sure.  Therefore I would be grateful if someone
could explain how to solve both problems.
 
Best regards
 
Henry Merryweather
 
 
use Tk;
 
my ($wg_sticky, $wg_padx,  $wg_pady);
my ($mw, $wg_name, $wg_res, @wg_options, $native_optionmenu_data_cols);
my ($mb_glob);
 
#=====================================================================
#
# sub optionmenu_wg
#
# this subroutine creates an Optionmenu within the given parent
# arguments
# 0        existing parent
# 1  reference to new NativeOptionmenu
# 2  reference to Optionmenu variable
# 3        reference to array holding options
# 4  number of data columns in the menu
# 4        row within parent
# 5  column within parent
#
# ====================================================================
 
 
 
sub native_optionmenu_wg {
 
my ($parent, $ref_native_optionmenu, $ref_result,
$ref_native_optionmenu_options, $native_optionmenu_data_cols,   
                        $native_optionmenu_sub,
$native_optionmenu_state,
                        $native_optionmenu_row,
$native_optionmenu_column, $native_optionmenu_columnspan) = @_;
 
my @local_options;
 
 my $temp;
# print  main::GUIOUT "\nin optionmenu_wg - options\n";
 foreach $temp (@$ref_native_optionmenu_options) {
#          print  main::GUIOUT "<$temp>\n";
            if(length($temp) > 0) {
                        push(@local_options, $temp);
            } else {
                        push(@local_options, " ");
            }
 }
 
 
$$ref_native_optionmenu = native_optionmenu(
                                                            $parent,
                                                            $ref_result,
                                                            [sub {print
"first native = @_.\n"}, 'First'],
 
@local_options)
                                    ->grid(
                                                -row        => 0,
                                                -column     => 0,
 
                                                );
 
my $menu = $$ref_native_optionmenu->cget(-menu);
for my $i (0 .. $#local_options) {
            $menu->entryconfigure($i, -columnbreak => 1) unless $i %
$native_optionmenu_data_cols;
            }
 
 
}
 
 
sub native_optionmenu {
 
    my($parent, $varref, $command, @optionvals) = @_;
 
    $$varref = $optionvals[0];
 
    my $mb = $parent->Menubutton(
        -textvariable       => $varref,
        -indicatoron        => 1,
        -relief             => 'raised',
        -borderwidth        => 2,
        -highlightthickness => 2,
        -anchor             => 'c',
        -direction          => 'flush',
    );
    my $menu = $mb->Menu(-tearoff => 0);
    $mb->configure(-menu => $menu);
 
    my $callback = ref($command) =~ /CODE/ ? [$command] : $command;
 
    foreach (@optionvals) {
            $menu->radiobutton(
            -label     => $_,
            -variable  => $varref,
            -command   => [@$callback, $_],
        );
    }
 
 
print "\[native_optionmenu] mb is <$mb>\n\n";
 
$mb_glob = $mb;
   $mb;
 
} # end native_optionmenu
 
#=================================================================
#
# this gets called when the change option button is used
 
sub change_options_cb {
 
 
my (@new_options, $varef);
 
@new_options = qw(ox ass bison moose rabbit mouse lion tiger cat dog cow
hen chicken);
 
change_options_nativemenu($wg_name, \$varef, [sub {print "changed native
= @_.\n"}, 'First'], @new_options);
 
}
 
#==================================================================
#
# this is the sub that makes the changes to the native option menu
choices
 
sub change_options_nativemenu {
 
my ($mb, $varref, $command, @new_optionvals) = @_;
 
            my $menu = $mb->Menu(-tearoff => 0);
            $mb->configure(-menu => $menu);
 
            my $callback = ref($command) =~ /CODE/ ? [$command] :
$command;
 
            $$varref = $new_optionvals[0];
 
            foreach (@new_optionvals) {
            $menu->radiobutton(
            -label     => $_,
            -variable  => $varref,
            -command   => [@$callback, $_],
        );
            }
 
            $mb_glob->configure(-textvariable => $$varref);
 
            my $menu_b = $mb->cget(-menu);
            for my $i (0 .. $#new_optionvals) {
            $menu->entryconfigure($i, -columnbreak => 1) unless $i % 3;
            }
 
 
}
 
 
my ($native_optionmenu_sub, $native_optionmenu_state);
my ($native_optionmenu_row, $native_optionmenu_column,
$native_optionmenu_columnspan);
 
$native_optionmenu_data_cols = 4;
$native_optionmenu_sub = '';
$native_optionmenu_state = 'normal';
$native_optionmenu_row = 0;
$native_optionmenu_column = 0;
$native_optionmenu_columnspan= 1;
 
@wg_options = qw(red blue green black yellow pink gentian purple umbre);
 
 
$mw = MainWindow->new;
 
native_optionmenu_wg ($mw, \$wg_name, \$wg_res, \@wg_options,
 
$native_optionmenu_data_cols, $native_optionmenu_sub,
$native_optionmenu_state,
 
$native_optionmenu_row, $native_optionmenu_column,
$native_optionmenu_columnspan);
 
 
my $change_button = $mw->Button(-text => 'change options',
 
-command => \&change_options_cb) ->grid(
                                                -row        => 1,
                                                -column     => 2);
 
MainLoop;