r43832 - 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
Tue Sep 8 11:24:32 UTC 2009
Author: ddumont-guest
Date: Tue Sep 8 11:24:25 2009
New Revision: 43832
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43832
Log:
new upstream release. Ready for upload
Added:
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/NodeEditor.pm
- copied unchanged from r43831, branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/NodeEditor.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/Tk/Wizard.pm
- copied unchanged from r43831, branches/upstream/libconfig-model-tkui-perl/current/lib/Config/Model/Tk/Wizard.pm
trunk/libconfig-model-tkui-perl/t/config-model-wizard.t
- copied unchanged from r43831, branches/upstream/libconfig-model-tkui-perl/current/t/config-model-wizard.t
Modified:
trunk/libconfig-model-tkui-perl/ChangeLog
trunk/libconfig-model-tkui-perl/MANIFEST
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/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/HashEditor.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/NodeViewer.pm
trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm
trunk/libconfig-model-tkui-perl/t/config-model-ui.t
Modified: trunk/libconfig-model-tkui-perl/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/ChangeLog?rev=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/ChangeLog (original)
+++ trunk/libconfig-model-tkui-perl/ChangeLog Tue Sep 8 11:24:25 2009
@@ -1,3 +1,24 @@
+2009-09-04 Dominique Dumont <dominique.dumont at hp.com> 1.301
+
+ * lib/Config/Model/Tk/NodeEditor.pm: New widget to edit several
+ config items in the same widget.
+
+2009-09-03 Dominique Dumont <dominique.dumont at hp.com>
+
+ * lib/Config/Model/Tk/NodeViewer.pm (Populate): Provide more
+ details (type and if possible value) on node elements.
+
+2009-09-01 Dominique Dumont <dominique.dumont at hp.com>
+
+ * lib/Config/Model/TkUI.pm (Populate): Use 'beginner' as default
+ experience level
+
+2009-08-31 Dominique Dumont <dominique.dumont at hp.com>
+
+ * lib/Config/Model/Tk/Wizard.pm: New file. Provides generic wizard
+ for configuration edition. This wizard can be run at different
+ experience (beginner, advanced or master).
+
2009-06-28 Dominique Dumont <domi at ylum.gre.hp.com> v1.211
* lib/Config/Model/TkUI.pm (save): don't pass undefined dir
@@ -9,7 +30,7 @@
* lib/Config/Model/Tk/LeafViewer.pm (add_info): use
upstream_default() method instead of deprecated built_in().
-2009-05-30 Dominique Dumont <dominique.dumont at hp.com>
+2009-05-30 Dominique Dumont <dominique.dumont at hp.com>
* lib/Config/Model/TkUI.pm (Populate): added -title option so the
application can set the title of the TkUI window
@@ -21,7 +42,7 @@
2009-03-31 Dominique Dumont <dominique.dumont at hp.com>
- * lib/Config/Model/Tk/*.pm (): Added display of summary
+ * lib/Config/Model/Tk/*.pm (): Added display of summary
2009-03-12 Dominique Dumont <dominique.dumont at hp.com> v1.207
Modified: trunk/libconfig-model-tkui-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/MANIFEST?rev=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/MANIFEST (original)
+++ trunk/libconfig-model-tkui-perl/MANIFEST Tue Sep 8 11:24:25 2009
@@ -16,11 +16,14 @@
lib/Config/Model/Tk/LeafViewer.pm
lib/Config/Model/Tk/ListEditor.pm
lib/Config/Model/Tk/ListViewer.pm
+lib/Config/Model/Tk/NodeEditor.pm
lib/Config/Model/Tk/NodeViewer.pm
+lib/Config/Model/Tk/Wizard.pm
lib/Config/Model/TkUI.pm
MANIFEST This list of files
README
t/big_model.pm
t/config-model-ui.t
+t/config-model-wizard.t
t/pod.t
META.yml
Modified: trunk/libconfig-model-tkui-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/META.yml?rev=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/META.yml (original)
+++ trunk/libconfig-model-tkui-perl/META.yml Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
---
name: Config-Model-TkUI
-version: 1.211
+version: 1.301
author:
- Dominique Dumont (ddumont at cpan dot org)
abstract: Tk GUI to edit config data through Config::Model
@@ -16,41 +16,48 @@
Tk::Tree: 0
recommends:
Tk::ObjScanner: 0
+configure_requires:
+ Module::Build: 0.35
provides:
Config::Model::Tk::AnyViewer:
file: lib/Config/Model/Tk/AnyViewer.pm
- version: 1.0910
+ version: 1.1022
Config::Model::Tk::CheckListEditor:
file: lib/Config/Model/Tk/CheckListEditor.pm
- version: 1.0910
+ version: 1.1009
Config::Model::Tk::CheckListViewer:
file: lib/Config/Model/Tk/CheckListViewer.pm
version: 1.0910
Config::Model::Tk::HashEditor:
file: lib/Config/Model/Tk/HashEditor.pm
- version: 1.0920
+ version: 1.1015
Config::Model::Tk::HashViewer:
file: lib/Config/Model/Tk/HashViewer.pm
version: 1.0910
Config::Model::Tk::LeafEditor:
file: lib/Config/Model/Tk/LeafEditor.pm
- version: 1.0910
+ version: 1.1009
Config::Model::Tk::LeafViewer:
file: lib/Config/Model/Tk/LeafViewer.pm
- version: 1.0979
+ version: 1.1021
Config::Model::Tk::ListEditor:
file: lib/Config/Model/Tk/ListEditor.pm
- version: 1.0910
+ version: 1.1009
Config::Model::Tk::ListViewer:
file: lib/Config/Model/Tk/ListViewer.pm
version: 1.0910
+ Config::Model::Tk::NodeEditor:
+ file: lib/Config/Model/Tk/NodeEditor.pm
+ version: 1.1013
Config::Model::Tk::NodeViewer:
file: lib/Config/Model/Tk/NodeViewer.pm
- version: 1.0910
+ version: 1.1022
+ Config::Model::Tk::Wizard:
+ file: lib/Config/Model/Tk/Wizard.pm
Config::Model::TkUI:
file: lib/Config/Model/TkUI.pm
- version: 1.211
-generated_by: Module::Build version 0.33
+ version: 1.301
+generated_by: Module::Build version 0.35
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: trunk/libconfig-model-tkui-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/debian/changelog?rev=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/debian/changelog (original)
+++ trunk/libconfig-model-tkui-perl/debian/changelog Tue Sep 8 11:24:25 2009
@@ -1,3 +1,10 @@
+libconfig-model-tkui-perl (1.301-1) unstable; urgency=low
+
+ * New upstream release. New NodeEditor widget. New wizard widget
+ * control: Updated to policy 3.8.3
+
+ -- Dominique Dumont <dominique.dumont at hp.com> Tue, 08 Sep 2009 13:22:59 +0200
+
libconfig-model-tkui-perl (1.211-1) unstable; urgency=low
[ Dominique Dumont ]
Modified: trunk/libconfig-model-tkui-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libconfig-model-tkui-perl/debian/control?rev=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/debian/control (original)
+++ trunk/libconfig-model-tkui-perl/debian/control Tue Sep 8 11:24:25 2009
@@ -13,7 +13,7 @@
liblog-log4perl-perl (>= 1.11)
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Dominique Dumont <dominique.dumont at hp.com>
-Standards-Version: 3.8.2
+Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/Config-Model-TkUI/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libconfig-model-tkui-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libconfig-model-tkui-perl/
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-03-31 13:41:21 +0200 (Tue, 31 Mar 2009) $
-# $Revision: 910 $
+# $Date: 2009-09-06 17:08:25 +0200 (Sun, 06 Sep 2009) $
+# $Revision: 1022 $
# Copyright (c) 2008-2009 Dominique Dumont.
#
@@ -32,7 +32,7 @@
use vars qw/$VERSION $icon_path/ ;
-$VERSION = sprintf "1.%04d", q$Revision: 910 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1022 $ =~ /(\d+)/;
my @fbe1 = qw/-fill both -expand 1/ ;
my @fxe1 = qw/-fill x -expand 1/ ;
@@ -154,5 +154,7 @@
$cw->Button(-text => 'Edit ...', -command => $sub)-> pack ;
}
+# do nothing by default
+sub reload { }
1;
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-03-31 13:41:21 +0200 (Tue, 31 Mar 2009) $
-# $Revision: 910 $
+# $Date: 2009-07-31 16:37:39 +0200 (Fri, 31 Jul 2009) $
+# $Revision: 1009 $
# Copyright (c) 2008 Dominique Dumont.
#
@@ -32,7 +32,7 @@
use Tk::NoteBook;
-$VERSION = sprintf "1.%04d", q$Revision: 910 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1009 $ =~ /(\d+)/;
Construct Tk::Widget 'ConfigModelCheckListEditor';
@@ -57,6 +57,7 @@
my $leaf = $cw->{leaf} = delete $args->{-item}
|| die "CheckListEditor: no -item, got ",keys %$args;
delete $args->{-path} ;
+ $cw->{store_cb} = delete $args->{-store_cb} || die __PACKAGE__,"no -store_cb" ;
my $inst = $leaf->instance ;
@@ -213,7 +214,7 @@
}
} $cw->{leaf}->get_choice;
- $cw->parent->parent->parent->parent->reload(1) ;
+ $cw->{store_cb}->() ;
}
sub reset_value {
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-04-07 13:16:38 +0200 (Tue, 07 Apr 2009) $
-# $Revision: 920 $
+# $Date: 2009-09-04 17:59:46 +0200 (Fri, 04 Sep 2009) $
+# $Revision: 1015 $
# Copyright (c) 2008 Dominique Dumont.
#
@@ -34,7 +34,7 @@
use Tk::Photo ;
use Tk::Balloon ;
-$VERSION = sprintf "1.%04d", q$Revision: 920 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1015 $ =~ /(\d+)/;
Construct Tk::Widget 'ConfigModelHashEditor';
@@ -63,6 +63,7 @@
my $hash = $cw->{hash} = delete $args->{-item}
|| die "HashEditor: no -item, got ",keys %$args;
delete $args->{-path} ;
+ $cw->{store_cb} = delete $args->{-store_cb} || die __PACKAGE__,"no -store_cb" ;
unless (defined $up_img) {
$up_img = $cw->Photo(-file => $icon_path.'up.png');
@@ -77,7 +78,8 @@
my $elt_frame = $elt_button_frame->Frame(qw/-relief raised -borderwidth 2/)
->pack(@fbe1,-side => 'left') ;
- $elt_frame -> Label(-text => $hash->element_name.' elements') -> pack() ;
+ $elt_frame -> Label(-text => $hash->element_name.' elements')
+ -> pack(@fx) ;
my $tklist = $elt_frame ->Scrolled ( 'Listbox',
-selectmode => 'single',
@@ -88,19 +90,20 @@
$tklist->insert( end => $hash->get_all_indexes) ;
- my $right_frame = $elt_button_frame->Frame->pack(@fxe1, -side => 'left');
-
- $cw->add_info($cw) ;
+ my $right_frame = $elt_button_frame->Frame
+ ->pack(@fxe1, qw/-side right -anchor n/);
+
+ $cw->add_info() ;
$cw->add_summary_and_description($hash) ;
- my $item_frame = $right_frame->Frame(-relief => 'groove',-bd => 4 )
+ my $item_frame = $right_frame->Frame(qw/-borderwidth 1 -relief groove/)
->pack( @fxe1);
my $balloon = $cw->Balloon(-state => 'balloon') ;
my $item = '';
my $keep = 0 ;
- my $label_frame = $item_frame->Frame->pack( @fxe1);
+ my $label_frame = $item_frame->Frame->pack( @fxe1, qw/-side top -anchor n/);
$label_frame -> Label (-text => 'Item:')->pack(@fxe1,-side => 'left') ;
my $keep_b = $label_frame -> Checkbutton (-variable => \$keep,
-text => 'keep')
@@ -109,11 +112,11 @@
-msg => 'keep entry in widget after add, move or copy');
my $entry = $item_frame -> Entry (-textvariable => \$item )
- -> pack (@fxe1) ;
+ -> pack (@fxe1, qw/-side top -anchor n/) ;
$balloon -> attach($entry,
-msg => 'enter item name to add, copy to, or move to') ;
- my $button_frame = $item_frame->Frame->pack( );
+ my $button_frame = $item_frame->Frame->pack( qw/-side top -anchor n/ );
my $addb = $button_frame
-> Button(-text => "Add",
@@ -121,7 +124,7 @@
$item = '' unless $keep;
},
-anchor => 'e',
- )->pack(-side => 'left');
+ )->pack(qw/-side left/);
my $add_str = $hash->ordered ? " after selection" : '' ;
$balloon->attach($addb,
-msg => "add entry".$add_str);
@@ -132,7 +135,7 @@
$item = '' unless $keep;},
-anchor => 'e',
)
- -> pack(-side => 'left');
+ -> pack(qw/-side right/);
$balloon->attach($cp_b,
-msg => "copy selected item in entry");
@@ -158,7 +161,7 @@
)-> pack( -side =>'left' , @fxe1);
}
- my $del_rm_frame = $right_frame->Frame->pack( @fxe1);
+ my $del_rm_frame = $right_frame->Frame->pack( @fxe1, qw/-side top -anchor n/);
$del_rm_frame->Button(-text => 'Delete selected',
-command => sub { $cw->delete_selection;
@@ -443,7 +446,7 @@
sub reload_tree {
my $cw = shift ;
- $cw->parent->parent->parent->parent->reload(1) ;
+ $cw->{store_cb}->() ;
}
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-03-31 13:41:21 +0200 (Tue, 31 Mar 2009) $
-# $Revision: 910 $
+# $Date: 2009-07-31 16:37:39 +0200 (Fri, 31 Jul 2009) $
+# $Revision: 1009 $
# Copyright (c) 2008-2009 Dominique Dumont.
#
@@ -30,7 +30,7 @@
use base qw/Config::Model::Tk::LeafViewer/;
use vars qw/$VERSION/ ;
-$VERSION = sprintf "1.%04d", q$Revision: 910 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1009 $ =~ /(\d+)/;
Construct Tk::Widget 'ConfigModelLeafEditor';
@@ -53,6 +53,7 @@
my $leaf = $cw->{leaf} = delete $args->{-item}
|| die "LeafEditor: no -item, got ",keys %$args;
delete $args->{-path} ;
+ $cw->{store_cb} = delete $args->{-store_cb} || die __PACKAGE__,"no -store_cb" ;
my $inst = $leaf->instance ;
$inst->push_no_value_check('fetch') ;
@@ -235,7 +236,7 @@
}
else {
# trigger redraw of Tk Tree
- $cw->parent->parent->parent->parent->reload(1) ;
+ $cw->{store_cb}->($cw->{leaf}) ;
}
}
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-06-23 13:41:22 +0200 (Tue, 23 Jun 2009) $
-# $Revision: 979 $
+# $Date: 2009-09-06 14:13:25 +0200 (Sun, 06 Sep 2009) $
+# $Revision: 1021 $
# Copyright (c) 2008 Dominique Dumont.
#
@@ -30,7 +30,7 @@
use base qw/Tk::Frame Config::Model::Tk::AnyViewer/;
use vars qw/$VERSION/ ;
-$VERSION = sprintf "1.%04d", q$Revision: 979 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1021 $ =~ /(\d+)/;
Construct Tk::Widget 'ConfigModelLeafViewer';
@@ -67,8 +67,7 @@
$cw->add_header(View => $leaf) ;
my @pack_args = @fx ;
- @pack_args = @fbe1 if $vt eq 'string' or $vt eq 'enum'
- or $vt eq 'reference' ;
+ @pack_args = @fbe1 if $vt eq 'string' ;
my $lv_frame = $cw->Frame(qw/-relief raised -borderwidth 2/)
->pack(@pack_args) ;
$lv_frame -> Label(-text => 'Value') -> pack() ;
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,6 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-03-31 13:41:21 +0200 (Tue, 31 Mar 2009) $
-# $Revision: 910 $
+# $Date: 2009-07-31 16:37:39 +0200 (Fri, 31 Jul 2009) $
+# $Revision: 1009 $
# Copyright (c) 2008 Dominique Dumont.
#
@@ -32,7 +32,7 @@
use subs qw/menu_struct/ ;
use Tk::Dialog ;
-$VERSION = sprintf "1.%04d", q$Revision: 910 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1009 $ =~ /(\d+)/;
Construct Tk::Widget 'ConfigModelListEditor';
@@ -54,6 +54,7 @@
my $list = $cw->{list} = delete $args->{-item}
|| die "ListEditor: no -item, got ",keys %$args;
delete $args->{-path} ;
+ $cw->{store_cb} = delete $args->{-store_cb} || die __PACKAGE__,"no -store_cb" ;
$cw->add_header(Edit => $list) ;
@@ -324,7 +325,7 @@
sub reload_tree {
my $cw = shift ;
- $cw->parent->parent->parent->parent->reload(1) ;
+ $cw->{store_cb}->() ;
}
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=43832&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 Tue Sep 8 11:24:25 2009
@@ -1,8 +1,8 @@
# $Author: ddumont $
-# $Date: 2009-03-31 13:41:21 +0200 (Tue, 31 Mar 2009) $
-# $Revision: 910 $
+# $Date: 2009-09-06 17:08:25 +0200 (Sun, 06 Sep 2009) $
+# $Revision: 1022 $
-# Copyright (c) 2008 Dominique Dumont.
+# Copyright (c) 2008-2009 Dominique Dumont.
#
# This file is part of Config-Model-TkUi.
#
@@ -30,7 +30,7 @@
use vars qw/$VERSION/ ;
use subs qw/menu_struct/ ;
-$VERSION = sprintf "1.%04d", q$Revision: 910 $ =~ /(\d+)/;
+$VERSION = sprintf "1.%04d", q$Revision: 1022 $ =~ /(\d+)/;
Construct Tk::Widget 'ConfigModelNodeViewer';
@@ -49,25 +49,32 @@
my ($cw, $args) = @_;
my $node = $cw->{node} = delete $args->{-item}
|| die "NodeViewer: no -item, got ",keys %$args;
- delete $args->{-path} ;
+ my $path = delete $args->{-path} ;
$cw->add_header(View => $node) ;
my $inst = $node->instance ;
- my $elt_frame = $cw->Frame(qw/-relief raised -borderwidth 4/)->pack(@fxe1) ;
+ my $elt_frame = $cw->Frame(qw/-relief flat/)->pack(@fbe1) ;
$elt_frame -> Label(-text => $node->composite_name.' node elements') -> pack() ;
- my $rt = $elt_frame ->Scrolled ( 'ROText',
- -height => 10,
- ) ->pack(@fbe1) ;
+ my $hl = $elt_frame ->Scrolled ( 'HList',
+ -scrollbars => 'osow',
+ -columns => 3,
+ -header => 1,
+ -height => 8,
+ ) -> pack(@fbe1) ;
+ $hl->headerCreate(0, -text => 'name') ;
+ $hl->headerCreate(1, -text => 'type') ;
+ $hl->headerCreate(2, -text => 'value') ;
+ $cw->{hlist}=$hl ;
+ $cw->reload ;
- my $exp = $cw->parent->parent->parent->parent->get_experience ;
-
- foreach my $c ($node->get_element_name(for => $exp)) {
- $rt->insert('end', $c."\n" ) ;
- }
+ # add adjuster. Buggy behavior on destroy...
+ #require Tk::Adjuster;
+ #$cw->{adjust} = $cw -> Adjuster();
+ #$cw->{adjust}->packAfter($hl, -side => 'top') ;
$cw->add_info($cw) ;
@@ -77,9 +84,53 @@
else {
$cw->add_help(class => $node->get_help) ;
}
+
+ $cw->add_editor_button($path) ;
+
$cw->SUPER::Populate($args) ;
}
+#sub DESTROY {
+# my $cw = shift ;
+# $cw->{adjust}->packForget(1);
+#}
+
+sub reload {
+ my $cw = shift ;
+
+ my $exp = $cw->parent->parent->parent->parent->get_experience ;
+ my $node = $cw->{node};
+ my $hl=$cw->{hlist} ;
+
+ my %old_elt = %{$cw->{elt_path}|| {} } ;
+
+ foreach my $c ($node->get_element_name(for => $exp)) {
+ next if delete $old_elt{$c} ;
+
+ $hl->add($c) ;
+ $cw->{elt_path}{$c} = 1 ;
+
+ $hl->itemCreate($c,0, -text => $c) ;
+ my $type = $node->element_type($c) ;
+ $hl->itemCreate($c,1, -text => $type) ;
+
+ if ($type eq 'leaf') {
+ my $v = eval {$node->fetch_element_value($c)} ;
+ if ($@) {
+ $hl->itemCreate($c,2,
+ -itemtype => 'image' ,
+ -image => $Config::Model::TkUI::warn_img) ;
+ }
+ elsif (defined $v) {
+ substr ($v,15) = '...' if length($v) > 15;
+ $hl->itemCreate($c,2, -text => $v) ;
+ }
+ }
+ }
+
+ # destroy leftover widgets (may occur with warp mechanism)
+ map {$hl->delete(entry => $_); } keys %old_elt ;
+}
sub add_info {
my $cw = shift ;
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=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm (original)
+++ trunk/libconfig-model-tkui-perl/lib/Config/Model/TkUI.pm Tue Sep 8 11:24:25 2009
@@ -1,24 +1,6 @@
# $Author: ddumont $
-# $Date: 2009-06-29 14:41:07 +0200 (Mon, 29 Jun 2009) $
-# $Revision: 994 $
-
-# Copyright (c) 2007,2009 Dominique Dumont.
-#
-# This file is part of Config-Model-TkUI.
-#
-# Config-Model is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser Public License as
-# published by the Free Software Foundation; either version 2.1 of
-# the License, or (at your option) any later version.
-#
-# Config-Model is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Lesser Public License for more details.
-#
-# You should have received a copy of the GNU Lesser Public License
-# along with Config-Model; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+# $Date: 2009-09-07 14:05:34 +0200 (Mon, 07 Sep 2009) $
+# $Revision: 1024 $
package Config::Model::TkUI ;
@@ -27,7 +9,7 @@
use Carp ;
use base qw/Tk::Toplevel/;
-use vars qw/$VERSION $icon_path/ ;
+use vars qw/$VERSION $icon_path $warn_img/ ;
use subs qw/menu_struct/ ;
use Scalar::Util qw/weaken/;
use Log::Log4perl;
@@ -51,13 +33,15 @@
use Config::Model::Tk::HashEditor ;
use Config::Model::Tk::NodeViewer ;
-
-
-$VERSION = '1.211' ;
+use Config::Model::Tk::NodeEditor ;
+
+use Config::Model::Tk::Wizard ;
+
+
+$VERSION = '1.301' ;
Construct Tk::Widget 'ConfigModelUI';
-my $warn_img ;
my $cust_img ;
my $tool_img ;
@@ -83,7 +67,7 @@
unless (defined $warn_img) {
$warn_img = $cw->Photo(-file => $icon_path.'stop.png');
$cust_img = $cw->Photo(-file => $icon_path.'next.png');
- # snatched from openclip-arts-png
+ # snatched from openclipart-png
$tool_img = $cw->Photo(-file => $icon_path.'tools_nicu_buculei_01.png');
}
@@ -94,12 +78,13 @@
or croak "Missing $parm arg\n";
}
- foreach my $parm (qw/-store_sub -quit -experience/) {
+ foreach my $parm (qw/-store_sub -quit/) {
my $attr = $parm ;
$attr =~ s/^-//;
$cw->{$attr} = delete $args->{$parm} ;
}
+ $cw->{experience} = delete $args->{'-experience'} || 'beginner' ;
my $extra_menu = delete $args->{'-extra-menu'} || [] ;
my $title = delete $args->{'-title'}
@@ -109,7 +94,7 @@
croak "Unknown parameter ",join(' ',keys %$args) if %$args;
# initialize internal attributes
- $cw->{location} = 'foobar';
+ $cw->{location} = '';
$cw->{modified_data} = 0;
$cw->setup_scanner() ;
@@ -120,7 +105,8 @@
$cw->configure(-menu => $menubar ) ;
$cw->{my_menu} = $menubar ;
- my $file_items = [[ qw/command reload -command/, sub{ $cw->reload }],
+ 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)}],
[ qw/command save -command/, sub{ $cw->save }],
[ command => 'save in dir ...',
@@ -202,7 +188,10 @@
$cw->{e_frame} ->Label(#-text => "placeholder",
-image => $tool_img,
-width => 400, # width in pixel for image
- ) -> pack ;
+ ) -> pack(-side => 'top') ;
+ $cw->{e_frame} ->Button(-text => "Run Wizard !",
+ -command => sub { $cw->wizard}
+ ) -> pack(-side => 'bottom') ;
# bind button3 as double-button-1 does not work
my $b3_sub = sub{my $item = $tree->nearest($tree->pointery - $tree->rooty) ;
@@ -253,7 +242,6 @@
EOF
my $todo_text = << 'EOF' ;
-- add wizard
- add better navigation
- add tabular view ?
- improve look and feel
@@ -270,7 +258,7 @@
my $about_sub = sub {
$cw->Dialog(-title => 'About',
-text => "Config::Model::TkUI \n"
- ."(c) 2008 Dominique Dumont \n"
+ ."(c) 2008-2009 Dominique Dumont \n"
."Licensed under LGPLv2\n"
) -> Show ;
};
@@ -427,8 +415,9 @@
sub reload {
my $cw =shift ;
- my $is_modif = shift || 0;
- my $force_display_obj = shift ;
+ my $is_modif = shift || 0; # whether values where modified
+ my $force_display_obj = shift ; # force open editor
+ my $path = shift ; # force tree to show this path
$logger->trace("reloading tk tree".
(defined $force_display_obj ? " (forcedisplay)" : '' )
@@ -455,6 +444,8 @@
# the first parameter indicates that we are opening the root
$sub->(1,$force_display_obj) ;
+ $tree->see($path) if $path and $tree->info(exists => $path);
+ $cw->{editor}->reload if defined $cw->{editor};
}
# call-back when Tree element is selected
@@ -772,7 +763,7 @@
check_list => 'ConfigModelCheckListEditor',
list => 'ConfigModelListEditor',
hash => 'ConfigModelHashEditor',
- node => 'ConfigModelNodeViewer',
+ node => 'ConfigModelNodeEditor',
},
view => {
leaf => 'ConfigModelLeafViewer',
@@ -786,7 +777,8 @@
sub create_element_widget {
my $cw = shift ;
my $mode = shift ;
- my $tree_path = shift ; # reserved for tests
+ my $tree_path = shift ; # optional
+ my $obj = shift ; # optional if tree is not opened to path
my $tree = $cw->{tktree};
@@ -797,27 +789,35 @@
$tree_path = $tree->nearest($tree->pointery - $tree->rooty) ;
}
- $tree->selectionClear() ; # clear all
- $tree->selectionSet($tree_path) ;
- my $data_ref = $tree->infoData($tree_path);
- unless (defined $data_ref->[1]) {
- $cw->reload;
- return;
- }
- my $loc = $data_ref->[1]->location;
-
- my $obj = $cw->{root}->grab($loc);
+ if ($tree->info(exists => $tree_path)) {
+ $tree->selectionClear() ; # clear all
+ $tree->selectionSet($tree_path) ;
+ my $data_ref = $tree->infoData($tree_path);
+ unless (defined $data_ref->[1]) {
+ $cw->reload;
+ return;
+ }
+ $obj = $data_ref->[1] ;
+ #my $loc = $data_ref->[1]->location;
+
+ #$obj = $cw->{root}->grab($loc);
+ }
+
+ my $loc = $obj ->location;
my $type = $obj -> get_type ;
$logger->trace( "item $loc to $mode (type $type)" );
# cleanup existing widget contained in this frame
+ delete $cw->{editor} ;
map { $_ ->destroy if Tk::Exists($_) } $cw->{e_frame}->children ;
my $frame = $cw->{e_frame} ;
my $widget = $widget_table{$mode}{$type}
|| die "Cannot find $mode widget for type $type";
- $cw->{editor} = $frame -> $widget(-item => $obj, -path => $tree_path ) ;
+ my @store = $mode eq 'edit' ? (-store_cb => sub {$cw->reload(@_)} ) : () ;
+ $cw->{editor} = $frame -> $widget(-item => $obj, -path => $tree_path,
+ @store ) ;
$cw->{editor}-> pack(-expand => 1, -fill => 'both') ;
return $cw->{editor} ;
}
@@ -907,6 +907,17 @@
$cw->reload(1) if @$cut_buf;
}
+sub wizard {
+ my $cw = shift ;
+ my $tree = $cw->{tktree} ;
+
+ my $wiz = $cw->ConfigModelWizard (
+ -root => $cw->{root},
+ -store_cb => sub{ $cw->force_element_display(@_)},
+ ) ;
+ $wiz->start_wizard($cw->{experience}) ;
+}
+
1;
__END__
@@ -943,6 +954,9 @@
model (like L<Config::Model::Xorg>), you get a tool to
edit configuration files (e.g. C</etc/X11/xorg.conf>).
+Be default, only items with C<beginner> experience are shown. You can
+change the C<experience> level in C<< Options -> experience >> menu.
+
=head1 USAGE
=head2 Left side tree
@@ -969,6 +983,15 @@
on the left side of TkUI. The new data will be stored in the
configuration file only when C<File->save> menu is invoked.
+=head2 Wizard
+
+A wizard can be launched either with C<< File -> Wizard >> menu entry
+or with C<Run Wizard> button.
+
+The wizard will scan the configuration tree and stop on all items
+flagged as important in the model. It will also stop on all erroneous
+items (mostly missing mandatory values).
+
=head2 TODO
Document widget options. (-root_model and -store_sub, -quit)
@@ -979,7 +1002,7 @@
=head1 LICENSE
- Copyright (c) 2008 Dominique Dumont.
+ Copyright (c) 2008-2009 Dominique Dumont.
This file is part of Config-Model.
@@ -998,24 +1021,6 @@
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
02110-1301 USA
-=head1 SEE ALSO
-
-=over
-
-=item *
-
-L<Config::Model>
-
-=item *
-
-http://config-model.wiki.sourceforge.net/
-
-=item *
-
-Config::Model mailing lists on http://sourceforge.net/mail/?group_id=155650
-
-=back
-
=head1 FEEDBACK and HELP wanted
This project needs feedback from its users. Please send your
@@ -1051,6 +1056,23 @@
config-mode-devel at lists.sourceforge.net
-=cut
-
-
+=head1 SEE ALSO
+
+=over
+
+=item *
+
+L<Config::Model>
+
+=item *
+
+http://config-model.wiki.sourceforge.net/
+
+=item *
+
+Config::Model mailing lists on http://sourceforge.net/mail/?group_id=155650
+
+=back
+
+
+
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=43832&op=diff
==============================================================================
--- trunk/libconfig-model-tkui-perl/t/config-model-ui.t (original)
+++ trunk/libconfig-model-tkui-perl/t/config-model-ui.t Tue Sep 8 11:24:25 2009
@@ -1,7 +1,7 @@
# -*- cperl -*-
# $Author: ddumont $
-# $Date: 2009-06-29 14:41:07 +0200 (Mon, 29 Jun 2009) $
-# $Revision: 994 $
+# $Date: 2009-09-04 14:29:16 +0200 (Fri, 04 Sep 2009) $
+# $Revision: 1014 $
use warnings FATAL => qw(all);
use ExtUtils::testlib;
@@ -113,16 +113,15 @@
my @force_test
= (
sub { $cmu->reload} ,
+ ) ;
+
+ my @test
+ = (
+ sub { $cmu->create_element_widget('edit','test1')},
sub { $cmu->force_element_display($root->grab('std_id:dd DX')) },
sub { $cmu->edit_copy('test1.std_id')},
sub { $cmu->force_element_display($root->grab('hash_a:titi')) },
sub { $cmu->edit_copy('test1.hash_a.titi')},
- #sub { $cmu->edit_paste('test1.hash_b')},
- #sub { $cmu->force_element_display($root->grab('hash_b:titi')) },
- ) ;
-
- my @test
- = (
sub { $cmu->create_element_widget('view','test1')},
sub { $tktree->open('test1.lista') },
sub { $cmu->create_element_widget('edit','test1.std_id');},
More information about the Pkg-perl-cvs-commits
mailing list