diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/Zinc/Debug.pm | 203 |
1 files changed, 133 insertions, 70 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 1e6fd34..19adf50 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -27,7 +27,7 @@ use Tk::ItemStyle; @EXPORT = qw(finditems snapshot tree); @EXPORT_OK = qw(finditems snapshot tree); -my ($help_tl0, $help_tl, $result_tl, $result_fm, $search_tl, +my ($help_tl, $result_tl, $result_fm, $search_tl, $searchtree_tl, $showitemflag); my $coords_tl; my $devicecoords_tl; @@ -50,59 +50,40 @@ my @seq; my $helptree_tl; my $wwidth; my $wheight; +my $preload; +my %run; +sub BEGIN { + # test if ZincDebug is loaded using the -M perl option + $preload = 1 if (caller(2))[2] == 0; +} -# Hack to capture $zinc symbols. -# Usefull to load ZincDebug by running your perl script in this way : -# perl -MZincdebug yourscript.pl -# or -# perl -MZincDebug=tree,finditems yourscript.pl -# -# Needs that zinc instance appears in the symbols table of main package, -# i.e. zinc instance is defined in you script as global (not lexical) -# variable -# -sub import { - my ($module, @args) = @_; - # export_to_level really export symbols - ZincDebug->export_to_level(1, @_); - my %args; - my $noargs = 1 unless @args > 0; - for (@args) { - $args{$_} = 1; - } - Tk::after(3000, sub { - my $found = 0; - # return if $zinc is alrealdy defined, by invocation of ZincDebug - # functions tree(), finditems()... in main - return if $zinc; - for my $name (keys %{'main::'}) { - if (ref(${$main::{$name}}) eq 'Tk::Zinc') { - &tree(${$main::{$name}}) if $args{tree} or $noargs; - &finditems(${$main::{$name}}) if $args{finditems} or $noargs; - &snapshot(${$main::{$name}}) if $args{snapshot} or $noargs; - $found++; - # return when first instance of Zinc is found - return; - } - } - if ($found == 0) { - print "in ZincDebug module, no zinc instance has been detected at ". - "runtime.\n"; - } - }); - -} # end import +# Hack to capture the instance of zinc. ZincDebug functions are invoked here. +# Note that created bindings might be overloaded by the application. +sub Tk::Zinc::InitObject { + Tk::Widget::InitObject(@_); + return unless $preload; + $zinc = $_[0]; + &tree($zinc); + &finditems($zinc); + &snapshot($zinc); +} -sub tree { +sub tree { + + if ($run{tree}) { + carp "in ZincDebug, tree() is already running\n"; + return; + } &setwidget(shift); return unless $zinc; + $run{tree} = 1; # styles definition $zinc->ItemStyle('text', -stylename => "item", -foreground => 'black'); $zinc->ItemStyle('text', -stylename => "group", -foreground => 'black'); - # options + # options my %options = @_; for my $opt (keys(%options)) { carp "in ZincDebug module, tree() function, unknown option $opt\n" @@ -120,10 +101,6 @@ sub tree { $options{-optionsFormat} = 'column'; } # - # binding for help screen - # - $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); - # # binding for building tree # $zinc->toplevel->Tk::bind('<'.$treeKey.'>', @@ -141,9 +118,14 @@ sub tree { sub finditems { - + + if ($run{finditems}) { + carp "in ZincDebug, tree() is already running\n"; + return; + } &setwidget(shift); return unless $zinc; + $run{finditems} = 1; # options my %options = @_; for my $opt (keys(%options)) { @@ -160,10 +142,6 @@ sub finditems { return unless &compatseq($enclosedModBtn, $overlapModBtn); return unless &compatkey($searchKey); # - # binding for help screen - # - $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); - # # bindings for Enclosed search # my $ekb = $enclosedModBtn; @@ -193,8 +171,13 @@ sub finditems { sub snapshot { + if ($run{snapshot}) { + carp "in ZincDebug, tree() is already running\n"; + return; + } &setwidget(shift); return unless $zinc; + $run{snapshot} = 1; # options my %options = @_; for my $opt (keys(%options)) { @@ -207,10 +190,6 @@ sub snapshot { my $snapshotBasename = ($options{-basename}) ? $options{-basename} : "zincsnapshot"; return unless &compatkey($snapKey); # - # binding for help screen - # - $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); - # # binding for printing a full zinc window # $zinc->toplevel->Tk::bind("<".$snapKey.">", @@ -278,12 +257,14 @@ sub showtree { $tree->bind('<1>', [sub { my $path = $tree->nearest($_[1]); my $item = (split(/\./, $path))[-1]; + print "item=$item\n"; &highlightitem($tree, $zinc, $item, 0); }, Ev('y')]); $tree->bind('<2>', [sub { my $path = $tree->nearest($_[1]); + return if $path == 1; $tree->selectionClear; $tree->selectionSet($path); $tree->anchorSet($path); @@ -294,6 +275,7 @@ sub showtree { $tree->bind('<3>', [sub { my $path = $tree->nearest($_[1]); + return if $path == 1; $tree->selectionClear; $tree->selectionSet($path); $tree->anchorSet($path); @@ -337,7 +319,7 @@ sub showtree { sub searchInTree { $searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl); $searchtree_tl = $zinc->Toplevel; - $searchtree_tl->title("Find in tree"); + $searchtree_tl->title("Find string in tree"); my $fm = $searchtree_tl->Frame->pack(-side => 'top'); $fm->Label(-text => "Find : ", )->pack(-side => 'left', -padx => 10, -pady => 10); @@ -359,7 +341,7 @@ sub searchInTree { $ep = $tree->info($side, $ep); unless ($ep) { $ep = 1; - $found = 1; + $found = 0; last; } $text = $tree->entrycget($ep, -text); @@ -372,7 +354,8 @@ sub searchInTree { last; } } - $status->configure(-text => "Search string not found") unless $found; + #print "searchTreeEntryValue=$searchTreeEntryValue found=$found\n"; + $status->configure(-text => "Search string not found") unless $found > 0; }; my $fm2 = $searchtree_tl->Frame->pack(-side => 'top'); @@ -614,9 +597,12 @@ sub setwidget { $zinc->update; my $geom = $zinc->geometry =~ /(\d+)x(\d+)+/=~ /(\d+)x(\d+)+/; ($wwidth, $wheight) = ($1, $2); + # binding for help screen + $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); } # end setwidget + # test input keys compatibility sub compatkey { push(@keys, @_); @@ -988,7 +974,7 @@ sub showgroupcontent { # belongs to an invisible group. sub highlightitem { my ($btn, $zinc, $item, $level) = @_; - return if $showitemflag; + return if $showitemflag or $item == 1; $showitemflag = 1; &surrounditem($zinc, $item, $level); @@ -1358,6 +1344,80 @@ sub showErrorWhilePrinting { #--------------------------------------------------------------------------- # display complete help screen sub showgeneralhelp { + return if Tk::Exists($help_tl); + $help_tl = $zinc->Toplevel; + $help_tl->title("Zinc Debug info"); + + my $text = $help_tl->Scrolled('Text', -font => scalar $zinc->cget(-font), + -wrap => 'word', + -foreground => 'gray10', + -width => 50, + -height => 32, + -scrollbars => 'osoe', + ); + $text->tagConfigure('keyword', -foreground => 'darkblue'); + $text->tagConfigure('title', -foreground => 'ivory', + -background => 'gray60'); + if ($treeKey) { + $text->insert('end', " To display the items tree\n", 'title'); + $text->insert('end', "\nUse the <"); + $text->insert('end', $treeKey, 'keyword'); + $text->insert('end', "> sequence.\n\n"); + } + if ($enclosedModBtn) { + my $eseq = $enclosedModBtn->[0]."-Button".$enclosedModBtn->[1]; + my $oseq = $overlapModBtn->[0]."-Button".$overlapModBtn->[1]; + $text->insert('end', " To analyse a particular area\n", 'title'); + $text->insert('end', "\nWith <"); + $text->insert('end', $oseq, 'keyword'); + $text->insert('end', "> sequence, create a rectangular area to parse items "); + $text->insert('end', "which overlap it.\n"); + $text->insert('end', "\nWith <"); + $text->insert('end', $eseq, 'keyword'); + $text->insert('end', "> sequence, create a rectangular area to parse items "); + $text->insert('end', "which are enclosed in it.\n\n"); + } + if ($treeKey or $enclosedModBtn) { + $text->insert('end', "To analyse a specific item.\n", 'title'); + if ($enclosedModBtn) { + $text->insert('end', "\nWith <"); + $text->insert('end', $searchKey, 'keyword'); + $text->insert('end', "> sequence, locate a specific item entering ". + "its tagOrId.\n"); + } + if ($treeKey) { + my $tseq = $treeModBtn->[0]."-Button".$treeModBtn->[1]; + $text->insert('end', "\nWith <"); + $text->insert('end', $tseq, 'keyword'); + $text->insert('end', "> sequence, select a particular item in the ". + "application window and locate it in the tree.\n"); + } + $text->insert('end', "\n"); + } + + if ($snapKey) { + $text->insert('end', "To snapshot the application window.\n", 'title'); + $text->insert('end', "\nWith <"); + $text->insert('end', $snapKey, 'keyword'); + $text->insert('end', "> sequence you can acquire " . + "a snapshot of the full zinc window. ". + "It will be saved in the current directory ". + "with the name zincsnapshot<n>.png ". + "The ImageMagic package must be installed.\n\n"); + } + $text->insert('end', "\nStrike <"); + $text->insert('end', 'Escape', 'keyword'); + $text->insert('end', "> key to display this help message again."); + + $help_tl->Button(-command => sub {$help_tl->destroy}, + -text => 'Close')->pack(-side => 'bottom', + -pady => 10); + $text->pack->pack(-side => 'top', -pady => 10, -padx => 10); + +} # end showgeneralhelp + + +sub showgeneralhelp_old { my $text; if ($enclosedModBtn) { my $eseq = $enclosedModBtn->[0]."-Button".$enclosedModBtn->[1]; @@ -1490,6 +1550,7 @@ sub infoAboutHighlighting { } # end infoAboutHighlighting + 1; __END__ @@ -1503,29 +1564,31 @@ ZincDebug - a perl module for analysing a Zinc application. =head1 SYNOPSIS perl -MZincDebug zincapplication.pl - - or + + or use ZincDebug; my $zinc = MainWindow->new()->Zinc()->pack; - finditems($zinc); - tree($zinc); - snapshot($zinc); + finditems($zinc, [options]); + tree($zinc, [options]); + snapshot($zinc, [options]); =head1 DESCRIPTION ZincDebug provides an interface to help developers to debug or analyse Zinc applications. -With B<finditems> function, you are able to scan all items which are enclosed in a rectangular area you have first drawn by drag & drop, or all items which overlap it. Result is a Tk table which presents details (options, coordinates, ...) about found items; you can also highlight a particular item, even if it's not visible, by clicking on its corresponding button in the table. You can also display particular item's features by entering this id in dedicated entry field +With B<finditems()> function, you are able to scan all items which are enclosed in a rectangular area you have first drawn by drag & drop, or all items which overlap it. Result is a Tk table which presents details (options, coordinates, ...) about found items; you can also highlight a particular item, even if it's not visible, by clicking on its corresponding button in the table. You can also display particular item's features by entering this id in dedicated entry field + +B<tree()> function displays item's hierarchy. You can find a particular item's position in the tree and you can highlight items and see their features as described above. -B<tree> function displays item's hierarchy. You can find a particular item's position in the tree and you can highlight items and see their features as described above. +With B<snapshot()> function, you are able to snapshot the application window, in order to illustrate a graphical bug for example. -With B<snapshot> function, you are able to snapshot the application window, in order to illustrate a graphical bug for example. +B<zincdebug()> function invokes all the previous specific functions with default options. Press B<Escape> key in the main window of the application to have some help about available input sequences. -If you load ZincDebug using the -M perl option, nothing needs to be added to your code. In this mode, a process parse the main symbols table in order to detect zinc instance. So, it works only if zinc instance is stored in a global (not lexical) variable of the main package. +If you load ZincDebug using the -M perl option, nothing needs to be added to your code. In this mode, all the previous specific functions are invoked with default options. =head1 FUNCTIONS |