Bug fix : pbm with bindings naming

1 files changed, 55 insertions, 67 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 82f6358..c2433bc 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -166,14 +166,14 @@ sub init {
     $on_command{findenclosed} = sub {
 	&savebindings($selectedzinc);
 	$button{findenclosed}->{Value} = 1;
-	$selectedzinc->Tk::bind("<1>",[\&startrectangle, 'simple', 'Enclosed',
+	$selectedzinc->Tk::bind("<ButtonPress-1>",
+				[\&startrectangle, 'simple', 'Enclosed',
 				       'sienna']);
 	$selectedzinc->Tk::bind("<B1-Motion>", \&resizerectangle);
-	$selectedzinc->Tk::bind("<B1-ButtonRelease>",
+	$selectedzinc->Tk::bind("<ButtonRelease-1>",
 				[\&stoprectangle, 'enclosed', 'Enclosed search']);
     };
     $off_command{findenclosed} = sub {
-	&savebindings($selectedzinc);
 	$button{findenclosed}->{Value} = 0;
 	&restorebindings($selectedzinc);
 	$selectedzinc->remove("zincdebugrectangle", "zincdebuglabel");
@@ -182,10 +182,10 @@ sub init {
     $on_command{findoverlap} = sub {
 	&savebindings($selectedzinc);
 	$button{findoverlap}->{Value} = 1;
-	$selectedzinc->Tk::bind("<1>", [\&startrectangle, 'mixed', 'Overlap',
+	$selectedzinc->Tk::bind("<ButtonPress-1>", [\&startrectangle, 'mixed', 'Overlap',
 					'sienna']);
 	$selectedzinc->Tk::bind("<B1-Motion>", \&resizerectangle);
-	$selectedzinc->Tk::bind("<B1-ButtonRelease>",
+	$selectedzinc->Tk::bind("<ButtonRelease-1>",
 				[\&stoprectangle, 'overlapping', 'Overlap search']);
     };
     $off_command{findoverlap} = sub {
@@ -197,7 +197,7 @@ sub init {
     $on_command{item} = sub {
 	&savebindings($selectedzinc);
 	$button{item}->{Value} = 1;
-	$selectedzinc->Tk::bind("<1>", [\&findintree]);
+	$selectedzinc->Tk::bind("<ButtonPress-1>", [\&findintree]);
     };
     $off_command{item} = sub {
 	$button{item}->{Value} = 0;
@@ -208,7 +208,7 @@ sub init {
 	&savebindings($selectedzinc);
 	$button{move}->{Value} = 1;
 	my ($x0, $y0);
-	$selectedzinc->Tk::bind('<1>', sub {
+	$selectedzinc->Tk::bind('<ButtonPress-1>', sub {
 	    my $ev = $selectedzinc->XEvent;
 	    ($x0, $y0) = ($ev->x, $ev->y);
 	});
@@ -230,7 +230,7 @@ sub init {
 	    $zinc->remove("zincdebugrectangle", "zincdebuglabel");
 	    &savebindings($zinc);
 	    my $r;
-	    $zinc->Tk::bind("<1>", sub {
+	    $zinc->Tk::bind("<ButtonPress-1>", sub {
 		$zinc->update;
 		my ($w, $h) = ($zinc->cget(-width), $zinc->cget(-height));
 		$zinc->tsave(1, 'transfoTopgroup', 1);
@@ -241,7 +241,7 @@ sub init {
 		$zinc->raise($r);
 		$selectedzinc = $zinc;
 	    });
-	    $zinc->Tk::bind("<B1-ButtonRelease>", sub {
+	    $zinc->Tk::bind("<ButtonRelease-1>", sub {
 		$zinc->remove($r);
 	    });
 	}
@@ -348,62 +348,6 @@ sub snapshot {
 } # end snapshot
 
 
-
-
-
-
-
-
-
-
-
-
-
-
-
-sub savebindings {
-
-    my ($zinc) = @_;
-    for my $seq ('1', 'B1-Motion', 'B1-ButtonRelease') {
-	$userbindings{$zinc}->{$seq} = $zinc->Tk::bind('<'.$seq.'>')
-	    unless defined $userbindings{$zinc}->{$seq};
-	$zinc->Tk::bind('<'.$seq.'>', "");
-    }
-    
-} # end savebindings
-
-
-sub restorebindings {
-
-    my ($zinc) = @_;
-    for my $seq ('1', 'B1-Motion', 'B1-ButtonRelease') {
-	next unless defined $userbindings{$zinc}->{$seq};
-	$zinc->Tk::bind('<'.$seq.'>', $userbindings{$zinc}->{$seq});
-	delete $userbindings{$zinc}->{$seq};
-    }
-    
-} # end restorebindings
-
-
-sub newinstance {
-    
-    my $zinc = shift;
-    return if $instances{$zinc};
-    $zinc->toplevel->Tk::bind('<Key-Escape>', sub {
-	$button{zn}->destroy() if @instances == 1 and Tk::Exists($button{zn});
-	$control_tl->deiconify();
-	$control_tl->raise();
-    });
-    $instances{$zinc} = 1;    
-    push(@instances, $zinc);
-    $zinc->Tk::focus;
-    $selectedzinc = $zinc;
-    
-} # end newinstance
-
-
-
-
 #---------------------------------------------------------------------------
 #
 # Functions related to items tree
@@ -540,7 +484,7 @@ sub findintree {
     # tree is rebuilded unless path exists
     unless ($tree->info('exists', $path)) {
 	$tree_tl->destroy;
-	print "path=$path rebuild tree\n";
+	#print "path=$path rebuild tree\n";
 	&showtree($zinc);
     }
     $tree->see($path);
@@ -1701,7 +1645,6 @@ sub hidecontour {
 
 # display contours points (one rectangle per point)
 sub showcontourpts {
-    print "showcontourpts\n";
     my ($widget, $zinc, $color, $item, $contourcoords, $deviceflag) = @_;
     my $i = 0;
     for my $coords (@$contourcoords) {
@@ -2680,6 +2623,51 @@ sub instances {
 } # end instances
 
 
+sub savebindings {
+
+    my ($zinc) = @_;
+    for my $seq ('ButtonPress-1', 'B1-Motion', 'ButtonRelease-1') {
+	$userbindings{$zinc}->{$seq} = $zinc->Tk::bind('<'.$seq.'>')
+	    unless defined $userbindings{$zinc}->{$seq};
+	$userbindings{$zinc}->{$seq} = "" unless defined $userbindings{$zinc}->{$seq};
+	#print "savebindings seq=$seq cb=$userbindings{$zinc}->{$seq}\n";
+	$zinc->Tk::bind('<'.$seq.'>', "");
+    }
+    
+} # end savebindings
+
+
+sub restorebindings {
+
+    my ($zinc) = @_;
+    for my $seq ('ButtonPress-1', 'B1-Motion', 'ButtonRelease-1') {
+	next unless defined $userbindings{$zinc}->{$seq};
+	$zinc->Tk::bind('<'.$seq.'>', $userbindings{$zinc}->{$seq});
+	#print "restorebindings seq=$seq cb=$userbindings{$zinc}->{$seq}\n";
+	delete $userbindings{$zinc}->{$seq};
+    }
+    
+} # end restorebindings
+
+
+sub newinstance {
+    
+    my $zinc = shift;
+    return if $instances{$zinc};
+    $zinc->toplevel->Tk::bind('<Key-Escape>', sub {
+	$button{zn}->destroy() if @instances == 1 and Tk::Exists($button{zn});
+	$control_tl->deiconify();
+	$control_tl->raise();
+    });
+    $instances{$zinc} = 1;    
+    push(@instances, $zinc);
+    $zinc->Tk::focus;
+    $selectedzinc = $zinc;
+    
+} # end newinstance
+
+
+
 1;
 
 __END__