r64073 - in /branches/upstream/libconfig-model-tkui-perl/current: ./ lib/Config/Model/ lib/Config/Model/Tk/ t/ wr_data/

ddumont-guest at users.alioth.debian.org ddumont-guest at users.alioth.debian.org
Wed Oct 20 16:56:42 UTC 2010


Author: ddumont-guest
Date: Wed Oct 20 16:56:24 2010
New Revision: 64073

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

Removed:
    branches/upstream/libconfig-model-tkui-perl/current/wr_data/
Modified:
    branches/upstream/libconfig-model-tkui-perl/current/ChangeLog
    branches/upstream/libconfig-model-tkui-perl/current/MANIFEST
    branches/upstream/libconfig-model-tkui-perl/current/MANIFEST.SKIP
    branches/upstream/libconfig-model-tkui-perl/current/META.yml
    branches/upstream/libconfig-model-tkui-perl/current/README
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/AnyViewer.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListEditor.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListViewer.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashEditor.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashViewer.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafEditor.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafViewer.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListEditor.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListViewer.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeEditor.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeViewer.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NoteEditor.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/Wizard.pm
    branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/TkUI.pm
    branches/upstream/libconfig-model-tkui-perl/current/t/config-model-ui.t
    branches/upstream/libconfig-model-tkui-perl/current/t/config-model-wizard.t

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=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/ChangeLog (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/ChangeLog Wed Oct 20 16:56:24 2010
@@ -1,3 +1,15 @@
+2010-10-19  Dominique Dumont  <domi.dumont at free.fr> 1.315
+
+	* Do no check value when creating widgets. Values will be checked 
+	  when saving file
+	* ListEditor: update 'set selected' entry when a list item is selected"
+
+2010-10-15  Dominique Dumont  <domi.dumont at free.fr> 1.314
+
+	* removed stuff obsoleted by Config::Model 1.212
+	* Depends on Config::Model 1.212
+	* added utf8 characters in tests
+	
 2010-10-08  Dominique Dumont  <domi.dumont at free.fr> 1.313
 
 	* Added display of configuration warnings provided by

Modified: branches/upstream/libconfig-model-tkui-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/MANIFEST?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/MANIFEST (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/MANIFEST Wed Oct 20 16:56:24 2010
@@ -33,4 +33,3 @@
 t/config-model-wizard.t
 t/pod.t
 t/release-pod-syntax.t
-wr_data/foo/test1.cds

Modified: branches/upstream/libconfig-model-tkui-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/MANIFEST.SKIP?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/MANIFEST.SKIP (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/MANIFEST.SKIP Wed Oct 20 16:56:24 2010
@@ -5,3 +5,4 @@
 \.orig$
 _build
 dist.ini
+blib

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=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/META.yml (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/META.yml Wed Oct 20 16:56:24 2010
@@ -7,7 +7,7 @@
 configure_requires:
   Module::Build: 0.3601
 dynamic_config: 0
-generated_by: 'Dist::Zilla version 4.102341, CPAN::Meta::Converter version 2.102400'
+generated_by: 'Dist::Zilla version 4.102342, CPAN::Meta::Converter version 2.102400'
 license: lgpl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -16,11 +16,11 @@
 recommends:
   Tk::ObjScanner: 0
 requires:
-  Config::Model: 1.211
+  Config::Model: 1.212
   Exception::Class: 0
   Log::Log4perl: 1.11
   Pod::POM: 0
   Tk: 0
   Tk::DirSelect: 0
   Tk::Tree: 0
-version: 1.313
+version: 1.315

Modified: branches/upstream/libconfig-model-tkui-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/README?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/README (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/README Wed Oct 20 16:56:24 2010
@@ -9,13 +9,21 @@
 Config::Model::OpenSsh, you get a graphical configuration editor for
 sshd_config.
 
-All icons used in this application were created by Crystal Project.
-They are licensed under LGPL. http://www.everaldo.com/crystal/
-
-Except:
-- tools_nicu_buculei_01.png from OpenCliparts.
-- dialog_warning.png from oxygen-icon-theme (GPL v3) See
-  /usr/share/doc/oxygen-icon-theme/copyright
+Copyright:
+- All *.png used in this application were created by Crystal Project.
+  They are licensed under LGPL. http://www.everaldo.com/crystal/
+  (c) 2003-2007 Everaldo Coelho
+- tools_nicu_buculei_01.png from OpenCliparts is public domain.
+- dialog_warning.png from oxygen-icon-theme is GPL v3:
+    Copyright (C) 2007-2009 David Vignoni <david at icon-king.com>
+    Copyright (C) 2007-2009 Johann Ollivier Lapeyre <johann at oxygen-icons.org>
+    Copyright (C) 2007-2009 Kenneth Wimer <kwwii at bootsplash.org>
+    Copyright (C) 2007-2009 Nuno Fernades Pinheiro <nf.pinheiro at gmail.com>
+    Copyright (C) 2007-2009 Riccardo Iaconelli <riccardo at oxygen-icons.org>
+    Copyright (C) 2007-2009 David Miller <miller at oxygen-icons.org>
+    and others.
+  See /usr/share/doc/oxygen-icon-theme/copyright on a Debian machine
+  
 
 
 -----------------------------------------------------------

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/AnyViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/AnyViewer.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/AnyViewer.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/AnyViewer.pm Wed Oct 20 16:56:24 2010
@@ -27,7 +27,7 @@
 
 package Config::Model::Tk::AnyViewer ;
 BEGIN {
-  $Config::Model::Tk::AnyViewer::VERSION = '1.313';
+  $Config::Model::Tk::AnyViewer::VERSION = '1.315';
 }
 
 use strict;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListEditor.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListEditor.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListEditor.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::CheckListEditor ;
 BEGIN {
-  $Config::Model::Tk::CheckListEditor::VERSION = '1.313';
+  $Config::Model::Tk::CheckListEditor::VERSION = '1.315';
 }
 
 use strict;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListViewer.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListViewer.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/CheckListViewer.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::CheckListViewer ;
 BEGIN {
-  $Config::Model::Tk::CheckListViewer::VERSION = '1.313';
+  $Config::Model::Tk::CheckListViewer::VERSION = '1.315';
 }
 
 use strict;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashEditor.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashEditor.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashEditor.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::HashEditor ;
 BEGIN {
-  $Config::Model::Tk::HashEditor::VERSION = '1.313';
+  $Config::Model::Tk::HashEditor::VERSION = '1.315';
 }
 
 use strict;
@@ -273,7 +273,7 @@
 
     if ($@) {
 	$cw -> Dialog ( -title => 'Hash index error',
-			-text  => $@,
+			-text  => $@->as_string,
 		      )
 	  -> Show ;
 	return 0 ;
@@ -504,7 +504,7 @@
 
     if ($@) {
 	$cw -> Dialog ( -title => 'Value error',
-			-text  => $@,
+			-text  => $@ -> as_string,
 		      )
             -> Show ;
 	$cw->reset_value ;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashViewer.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashViewer.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/HashViewer.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::HashViewer ;
 BEGIN {
-  $Config::Model::Tk::HashViewer::VERSION = '1.313';
+  $Config::Model::Tk::HashViewer::VERSION = '1.315';
 }
 
 use strict;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafEditor.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafEditor.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafEditor.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::LeafEditor ;
 BEGIN {
-  $Config::Model::Tk::LeafEditor::VERSION = '1.313';
+  $Config::Model::Tk::LeafEditor::VERSION = '1.315';
 }
 
 use strict;
@@ -45,14 +45,12 @@
     $cw->{store_cb} = delete $args->{-store_cb} || die __PACKAGE__,"no -store_cb" ;
 
     my $inst = $leaf->instance ;
-    $inst->push_no_value_check('fetch') ;
-
     my $vt = $leaf -> value_type ;
     $logger->info("Creating leaf editor for value_type $vt");
 
     $cw->add_header(Edit => $leaf)->pack(@fx) ;
 
-    $cw->{value} = $leaf->fetch ;
+    $cw->{value} = $leaf->fetch ( check => 'no');
     my $vref = \$cw->{value};
 
     my @pack_args = @fx ;
@@ -108,8 +106,6 @@
 
     }
 
-    $inst->pop_no_value_check ;
-
     $cw->ConfigModelNoteEditor( -object => $leaf )->pack;
     $cw->add_warning($leaf)->pack(@fx) ;
     $cw->add_info_button()->pack( @fx,qw/-anchor n/) ;
@@ -207,7 +203,7 @@
 
     if ($@) {
         $cw -> Dialog ( -title => 'Delete error',
-                        -text  => "$@",
+                        -text  => $@->as_string,
                       )
             -> Show ;
     }
@@ -230,7 +226,7 @@
 
     if ($@) {
         $cw -> Dialog ( -title => 'Value error',
-                        -text  => "$@",
+                        -text  => $@->as_string,
                       )
             -> Show ;
         $cw->reset_value ;
@@ -255,7 +251,7 @@
 
 sub reset_value {
     my $cw = shift ;
-    $cw->{value} = $cw->{leaf}->fetch ;
+    $cw->{value} = $cw->{leaf}->fetch (check => 'no') ;
     if (defined $cw->{e_widget}) {
         $cw->{e_widget}->delete('1.0','end') ;
         $cw->{e_widget}->insert('end',$cw->{value},'value') ;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafViewer.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafViewer.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/LeafViewer.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::LeafViewer ;
 BEGIN {
-  $Config::Model::Tk::LeafViewer::VERSION = '1.313';
+  $Config::Model::Tk::LeafViewer::VERSION = '1.315';
 }
 
 use strict;
@@ -43,13 +43,10 @@
       || die "LeafViewer: no -path, got ",keys %$args;
 
     my $inst = $leaf->instance ;
-    $inst->push_no_value_check('fetch') ;
 
     my $vt = $leaf -> value_type ;
     $logger->info("Creating leaf viewer for value_type $vt");
-    my $v = $leaf->fetch ;
-
-    $inst->pop_no_value_check ;
+    my $v = $leaf->fetch( check => 'no' ) ;
 
     $cw->add_header(View => $leaf)->pack(@fx) ;
 
@@ -109,11 +106,12 @@
 		 'type : '.$leaf->value_type.$choice_str,
 		);
 
+    my $std = $leaf->fetch(qw/mode standard check no/) ;
     if (defined $leaf->upstream_default) {
 	push @items, "upstream_default value: " . $leaf->upstream_default ;
     }
-    elsif (defined $leaf->fetch('standard')) {
-	push @items, "default value: " . $leaf->fetch('standard') ;
+    elsif (defined $std) {
+	push @items, "default value: $std"  ;
     }
     elsif (defined $leaf->refer_to) {
 	push @items, "reference to: " . $leaf->refer_to ;
@@ -125,7 +123,7 @@
     my $m = $leaf->mandatory ;
     push @items, "is mandatory: ".($m ? 'yes':'no') if defined $m;
 
-    foreach my $what (qw/min max warn_if_match warn_unless_match warn/) {
+    foreach my $what (qw/min max warn_if_match warn_unless_match warn grammar/) {
 	my $v = $leaf->$what() ;
 	push @items, "$what value: $v" if defined $v;
     }

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListEditor.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListEditor.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListEditor.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::ListEditor ;
 BEGIN {
-  $Config::Model::Tk::ListEditor::VERSION = '1.313';
+  $Config::Model::Tk::ListEditor::VERSION = '1.315';
 }
 
 use strict;
@@ -69,7 +69,7 @@
     my $elt_button_frame = $cw->Frame(qw/-relief raised -borderwidth 2/)
                                      ->pack(@fbe1) ;
     my $frame_title = $list->element_name ;
-    $frame_title .= ($value_type =~ /node/) ? 'elements' : 'values' ;
+    $frame_title .= (defined $value_type and $value_type =~ /node/) ? 'elements' : 'values' ;
     $elt_button_frame -> Label(-text => $frame_title) -> pack() ; 
 
     my $tklist = $elt_button_frame ->Scrolled ( 'Listbox',
@@ -84,7 +84,7 @@
 		             . 'an action on the right');
 
     my $cargo_type = $list->cargo_type ;
-    my @insert = $cargo_type eq 'leaf' ? $list->fetch_all_values 
+    my @insert = $cargo_type eq 'leaf' ? $list->fetch_all_values (check => 'no')
                :                         $list->get_all_indexes ;
     map { $_ = '<undef>' unless defined $_ } @insert ;
     $tklist->insert( end => @insert ) ;
@@ -112,7 +112,7 @@
 			)-> pack( @fxe1);
 
     if ($cargo_type eq 'leaf' and $value_type ne 'enum' and $value_type ne 'reference') {
-	$cw->add_set_entry  ($right_frame, $balloon)->pack( @fxe1) ;
+	$cw->add_set_entry  ($right_frame, $balloon, $tklist)->pack( @fxe1) ;
 	$right_frame->Frame(-borderwidth => 2, -relief => 'groove') -> pack( @fxe1) ;
 	$cw->add_push_entry ($right_frame, $balloon)->pack( @fxe1) ;
 	$cw->add_set_all_b ($right_frame, $balloon)->pack( @fxe1) ;
@@ -145,7 +145,7 @@
 }
 
 sub add_set_entry {
-    my ($cw,$right_frame, $balloon) = @_ ;
+    my ($cw,$right_frame, $balloon,$tklist) = @_ ;
 
     my $set_item = '';
     my $set_sub = sub {$cw->set_entry($set_item); $set_item = '';} ;
@@ -164,6 +164,13 @@
 		           . 'and click the button to replace the selected '
 		           . 'element with this value.');
 
+    my $b_sub = sub { 
+	my $idx = $tklist->curselection ;
+	$set_item = $tklist->get($idx) if $idx ;
+    };
+
+    $tklist->bind('<<ListboxSelect>>',$b_sub);
+
     return $set_frame ;
 }
 
@@ -208,8 +215,8 @@
     }
 
     if ($@) {
-	$cw -> Dialog ( -title => 'List index error with type $cargo_type',
-			-text  => $@,
+	$cw -> Dialog ( -title => "List index error with type $cargo_type",
+			-text  => $@->as_string,
 		      )
 	  -> Show ;
     }
@@ -249,30 +256,38 @@
     my ($cw,$right_frame, $balloon) = @_ ;
 
     my $set_all_items = '' ;
-    my $set_all_sub = sub {$cw->set_all_items($set_all_items);} ;
+    my $regexp = '\s*,\s*' ;
+    my $set_all_sub = sub {$cw->set_all_items($set_all_items,$regexp);} ;
     my $set_all_frame = $right_frame->Frame;
-    $set_all_frame -> Button(-text => "set all:",
-			     -command => $set_all_sub ,
-			     -anchor => 'e',
-			    )->pack(-side => 'left', @fxe1);
+    my $set_top    = $set_all_frame->Frame->pack(@fxe1) ;
+    my $set_bottom = $set_all_frame->Frame->pack(@fxe1) ;
+    
+    $set_top -> Button(-text => "set all:",
+		       -command => $set_all_sub ,
+		       -anchor => 'e',
+		      )->pack(-side => 'left', @fx);
     my $set_all_entry 
-      = $set_all_frame -> Entry (-textvariable => \$set_all_items, 
-				 -width => $entry_width)
-	-> pack  (-side => 'left') ;
+      = $set_top -> Entry (-textvariable => \$set_all_items,)
+	-> pack  (-side => 'left', at fxe1) ;
     $balloon->attach($set_all_entry, 
-		     -msg => 'set all elements with a single string of '
-		     . 'comma separated values. I.e. "foo,bar,baz"');
+		     -msg => 'set all elements with a single string that '
+		     . 'will be split by the regexp displayed below');
+
+    $set_bottom-> Label(-text => 'split regexp') -> pack(-side => 'left', @fxe1);
+    $set_bottom-> Entry(-textvariable => \$regexp )
+	-> pack(-side => 'left', at fxe1);
     return $set_all_frame ;
 }
 
 sub set_all_items {
     my $cw =shift;
     my $data = shift ;
+    my $regexp = shift ;
 
     return unless $data ;
     my $tklist = $cw->{tklist} ;
 
-    my @list = split /[^\w\-]+/,$data ;
+    my @list = split /$regexp/,$data ;
 
     $tklist->delete(0,'end') ;
     $tklist->insert(0, @list) ;
@@ -353,7 +368,7 @@
     # redraw the list content
     $tklist -> delete(0,'end') ;
     my $cargo_type = $list->cargo_type ;
-    my @insert = $cargo_type eq 'leaf' ? $list->fetch_all_values 
+    my @insert = $cargo_type eq 'leaf' ? $list->fetch_all_values (check => 'no')
                :                         $list->get_all_indexes ;
     map { $_ = '<undef>' unless defined $_ } @insert ;
     $tklist->insert( end => @insert ) ;
@@ -366,7 +381,7 @@
 
     if ($@) {
 	$cw -> Dialog ( -title => 'Value error',
-			-text  => $@,
+			-text  => $@->as_string,
 		      )
             -> Show ;
 	$cw->reset_value ;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListViewer.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListViewer.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/ListViewer.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::ListViewer ;
 BEGIN {
-  $Config::Model::Tk::ListViewer::VERSION = '1.313';
+  $Config::Model::Tk::ListViewer::VERSION = '1.315';
 }
 
 use strict;
@@ -53,7 +53,7 @@
 				     -height => 10,
 				   ) ->pack(@fbe1) ;
 
-    my @insert = $list->cargo_type eq 'leaf' ? $list->fetch_all_values 
+    my @insert = $list->cargo_type eq 'leaf' ? $list->fetch_all_values (check => 'no')
                :                         $list->get_all_indexes ;
     foreach my $c (@insert) {
 	my $line = defined $c ? $c : '<undef>' ;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeEditor.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeEditor.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeEditor.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::NodeEditor ;
 BEGIN {
-  $Config::Model::Tk::NodeEditor::VERSION = '1.313';
+  $Config::Model::Tk::NodeEditor::VERSION = '1.315';
 }
 
 use strict;
@@ -110,7 +110,7 @@
 
 	if ($type eq 'leaf') {
 	    my $leaf = $node->fetch_element($c) ;
-	    my $v = eval {$node->fetch_element_value($c)} ;
+	    my $v = $node->fetch_element_value(name => $c, check  => 'no') ;
 	    my $store_sub = sub {$leaf->store($v); 
 				 $cw->{store_cb}->(1,undef,$elt_path);
 				 $cw->fill_pane;
@@ -152,7 +152,7 @@
 		    -command => $edit_sub) ;
 	$edb -> pack(-anchor => 'w');
 
-	my $content = $type eq 'leaf' ? $obj->fetch_no_check || ''
+	my $content = $type eq 'leaf' ? $obj->fetch( check => 'no') || ''
 	            : $type eq 'node' ? $node->config_class_name
 	            :                   $type ;
  	$cw->Balloon(-state => 'balloon') 

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeViewer.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeViewer.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeViewer.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::NodeViewer ;
 BEGIN {
-  $Config::Model::Tk::NodeViewer::VERSION = '1.313';
+  $Config::Model::Tk::NodeViewer::VERSION = '1.315';
 }
 
 use strict;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NoteEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NoteEditor.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NoteEditor.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NoteEditor.pm Wed Oct 20 16:56:24 2010
@@ -9,7 +9,7 @@
 # 
 package Config::Model::Tk::NoteEditor ;
 BEGIN {
-  $Config::Model::Tk::NoteEditor::VERSION = '1.313';
+  $Config::Model::Tk::NoteEditor::VERSION = '1.315';
 }
 
 use strict;

Modified: branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/Wizard.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/Wizard.pm?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/Wizard.pm (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/Wizard.pm Wed Oct 20 16:56:24 2010
@@ -10,7 +10,7 @@
 
 package Config::Model::Tk::Wizard ;
 BEGIN {
-  $Config::Model::Tk::Wizard::VERSION = '1.313';
+  $Config::Model::Tk::Wizard::VERSION = '1.315';
 }
 
 use strict;

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=64073&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 Wed Oct 20 16:56:24 2010
@@ -11,7 +11,7 @@
 
 package Config::Model::TkUI ;
 BEGIN {
-  $Config::Model::TkUI::VERSION = '1.313';
+  $Config::Model::TkUI::VERSION = '1.315';
 }
 
 use strict;
@@ -31,8 +31,6 @@
 use Tk::PNG ; # required for Tk::Photo to be able to load pngs
 use Tk::DialogBox ;
 
-require Tk::ErrorDialog;
-
 use Config::Model::Tk::LeafEditor ;
 use Config::Model::Tk::CheckListEditor ;
 
@@ -61,6 +59,19 @@
 $icon_path .= 'Tk/icons/' ;
 
 my $logger = Log::Log4perl::get_logger(__PACKAGE__);
+
+no warnings "redefine" ;
+
+sub Tk::Error {
+    my ($cw,$error, at locations) = @_;
+    my $msg = ref($error) ? $error->as_string : $error ;
+    $msg .= "stack: \n at locations\n";
+    $cw -> Dialog ( -title => 'Config::Model error',
+                    -text  => $msg,
+                  ) ;
+}
+
+use warnings "redefine" ;
 
 sub ClassInit {
     my ($class, $mw) = @_;
@@ -404,7 +415,7 @@
 	eval { $cw->{root}->instance->write_back(@wb_args); } ;
 	if ($@) {
 	  $cw -> Dialog ( -title => 'Save error',
-			  -text  => "$@",
+			  -text  => $@->as_string,
 			)
             -> Show ;
 	}
@@ -629,6 +640,17 @@
 
     my $node_loc = $node->location ;
 
+    # need to keep track myself of previous sibling as 
+    # $tkt->entrycget($path,'-after') dies
+    # and $tkt->info('prev',$path) return the path above in the displayed tree, which
+    # is not necessarily a sibling :-(
+    my $prev_sibling = '';
+    my %tk_previous_path ;
+    foreach ($tkt->info('children', $path )) {
+	$tk_previous_path{$_} = $prev_sibling ;
+	$prev_sibling = $_ ;
+    }
+
     my $prevpath = '' ;
     foreach my $idx (@idx) {
 	my $newpath = $path.'.'. to_path($idx) ;
@@ -640,9 +662,8 @@
 	my $sub_elt =  $elt->fetch_with_id($idx) ;
 
 	# check for display order mismatch
-	if ($tkt->infoExists($newpath) and $prevpath) {
-	    my $tkprevpath = $tkt->info( prev => $newpath );
-	    if ($prevpath ne $tkprevpath) {
+	if ($tkt->infoExists($newpath)) {
+	    if ($prevpath ne $tk_previous_path{$newpath}) {
 		$logger->trace("disp_hash deleting mismatching $newpath mode $eltmode cargo_type $elt_type" );
 		$tkt->delete(entry => $newpath) ;
 	    }
@@ -772,8 +793,8 @@
     my ($path,$cw,$opening,$fdp_obj) = @$data_ref ;
     $logger->trace( "disp_leaf    path is $path" );
 
-    my $std_v = $leaf_object->fetch('standard') ;
-    my $value = $leaf_object->fetch_no_check ;
+    my $std_v = $leaf_object->fetch(qw/mode standard check no silent 1/) ;
+    my $value = $leaf_object->fetch(check => 'no', silent => 1) ;
     my $tkt = $cw->{tktree} ;
 
     my $img ;

Modified: branches/upstream/libconfig-model-tkui-perl/current/t/config-model-ui.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/t/config-model-ui.t?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/t/config-model-ui.t (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/t/config-model-ui.t Wed Oct 20 16:56:24 2010
@@ -53,7 +53,7 @@
 std_id:"a b" X=Av -
 std_id:"a b.c" X=Av -
 tree_macro=mXY#"big lever here"
-a_string="toto tata"
+a_string="utf8 smiley \x{263A}"
 a_long_string="a very long string with\nembedded return"
 hash_a:toto=toto_value
 hash_a:toto#"index comment"
@@ -73,7 +73,7 @@
 warp warp2 aa2="foo bar"
 !;
 
-ok( $root->load( step => $step, permission => 'advanced' ),
+ok( $root->load( step => $step, experience => 'advanced' ),
   "set up data in tree");
 
 my $load_fix = "a_mandatory_string=foo1 another_mandatory_string=foo2 
@@ -81,7 +81,7 @@
                 warp a_string=warpfoo a_long_string=longfoo another_string=anotherfoo -
                 slave_y a_string=slave_y_foo a_long_string=sylongfoo another_string=sy_anotherfoo" ;
 
-#$root->load(step => "tree_macro=XZ", permission => 'advanced') ;
+#$root->load(step => "tree_macro=XZ", experience => 'advanced') ;
 
 $root->fetch_element('ordered_hash_of_mandatory')->fetch_with_id('foo') ;
 
@@ -93,7 +93,7 @@
     my $mw = eval {MainWindow-> new ; };
 
     # cannot create Tk window
-    skip "Cannot create Tk window",1 if $@;
+    skip "Cannot create Tk window",48 unless $mw;
 
     $mw->withdraw ;
 
@@ -162,6 +162,8 @@
 	 sub { $cmu->create_element_widget('edit','test1.always_warn');
 		$cmu -> force_element_display($root->grab('always_warn')) ; 
 	    ; ok(1,"test ".$idx++)},
+
+	 # warn test
 	 sub { warnings_like { $root->load("always_warn=foo") ; $cmu->reload ;}
 	       [ qr/always/ , qr/always/] ,"warn test ".$idx++ ;
 	     },

Modified: branches/upstream/libconfig-model-tkui-perl/current/t/config-model-wizard.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libconfig-model-tkui-perl/current/t/config-model-wizard.t?rev=64073&op=diff
==============================================================================
--- branches/upstream/libconfig-model-tkui-perl/current/t/config-model-wizard.t (original)
+++ branches/upstream/libconfig-model-tkui-perl/current/t/config-model-wizard.t Wed Oct 20 16:56:24 2010
@@ -1,7 +1,5 @@
 # -*- cperl -*-
-# $Author: ddumont $
-# $Date: 2009-06-29 14:41:07 +0200 (Mon, 29 Jun 2009) $
-# $Revision: 994 $
+
 use warnings FATAL => qw(all);
 
 use ExtUtils::testlib;
@@ -77,7 +75,7 @@
 warp warp2 aa2="foo bar"
 !;
 
-ok( $root->load( step => $step, permission => 'advanced' ),
+ok( $root->load( step => $step, experience => 'advanced' ),
   "set up data in tree");
 
 # use Tk::ObjScanner; Tk::ObjScanner::scan_object($root) ;




More information about the Pkg-perl-cvs-commits mailing list