* Modification concernant la fonction tree() :

  Possibilit� d'afficher, pour chaque item de l'arbre, la valeur d'un ou
  de plusieurs de ses attributs; utiliser les options -optionsToDisplay et
  -optionsFormat.
  M�canisme de recherche de chaine de caract�res.
  Feedback pour signaler qu'un item s�lectionn� dans l'arbre n'est pas
  visible car en dehors de la fen�tre.

1 files changed, 290 insertions, 39 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 32309d4..6f7f75b 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -9,8 +9,9 @@
 package ZincDebug;
 
 use strict 'vars';
-use vars qw(@ISA @EXPORT);
+use vars qw(@ISA @EXPORT $WARNING);
 use Carp;
+use English;
 require Exporter;
 use File::Basename;
 use Tk;
@@ -19,17 +20,20 @@ use Tk::LabFrame;
 use Tk::Pane;
 use Tk::Dialog;
 use Tk::Tree;
+use Tk::ItemStyle;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(finditems snapshot tree);
 
-my ($help_tl0, $help_tl, $result_tl, $result_fm, $search_tl, $showitemflag);
+my ($help_tl0, $help_tl, $result_tl, $result_fm, $search_tl,
+    $searchtree_tl, $showitemflag);
 my $coords_tl;
 my $devicecoords_tl;
 my ($text_id, $rectangle_id);
 my ($x0, $y0);
 my ($help_print, $imagecounter, $saving) = (0,0);
 my $searchEntryValue;
+my $searchTreeEntryValue;
 my $tree_tl;
 my $zinc;
 my $enclosedModBtn;
@@ -42,21 +46,33 @@ my $tree;
 my @keys;
 my @seq;
 my $helptree_tl;
+my $wwidth;
+my $wheight;
 
 sub tree {
 
     &setwidget(shift);
     return unless $zinc;
+    # styles definition
+    $zinc->ItemStyle('text', -stylename => "item", -foreground => 'black');
+    $zinc->ItemStyle('text', -stylename => "group", -foreground => 'black');
     # 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');
+	    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);
+    $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 help screen
     #
@@ -64,12 +80,16 @@ sub tree {
     #
     # binding for building tree
     #
-    $zinc->toplevel->Tk::bind('<'.$treeKey.'>', \&showtree);
+    $zinc->toplevel->Tk::bind('<'.$treeKey.'>',
+			      [\&showtree, $options{-optionsToDisplay},
+			       $options{-optionsFormat}]);
     #
     # binding for displaying item in tree
     #
     my $tkb = $treeModBtn;
-    $zinc->Tk::bind('<'.$tkb->[0]."-".$tkb->[1].'>', \&findintree);
+    $zinc->Tk::bind('<'.$tkb->[0]."-".$tkb->[1].'>',
+		    [\&findintree, $options{-optionsToDisplay},
+			       $options{-optionsFormat}]);
     
 } # end tree
 
