| Subject: | [patch] Widget Scrolled Text, widget parent |
Dear,
First of all, I want to say that the module is very simple and works well.
I use it since a long time and I want to report a small bug and I
suggest a patch to change two things.
That is a script to explain the bug :
#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::Preferences;
my $main = MainWindow->new();
$main->minsize( 500, 500 );
my $frame = $main->Frame()->pack();
$frame->Label( -text => 'label' )->pack();
$frame->Scrolled('Text')->pack();
$main->SetPrefs(
-prefs => {
MainWindow => { -background => 'red', },
Label => { -background => 'green', },
Frame => { -background => 'yellow', },
Button => { -background => 'brown' },
Text => { -background => 'pink', -height => 3 },
},
-debug => 1,
-parent => 1, # new option
);
MainLoop;
If you test this script, you will see two things :
1- The main windows does not have red background color.
I know that the module set preferences in all child widgets.
It would be a good idea to have an option to allow setting options
to the widget, for example -parent => 1 !
2- You can see that the background of text widget are not pink (see
script above).
Using -debug option, we have this :
configuring Label at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Text at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Scrollbar at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Scrollbar at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Frame at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Frame at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Frame at C:/Perl/site/lib/Tk/Preferences.pm line 72.
configuring Frame at C:/Perl/site/lib/Tk/Preferences.pm line 72.
Text widget has been set to white color, but the last Frame setting
overrides this setting and applies yellow color to Text widget.
This is a patch which can resolv the 2 points :
1- A new option (-parent) has been created to allow to configure
children of a widget and the widget also.
2- Now, when the module sets options of children of a widget (using Walk
method), it also reconfigures the children (3 levels). Then, when the
script set option to the last frame for example, the children are
reconfigured and Text widget is great.
Preferences.pm patch
--- Preferences.pm Sat Aug 8 17:05:13 2009
+++ Preferences_new.pm Sat Aug 8 17:06:32 2009
@@ -31,10 +31,28 @@
warn ("setting palette: $p{'-prefs'}->{'Palette'}") if
$p{'-debug'};
$parent->setPalette($p{'-prefs'}->{'Palette'});
}
- #set prefs in all child widgets
- $parent->Walk(
- sub { $_[0]->Tk::Preferences::ApplyWidget(\%p); }
+
+ # set prefs to widget
+ my ($class,$type) = split (/::/,ref($parent));
+ if ( exists($p{'-prefs'}->{$class}) and exists($p{'-parent'}) ) {
+ warn ("configuring $class") if $p{'-debug'};
+ $parent->configure( %{ $p{'-prefs'}->{$class} } );
+ }
+
+ #set prefs in all child widgets
+ $parent->Walk( sub {
+ # first level
+ $_[0]->Tk::Preferences::ApplyWidget(\%p);
+ # second level if necessary
+ $_[0]->Walk( sub {
+ $_[0]->Tk::Preferences::ApplyWidget(\%p);
+ # third level if necessary
+ $_[0]->Walk( sub {$_[0]->Tk::Preferences::ApplyWidget(\%p);});
+ }
+ );
+ }
);
+
#'tis all good
return (1);
}
Preferences.pod patch
--- Preferences.pod Tue Jul 14 21:52:42 2009
+++ Preferences_new.pod Sat Aug 8 17:11:23 2009
@@ -1,6 +1,6 @@
=head1 NAME
-Tk::Preferences - a perl module for setting font and color preferenes
in all children of a perl/Tk
+Tk::Preferences - a perl module for setting font and color preferences
in all children of a perl/Tk
widget.
=head1 SYNOPSIS
@@ -164,6 +164,10 @@
=item -debug 1|0
off be default, this option will 'warn' your console with debug
messsages as they occur.
+
+=item -parent 1|0
+
+off be default, this option to allow to configure children of a widget
and the widget also.
=back
Djibril Ousmanou