diff options
Diffstat (limited to 'Perl/Zinc')
| -rw-r--r-- | Perl/Zinc/Debug.pm | 741 |
1 files changed, 445 insertions, 296 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index d086e63..a0699b5 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -27,32 +27,29 @@ use Tk::ItemStyle; @EXPORT = qw(finditems snapshot tree); @EXPORT_OK = qw(finditems snapshot tree); -my ($help_tl, $result_tl, $result_fm, $search_tl, - $searchtree_tl, $showitemflag); -my $coords_tl; -my $devicecoords_tl; -my ($text_id, $rectangle_id); +my ($itemstyle, $groupstyle); +my (%help_tl, $result_tl, $result_fm, $search_tl, $helptree_tl, $coords_tl, + $searchtree_tl, $tree_tl, $tree); +my $showitemflag; my ($x0, $y0); my ($help_print, $imagecounter, $saving) = (0, 0, 0); -my $searchEntryValue; +my %searchEntryValue; my $searchTreeEntryValue; -my $tree_tl; -my $zinc; -my $enclosedModBtn; -my $overlapModBtn; -my $treeModBtn; -my $searchKey; -my $snapKey; -my $treeKey; -my $tree; -my @keys; -my @seq; -my $helptree_tl; -my $wwidth = 0; -my $wheight = 0; +my %enclosedModBtn; +my %overlapModBtn; +my %treeModBtn; +my %searchKey; +my %snapKey; +my %treeKey; +my %keys; +my %seq; +my %wwidth; +my %wheight; my $preload; -my %run; my %defaultoptions; +my %focus; +my %instances; +my @instances; sub BEGIN { # test if ZincDebug is loaded using the -M perl option @@ -64,70 +61,93 @@ sub BEGIN { sub Tk::Zinc::InitObject { Tk::Widget::InitObject(@_); return unless $preload; - return if $zinc; - $zinc = $_[0]; + my $zinc = $_[0]; &tree($zinc); &finditems($zinc); &snapshot($zinc); } - +#--------------------------------------------------------------------------- +# tree : display items hierarchy +#--------------------------------------------------------------------------- sub tree { - if ($run{tree}) { - carp "in ZincDebug, tree() is already running\n"; + my $zinc = shift; + unless ($zinc) { + carp "In ZincDebug module, tree() function, widget must be specified\n"; return; } - &setwidget(shift); - return unless $zinc; - $run{tree} = 1; + &newinstance($zinc); # styles definition - $zinc->ItemStyle('text', -stylename => "item", -foreground => 'black'); - $zinc->ItemStyle('text', -stylename => "group", -foreground => 'black'); - # options + $itemstyle = + $zinc->ItemStyle('text', -stylename => "item", -foreground => 'black') + unless $itemstyle; + $groupstyle = + $zinc->ItemStyle('text', -stylename => "group", -foreground => 'black') + unless $groupstyle; + + # options my %options = @_; for my $opt (keys(%options)) { carp "in ZincDebug module, tree() function, unknown option $opt\n" unless ($opt eq '-itemModBtn' or $opt eq '-key' or $opt eq '-optionsToDisplay' or $opt eq '-optionsFormat'); } - $treeKey = ($options{-key}) ? $options{-key} : 'Control-t'; - $treeModBtn = ($options{-itemModBtn}) ? $options{-itemModBtn} : ['Control', 2]; - return unless &compatseq($treeModBtn); - return unless &compatkey($treeKey); + + # unset previous bindings; + $zinc->Tk::bind('<'.$treeKey{$zinc}.'>', '') if $treeKey{$zinc}; + if ($treeModBtn{$zinc}) { + my $seq; + if ($treeModBtn{$zinc}->[0]) { + $seq = $treeModBtn{$zinc}->[0]."-".$treeModBtn{$zinc}->[1]; + } else { + $seq = $treeModBtn{$zinc}->[1]; + + } + $zinc->Tk::bind('<'.$seq.'>', ''); + } + + $treeKey{$zinc} = ($options{-key}) ? $options{-key} : 'Control-t'; + $treeModBtn{$zinc} = ($options{-itemModBtn}) ? $options{-itemModBtn} : + ['Control', 2]; $options{-optionsFormat} = 'column' unless $options{-optionsFormat}; if ($options{-optionsFormat} ne 'row' and $options{-optionsFormat} ne 'column') { carp "in ZincDebug module, tree() function, expected values for ". "-optionsFormat are 'row' or 'column'. Option is set to 'column'\n"; $options{-optionsFormat} = 'column'; } - # # binding for building tree - # - $zinc->toplevel->Tk::bind('<'.$treeKey.'>', + $zinc->Tk::bind('<'.$treeKey{$zinc}.'>', [\&showtree, $options{-optionsToDisplay}, $options{-optionsFormat}]); - # # binding for displaying item in tree - # - my $tkb = $treeModBtn; - $zinc->Tk::bind('<'.$tkb->[0]."-".$tkb->[1].'>', - [\&findintree, $options{-optionsToDisplay}, - $options{-optionsFormat}]); + my $seq; + if ($treeModBtn{$zinc}->[0]) { + $seq = $treeModBtn{$zinc}->[0]."-".$treeModBtn{$zinc}->[1]; + } else { + $seq = $treeModBtn{$zinc}->[1]; + } + $zinc->Tk::bind("<".$seq.">", [\&findintree, $options{-optionsToDisplay}, + $options{-optionsFormat}]); + # binding for general help + $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); } # end tree +#--------------------------------------------------------------------------- +# finditems : scan items which are enclosed in a rectangular area first +# drawn by drag & drop or all items which overlap it +#--------------------------------------------------------------------------- sub finditems { - - if ($run{finditems}) { - carp "in ZincDebug, tree() is already running\n"; + + my $zinc = shift; + unless ($zinc) { + carp "In ZincDebug module, finditems() function, widget must be specified\n"; return; - } - &setwidget(shift); - return unless $zinc; - $run{finditems} = 1; + } + &newinstance($zinc); # options my %options = @_; for my $opt (keys(%options)) { @@ -135,51 +155,93 @@ sub finditems { unless ($opt eq '-color' or $opt eq '-enclosedModBtn' or $opt eq '-overlapModBtn' or $opt eq '-searchKey'); } + # unset previous bindings; + my $ekb = $enclosedModBtn{$zinc}; + if ($ekb) { + if ($ekb->[0]) { + $zinc->Tk::bind("<".$ekb->[0]."-".$ekb->[1].">", ''); + $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-Motion>", ''); + $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-ButtonRelease>", ''); + } else { + $zinc->Tk::bind("<".$ekb->[1].">", ''); + $zinc->Tk::bind("<B".$ekb->[1]."-Motion>", ''); + $zinc->Tk::bind("<B".$ekb->[1]."-ButtonRelease>", ''); + } + } + my $okb = $overlapModBtn{$zinc}; + if ($okb) { + if ($okb->[0]) { + $zinc->Tk::bind("<".$okb->[0]."-".$okb->[1].">", ''); + $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-Motion>", ''); + $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-ButtonRelease>", ''); + } else { + $zinc->Tk::bind("<".$okb->[1].">", ''); + $zinc->Tk::bind("<B".$okb->[1]."-Motion>", ''); + $zinc->Tk::bind("<B".$okb->[1]."-ButtonRelease>", ''); + } + } + my $color = ($options{-color}) ? $options{-color} : 'sienna'; - $enclosedModBtn = ($options{-enclosedModBtn}) ? $options{-enclosedModBtn} : + $enclosedModBtn{$zinc} = ($options{-enclosedModBtn}) ? $options{-enclosedModBtn} : ['Control', 3]; - $overlapModBtn = ($options{-overlapModBtn}) ? $options{-overlapModBtn} : + $overlapModBtn{$zinc} = ($options{-overlapModBtn}) ? $options{-overlapModBtn} : ['Shift', 3]; - $searchKey = ($options{-searchKey}) ? $options{-searchKey} : 'Control-f'; - return unless &compatseq($enclosedModBtn, $overlapModBtn); - return unless &compatkey($searchKey); - # + $searchKey{$zinc} = ($options{-searchKey}) ? $options{-searchKey} : 'Control-f'; # bindings for Enclosed search - # - my $ekb = $enclosedModBtn; - $zinc->Tk::bind('all', "<".$ekb->[0]."-".$ekb->[1].">", - [\&startrectangle, 'simple', 'Enclosed', $color]); - $zinc->Tk::bind('all', "<".$ekb->[0]."-B".$ekb->[1]."-Motion>", \&resizerectangle); - $zinc->Tk::bind('all', "<".$ekb->[0]."-B".$ekb->[1]."-ButtonRelease>", - [\&stoprectangle, 'enclosed', 'Enclosed search']); - # + $ekb = $enclosedModBtn{$zinc}; + if ($ekb) { + if ($ekb->[0]) { + $zinc->Tk::bind("<".$ekb->[0]."-".$ekb->[1].">", + [\&startrectangle, 'simple', 'Enclosed', $color]); + $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-Motion>", \&resizerectangle); + $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-ButtonRelease>", + [\&stoprectangle, 'enclosed', 'Enclosed search']); + } else { + $zinc->Tk::bind("<".$ekb->[1].">", + [\&startrectangle, 'simple', 'Enclosed', $color]); + $zinc->Tk::bind("<B".$ekb->[1]."-Motion>", \&resizerectangle); + $zinc->Tk::bind("<B".$ekb->[1]."-ButtonRelease>", + [\&stoprectangle, 'enclosed', 'Enclosed search']); + } + } # bindings for Overlap search - # - my $okb = $overlapModBtn; - $zinc->Tk::bind('all', "<".$okb->[0]."-".$okb->[1].">", - [\&startrectangle, 'mixed', 'Overlap', $color]); - $zinc->Tk::bind('all', "<".$okb->[0]."-B".$okb->[1]."-Motion>", \&resizerectangle); - $zinc->Tk::bind('all', "<".$okb->[0]."-B".$okb->[1]."-ButtonRelease>", - [\&stoprectangle, 'overlapping', 'Overlap search']); - # + $okb = $overlapModBtn{$zinc}; + if ($okb) { + if ($okb->[0]) { + $zinc->Tk::bind("<".$okb->[0]."-".$okb->[1].">", + [\&startrectangle, 'mixed', 'Overlap', $color]); + $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-Motion>", \&resizerectangle); + $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-ButtonRelease>", + [\&stoprectangle, 'overlapping', 'Overlap search']); + } else { + $zinc->Tk::bind("<".$okb->[1].">", + [\&startrectangle, 'mixed', 'Overlap', $color]); + $zinc->Tk::bind("<B".$okb->[1]."-Motion>", \&resizerectangle); + $zinc->Tk::bind("<B".$okb->[1]."-ButtonRelease>", + [\&stoprectangle, 'overlapping', 'Overlap search']); + } + } # binding for search entry - # - $zinc->toplevel->Tk::bind('<'.$searchKey.'>', \&searchentry); - + $zinc->Tk::bind('<'.$searchKey{$zinc}.'>', \&searchentry); + # binding for general help + $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); } # end finditems +#--------------------------------------------------------------------------- +# snapshot : snapshot the application window, in order to illustrate a +# graphical bug for example +#--------------------------------------------------------------------------- sub snapshot { - if ($run{snapshot}) { - carp "in ZincDebug, tree() is already running\n"; + my $zinc = shift; + unless ($zinc) { + carp "In ZincDebug module, snapshot() function, widget must be specified\n"; return; - } - &setwidget(shift); - return unless $zinc; - $run{snapshot} = 1; + } + &newinstance($zinc); # options my %options = @_; for my $opt (keys(%options)) { @@ -187,15 +249,17 @@ sub snapshot { unless ($opt eq '-key' or $opt eq '-verbosity' or $opt eq '-basename'); } - $snapKey = ($options{-key}) ? $options{-key} : 'Control-s'; + # unset previous bindings; + $zinc->Tk::bind("<".$snapKey{$zinc}.">", '') if $snapKey{$zinc}; + + $snapKey{$zinc} = ($options{-key}) ? $options{-key} : 'Control-s'; my $snapshotVerbosity = (defined $options{-verbosity}) ? $options{-verbosity} : 1; my $snapshotBasename = ($options{-basename}) ? $options{-basename} : "zincsnapshot"; - return unless &compatkey($snapKey); - # # binding for printing a full zinc window - # - $zinc->toplevel->Tk::bind("<".$snapKey.">", + $zinc->Tk::bind("<".$snapKey{$zinc}.">", [\&printWindow , $snapshotBasename, $snapshotVerbosity]); + # binding for general help + $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); } # end snapshot @@ -206,16 +270,15 @@ sub snapshot { # #--------------------------------------------------------------------------- sub findintree { - my $optionstodisplay = $_[1]; - my $optionsFormat = $_[2]; + my ($zinc, $optionstodisplay, $optionsFormat) = @_; if (not Tk::Exists($tree_tl)) { - &showtree(undef, $optionstodisplay, $optionsFormat); + &showtree($zinc, $optionstodisplay, $optionsFormat); } my $ev = $zinc->XEvent; ($x0, $y0) = ($ev->x, $ev->y); - my @atomicgroups = &unsetAtomicity; + my @atomicgroups = &unsetAtomicity($zinc); my $item = $zinc->find('closest', $x0, $y0); - &restoreAtomicity(@atomicgroups); + &restoreAtomicity($zinc, @atomicgroups); return unless $item > 1; my @ancestors = reverse($zinc->find('ancestors', $item)); my $path = join('.', @ancestors).".".$item; @@ -231,8 +294,7 @@ sub findintree { sub showtree { - my $optionstodisplay = $_[1]; - my $optionsFormat = $_[2]; + my ($zinc, $optionstodisplay, $optionsFormat) = @_; $WARNING = 0; my @optionstodisplay = split(/,/, $optionstodisplay); $WARNING = 1; @@ -286,18 +348,18 @@ sub showtree { }, Ev('y')]); $tree->add("1", -text => "Group(1)", -state => 'disabled'); - &scangroup($tree, 1, "1", $optionsFormat, @optionstodisplay); + &scangroup($zinc, $tree, 1, "1", $optionsFormat, @optionstodisplay); $tree->autosetmode; # control buttons frame my $tree_butt_fm = $tree_tl->Frame(-height => 40)->pack(-side => 'bottom', -fill => 'y'); $tree_butt_fm->Button(-text => 'Help', - -command => \&showHelpAboutTree, + -command => [\&showHelpAboutTree, $zinc], )->pack(-side => 'left', -pady => 10, -padx => 30, -fill => 'both'); $tree_butt_fm->Button(-text => 'Search', - -command => \&searchInTree, + -command => [\&searchInTree, $zinc], )->pack(-side => 'left', -pady => 10, -padx => 30, -fill => 'both'); @@ -318,6 +380,7 @@ sub showtree { } # end showtree sub searchInTree { + my $zinc = shift; $searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl); $searchtree_tl = $zinc->Toplevel; $searchtree_tl->title("Find string in tree"); @@ -377,6 +440,7 @@ sub searchInTree { } # end searchInTree sub extractinfo { + my $zinc = shift; my $item = shift; my $format = shift; my $option = shift; @@ -420,23 +484,23 @@ sub extractinfo { } sub scangroup { - my ($tree, $group, $path, $format, @optionstodisplay) = @_; + my ($zinc, $tree, $group, $path, $format, @optionstodisplay) = @_; my @items = $zinc->find('withtag', "$group."); for my $item (@items) { my $type = ucfirst($zinc->type($item)); my $info = " "; if (@optionstodisplay == 1) { - $info .= &extractinfo($item, $format, $optionstodisplay[0]); + $info .= &extractinfo($zinc, $item, $format, $optionstodisplay[0]); } elsif (@optionstodisplay > 1) { for my $opt (@optionstodisplay) { - $info .= &extractinfo($item, $format, $opt, 1); + $info .= &extractinfo($zinc, $item, $format, $opt, 1); } } if ($type eq "Group") { $tree->add($path.".".$item, -text => "$type($item)$info", -style => 'group'); - &scangroup($tree, $item, $path.".".$item, $format, @optionstodisplay); + &scangroup($zinc, $tree, $item, $path.".".$item, $format, @optionstodisplay); } else { $tree->add($path.".".$item, -text => "$type($item)$info", @@ -453,47 +517,50 @@ sub scangroup { #--------------------------------------------------------------------------- # begin to draw rectangular area for search sub startrectangle { - my ($widget, $style, $text, $color) = @_; - $zinc->remove($rectangle_id, $text_id); + my ($zinc, $style, $text, $color) = @_; + $zinc->remove("zincdebugrectangle", "zincdebuglabel"); my $ev = $zinc->XEvent; ($x0, $y0) = ($ev->x, $ev->y); - $rectangle_id = $zinc->add('rectangle', 1, [$x0, $y0, $x0, $y0], - -linecolor => $color, - -linewidth => 2, - -linestyle => $style, + $zinc->add('rectangle', 1, [$x0, $y0, $x0, $y0], + -linecolor => $color, + -linewidth => 2, + -linestyle => $style, + -tags => ["zincdebugrectangle"], ); - $text_id = $zinc->add('text', 1, - -color => $color, - -font => '7x13', - -position => [$x0+5, $y0-15], - -text => $text, - ); + $zinc->add('text', 1, + -color => $color, + -font => '7x13', + -position => [$x0+5, $y0-15], + -text => $text, + -tags => ["zincdebuglabel"], + ); } # end startrectangle # resize the rectangular area for search sub resizerectangle { + my $zinc = shift; my $ev = $zinc->XEvent; my ($x, $y) = ($ev->x, $ev->y); - return unless ($zinc->find('withtag', $rectangle_id)); + return unless ($zinc->find('withtag', "zincdebugrectangle")); - $zinc->coords($rectangle_id, 1, 1, [$x, $y]); + $zinc->coords("zincdebugrectangle", 1, 1, [$x, $y]); if ($x < $x0) { if ($y < $y0) { - $zinc->coords($text_id, [$x+5, $y-15]); + $zinc->coords("zincdebuglabel", [$x+5, $y-15]); } else { - $zinc->coords($text_id, [$x+5, $y0-15]); + $zinc->coords("zincdebuglabel", [$x+5, $y0-15]); } } else { if ($y < $y0) { - $zinc->coords($text_id, [$x0+5, $y-15]); + $zinc->coords("zincdebuglabel", [$x0+5, $y-15]); } else { - $zinc->coords($text_id, [$x0+5, $y0-15]); + $zinc->coords("zincdebuglabel", [$x0+5, $y0-15]); } } - $zinc->raise($rectangle_id); - $zinc->raise($text_id); + $zinc->raise("zincdebugrectangle"); + $zinc->raise("zincdebuglabel"); } # end resizerectangle @@ -501,21 +568,21 @@ sub resizerectangle { # stop drawing rectangular area for search sub stoprectangle { - my ($widget, $searchtype, $text) = @_; - return unless ($zinc->find('withtag', $rectangle_id)); + my ($zinc, $searchtype, $text) = @_; + return unless ($zinc->find('withtag', "zincdebugrectangle")); - my @atomicgroups = &unsetAtomicity; - my @coords = $zinc->coords0($rectangle_id); + my @atomicgroups = &unsetAtomicity($zinc); + my @coords = $zinc->coords0("zincdebugrectangle"); my @items; for my $item ($zinc->find($searchtype, @coords, 1, 1)) { - push (@items, $item) if $item != $rectangle_id and - $item != $text_id; + push (@items, $item) unless $zinc->hastag($item, "zincdebugrectangle") or + $zinc->hastag($item, "zincdebuglabel"); } - &restoreAtomicity(@atomicgroups); + &restoreAtomicity($zinc, @atomicgroups); if (@items) { &showresult($text, $zinc, @items); } else { - $zinc->remove($rectangle_id, $text_id); + $zinc->remove("zincdebugrectangle", "zincdebuglabel"); } } # end stoprectangle @@ -525,6 +592,7 @@ sub stoprectangle { # in order to avoid find problems with group atomicity, we set all -atomic # attributes to 0 sub unsetAtomicity { + my $zinc = shift; my @groups = $zinc->find('withtype', 'group'); my @atomicgroups; for my $group (@groups) { @@ -540,6 +608,7 @@ sub unsetAtomicity { sub restoreAtomicity { + my $zinc = shift; my @atomicgroups = @_; for my $group (@atomicgroups) { $zinc->itemconfigure($group, -atomic => 1); @@ -551,6 +620,7 @@ sub restoreAtomicity { # display search entry field sub searchentry { + my $zinc = shift; $search_tl->destroy if $search_tl and Tk::Exists($search_tl); $search_tl = $zinc->Toplevel; $search_tl->title("Specific search"); @@ -566,78 +636,22 @@ sub searchentry { )->pack(-side => 'top', -pady => 10); $entry->focus; $entry->delete(0, 'end'); - $entry->insert(0, $searchEntryValue) if $searchEntryValue; + $entry->insert(0, $searchEntryValue{$zinc}) if $searchEntryValue{$zinc}; $entry->bind('<Key-Return>', [sub { $status->configure(-text => ""); $status->update; - $searchEntryValue = $entry->get(); - my @items = $zinc->find('withtag', $searchEntryValue); + $searchEntryValue{$zinc} = $entry->get(); + my @items = $zinc->find('withtag', $searchEntryValue{$zinc}); if (@items) { - &showresult("Search with TagOrId $searchEntryValue", $zinc, @items); + &showresult("Search with TagOrId $searchEntryValue{$zinc}", $zinc, @items); } else { - $status->configure(-text => "No such TagOrId ($searchEntryValue)"); + $status->configure(-text => "No such TagOrId ($searchEntryValue{$zinc})"); } }]); } # end searchentry -# test and set $zinc variable -sub setwidget { - my $widget = shift; - if ($zinc) { - if ($zinc ne $widget) { - carp "In ZincDebug module, widget value already exists. ". - "New value is ignored\n"; - } - } elsif (not $widget) { - carp "In ZincDebug module, widget must be specified\n"; - } else { - $zinc = $widget; - } - # binding for help screen - $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp); - -} # end setwidget - - -# test input keys compatibility -sub compatkey { - push(@keys, @_); - my %keys; - for (@keys) { - if ($keys{$_}) { - carp "In ZincDebug module, several bindings on <$_> key exist. ". - "Only the last created will work\n"; - return 0; - } - $keys{$_} = 1; - } - return 1; - -} # end compatkey - - - -# test input sequences compatibility -sub compatseq { - push(@seq, @_); - my %seq; - for (@seq) { - my $key = $_->[0].'-'.$_->[1]; - if ($seq{$key}) { - carp "In ZincDebug module, several bindings on <$key> sequence exit. ". - "Only the last created will work\n"; - return 0; - } - $seq{$key} = 1; - } - return 1; - - -} # end compatkey - - #--------------------------------------------------------------------------- # # RESULTS DISPLAY PRIVATE FUNCTIONS @@ -658,12 +672,12 @@ sub showresult { my $fm = $result_tl->Frame()->pack(-side => 'bottom', ); $fm->Button(-text => 'Help', - -command => [\&showHelpAboutAttributes, $result_tl] + -command => [\&showHelpAboutAttributes, $zinc] )->pack(-side => 'left', -padx => 40, -pady => 10); $fm->Button(-text => 'Close', -command => sub { $result_tl->destroy; - $zinc->remove($rectangle_id, $text_id); + $zinc->remove("zincdebugrectangle", "zincdebuglabel"); })->pack(-side => 'left', -padx => 40, -pady => 10); # scrolled pane creation @@ -684,16 +698,16 @@ sub showresult { -expand => 1, ); # attributes display - &showattributes($result_fm, \@items); - + &showattributes($zinc, $result_fm, \@items); } # end showresult # display in a toplevel the values of other options sub showotheroptions { - my ($zinc, $item) = @_; - my $tl = $zinc->Toplevel; + my ($zinc, $item, $fmp) = @_; + my $tl = $fmp->Toplevel; + #$tl->transient($fmp); my $title = "Other options of item $item"; $tl->title($title); my $background = $tl->cget(-background); @@ -752,7 +766,9 @@ sub showdevicecoords { sub showcoords { my ($zinc, $item, $deviceflag) = @_; my $bgcolor = 'ivory'; - $coords_tl->destroy if Tk::Exists($coords_tl); + my $bgcolor2 = 'gray75'; + $coords_tl->destroy if Tk::Exists($coords_tl) and not $deviceflag; + $coords_tl = $zinc->Toplevel(); my $title = "Zinc Debug"; if ($deviceflag) { @@ -770,9 +786,11 @@ sub showcoords { my $heightmax = 500; my $height = 100 + 50; $height = $heightmax if $height > $heightmax; + my $width = $coords_tl->screenwidth; + $width = 1200 if $width > 1200; my $coords_fm = $coords_tl->Scrolled('Pane', -scrollbars => 'se', - -width => scalar $coords_tl->screenwidth, + -width => $width, -height => $height, ); $coords_fm->pack(-padx => 10, -pady => 10, @@ -798,10 +816,10 @@ sub showcoords { ## the first element is an array reference, as every ## other elements of the list for (my $j=0; $j < @coords; $j ++) { - my ($x,$y,$type) = @{$coords[$j]}; - ($x,$y) = $zinc->transform(scalar $zinc->group($item), 1, [$x, $y]) + my @c = @{$coords[$j]}; + @c = $zinc->transform(scalar $zinc->group($item), 1, [@c]) if $deviceflag; - push(@{$contour[$i]}, [ $x , $y, $type]); + push(@{$contour[$i]}, [@c]); } } } @@ -823,9 +841,15 @@ sub showcoords { } $coords->[0] =~ s/\.(\d\d).*/\.$1/; $coords->[1] =~ s/\.(\d\d).*/\.$1/; - my $pointtype = (defined $coords->[2]) ? " ".$coords->[2] : ""; - $coords_fm->Label(-text => sprintf('%s, %s%s', $coords->[0], $coords->[1], - $pointtype), + my @opt; + if (defined $coords->[2]) { + @opt = (-text => sprintf('%s, %s, %s', @$coords), + -underline => length(join(',', @$coords)) + 1, + ); + } else { + @opt = (-text => sprintf('%s, %s', @{$coords}[0,1])); + } + $coords_fm->Label(@opt, -width => 15, -relief => 'ridge')->grid(-row => $row, -ipadx => 5, @@ -972,23 +996,25 @@ sub showgroupcontent { my $fm2 = $tl->Frame()->pack(-side => 'bottom', ); $fm2->Button(-text => 'Help', - -command => [\&showHelpAboutAttributes, $tl] + -command => [\&showHelpAboutAttributes, $zinc] )->pack(-side => 'left', -padx => 40, -pady => 10); $fm2->Button(-text => 'Close', -command => sub { $tl->destroy; })->pack(-side => 'left', -padx => 40, -pady => 10); + my $width = $result_tl->screenwidth; + $width = 1200 if $width > 1200; my $fm = $tl->Scrolled('Pane', -scrollbars => 'se', - -width => scalar $result_tl->screenwidth, + -width => $width, -height => $height, -label => $title, )->pack(-padx => 10, -pady => 10, -ipadx => 10, -expand => 1, -fill => 'both'); - &showattributes($fm, \@items); + &showattributes($zinc, $fm, \@items); } # end showgroupcontent @@ -999,7 +1025,7 @@ sub showbbox { if (scalar @bbox == 4) { # If item is visible, rectangle is drawm surround it. # Else, a warning is displayed. - unless (&itemisoutside(@bbox)) { + unless (&itemisoutside($zinc, @bbox)) { my $i = 0; for ('white', 'blue', 'white') { $zinc->add('rectangle', 1, @@ -1034,24 +1060,25 @@ sub highlightitem { &surrounditem($zinc, $item, $level); - $btn->bind('<ButtonRelease>', [\&undohighlightitem]) if $btn; + $btn->bind('<ButtonRelease>', [\&undohighlightitem, $zinc]) if $btn; } # end highlightitem sub itemisoutside { + my $zinc = shift; my @bbox = @_; my $outflag; $WARNING = 0; if ($bbox[2] < 0) { - if ($bbox[1] > $wheight) { + if ($bbox[1] > $wheight{$zinc}) { $outflag = 'left+bottom'; } elsif ($bbox[3] < 0) { $outflag = 'left+top'; } else { $outflag = 'left'; } - } elsif ($bbox[0] > $wwidth) { - if ($bbox[1] > $wheight) { + } elsif ($bbox[0] > $wwidth{$zinc}) { + if ($bbox[1] > $wheight{$zinc}) { $outflag = 'right+bottom'; } elsif ($bbox[3] < 0) { $outflag = 'right+top'; @@ -1060,7 +1087,7 @@ sub itemisoutside { } } elsif ($bbox[3] < 0) { $outflag = 'top'; - } elsif ($bbox[1] > $wheight) { + } elsif ($bbox[1] > $wheight{$zinc}) { $outflag = 'bottom'; } #print "outflag=$outflag bbox=@bbox\n"; @@ -1087,35 +1114,35 @@ sub itemisoutside { if ($outflag eq 'bottom') { $x = $bbox[0] + ($bbox[2]-$bbox[0])/2; $x = $hw + 10 if $x < $hw + 10; - $x = $wwidth - $hw - 10 if $x > $wwidth - $hw - 10; - $y = $wheight - $hh - 10; + $x = $wwidth{$zinc} - $hw - 10 if $x > $wwidth{$zinc} - $hw - 10; + $y = $wheight{$zinc} - $hh - 10; } elsif ($outflag eq 'top') { $x = $bbox[0] + ($bbox[2]-$bbox[0])/2; $x = $hw + 10 if $x < $hw + 10; - $x = $wwidth - $hw - 10if $x > $wwidth - $hw - 10; + $x = $wwidth{$zinc} - $hw - 10if $x > $wwidth{$zinc} - $hw - 10; $y = $hh + 10; } elsif ($outflag eq 'left') { $x = $hw + 10; $y = $bbox[1] + ($bbox[3]-$bbox[1])/2; $y = $hh + 10 if $y < $hh + 10; - $y = $wheight - $hh - 10 if $y > $wheight - $hh - 10; + $y = $wheight{$zinc} - $hh - 10 if $y > $wheight{$zinc} - $hh - 10; } elsif ($outflag eq 'right') { - $x = $wwidth - $hw - 10; + $x = $wwidth{$zinc} - $hw - 10; $y = $bbox[1] + ($bbox[3]-$bbox[1])/2; $y = $hh + 10 if $y < $hh + 10; - $y = $wheight - $hh - 10 if $y > $wheight - $hh - 10; + $y = $wheight{$zinc} - $hh - 10 if $y > $wheight{$zinc} - $hh - 10; } elsif ($outflag eq 'left+top') { $x = $hw + 10; $y = $hh + 10; } elsif ($outflag eq 'left+bottom') { $x = $hw + 10; - $y = $wheight - $hh - 10; + $y = $wheight{$zinc} - $hh - 10; } elsif ($outflag eq 'right+top') { - $x = $wwidth - $hw - 10; + $x = $wwidth{$zinc} - $hw - 10; $y = $hh + 10; } elsif ($outflag eq 'right+bottom') { - $x = $wwidth - $hw - 10; - $y = $wheight - $hh - 10; + $x = $wwidth{$zinc} - $hw - 10; + $y = $wheight{$zinc} - $hh - 10; } $zinc->coords($g, [$x, $y]); $zinc->raise('zincdebug'); @@ -1152,7 +1179,7 @@ sub surrounditem { my @bbox = $zinc->transform(1, $topgroup, [@bbox0]); # If item is visible, rectangle is drawm surround it. # Else, a warning is displayed. - unless (&itemisoutside(@bbox0)) { + unless (&itemisoutside($zinc, @bbox0)) { if (defined($level) and $level > 0) { my $r = $zinc->add('Rectangle', $topgroup, [$bbox[0] - 10, $bbox[1] - 10, @@ -1182,7 +1209,7 @@ sub surrounditem { sub undohighlightitem { - my ($btn) = @_; + my ($btn, $zinc) = @_; $btn->bind('ReleaseButton', ''); $zinc->remove('zincdebug'); $showitemflag = 0; @@ -1222,11 +1249,11 @@ sub showbanner { # display in a grid the values of most important attributes sub showattributes { - my ($fm, $items) = @_; - unless ($wwidth > 1) { + my ($zinc, $fm, $items) = @_; + unless ($wwidth{$zinc} > 1) { $zinc->update; my $geom = $zinc->geometry =~ /(\d+)x(\d+)+/=~ /(\d+)x(\d+)+/; - ($wwidth, $wheight) = ($1, $2); + ($wwidth{$zinc}, $wheight{$zinc}) = ($1, $2); } my $bgcolor = 'ivory'; my $i = 1; @@ -1286,7 +1313,7 @@ sub showattributes { $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; } } - if ($type eq 'curve' and @coords > 4) { + if ($type eq 'curve' and @coords > 2) { $fm->Button(-text => $coords, -command => [\&showcoords, $zinc, $item]) ->grid(-row => $i, -col => 7, -sticky => 'nswe', -ipadx => 5); @@ -1296,25 +1323,25 @@ sub showattributes { } # device coords @coords = $zinc->transform(scalar $zinc->group($item), 1, [@coords]); - if (@coords == 2) { + if (!ref $coords[0]) { my $x0 = int($coords[0]); my $y0 = int($coords[1]); $coords = "($x0, $y0)"; - } elsif (@coords == 4) { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - my $x1 = int($coords[2]); - my $y1 = int($coords[3]); - $coords = "($x0, $y0, $x1, $y1)"; } else { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - my $xn = int($coords[$#coords-1]); - my $yn = int($coords[$#coords]); - my $n = @coords/2 - 1; - $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; + my @points0 = @{$coords[0]}; + my $n = $#coords; + my @pointsN = @{$coords[$n]}; + my $x0 = int($points0[0]); + my $y0 = int($points0[1]); + my $xn = int($pointsN[0]); + my $yn = int($pointsN[1]); + if ($n == 1) { ## a couple of points + $coords = "($x0, $y0, $xn, $yn)"; + } else { + $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; + } } - if ($type eq 'curve' and @coords > 4) { + if ($type eq 'curve' and @coords > 2) { $fm->Button(-text => $coords, -command => [\&showdevicecoords, $zinc, $item]) ->grid(-row => $i, -col => 8, -sticky => 'nswe', -ipadx => 5); @@ -1335,7 +1362,7 @@ sub showattributes { -relief => 'ridge') ->grid(-row => $i, -col => 10, -sticky => 'nswe', -ipadx => 5); $fm->Button(-text => 'Other options', - -command => [\&showotheroptions, $zinc, $item]) + -command => [\&showotheroptions, $zinc, $item, $fm]) ->grid(-row => $i, -col => 11, -sticky => 'nswe', -ipadx => 5); $i++; &showbanner($fm, $i++) if ($i % 15 == 0); @@ -1367,7 +1394,7 @@ sub printWindow { $saving = 0; if ($res) { - &showErrorWhilePrinting($res) + &showErrorWhilePrinting($zinc, $res) } else { my $dir = `pwd`; chomp ($dir); @@ -1380,7 +1407,7 @@ sub printWindow { # display complete help screen sub showErrorWhilePrinting { - my ($res) = @_; + my ($zinc, $res) = @_; my $dir = `pwd`; chomp ($dir); $help_print->destroy if $help_print and Tk::Exists($help_print); $help_print = $zinc->Dialog(-title => 'Zinc Print info', @@ -1404,29 +1431,100 @@ sub showErrorWhilePrinting { #--------------------------------------------------------------------------- # display complete help screen sub showgeneralhelp { - return if Tk::Exists($help_tl); - $help_tl = $zinc->Toplevel; - $help_tl->title("Zinc Debug info"); + if (@instances == 1) { + &showinstancehelp($instances[0], "ZincDebug help", 1); + } elsif (@instances > 1) { + $help_tl{gene}->destroy if $help_tl{gene} and Tk::Exists($help_tl{gene}); + $help_tl{gene} = $instances[0]->Toplevel; + $help_tl{gene}->title("ZincDebug general help"); + + my $text = $help_tl{gene}->Scrolled('Text', -font => + scalar $instances[0]->cget(-font), + -wrap => 'word', + -foreground => 'gray10', + -width => 50, + -height => 15, + -scrollbars => 'osoe', + ); + $text->tagConfigure('keyword', -foreground => 'darkblue'); + $text->tagConfigure('title', -foreground => 'ivory', + -background => 'gray60', + -spacing1 => 3, + -spacing3 => 3); + + my $fm = $text->Frame; + for (my $i=0; $i < @instances; $i++) { + my $j = $i + 1; + $fm->Label(-text => 'Instance #'.$j)->grid(-row => $j, -column => 1); + $fm->Button(-text => 'Show', + -cursor => 'top_left_arrow', + -command => [\&showinstance, $instances[$i]], + )->grid(-row => $j, -column => 2); + + $fm->Button(-text => 'Take focus', + -cursor => 'top_left_arrow', + -command => [\&takefocus, $instances[$i]], + )->grid(-row => $j, -column => 3); + + $fm->Button(-text => 'Help', + -cursor => 'top_left_arrow', + -command => [\&showinstancehelp, $instances[$i], + 'ZincDebug help about instance #'.$j], + )->grid(-row => $j, -column => 4); + #&showinstancehelp($_); + } + $text->insert('end', "Several instances of Zinc widget are managed. "); + $text->insert('end', "They are listed in the following table. \n\n\n"); + $text->window('create', 'end', -window => $fm); + $text->insert('end', "\n\n\nStrike <"); + $text->insert('end', 'Escape', 'keyword'); + $text->insert('end', "> key to display this help message again."); + + $help_tl{gene}->Button(-command => sub {$help_tl{gene}->destroy}, + -text => 'Close')->pack(-side => 'bottom', + -pady => 10); + $text->pack(-side => 'top', -pady => 10, -padx => 10); + } +} # end showgeneralhelp - my $text = $help_tl->Scrolled('Text', -font => scalar $zinc->cget(-font), - -wrap => 'word', - -foreground => 'gray10', - -width => 50, - -height => 32, - -scrollbars => 'osoe', - ); +sub showinstancehelp { + my $zinc = shift; + my $title = shift; + my $singleflag = shift; + $zinc->Tk::focus; + $help_tl{$zinc}->destroy if $help_tl{$zinc} and Tk::Exists($help_tl{$zinc}); + if ($singleflag) { + $help_tl{$zinc} = $zinc->Toplevel; + } else { + $help_tl{$zinc} = $help_tl{gene}->Toplevel; + $help_tl{$zinc}->transient($help_tl{gene}) unless $singleflag; + } + $help_tl{$zinc}->title($title); + + my $text = $help_tl{$zinc}->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) { + -background => 'gray60', + -spacing1 => 3, + -spacing3 => 3); + my $zincnb = scalar keys(%instances); + if ($treeKey{$zinc}) { $text->insert('end', " To display the items tree\n", 'title'); $text->insert('end', "\nUse the <"); - $text->insert('end', $treeKey, 'keyword'); + $text->insert('end', $treeKey{$zinc}, 'keyword'); $text->insert('end', "> sequence.\n\n"); } - if ($enclosedModBtn) { - my $eseq = $enclosedModBtn->[0]."-Button".$enclosedModBtn->[1]; - my $oseq = $overlapModBtn->[0]."-Button".$overlapModBtn->[1]; + if ($enclosedModBtn{$zinc}) { + my $eseq = $enclosedModBtn{$zinc}->[0]."-Button".$enclosedModBtn{$zinc}->[1]; + my $oseq = $overlapModBtn{$zinc}->[0]."-Button".$overlapModBtn{$zinc}->[1]; + $eseq =~ s/^-//; + $oseq =~ s/^-//; $text->insert('end', " To analyse a particular area\n", 'title'); $text->insert('end', "\nWith <"); $text->insert('end', $oseq, 'keyword'); @@ -1437,16 +1535,17 @@ sub showgeneralhelp { $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) { + if ($treeKey{$zinc} or $enclosedModBtn{$zinc}) { $text->insert('end', "To analyse a specific item.\n", 'title'); - if ($enclosedModBtn) { + if ($enclosedModBtn{$zinc}) { $text->insert('end', "\nWith <"); - $text->insert('end', $searchKey, 'keyword'); + $text->insert('end', $searchKey{$zinc}, 'keyword'); $text->insert('end', "> sequence, locate a specific item entering ". "its tagOrId.\n"); } - if ($treeKey) { - my $tseq = $treeModBtn->[0]."-Button".$treeModBtn->[1]; + if ($treeKey{$zinc}) { + my $tseq = $treeModBtn{$zinc}->[0]."-Button".$treeModBtn{$zinc}->[1]; + $tseq =~ s/^-//; $text->insert('end', "\nWith <"); $text->insert('end', $tseq, 'keyword'); $text->insert('end', "> sequence, select a particular item in the ". @@ -1455,30 +1554,40 @@ sub showgeneralhelp { $text->insert('end', "\n"); } - if ($snapKey) { + if ($snapKey{$zinc}) { $text->insert('end', "To snapshot the application window.\n", 'title'); $text->insert('end', "\nWith <"); - $text->insert('end', $snapKey, 'keyword'); + $text->insert('end', $snapKey{$zinc}, '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"); + "The ImageMagic package must be installed.\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); + my $fm = $help_tl{$zinc}->Frame->pack(-side => 'bottom', + -pady => 5, + -expand => 1, + -fill => 'none'); + $fm->Button(-text => 'Show', + -cursor => 'top_left_arrow', + -command => [\&showinstance, $zinc], + )->pack(-side => 'left', -padx => 10) unless $singleflag; + + $fm->Button(-text => 'Take focus', + -cursor => 'top_left_arrow', + -command => [\&takefocus, $zinc], + )->pack(-side => 'left', -padx => 10); + + $fm->Button(-command => sub {$help_tl{$zinc}->destroy}, + -text => 'Close')->pack(-side => 'left', -padx => 10); + $text->pack(-side => 'top', -pady => 10, -padx => 10); -} # end showgeneralhelp +} # end showsinstancehelp # display help about tree sub showHelpAboutTree { + my $zinc = shift; $helptree_tl->destroy if $helptree_tl and Tk::Exists($helptree_tl); $helptree_tl = $tree_tl->Toplevel; $helptree_tl->title("Help about Tree"); @@ -1523,9 +1632,9 @@ sub showHelpAboutTree { sub showHelpAboutAttributes { - my $widget = shift; + my $zinc = shift; $helptree_tl->destroy if $helptree_tl and Tk::Exists($helptree_tl); - $helptree_tl = $widget->Toplevel; + $helptree_tl = $zinc->Toplevel; $helptree_tl->title("Help about attributes"); my $text = $helptree_tl->Text(-font => scalar $zinc->cget(-font), @@ -1534,7 +1643,9 @@ sub showHelpAboutAttributes { ); $text->tagConfigure('keyword', -foreground => 'darkblue'); $text->tagConfigure('title', -foreground => 'ivory', - -background => 'gray60'); + -background => 'gray60', + -spacing1 => 3, + -spacing3 => 3); $text->insert('end', " To highlight a specific item\n", 'title'); @@ -1636,6 +1747,34 @@ sub entryoption { } # end entryoption +sub showinstance { + my $zinc = shift; + my $a = $zinc->itemcget(1, -alpha); + my $b = ($a > 40) ? 10 : 100; + $zinc->itemconfigure(1, -alpha => $b); + $zinc->update; + $zinc->after(100); + $zinc->itemconfigure(1, -alpha => $a); + $zinc->update; + +} # end showinstance + + +sub takefocus { + my $zinc = shift; + $zinc->Tk::focus; + +} # end takefocus + + +sub newinstance { + my $zinc = shift; + return if $instances{$zinc}; + $instances{$zinc} = 1; + push(@instances, $zinc); + +} # end newinstance + 1; __END__ @@ -1665,15 +1804,13 @@ ZincDebug provides an interface to help developers to debug or analyse Zinc appl 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 items 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. - -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. +Press B<Escape> key in the toplevel of the application to have some help about available input sequences. -B<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. +B<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 for each instance of Zinc widget. =head1 FUNCTIONS @@ -1693,11 +1830,11 @@ Defines color of search area contour. Default to 'sienna'. =item E<32>E<32>E<32>B<-enclosedModBtn> => [Mod, Btn] -Defines input sequence used to process "enclosed" search. Default to ['Control', 3]. +Defines input sequence used to process "enclosed" search. Default to ['Control', 3]. B<Mod> can be set to undef. =item E<32>E<32>E<32>B<-overlapModBtn> => [Mod, Btn] -Defines input sequence used to process "overlap" search. Default to ['Shift', 3]. +Defines input sequence used to process "overlap" search. Default to ['Shift', 3]. B<Mod> can be set to undef. =item E<32>E<32>E<32>B<-searchKey> => key @@ -1717,7 +1854,7 @@ Defines input sequence used to build and display items tree. Default to 'Control =item E<32>E<32>E<32>B<-itemModBtn> => [Mod, Btn] -Defines input sequence used to select an item in the application window in order to display its position in the item's tree. Default to ['Control', 2]. +Defines input sequence used to select an item in the application window in order to display its position in the item's tree. Default to ['Control', 2]. B<Mod> can be set to undef. =item E<32>E<32>E<32>B<-optionsToDisplay> => opt1[,..,optN] @@ -1754,12 +1891,24 @@ Defines the basename used for the file containing the snaphshot. The filename wi =back -=head1 LIMITATIONS -ZincDebug is currently able to manage only one zinc instance. - -=head1 AUTEURS +=head1 AUTEUR Daniel Etienne <etienne@cena.fr> -Christophe Mertz <mertz@cena.fr> + +=head1 HISTORY + +Feb 6 2003 : ZincDebug can manage several instances of Zinc widget. + +Jan 20 2003 : item's attributes can be edited. + +Jan 14 2003 : ZincDebug can be loaded at runtime using the -M perl option without any change in the application's code. + +Nov 6 2002 : some additional informations (like tags or other attributes values) can be displayed in the items tree. Add feedback when selected item is not visible because outside window. + +Sep 2 2002 : add the tree() function + +May 27 2002 : add the snapshot() function contributed by Ch. Mertz. + +Jan 28 2002 : Zincdebug provides the finditems() function and can manage only one instance of Zinc widget. |