@@ -159,8 +179,10 @@ sub snapshot {
 #
 #---------------------------------------------------------------------------
 sub findintree {
+    my $optionstodisplay = $_[1];
+    my $optionsFormat = $_[2];
     if (not Tk::Exists($tree_tl)) {
-	&showtree;
+	&showtree(undef, $optionstodisplay, $optionsFormat);
     }
     my $ev = $zinc->XEvent;
     ($x0, $y0) = ($ev->x, $ev->y);
@@ -182,8 +204,14 @@ sub findintree {
 
 
 sub showtree {
+    my $optionstodisplay = $_[1];
+    my $optionsFormat = $_[2];
+    $WARNING = 0;
+    my @optionstodisplay = split(/,/, $optionstodisplay);
+    $WARNING = 1;
     $tree_tl->destroy if $tree_tl and Tk::Exists($search_tl);
     $tree_tl = $zinc->Toplevel;
+    $tree_tl->minsize(280, 200);
     $tree_tl->title("Zinc Items Tree");
     $tree = $tree_tl->Scrolled('Tree',
 			       -scrollbars => 'se',
@@ -229,21 +257,25 @@ sub showtree {
     }, Ev('y')]);
     
     $tree->add("1", -text => "Group(1)", -state => 'disabled');
-    &scangroup($tree, 1, "1",);
+    &scangroup($tree, 1, "1", $optionsFormat, @optionstodisplay);
     $tree->autosetmode;
     # control buttons frame
     my $tree_butt_fm = $tree_tl->Frame(-height => 40)->pack(-side => 'bottom',
-							    -expand => 1,
-							    -fill => 'both');
+							    -fill => 'y');
     $tree_butt_fm->Button(-text => 'Help',
 			  -command => \&showHelpAboutTree,
 			  )->pack(-side => 'left', -pady => 10,
 				  -padx => 30, -fill => 'both');
     
+    $tree_butt_fm->Button(-text => 'Search',
+			  -command => \&searchInTree,
+			  )->pack(-side => 'left', -pady => 10,
+				  -padx => 30, -fill => 'both');
+
     $tree_butt_fm->Button(-text => 'Close',
 			  -command => sub {$zinc->remove("zincdebug");
 					   $tree_tl->destroy},
-			  )->pack(-side => 'right', -pady => 10,
+			  )->pack(-side => 'left', -pady => 10,
 				  -padx => 30, -fill => 'both');
     # pack tree
     $tree->pack(-padx => 10, -pady => 10,
@@ -256,17 +288,129 @@ sub showtree {
 
 } # end showtree
 
+sub searchInTree {
+    $searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl);
+    $searchtree_tl = $zinc->Toplevel;
+    $searchtree_tl->title("Find in tree");
+    my $fm = $searchtree_tl->Frame->pack(-side => 'top');
+    $fm->Label(-text => "Find : ",
+	       )->pack(-side => 'left', -padx => 10, -pady => 10);
+    my $entry = $fm->Entry(-width => 20)->pack(-side => 'left',
+					       -padx => 10, -pady => 10);
+    my $status = $searchtree_tl->Label(-foreground => 'sienna',
+				   )->pack(-side => 'top');
+    my $ep = 1;
+    my $searchfunc =  sub {
+	my $side = shift;
+	my $found = 0;
+        #print "ep=$ep side=$side\n";
+	$status->configure(-text => "");
+	$status->update;
+	$searchTreeEntryValue = $entry->get();
+	$searchTreeEntryValue = quotemeta($searchTreeEntryValue);
+	my $text;
+	while ($ep) {
+ 	    $ep = $tree->info($side, $ep);
+	    unless ($ep) {
+		$ep = 1;
+		$found = 1;
+		last;
+	    }
+	    $text = $tree->entrycget($ep, -text);
+	    if ($text =~ /$searchTreeEntryValue/) {
+		$tree->see($ep);
+		$tree->selectionClear;
+		$tree->anchorSet($ep);
+		$tree->selectionSet($ep);
+		$found = 1;
+		last;
+	    }
+	}
+	$status->configure(-text => "Search string not found") unless $found;
+    };
+
+    my $fm2 = $searchtree_tl->Frame->pack(-side => 'top');
+    $fm2->Button(-text => 'Prev',
+		 -command => sub {&$searchfunc('prev');},
+		 )->pack(-side => 'left', -pady => 10);
+    $fm2->Button(-text => 'Next',
+		 -command => sub {&$searchfunc('next');},
+		 )->pack(-side => 'left', -pady => 10);
+    $fm2->Button(-text => 'Close',
+		 -command => sub {$searchtree_tl->destroy},
+		 )->pack(-side => 'right', -pady => 10);
+    $entry->focus;
+    $entry->delete(0, 'end');
+    $entry->insert(0, $searchTreeEntryValue) if $searchTreeEntryValue;
+    $entry->bind('<Key-Return>', sub {&$searchfunc('next');});
+    
+} # end searchInTree
+
+sub extractinfo {
+    my $item = shift;
+    my $format = shift;
+    my $option = shift;
+    my $titleflag = shift;
+    $option =~ s/^\s+//;
+    $option =~ s/\s+$//;
+    #print "option=[$option]\n";
+    my @info;
+    $WARNING = 0;
+    eval {@info = $zinc->itemcget($item, $option)};
+    #print "eval $option = (@info) $@\n";
+    return if $@;
+    return if @info == 0;
+    my $info;
+    my $sep = ($format eq 'column') ? "\n  " : ", ";
+    if ($titleflag) {
+	$info = $sep."[$option] ".$info[0];
+    } else {
+	$info = $sep.$info[0];
+    }
+    if (@info > 1) {
+	shift(@info);
+	for (@info) {
+	    if ($format eq 'column') {
+		if (length($info." ".$_) > 40) {
+		    if ($titleflag) {
+			$info .= $sep."[$option] ".$_;
+		    } else {
+			$info .= $sep.$_;
+		    }
+		} else {
+		    $info .= ", $_";
+		}
+	    } else {
+		$info .= $sep.$_;
+	    }
+	}
+    }
+    $WARNING = 1;
+    return $info;
+}
 
 sub scangroup {
-    my ($tree, $group, $path) = @_;
+    my ($tree, $group, $path, $format, @optionstodisplay) = @_;
     my @items = $zinc->find('withtag', "$group.");
-    
     for my $item (@items) {
 	my $type = ucfirst($zinc->type($item));
-	my $priority = $zinc->itemcget($item, -priority);
-	$tree->add($path.".".$item, -text => "$type($item)");
+	my $info = " ";
+	if (@optionstodisplay == 1) {
+	    $info .= &extractinfo($item, $format, $optionstodisplay[0]);
+	} elsif (@optionstodisplay > 1) {
+	    for my $opt (@optionstodisplay) {
+		$info .= &extractinfo($item, $format, $opt, 1);
+	    }
+	}
 	if ($type eq "Group") {
-	    &scangroup($tree, $item, $path.".".$item);
+	    $tree->add($path.".".$item,
+		       -text => "$type($item)$info",
+		       -style => 'group');
+	    &scangroup($tree, $item, $path.".".$item, $format, @optionstodisplay);
+	} else {
+	    $tree->add($path.".".$item,
+		       -text => "$type($item)$info",
+		       -style => 'item');
 	}
     }
 
@@ -421,6 +565,9 @@ sub setwidget {
     } else {
 	$zinc = $widget;
     }
+    $zinc->update;
+    my $geom = $zinc->geometry =~ /(\d+)x(\d+)+/=~ /(\d+)x(\d+)+/;
+    ($wwidth, $wheight) = ($1, $2);
 	    
 } # end setwidget
 
@@ -487,10 +634,13 @@ sub showresult {
     # scrolled pane creation
     my $heightmax = 500;
     my $height = 100 + 50*@items;
+    my $width = $result_tl->screenwidth;
+    $width = 1200 if $width > 1200;
     $height = $heightmax if $height > $heightmax;
     $result_fm = $result_tl->Scrolled('Pane',
-				      -scrollbars => 'se',
-				      -width => scalar $result_tl->screenwidth,
+				      -scrollbars => 'soeo',
+				      -gridded => 'xy',
+				      -width => $width,
 				      -height => $height,
 				      );
     $result_fm->pack(-padx => 10, -pady => 10,
@@ -501,6 +651,7 @@ sub showresult {
     # attributes display
     &showattributes($result_fm, \@items);
 
+
 } # end showresult
 
 
@@ -785,6 +936,91 @@ sub highlightitem {
 
 } # end highlightitem
 
+sub itemisoutside {
+    my @bbox = @_;
+    my $outflag;
+    if ($bbox[2] < 0) {
+	if ($bbox[1] >  $wheight) {
+	    $outflag = 'left+bottom';
+	} elsif ($bbox[3] < 0) {
+	    $outflag = 'left+top';
+	} else {
+	    $outflag = 'left';
+	} 
+    } elsif ($bbox[0] > $wwidth) {
+	if ($bbox[1] >  $wheight) {
+	    $outflag = 'right+bottom';
+	} elsif ($bbox[3] < 0) {
+	    $outflag = 'right+top';
+	} else {
+	    $outflag = 'right';
+	}
+    } elsif ($bbox[3] < 0) {
+	$outflag = 'top';
+    } elsif ($bbox[1] > $wheight) {
+	$outflag = 'bottom';
+    }
+    #print "outflag=$outflag bbox=@bbox\n";
+    return 0 unless $outflag;
+    my $g = $zinc->add('group', 1);
+    my $hw = 110;
+    my $hh = 80;
+    my $r = 5;
+    $zinc->add('rectangle', $g, [-$hw, -$hh, $hw, $hh],
+	       -filled => 1,
+	       -linecolor => 'sienna',
+	       -linewidth => 3,
+	       -tags => ['zincdebug'],
+	       -fillcolor => 'bisque',
+	       -priority => 1,
+	       );
+    $zinc->add('text', $g,
+	       -position => [0, 0],
+	       -color => 'sienna',
+	       -font => '-b&h-lucida-bold-i-normal-sans-34-240-*-*-p-*-iso8859-1',
+	       -anchor => 'center',
+	       -tags => ['zincdebug'],
+	       -priority => 2,
+	       -text => "Item is\noutside\nwindow\n");
+    my ($x, $y);
+    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;
+    } 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;
+	$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;
+    } elsif ($outflag eq 'right') {
+	$x = $wwidth - $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;
+    } elsif ($outflag eq 'left+top') {
+	$x = $hw + 10;
+	$y = $hh + 10;
+    } elsif ($outflag eq 'left+bottom') {
+	$x = $hw + 10;
+	$y = $wheight - $hh - 10;
+    } elsif ($outflag eq 'right+top') {
+	$x = $wwidth - $hw - 10;
+	$y = $hh + 10;
+    } elsif ($outflag eq 'right+bottom') {
+	$x = $wwidth - $hw - 10;
+	$y = $wheight - $hh - 10;
+    }
+    $zinc->coords($g, [$x, $y]);
+    $zinc->raise('zincdebug');
+    
+} # end itemisoutside
+
 
 # draw a rectangle arround the selected item
 sub surrounditem {
@@ -811,32 +1047,36 @@ sub surrounditem {
     # move in topgroup  
     $zinc->chggroup($clone, $topgroup);
     # create a rectangle around 
-    my @bbox  = $zinc->bbox($clone);
-    if (scalar @bbox == 4) {
-	@bbox = $zinc->transform(1, $topgroup, [@bbox]);
-	if ($level > 0) {
-	    my $r = $zinc->add('Rectangle', $topgroup,
-			       [$bbox[0] - 10, $bbox[1] - 10,
-				$bbox[2] + 10, $bbox[3] + 10],
-			       -filled => 1,
-			       -tags => ['zincdebug'],
-			       -fillcolor => "gray20");
-	    $zinc->itemconfigure($r, -fillcolor => "gray80") if $level == 1;
-	} 
-	my $i = 0;
-	for ('white', 'red', 'white') {
-	    $zinc->add('rectangle', $topgroup,
-			       [$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i,
-				$bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i],
-			       -linecolor => $_,
-			       -linewidth => 1,
-			       -tags => ['zincdebug']);
-	    $i++;
+    my @bbox0  = $zinc->bbox($clone);
+    if (scalar @bbox0 == 4) {
+	my @bbox = $zinc->transform(1, $topgroup, [@bbox0]);
+	# If item is visible, rectangle is drawm surround it.
+	# Else, a warning is displayed.
+	unless (&itemisoutside(@bbox0)) {
+	    if ($level > 0) {
+		my $r = $zinc->add('Rectangle', $topgroup,
+				   [$bbox[0] - 10, $bbox[1] - 10,
+				    $bbox[2] + 10, $bbox[3] + 10],
+				   -filled => 1,
+				   -tags => ['zincdebug'],
+				   -fillcolor => "gray20");
+		$zinc->itemconfigure($r, -fillcolor => "gray80") if $level == 1;
+	    } 
+	    my $i = 0;
+	    for ('white', 'red', 'white') {
+		$zinc->add('rectangle', $topgroup,
+			   [$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i,
+			    $bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i],
+			   -linecolor => $_,
+			   -linewidth => 1,
+			   -tags => ['zincdebug']);
+		$i++;
+	    }
 	}
     }
     # raise
     $zinc->raise('zincdebug');
-     $zinc->raise($clone);
+    $zinc->raise($clone);
    
 } # end surrounditem
 
@@ -996,6 +1236,8 @@ sub showattributes {
 	$i++;
 	&showbanner($fm, $i++) if ($i % 15 == 0);
     }
+    $fm->update;
+    return ($fm->width, $fm->height);
     
 } # end showattributes
 
@@ -1264,6 +1506,15 @@ Defines input sequence used to build and display items tree. Default to 'Control
 
 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].
 
+=item E<32>E<32>E<32>B<-optionsToDisplay> => opt1[,..,optN]
+
+Used to display some option's values associated to items of tree. Expected argument is a string of commas separated options.
+
+
+=item E<32>E<32>E<32>B<-optionsFormat> => row | column
+
+Defines the display format of option's values. Default is 'column'.
+
 =back