graff has asked for the wisdom of the Perl Monks concerning the following question:

I need to change the entries in a Tk::Optionmenu widget whenever the user does something in another widget. No problem with that, but every time this happens, it triggers the Optionmenu widget's "-command" (callback) subroutine.

Of course, when the user actually clicks on the Optionmenu widget and selects one of the current menu items, this runs the callback with the menu value chosen by the user, and this is fine.

My problem is, how can the callback function tell the difference between being invoked by an actual menu selection (user has made a choice, so do something with that) vs. being invoked because the options have been changed (user hasn't really picked a specific option, so don't do anything yet).

Here's a little test script demonstrates the behavior: when the window first starts up, the first installation of options invokes the callback. Thereafter, the callback is invoked when the Optionmenu itself is used to make a selection, and each time the "Change Options" button is clicked.

I want the callback to be able to skip its work (or not be called in the first place) when installing a new menu. How do I do that? 

#!/usr/bin/perl

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

my ($var, $tvar);
my $opt = $mw->Optionmenu(
                          -command => \&show_choice,
                          -variable => \$var,
                          -textvariable => \$tvar
                         )->pack;
change_ops( $opt );

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=>'Change Options',-command=>[\&change_ops, $opt])->p
+ack;
$mw->Button(-text=>'Exit', -command=>sub{$mw->destroy})->pack;

MainLoop;

sub show_choice
{
    print "got: ", shift, "\n"
}

sub change_ops
{
    my $op = shift;
    my @newoptions = map { ++$. } ( 0 .. 3 );
    $op->configure( -options => \@newoptions );
}

[download]
(the script is based loosely on the example provided in the Optionmenu man page, which also demonstrates the issue when it starts up)

I've looked at the source (Optionmenu.pm), and I could create a modified version of this widget, altering its "addOptions" and "setOption" functions so that the latter does not invoke the callback whenever it happens to be called by the former...

But creating a new version of a widget is the sort of thing I'm likely to do wrong the first few times I try, so I'm hoping some monk can guide me (actually, I'm hoping there's an easier work-around that I'm missing).

Replies are listed 'Best First'.
Re: Setting options in Tk::Optionmenu without the callback?
by BrowserUk (Patriarch) on Aug 22, 2007 at 23:08 UTC
    (actually, I'm hoping there's an easier work-around that I'm missing).

    It's crude and nasty, but it's a lot simpler than creating your own widget.

    I had a go at that a while ago and it's definitely not for the faint hearted. Or even the bold and brassy if they have any sort of time contstraints. 

    my $changed = 0;

sub show_choice
{
    $changed = 0, return if $changed;
    print "got: ", shift, "\n"
}

sub change_ops
{
    my $op = shift;
    my @newoptions = map { ++$. } ( 0 .. 3 );
    $changed = 1;
    $op->configure( -options => \@newoptions );
}

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
Re: Setting options in Tk::Optionmenu without the callback?
by GrandFather (Saint) on Aug 22, 2007 at 23:18 UTC

    Don't know if there is a better way, but:

    sub change_ops
{
    my @ops = @_;
    my @newoptions = map { ++$. } ( 0 .. 3 );
    my $callback = $ops[0]->cget (-command);
    $ops[0]->configure( -command => undef );
    $ops[0]->configure( -options => \@newoptions );
    $ops[0]->configure( -command => $callback );
}

    [download]

    fixes the problem.

    DWIM is Perl's answer to Gödel
[reply]
[d/l]
Re: Setting options in Tk::Optionmenu without the callback?
by zentara (Cardinal) on Aug 23, 2007 at 12:19 UTC
    You can determine the current Tk widget being used to initiate the callbacks, and setup logic as needed. 
    sub show_choice{
    
    my $caller = $Tk::widget;
    
    print 'caller-> ',$caller,"\n";
    
    if( $caller =~ /^Tk::Menu.*/){    
       print "got: ", shift, "\n"
    }else{ return }

}

    [download]
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
[d/l]
      This is clearly The Way It's Supposed To Be Done™. In fact, I can now make a really compact (and fairly coherent) idiom: 
      sub my_optionmenu_callback
{
    return unless ( $Tk::widget =~ /^Tk::Menu/ );
    # do stuff...
}

      [download]
      Thank you -- knowing how to identify the caller like that is likely to simplify many things.
[reply]
[d/l]
Re: Setting options in Tk::Optionmenu without the callback?
by Anonymous Monk on Apr 30, 2014 at 18:19 UTC

    You can prevent the callback from being triggered by setting the variable to the first item of @newoptions before changing the options.

    sub change_ops
{
    my $op = shift;
    my $var = $op->cget('-textvariable');
    my @newoptions = map { ++$. } ( 0 .. 3 );
    my ($prev) = (grep {$_ eq $$var} @newoptions) || '';
    $$var = $newoptions[0];
    $op->configure( -options => \@newoptions );
    $$var = $prev;
}

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom