Hello Monks,

I'm having problems with a menu checkbutton. It seems that in a particular case, a checkbutton is not changing the value of the associated variable.

I am coding with strawberry perl 5.30 on windows 10.

In the code below, the thing1 checkbutton is associated with the variable $self->{SETTINGS}->{thing1}. The thing2 checkbutton is associated with the variable $self->{thing2}.

If I click on the thing2 checkbutton, the value of $self->{thing2} is changed, as I would expect. But if I click on the thing1 checkbutton, the value of $self->{SETTINGS}->{thing1} is NOT changed.

Can anyone explain with this is the case? Your help would be appreciated.

use warnings;
use strict;

{
 package OptionsTest;
 
 use Cwd;
 use Tk  qw(MainLoop);
 require Tk::ROText;

 sub new
 { 
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = bless { @_ }, $class;
 
  my $mw = MainWindow->new();
  $self->{MW} = $mw;

  $self->MakeWidgets;

  $mw->configure(-title => "Options Test");
  
  my $menu = $mw->Menu(-type => 'menubar');
  $mw->configure(-menu => $menu);
  $self->BuildMenu($menu);

  $self->{SETTINGS} = { thing1 => 7 }; 
  $self->{thing2} = 3;

  MainLoop();
 }

 sub BuildMenu
 {
  my ($self, $menu) = @_;
  
  $menu->Cascade(
    -label     => 'Options',
    -tearoff   => 0,
    -menuitems => [ 
   ['checkbutton', 'thing1', -variable => \$self->{SETTINGS}->{thing1}
+, -command => sub { $self->AdjustConsole(); }], 
   ['checkbutton', 'thing2', -variable => \$self->{thing2}, -command =
+> sub { $self->AdjustConsole(); }], 
           ]       
  );
 }

 sub MakeWidgets
 {
  my ($self) = @_;

  my $frm = $self->{MW}->Frame()->pack(qw(-side top -fill both -expand
+ 0));
 
  $self->{CONSOLE} = $frm->Scrolled('ROText', 
                   -font => "{Courier New} 12 bold", 
                   -background => 'DarkBlue', 
                   -foreground => 'OldLace',
                   -scrollbars => 'se',
                   -wrap => 'none',
                   -height => 10,
                   -width => 60,
                   -tabs => ['2'],
                   )->pack(-expand => 1, -fill => 'both', -anchor => '
+n' );                  
                    
  tie *STDOUT, 'Tk::Text', $self->{CONSOLE};  # Send STDOUT to console
  tie *STDERR, 'Tk::Text', $self->{CONSOLE};  # Send STDERR to console
+    
 }
                         
 sub AdjustConsole
 {
  my ($self) = @_;

  printf( "thing1: %s %s   thing2: %s %s\n",
   \$self->{SETTINGS}->{thing1}, $self->{SETTINGS}->{thing1},
   \$self->{thing2}, $self->{thing2});
 }
}

OptionsTest->new();
[download]