view release on metacpan or  search on metacpan

t/_gui/loadbook.gt  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use inc::testplan(1, 7);
use test_inc::loginit;

use constant { D => 0 };

use Wx;
use Wx::Event qw(
  EVT_IDLE
  EVT_TREE_SEL_CHANGED
  EVT_TREE_SEL_CHANGING
  EVT_TREE_ITEM_EXPANDED
  );

#BEGIN {
#use inc::loginit;
#}

my $package = require("./client/app.pl");

# NOTE: crash will typically happen here.  If it does, we're dead in
# the water (probably a syntax error.)
my $app = eval {$package->new(); };
ok((not $@), "$package constructor") or
  BAIL_OUT("error: " . join('\n', split(/\n+/, $@)));

local $SIG{__WARN__};

my $main_frame = $package->_main_frame;
$main_frame->set_TESTING(1);
my $first = sub {
  $main_frame->sidebar->select_item('libraries');
  my $tr = $main_frame->sidebar->libraries;
  $tr->SetFocus();
  my $id = $tr->GetRootItem;
  $tr->Expand($id);
  D and warn "$id children:", $tr->GetChildrenCount($id), " (", $tr->GetChildrenCount($id,0), ")\n";
  ($id) = $tr->GetFirstChild($id); # My Libraries
  $tr->Expand($id);
  D and warn "$id children:",
    $tr->GetChildrenCount($id), " (", $tr->GetChildrenCount($id,0), ")\n";
  ($id) = $tr->GetFirstChild($id); # SQLLite test library
  $tr->Expand($id);
  D and warn "$id children:",
    $tr->GetChildrenCount($id), " (", $tr->GetChildrenCount($id,0), ")\n";
  D and warn "tr is ", $tr->GetId, "\n";
  D and warn "text: ", $tr->GetItemText($id), "\n";
  D and warn "data is ", $tr->GetPlData($id);
  $tr->SelectItem($id); # BSD Book
}; # first
my @evt_subs = (
  $first,
);

my $shim_type = ref($main_frame->bv_manager->htmlwidget);
$shim_type =~ s/dtRdr::HTMLShim:://;
my @checklist = (qw(
  activate
  book_open
  ),
  ($shim_type eq 'WxMozilla' ? 'html_loaded' : 'skip1'),
  );
my %ok = map({$_ => 0} @checklist);

# our evt_sub will trigger this
EVT_TREE_SEL_CHANGED($main_frame, $main_frame->sidebar->libraries,
  sub {
    my ($fr, $event) = @_;
    $fr->sidebar->libraries->item_activated($event);
    my $foc = Wx::Window::FindFocus();
    D and warn "focus is on $foc (",
      join(", ", $fr, $fr->sidebar->contents, $fr->sidebar), ")";
    my $tb = $fr->sidebar->contents;
    if(not(defined($foc)) or ($foc eq $fr->sidebar->contents)) {
      $ok{activate}++;
      D and warn "that's good";
      my $id = $tb->GetRootItem;
      $tb->UnselectAll;
      $tb->IsExpanded($id) and $tb->Collapse($id);