r70298 - in /trunk/libconfig-model-tkui-perl: ./ debian/ lib/Config/Model/ lib/Config/Model/Tk/ t/
ddumont-guest at users.alioth.debian.org
ddumont-guest at users.alioth.debian.org
Thu Mar 3 13:16:32 UTC 2011
Author: ddumont-guest
Date: Thu Mar 3 13:10:59 2011
New Revision: 70298
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70298
Log:
new upstream release. lintian clean. Ready for review
Modified:
trunk/libconfig-model-tkui-perl/Build.PL
trunk/libconfig-model-tkui-perl/ChangeLog
trunk/libconfig-model-tkui-perl/META.yml
trunk/libconfig-model-tkui-perl/debian/changelog
trunk/libconfig-model-tkui-perl/debian/control
trunk/libconfig-model-tkui-perl/debian/copyright
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/AnyViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NoteEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/Wizard.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm
trunk/libconfig-model-tkui-perl/t/config-model-ui.t
trunk/libconfig-model-tkui-perl/t/config-model-wizard.t
Modified: trunk/libconfig-model-tkui-perl/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/Build.PL?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/Build.PL (original)
+++ trunk/libconfig-model-tkui-perl/Build.PL Thu Mar 3 13:10:59 2011
@@ -51,7 +51,7 @@
'Tk::ObjScanner' => '0'
},
'requires' => {
- 'Config::Model' => '1.228',
+ 'Config::Model' => '1.235',
'Exception::Class' => '0',
'File::Slurp' => '0',
'Log::Log4perl' => '1.11',
Modified: trunk/libconfig-model-tkui-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/ChangeLog?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/ChangeLog (original)
+++ trunk/libconfig-model-tkui-perl/ChangeLog Thu Mar 3 13:10:59 2011
@@ -1,3 +1,9 @@
+2011-03-01 Dominique Dumont <domi.dumont at free.fr> 1.321
+
+ * TkUi.pm: renamed 'check' menu to 'check for errors'. Added 'check for warnings'
+ * AnyViewer: renamed warning widget to 'issue'. Display errors with red background
+ * NodeEditor: added widget to edit node annotations
+
2011-01-11 Dominique Dumont <domi.dumont at free.fr> 1.320
* LeafViewer: removed 'apply fix' button. This one is reserved for
Modified: trunk/libconfig-model-tkui-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/META.yml?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/META.yml (original)
+++ trunk/libconfig-model-tkui-perl/META.yml Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
configure_requires:
Module::Build: 0.3601
dynamic_config: 0
-generated_by: 'Dist::Zilla version 4.200000, CPAN::Meta::Converter version 2.102400'
+generated_by: 'Dist::Zilla version 4.200003, CPAN::Meta::Converter version 2.102400'
license: lgpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -18,7 +18,7 @@
recommends:
Tk::ObjScanner: 0
requires:
- Config::Model: 1.228
+ Config::Model: 1.235
Exception::Class: 0
File::Slurp: 0
Log::Log4perl: 1.11
@@ -26,4 +26,4 @@
Tk: 0
Tk::DirSelect: 0
Tk::Tree: 0
-version: 1.320
+version: 1.321
Modified: trunk/libconfig-model-tkui-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/debian/changelog?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/debian/changelog (original)
+++ trunk/libconfig-model-tkui-perl/debian/changelog Thu Mar 3 13:10:59 2011
@@ -1,3 +1,13 @@
+libconfig-model-tkui-perl (1.321-1) unstable; urgency=low
+
+ * New upstream release (improved usability)
+ * control: changed my e-mail address. Added libconfig-model-perl
+ to Enhance field. Bumped *Depends version of libconfig-model-perl
+ to 1.235
+ * copyright: updated field names to latest DEP5
+
+ -- Dominique Dumont <domi.dumont at free.fr> Thu, 03 Mar 2011 14:09:02 +0100
+
libconfig-model-tkui-perl (1.320-1) unstable; urgency=low
* New upstream release:
Modified: trunk/libconfig-model-tkui-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/debian/control?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/debian/control (original)
+++ trunk/libconfig-model-tkui-perl/debian/control Thu Mar 3 13:10:59 2011
@@ -1,6 +1,6 @@
Source: libconfig-model-tkui-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
-Uploaders: Dominique Dumont <dominique.dumont at hp.com>,
+Uploaders: Dominique Dumont <domi.dumont at free.fr>,
Jonathan Yu <jawnsy at cpan.org>,
gregor herrmann <gregoa at debian.org>,
Salvatore Bonaccorso <carnil at debian.org>
@@ -8,7 +8,7 @@
Priority: optional
Build-Depends: debhelper ( >= 7),
perl
-Build-Depends-Indep: libconfig-model-perl (>= 1.229),
+Build-Depends-Indep: libconfig-model-perl (>= 1.235),
libexception-class-perl,
libfile-slurp-perl,
liblog-log4perl-perl,
@@ -27,7 +27,7 @@
Architecture: all
Depends: ${perl:Depends},
${misc:Depends},
- libconfig-model-perl (>= 1.229),
+ libconfig-model-perl (>= 1.235),
libexception-class-perl,
libfile-slurp-perl,
liblog-log4perl-perl,
@@ -35,6 +35,7 @@
libtk-dirselect-perl,
perl-tk
Suggests: libtk-objscanner-perl
+Enhances: libconfig-model-perl
Description: Tk GUI to edit config data through Config::Model
Config::Model::TkUI provides a Perl/Tk interface to:
- the configuration editor provided by Config::Model.
Modified: trunk/libconfig-model-tkui-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/debian/copyright?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/debian/copyright (original)
+++ trunk/libconfig-model-tkui-perl/debian/copyright Thu Mar 3 13:10:59 2011
@@ -1,23 +1,26 @@
-Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
-Maintainer: Dominique Dumont <ddumont at cpan.org>
+Format: http://dep.debian.net/deps/dep5/
+Upstream-Name: Config-Model-TkUI
+Upstream-Contact: Dominique Dumont <ddumont at cpan.org>
Source: http://search.cpan.org/dist/Config-Model-TkUI/
-Name: Config-Model-TkUI
Files: *
Copyright: 2008-2011, Dominique Dumont <ddumont at cpan.org>
License: LGPL-2.1+
+
Files: examples/model.pl
Copyright: 2009, Alexander Becker <asb_ehb at yahoo.de>
- 2009, Dominique Dumont <ddumont at cpan.org>
+ 2009, Dominique Dumont <ddumont at cpan.org>
License: LGPL-2.1+
+
Files: debian/*
-Copyright: 2008-2011, Dominique Dumont <dominique.dumont at hp.com>
- 2010, Jonathan Yu <jawnsy at cpan.org>
- 2010, gregor herrmann <gregoa at debian.org>
- 2010, Salvatore Bonaccorso <carnil at debian.org>
+Copyright: 2008-2011, Dominique Dumont <domi.dumont at free.fr>
+ 2010, Jonathan Yu <jawnsy at cpan.org>
+ 2010, gregor herrmann <gregoa at debian.org>
+ 2010, Salvatore Bonaccorso <carnil at debian.org>
License: LGPL-2.1+
+
License: LGPL-2.1+
This program is free software; you can redistribute it and/or modify it
@@ -27,3 +30,4 @@
.
On Debian ystems, the complete text of version 2.1 of the GNU Lesser
Public License can be found in `/usr/share/common-licenses/LGPL-2.1'.
+
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/AnyViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/AnyViewer.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/AnyViewer.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/AnyViewer.pm Thu Mar 3 13:10:59 2011
@@ -27,7 +27,7 @@
package Config::Model::Tk::AnyViewer ;
BEGIN {
- $Config::Model::Tk::AnyViewer::VERSION = '1.320';
+ $Config::Model::Tk::AnyViewer::VERSION = '1.321';
}
use strict;
@@ -38,8 +38,11 @@
use Tk::ROText;
use Tk::Dialog ;
use Config::Model::TkUI ;
+use Log::Log4perl qw(get_logger :levels);
use vars qw/$icon_path/ ;
+
+my $logger = get_logger("Tk");
my @fbe1 = qw/-fill both -expand 1/ ;
my @fxe1 = qw/-fill x -expand 1/ ;
@@ -170,14 +173,12 @@
sub add_warning {
my ($cw, $elt_obj,$usage) = @_ ;
- my $msg = $elt_obj->warning_msg || '' . "with " . $elt_obj->has_fixes." fixes";
-
my $frame = $cw -> Frame ; # packed by caller
my $inner_frame = $frame->Frame ; # packed by update_warning
my $label_button_frame = $inner_frame->Frame->pack(@fxe1) ;
$label_button_frame ->Label(
- -text => 'Warning',
+ -text => 'Issues',
) ->pack(-anchor => 'w', -side => 'left', -fill =>'x');
if ($usage eq 'edit') {
@@ -199,8 +200,16 @@
-height => 4,
);
+ my $err = $elt_obj->error_msg || '';
+ $warn_widget ->pack( @fbe1 ) ->insert('end',$err,'error') ;
+ $warn_widget ->tagConfigure(qw/error -lmargin1 2 -lmargin2 2 -rmargin 2 -background red/);
+
+ my $msg = $elt_obj->warning_msg || '' ;
+ $msg .= "with " . $elt_obj->has_fixes." fixes" if $msg ;
$warn_widget ->pack( @fbe1 ) ->insert('end',$msg,'warning') ;
$warn_widget ->tagConfigure(qw/warning -lmargin1 2 -lmargin2 2 -rmargin 2 -background orange/);
+
+ $logger->debug("creating warning widget". ($err ? " with errors": '').($msg ? " with warnings":''));
$cw->Advertise(warn_widget => $warn_widget) ;
$cw->Advertise(warn_frame => $inner_frame ) ;
@@ -211,23 +220,31 @@
}
sub update_warning {
- my ($cw, $elt_obj,$usage) = @_ ;
-
- my $msg = $elt_obj->warning_msg ;
- if (ref ($msg) eq 'HASH') {
- $msg = join('', map { join("\n\t",@{$msg->{$_}}) } sort keys %$msg ) ;
- }
+ my ($cw, $elt_obj) = @_ ;
my $wf = $cw->Subwidget('warn_frame') ;
my $ww = $cw->Subwidget('warn_widget') ;
my $fw = $cw->Subwidget('fix_widget') ;
- if ($msg) {
- $ww->delete('0.0', 'end') ;
- $ww->insert('end',$msg,'warning') ;
+ $ww->delete('0.0', 'end') ;
+
+ my $err = $elt_obj -> error_msg || '' ;
+ $ww->insert('end',$err,'error') if $err ;
+
+
+ my $msg .= $elt_obj->warning_msg || '';
+ if (ref ($msg) eq 'HASH') {
+ $msg = join('', map { join("\n\t",@{$msg->{$_}}) } sort keys %$msg ) ;
+ }
+ $ww->insert('end',$msg,'warning') if $msg ;
+
+ $logger->debug("updating warning widget". ($err ? " with errors": '').($msg ? " with warnings":''));
+
+
+ if ($msg or $err) {
$wf->pack(@fbe1) ;
- if ( defined $fw ) {
+ if ( $msg and defined $fw ) {
my $nb_fixes = $elt_obj->has_fixes;
$fw->configure(
-text => "Apply $nb_fixes fixes",
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListEditor.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListEditor.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListEditor.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::CheckListEditor ;
BEGIN {
- $Config::Model::Tk::CheckListEditor::VERSION = '1.320';
+ $Config::Model::Tk::CheckListEditor::VERSION = '1.321';
}
use strict;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListViewer.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListViewer.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/CheckListViewer.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::CheckListViewer ;
BEGIN {
- $Config::Model::Tk::CheckListViewer::VERSION = '1.320';
+ $Config::Model::Tk::CheckListViewer::VERSION = '1.321';
}
use strict;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashEditor.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashEditor.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashEditor.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::HashEditor ;
BEGIN {
- $Config::Model::Tk::HashEditor::VERSION = '1.320';
+ $Config::Model::Tk::HashEditor::VERSION = '1.321';
}
use strict;
@@ -30,7 +30,7 @@
my @fbe1 = qw/-fill both -expand 1/ ;
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x / ;
-my $logger = Log::Log4perl::get_logger(__PACKAGE__);
+my $logger = Log::Log4perl::get_logger(")Tk::HashEditor");
my $entry_width = 15 ;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashViewer.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashViewer.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/HashViewer.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::HashViewer ;
BEGIN {
- $Config::Model::Tk::HashViewer::VERSION = '1.320';
+ $Config::Model::Tk::HashViewer::VERSION = '1.321';
}
use strict;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafEditor.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafEditor.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafEditor.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::LeafEditor ;
BEGIN {
- $Config::Model::Tk::LeafEditor::VERSION = '1.320';
+ $Config::Model::Tk::LeafEditor::VERSION = '1.321';
}
use strict;
@@ -30,7 +30,7 @@
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x / ;
-my $logger = Log::Log4perl::get_logger(__PACKAGE__);
+my $logger = Log::Log4perl::get_logger("Tk::LeafEditor");
sub ClassInit {
my ($cw, $args) = @_;
@@ -50,10 +50,11 @@
my $inst = $leaf->instance ;
my $vt = $leaf -> value_type ;
$logger->info("Creating leaf editor for value_type $vt");
+ $cw->{value} = $leaf->fetch ( check => 'no');
+ $logger->info("Creating leaf editor with error ".$leaf->error_msg);
$cw->add_header(Edit => $leaf)->pack(@fx) ;
- $cw->{value} = $leaf->fetch ( check => 'no');
my $vref = \$cw->{value};
my @pack_args = @fx ;
@@ -188,7 +189,7 @@
: $cw->{value} ;
}
- return unless defined $v;
+ $v = '' unless defined $v ;
chomp $v ;
$logger->debug( "try: value $v") ;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafViewer.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafViewer.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/LeafViewer.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::LeafViewer ;
BEGIN {
- $Config::Model::Tk::LeafViewer::VERSION = '1.320';
+ $Config::Model::Tk::LeafViewer::VERSION = '1.321';
}
use strict;
@@ -25,7 +25,7 @@
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x / ;
-my $logger = Log::Log4perl::get_logger(__PACKAGE__);
+my $logger = Log::Log4perl::get_logger("Tk::LeafViewer");
sub ClassInit {
my ($cw, $args) = @_;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListEditor.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListEditor.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListEditor.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::ListEditor ;
BEGIN {
- $Config::Model::Tk::ListEditor::VERSION = '1.320';
+ $Config::Model::Tk::ListEditor::VERSION = '1.321';
}
use strict;
@@ -29,7 +29,7 @@
my @fbe1 = qw/-fill both -expand 1/ ;
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x / ;
-my $logger = Log::Log4perl::get_logger(__PACKAGE__);
+my $logger = Log::Log4perl::get_logger("Tk::ListEditor");
my $up_img;
my $down_img;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListViewer.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListViewer.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/ListViewer.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::ListViewer ;
BEGIN {
- $Config::Model::Tk::ListViewer::VERSION = '1.320';
+ $Config::Model::Tk::ListViewer::VERSION = '1.321';
}
use strict;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeEditor.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeEditor.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeEditor.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::NodeEditor ;
BEGIN {
- $Config::Model::Tk::NodeEditor::VERSION = '1.320';
+ $Config::Model::Tk::NodeEditor::VERSION = '1.321';
}
use strict;
@@ -19,6 +19,7 @@
use Tk::Pane ;
use Tk::Balloon;
use Text::Wrap;
+use Config::Model::Tk::NoteEditor ;
use base qw/Tk::Frame Config::Model::Tk::AnyViewer/;
use subs qw/menu_struct/ ;
@@ -30,7 +31,7 @@
my @fxe1 = qw/-fill x -expand 1/ ;
my @fx = qw/-fill x -expand 0/ ;
-my $logger = Log::Log4perl::get_logger(__PACKAGE__);
+my $logger = Log::Log4perl::get_logger("Tk::NodeEditor");
sub ClassInit {
my ($cw, $args) = @_;
@@ -60,6 +61,7 @@
#require Tk::Adjuster;
#$cw -> Adjuster()->pack(-fill => 'x' , -side => 'top') ;
+ $cw->ConfigModelNoteEditor( -object => $node )->pack;
$cw->add_info_button()->pack(@fxe1, qw/-anchor n/) ;
if ($node->parent) {
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeViewer.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeViewer.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeViewer.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeViewer.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::NodeViewer ;
BEGIN {
- $Config::Model::Tk::NodeViewer::VERSION = '1.320';
+ $Config::Model::Tk::NodeViewer::VERSION = '1.321';
}
use strict;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NoteEditor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NoteEditor.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NoteEditor.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NoteEditor.pm Thu Mar 3 13:10:59 2011
@@ -9,7 +9,7 @@
#
package Config::Model::Tk::NoteEditor ;
BEGIN {
- $Config::Model::Tk::NoteEditor::VERSION = '1.320';
+ $Config::Model::Tk::NoteEditor::VERSION = '1.321';
}
use strict;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/Wizard.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/Wizard.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/Wizard.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/Wizard.pm Thu Mar 3 13:10:59 2011
@@ -10,7 +10,7 @@
package Config::Model::Tk::Wizard ;
BEGIN {
- $Config::Model::Tk::Wizard::VERSION = '1.320';
+ $Config::Model::Tk::Wizard::VERSION = '1.321';
}
use strict;
@@ -62,6 +62,7 @@
$logger->info("Creating wizard widget");
$cw->{show_cb} ||= sub {} ;
$cw->{store_cb} ||= sub {} ;
+ $cw->{has_stopped} = 0;
my $title = delete $args->{'-title'}
|| "config wizard ".$cw->{root}->config_class_name ;
@@ -105,6 +106,7 @@
sub leaf_cb {
my ( $cw, $scanner, $data_ref, $node, $element_name, $index, $leaf_object )
= @_;
+ $cw->{has_stopped} = 1;
# cleanup existing widget contained in this frame
$cw->{show_cb}->($leaf_object);
@@ -116,6 +118,7 @@
sub list_element_cb {
my ( $cw, $scanner, $data_ref, $node, $element_name, @indexes ) = @_;
+ $cw->{has_stopped} = 1;
# cleanup existing widget contained in this frame
my $obj = $node->fetch_element($element_name);
@@ -128,6 +131,7 @@
sub hash_element_cb {
my ( $cw, $scanner, $data_ref, $node, $element_name, @keys ) = @_;
+ $cw->{has_stopped} = 1;
# cleanup existing widget contained in this frame
my $obj = $node->fetch_element($element_name);
@@ -140,6 +144,7 @@
sub check_list_element_cb {
my ( $cw, $scanner, $data_ref, $node, $element_name, @items ) = @_;
+ $cw->{has_stopped} = 1;
# cleanup existing widget contained in this frame
my $obj = $node->fetch_element($element_name);
@@ -150,10 +155,14 @@
)->pack(@fbe1);
}
-sub start_wizard {
- my ($cw,$exp) = @_ ;
-
- my $text = 'The wizard will scan all configuration items and stop on "important" items or on error (like missing mandatory values). If no "important" item and no error are found, the wizard will exit immediately' ;
+sub prepare_wizard {
+ my ($cw,%args) = @_ ;
+
+ my $exp = $args{experience} || 'beginner' ;
+
+ my $text = 'The wizard will scan all configuration items and stop on '
+ . '"important" items or on error (like missing mandatory values). If no '
+ . '"important" item and no error are found, the wizard will exit immediately' ;
my $edf = $cw->{ed_frame} ;
@@ -180,17 +189,18 @@
$edf->Checkbutton (-text => 'stop on warning', -variable => \$stop_on_warn )->pack(qw/-side top -anchor w/);
$edf->Button(-text => 'OK',
- -command => sub {$cw->_start_wizard($exp,$stop_on_warn)}
+ -command => sub {$cw->start_wizard($exp,$stop_on_warn)}
) -> pack (qw/-side right -anchor e/) ;
$edf->Button(-text => 'cancel',
-command => sub {$cw->destroy_wizard()}
) -> pack (qw/-side left -anchor w/) ;
}
-sub _start_wizard {
- my ( $cw, $exp, $stop_on_warn ) = @_;
+sub start_wizard {
+ my ( $cw, %args) = @_;
my $button_f = $cw->Frame->pack(qw/-pady 0 -fill x -expand 1/);
+ $cw->{has_stopped} = 0;
my $back = $button_f->Button(
-text => 'Back',
@@ -248,15 +258,19 @@
}
my @wiz_args = (
- experience => $exp,
- call_back_on_warning => $stop_on_warn,
+ experience => $args{experience} || 'beginner',
%cb_table
);
+ foreach (qw/warning important/) {
+ push @wiz_args, "call_back_on_$_" => $args{"stop_on_$_"}
+ if defined $args{"stop_on_$_"} ;
+ }
+
#Tk::ObjScanner::scan_object(\@wiz_args) ;
- $cw->{wizard} = $cw->{root}->instance->wizard_helper(@wiz_args);
-
- # exits when wizard is done (but not when stopped)
+ $cw->{wizard} = $cw->{root}->instance->iterator(@wiz_args);
+
+ # exits when wizard is done
$cw->{wizard}->start;
$cw->destroy_wizard;
}
@@ -267,13 +281,14 @@
delete $cw->{ed_w} ;
delete $cw->{wizard} ;
+ # print "Destroying wizard\n" ;
+ $logger->debug("Destroying wizard");
+ $cw->destroy ;
+
if (defined $cw->{end_cb}) {
$logger->debug("Calling end_cb");
- $cw->{end_cb}->() ;
- }
-
- $logger->debug("Destroying wizard");
- $cw->destroy ;
+ $cw->{end_cb}->($cw->{has_stopped}) ;
+ }
}
1;
Modified: trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm Thu Mar 3 13:10:59 2011
@@ -11,7 +11,7 @@
package Config::Model::TkUI ;
BEGIN {
- $Config::Model::TkUI::VERSION = '1.320';
+ $Config::Model::TkUI::VERSION = '1.321';
}
use strict;
@@ -130,7 +130,8 @@
my $file_items = [[ qw/command wizard -command/, sub{ $cw->wizard }],
[ qw/command reload -command/, sub{ $cw->reload }],
- [ qw/command check -command/, sub{ $cw->check(1)}],
+ [ command => 'check for errors', -command => sub{ $cw->check(1)} ],
+ [ command => 'check for warnings', -command => sub{ $cw->check(1)} ],
[ qw/command save -command/, sub{ $cw->save }],
[ command => 'save in dir ...',
-command => sub{ $cw->save_in_dir ;} ],
@@ -347,53 +348,25 @@
sub check {
my $cw = shift ;
- my $show = shift || 0 ;
-
- # first check for errors, will die on errors
- eval { $cw->{root}->dump_tree(auto_vivify => 1, full_dump => 1) } ;
-
- if ($@) {
- $cw->handle_error($@) ;
- }
- elsif ($show) {
+ my $show = shift || 0;
+ my $check_warnings = shift || 0;
+
+ my $wiz = $cw->setup_wizard(sub{ $cw->check_end($show, at _) ;});
+
+ $wiz->start_wizard(experience => $cw->{experience}, stop_on_warning => $check_warnings ) ;
+}
+
+sub check_end {
+ my $cw = shift ;
+ my $show = shift ;
+ my $has_stopped = shift ;
+
+ $cw->reload if $has_stopped ;
+
+ if ($show and not $has_stopped) {
$cw->Dialog(-title => 'Check',
- -text => "No errors found"
+ -text => "No issue found"
) -> Show ;
- }
-}
-
-sub handle_error {
- my $cw = shift;
- my $e_obj = shift ;
- my $mode = shift || '' ;
-
- my @buttons = qw/ok/ ;
-
- my $conf_obj = $e_obj->object ;
- push @buttons, 'edit' if defined $conf_obj ;
-
- push @buttons, 'trace' unless $mode eq 'trace' ;
-
- my $d = $cw->DialogBox(-title => 'Error',
- -buttons => \@buttons,
- ) ;
-
- if ($mode eq 'trace') {
- my $t = $d->add('ROText') -> pack;
- $t->insert(end => $e_obj->trace->as_string);
- }
- else {
- $d->add('Label',
- -text => $e_obj-> as_string ) -> pack ;
- }
-
- my $answer = $d -> Show ;
-
- if ($answer eq 'trace') {
- $cw->handle_error($e_obj,$answer) ;
- }
- elsif ($answer eq 'edit') {
- $cw->force_element_display($conf_obj) ;
}
}
@@ -407,18 +380,18 @@
$cw->check() ;
if (defined $cw->{store_sub}) {
- $logger->info( "Saving data in $trace_dir directory with store call-back" );
- $cw->{store_sub}->($dir) ;
+ $logger->info( "Saving data in $trace_dir directory with store call-back" );
+ $cw->{store_sub}->($dir) ;
}
else {
- $logger->info( "Saving data in $trace_dir directory with instance write_back" );
- eval { $cw->{root}->instance->write_back(@wb_args); } ;
- if ($@) {
- $cw -> Dialog ( -title => 'Save error',
- -text => $@->as_string,
- )
+ $logger->info( "Saving data in $trace_dir directory with instance write_back" );
+ eval { $cw->{root}->instance->write_back(@wb_args); } ;
+ if ($@) {
+ $cw -> Dialog ( -title => 'Save error',
+ -text => $@->as_string,
+ )
-> Show ;
- }
+ }
}
$cw->{modified_data} = 0 ;
}
@@ -842,6 +815,7 @@
fallback => 'node',
experience => 'master', #'beginner',
+ check => 'no',
# node callback
node_content_cb => \&disp_obj_elt ,
@@ -1026,23 +1000,28 @@
sub wizard {
my $cw = shift ;
- my $tree = $cw->{tktree} ;
+
+ my $wiz = $cw->setup_wizard(sub{ $cw->deiconify; $cw->raise ; $cw->reload ;});
+
+ # hide main window while wizard is running
+ # end_cb callback will raise the main window
+ $cw->withdraw ;
+
+ $wiz->prepare_wizard(experience => $cw->{experience}) ;
+}
+
+sub setup_wizard {
+ my $cw = shift ;
+ my $end_sub = shift ;
# when wizard is run, there's no need to update editor window in
# main widget
- my $wiz = $cw->ConfigModelWizard
+ return $cw->ConfigModelWizard
(
-root => $cw->{root},
-store_cb => sub{ $cw->{modified_data} = 1 ;},
- -end_cb => sub{ $cw->deiconify; $cw->raise ; $cw->reload ;},
- # -show_cb => sub{ $cw->force_element_display(@_)},
+ -end_cb => $end_sub,
) ;
-
- # hide main window while wizard is running
- # end_cb callback will raise the main window
- $cw->withdraw ;
-
- $wiz->start_wizard($cw->{experience}) ;
}
1;
Modified: trunk/libconfig-model-tkui-perl/t/config-model-ui.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/t/config-model-ui.t?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/t/config-model-ui.t (original)
+++ trunk/libconfig-model-tkui-perl/t/config-model-ui.t Thu Mar 3 13:10:59 2011
@@ -3,7 +3,7 @@
use warnings FATAL => qw(all);
use ExtUtils::testlib;
-use Test::More tests => 53 ;
+use Test::More tests => 52 ;
use Test::Warn ;
use Tk;
use Config::Model::TkUI;
@@ -24,7 +24,14 @@
print "You can play with the widget if you run the test with 's' argument\n";
-Log::Log4perl->easy_init($log ? $TRACE: $WARN);
+my $log4perl_user_conf_file = $ENV{HOME}.'/.log4config-model' ;
+
+if ($log and -e $log4perl_user_conf_file ) {
+ Log::Log4perl::init($log4perl_user_conf_file);
+}
+else {
+ Log::Log4perl->easy_init($log ? $WARN: $ERROR);
+}
Config::Model::Exception::Any->Trace(1) if $arg =~ /e/;
@@ -126,15 +133,15 @@
sub { $cmu->create_element_widget('edit','test1.std_id');; ok(1,"test ".$idx++)},
sub { $cmu->{editor}->add_entry('e'); ok(1,"test ".$idx++)},
sub { $tktree->open('test1.std_id') ; ok(1,"test ".$idx++)},
- sub { $cmu->reload; ok(1,"test ".$idx++)} ,
+ sub { $cmu->reload; ok(1,"test reload ".$idx++)} ,
sub { $cmu->create_element_widget('view','test1.std_id'); ok(1,"test ".$idx++)},
sub { $cmu->create_element_widget('edit','test1.std_id'); ok(1,"test ".$idx++)},
sub { $tktree->open('test1.std_id.ab') ; ok(1,"test ".$idx++)},
sub { $cmu->create_element_widget('view','test1.std_id.ab.Z'); ok(1,"test ".$idx++)},
- sub { $root->load(step => "std_id:ab Z=Cv") ; $cmu->reload ;; ok(1,"test ".$idx++)},
+ sub { $root->load(step => "std_id:ab Z=Cv") ; $cmu->reload ;; ok(1,"test load ".$idx++)},
sub { $tktree->open('test1.std_id.ab') ; ok(1,"test ".$idx++)},
sub { $cmu->create_element_widget('edit','test1.std_id.ab.DX'); ok(1,"test ".$idx++)},
- sub { $root->load(step => "std_id:ab3") ; $cmu->reload ;; ok(1,"test ".$idx++)} ,
+ sub { $root->load(step => "std_id:ab3") ; $cmu->reload ;; ok(1,"test load ".$idx++)} ,
sub { $cmu->create_element_widget('view','test1.string_with_def'); ok(1,"test ".$idx++)},
sub { $cmu->create_element_widget('edit','test1.string_with_def'); ok(1,"test ".$idx++)},
sub { $cmu->create_element_widget('view','test1.a_long_string'); ok(1,"test ".$idx++)},
@@ -148,36 +155,36 @@
sub { $cmu->create_element_widget('view','test1.my_reference'); ok(1,"test ".$idx++)},
sub { $cmu->create_element_widget('edit','test1.my_reference'); ok(1,"test ".$idx++)},
- sub { $root->load(step => "ordered_checklist=A,Z,G") ; $cmu->reload ;; ok(1,"test ".$idx++)} ,
+ sub { $root->load(step => "ordered_checklist=A,Z,G") ; $cmu->reload ;; ok(1,"test load ".$idx++)} ,
sub { $widget = $cmu->create_element_widget('edit','test1.ordered_checklist'); ok(1,"test ".$idx++)},
- sub { $widget->Subwidget('notebook')->raise('order') ;; ok(1,"test ".$idx++)},
- sub { $widget->Subwidget('notebook')->raise('order') ;; ok(1,"test ".$idx++)},
+ sub { $widget->Subwidget('notebook')->raise('order') ;; ok(1,"test notebook raise 1 ".$idx++)},
+ sub { $widget->Subwidget('notebook')->raise('order') ;; ok(1,"test notebook raise 2 ".$idx++)},
sub { $widget->{order_list}->selectionSet(1,1) ;; ok(1,"test ".$idx++)}, # Z
sub { $widget->move_selected_down ;; ok(1,"test ".$idx++)},
- sub { $cmu->save(); ok(1,"test ".$idx++)},
+ # cannot save with pernding errors sub { $cmu->save(); ok(1,"test save 1 ".$idx++)},
sub {
- for ($cmu->children) { $_->destroy if $_->name =~ /dialog/i; } ;
- $root->load($load_fix);; ok(1,"test ".$idx++)},
- sub { $cmu->save(); ok(1,"test ".$idx++)},
+ #for ($cmu->children) { $_->destroy if $_->name =~ /dialog/i; } ;
+ $root->load($load_fix);; ok(1,"test load_fix ".$idx++)},
+ sub { $cmu->save(); ok(1,"test save 2 ".$idx++)},
sub { $cmu->create_element_widget('edit','test1.always_warn');
$cmu -> force_element_display($root->grab('always_warn')) ;
- ; ok(1,"test ".$idx++)},
+ ; ok(1,"test always_warn ".$idx++)},
# warn test, 3 warnings: load, fetch for hlist, fetch for editor
sub { warnings_like { $root->load("always_warn=foo") ; $cmu->reload ;}
- [ qr/always/ , qr/always/, qr/always/] ,"warn test ".$idx++ ;
+ [ qr/always/ , qr/always/, qr/always/] ,"warn test always_warn 2 ".$idx++ ;
},
- sub { $root->load('always_warn~') ; $cmu->reload ;; ok(1,"test ".$idx++)},
+ sub { $root->load('always_warn~') ; $cmu->reload ;; ok(1,"test remove always_warn ".$idx++)},
sub { $cmu->create_element_widget('edit','test1.warn_unless');
$cmu -> force_element_display($root->grab('warn_unless')) ;
- ok(1,"test ".$idx++);
+ ok(1,"test warn_unless ".$idx++);
},
sub { warnings_like { $root->load("warn_unless=bar") ; $cmu->reload ;}
- [ qr/warn_unless/ , qr/warn_unless/, qr/warn_unless/] ,"warn test ".$idx++ ;
+ [ qr/warn_unless/ , qr/warn_unless/, qr/warn_unless/] ,"warn test warn_unless ".$idx++ ;
},
- sub { $root->load('warn_unless=foo2') ; $cmu->reload ;; ok(1,"test ".$idx++)},
+ sub { $root->load('warn_unless=foo2') ; $cmu->reload ;; ok(1,"test fix warn_unless ".$idx++)},
sub { $mw->destroy; }
);
Modified: trunk/libconfig-model-tkui-perl/t/config-model-wizard.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/t/config-model-wizard.t?rev=70298&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/t/config-model-wizard.t (original)
+++ trunk/libconfig-model-tkui-perl/t/config-model-wizard.t Thu Mar 3 13:10:59 2011
@@ -124,7 +124,7 @@
}
}
- $cmw->_start_wizard('master',1) ;
+ $cmw->start_wizard('master',1) ;
ok(1,"wizard done") ;
More information about the Pkg-perl-cvs-commits
mailing list