r54260 - in /branches/upstream/libconfig-model-tkui-perl/current: ChangeLog META.yml lib/Config/Model/TkUI.pm

[jawnsy-guest at users.alioth.debian.org]

Author: jawnsy-guest
Date: Sat Mar 13 22:47:54 2010
New Revision: 54260

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=54260
Log:
[svn-upgrade] Integrating new upstream version, libconfig-model-tkui-perl (1.304)

Modified:
    branches/upstream/libconfig-model-tkui-perl/current/ChangeLog
    branches/upstream/libconfig-model-tkui-perl/current/META.yml
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/TkUI.pm

Modified: branches/upstream/libconfig-model-tkui-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/ChangeLog?rev=54260&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/ChangeLog (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/ChangeLog Sat Mar 13 22:47:54 2010
@@ -1,3 +1,8 @@
+2010-03-12  Dominique Dumont  <dominique.dumont at hp.com> 1.304
+
+	* lib/Config/Model/TkUI.pm (disp_hash): Fix bug that messed tk
+	tree content after deletion of list elements
+
 2010-02-26  Dominique Dumont  <dominique.dumont at hp.com> 1.303
 
 	* Build.PL: Depends on Config::Model 0.643

Modified: branches/upstream/libconfig-model-tkui-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/META.yml?rev=54260&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/META.yml (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/META.yml Sat Mar 13 22:47:54 2010
@@ -48,7 +48,7 @@
     file: lib/Config/Model/Tk/Wizard.pm
   Config::Model::TkUI:
     file: lib/Config/Model/TkUI.pm
-    version: 1.303
+    version: 1.304
 recommends:
   Tk::ObjScanner: 0
 requires:
@@ -60,4 +60,4 @@
   Tk::Tree: 0
 resources:
   license: http://opensource.org/licenses/lgpl-license.php
-version: 1.303
+version: 1.304

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/TkUI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/TkUI.pm?rev=54260&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/TkUI.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/TkUI.pm Sat Mar 13 22:47:54 2010
@@ -38,7 +38,7 @@
 use Config::Model::Tk::Wizard ;
 
 
-$VERSION = '1.303' ;
+$VERSION = '1.304' ;
 
 Construct Tk::Widget 'ConfigModelUI';
 
@@ -579,7 +579,6 @@
     my $node_loc = $node->location ;
 
     my $prevpath = '' ;
-    my $idx_nb = 0 ; # used to keep track of tktree item order
     foreach my $idx (@idx) {
 	my $newpath = $path.'.'. to_path($idx) ;
 	my $scan_sub = sub {
@@ -587,15 +586,20 @@
 	};
 
 	my $eltmode = $elt_mode{$elt_type};
+	my $sub_elt =  $elt->fetch_with_id($idx) ;
 
 	if ($tkt->infoExists($newpath) ) {
 	    my $previous_data = $tkt->info(data => $newpath);
-	    my $previous_idx_nb = $previous_data->[2] ;
+	    my $previous_elt  = $previous_data->[1] ;
 	    $eltmode = $tkt->getmode($newpath); # will reuse mode below
-	    if ($idx_nb != $previous_idx_nb) {
+	    $logger->trace("disp_hash reuse $newpath mode $eltmode cargo_type $elt_type"
+			   ." obj $previous_elt" );
+
+	    # string comparison of objects is intentional to check that the tree
+	    # refers to the correct Config::Model object
+	    if ($sub_elt ne $previous_elt) {
 		$logger->trace( "disp_hash delete $newpath mode $eltmode (got "
-				.$previous_idx_nb
-				." expected $idx_nb)" );
+				. "$previous_elt expected $sub_elt)" );
 		# wrong order, delete the entry
 		$tkt->delete(entry => $newpath) ;
 	    }
@@ -603,8 +607,9 @@
 
 	if (not $tkt->infoExists($newpath)) {
 	    my @opt = $prevpath ? (-after => $prevpath) : (-at => 0 ) ;
-	    $logger->trace( "disp_hash add $newpath mode $eltmode cargo_type $elt_type" );
-	    my @data = ( $scan_sub, $elt->fetch_with_id($idx), $idx_nb );
+	    $logger->trace( "disp_hash add $newpath mode $eltmode cargo_type $elt_type"
+			    ." elt $sub_elt" );
+	    my @data = ( $scan_sub, $sub_elt );
 	    weaken($data[1]) ;
 	    $tkt->add($newpath, -data => \@data, @opt) ;
 	    $tkt->itemCreate($newpath,0, -text => $idx ) ;
@@ -619,7 +624,6 @@
 	$cw->setmode('hash',$newpath,$eltmode,$elt_loc,$fdp_obj,$opening,$scan_sub) ;
 
 	$prevpath = $newpath ;
-	$idx_nb++ ;
     } ;
 }
 
@@ -804,6 +808,7 @@
 	    return;
 	}
 	$obj = $data_ref->[1] ;
+	weaken($obj) ;
 	#my $loc = $data_ref->[1]->location;
 
 	#$obj = $cw->{root}->grab($loc);