Tcl-pTk

 view release on metacpan or  search on metacpan

t/ttkBrowseEntry.t  view on Meta::CPAN

                #$w->configure(-choices => [1..5]);
                $listCmdArg = $w;
        },
        'ExtraArg1',
        'ExtraArg2']);

$cb->_postcommandCallback();

ok(ref($listCmdArg), 'Tcl::pTk::ttkBrowseEntry', '-listcmd callback');
ok(join(", ", @listCmdArgs), "ExtraArg1, ExtraArg2", '-listcmd callback args');

#$cb->set("10");

# check delete method
$cb->delete(0, 'end');


my @choices2 = $cb->cget(-choices);
ok(@choices2, 0, "Empty Choices after delete");

$cb->insert(0, @choices);
@choices2 = $cb->cget(-choices);
ok(@choices2, 50, "Choices populated after insert");

# Check the get command
my @choices3 = $cb->get(10, 'end');
#print "Choices3 = ".join(", ", @choices3)."\n";
ok($choices3[0], 11, "Get value return 1");
ok($choices3[-1], 50, "Get value return 2");
ok(scalar(@choices3), 40, "Get value return 3");

#print "Combobox width  = ".$cb->cget(-width)."\n";
#print "Combobox height = ".$cb->cget(-height)."\n";


# $cb->bind('<<ComboboxSelected>>', 
#         sub{ 
#                 print "Selected args = ".join(', ', @_)."\n";
#                 print "get returns ".$cb->get()."\n";
#                 print "Variable is $ttkoption\n";
#                 });

# Check browsecmd operation
$top->after(1000, 
        sub{
        # Check browsecmd by sending virtual events
        my $selection;
        $cb->configure(-browsecmd => 
               [ sub{ 
                        my ($extraArg, $w, $value) = @_;
                        #print "browsecmd args ".join(", ", @_)."\n";
                        $selection = $value;
                        
                        ok($extraArg, 'extraArg', "browsecmd arg order check");
                        
                }, 'extraArg']
                );
        
        $cb->set(3); # Make a selection
        # generate event that would happen if we actually made the selection in the GUI
        $cb->Subwidget('combobox')->eventGenerate('<<ComboboxSelected>>');

        # check for browsecmd being called
        ok($selection, 3, "browsecmd check");

        $selection = undef;
        
        # Now check browse2cmd
        $cb->configure(-browsecmd => undef);
        

        $cb->configure(-browse2cmd => 
                sub{ 
                        my ($w, $value) = @_;
                        #print STDERR "browse2cmd args ".join(", ", @_)."\n";
                        $selection = $value;
                        
                });
                
        $cb->set(21); # Make a selection
        # generate event that would happen if we actually made the selection in the GUI
        $cb->Subwidget('combobox')->eventGenerate('<<ComboboxSelected>>');

        ok($selection, 20, "browse2cmd check");
        });



$top->after(2000, sub{ $top->destroy() }) unless (@ARGV); # for debugging, don't go away if something on the command line
MainLoop;

#print "options = $ttkoption\n";







( run in 2.759 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )