view release on metacpan or  search on metacpan

t/03_Options_Callback.t  view on Meta::CPAN

      $button->eventGenerate('<ButtonPress-1>');
      $jcb->hidePopup;
      $mw->update;
      is($cb, 2);
      $cb = 0;
      $jcb->destroy;
   };
   fail "\nFail - TestCreateModifyPopup($mode): $@" if $@;
}
  
sub TestKeyCommand
{
   my $mode = shift;
   eval {
      my $uChar;
      my $key;
      my $cb = 0;

      my $jcb = Setup('pack',
         -mode => $mode,
         -keycommand => sub {
	    $uChar = $_[1];
	    $key = $_[2];
	    $cb++;
	 }
      );
      my $e = $jcb->Subwidget('Entry');
      $e->focusForce;
      $e->eventGenerate('<KeyPress>', -keysym => 'a');

      is($cb, 1, 'KeyCommand called');
      is($uChar, 'a', 'uChar correctly passed');
      is($key, 'a', 'key correctly passed');
      $jcb->destroy;
   };
   fail "\nFail - TestKeyCommand($mode): $@" if $@;
}

sub TestPopup
{
   my ($type, $mode) = @_;
   eval {
      my $cb = 0;

      my $jcb = Setup('pack',
         -mode => $mode,
        "-popup$type", sub { $cb++; }
      );
      $jcb->showPopup;
      $jcb->hidePopup;
      is($cb, 1, "-popup$type called, even when there are no items");
      $cb = 0;

      my $button = $jcb->Subwidget('Button');
      $button->eventGenerate('<ButtonPress-1>');
      $jcb->hidePopup;
      $mw->update;
      is($cb, 1, "-popup$type called, even when there are no items");
      $cb = 0;

      ## Add one item to the combobox 
      $jcb->addItem("one");
      $jcb->showPopup;
      is($cb, 1, "-popup$type - configured, items, popup invisible");
      $cb = 0;
   
      $jcb->showPopup;
      $jcb->hidePopup;
      is($cb, 1, "-popup$type not called when popup is visible");
      $cb = 0;

      $button->eventGenerate('<ButtonPress-1>');
      $mw->update;
      is($cb, 1, "-popup$type called from <ButtonPress-1>");
      $cb = 0;

      $button->eventGenerate('<ButtonPress-1>');
      $jcb->hidePopup;
      $mw->update;
      is($cb, 1, "-popup$type not called when popup is visible");
      $cb = 0;
      $jcb->destroy;
   };
   fail "\nFail - TestPopup($mode): $@" if $@;
}

sub TestSelectCommand 
{
   my $mode = shift;
   eval {
      my ($w, $selIndex, $selName, $selValue);
      my $cb = 0;
      my $jcb = Setup('pack',
         -mode => $mode,
         -choices => [qw/one two three/],
         -selectcommand => sub {
            ($w, $selIndex, $selName, $selValue) = @_;
            $cb++;
	 });
      $jcb->addItem('four', -value => 4);
      $mw->update;

      ## 1) Test that selectcommand is triggered by setSelectedIndex
      ##    method call.
      $jcb->setSelectedIndex(0);
      is($cb, 1, 'Verify that -selectcommand callback was called');
      is($selIndex, 0, 'verify that index 0 was passed to callback');
      is($selName, 'one', 'verify that "one" (name) was selected');
      is($selValue, 'one', 'verify that "one"(value) was selected');
      $cb = 0;

      ## 2) Test that selectcommand is not triggered when selection is set 
      ## that matches existing selection.
      $jcb->setSelectedIndex(0);
      is($cb, 0, '-selectcommand triggered by duplicate selection');
   
      ## 3) Test that selectcommand is triggered when setSelected method is
      ## is called.
      $jcb->setSelected('four');
      is($cb, 1, 'verify that -selectcommand callback was called');
      is($selIndex, 3, 'verify that index 3 was passed');