package Tk::Style;
$VERSION='0.4';
use strict;
use Carp;
use XML::Parser;
use Storable;
use base 'Tk::MainWindow';
{
my $parse;
{
my %stuff;
my $handler = sub {
shift;
my $name = shift;
return if $name eq 'tkcss';
my %x = @_;
my $y;
@$y{map {'-' . lc($_)} keys %x } = values %x;
$stuff{$name} = $y;
};
$parse =
sub {
my $xml = new XML::Parser(Handlers => { Start => $handler });
my @args = @_;
my $badlist = 'Incorrect argument list; ' .
'for correct usage, see perldoc Tk::Style.';
my $stylize = sub {
@_ % 2 and croak $badlist;
my %temp = @_;
for (keys %temp) {
$stuff{$_} ||= {};
%{$stuff{$_}} = (%{$stuff{$_}}, %{$temp{$_}});
}
};
my @style;
my %action = (
style => sub { push @style, $_[0] },
file => sub {
$stylize->(@style) if @style;
@style = ();
$xml->parsefile($_[0])
}
);
my $state = 'style';
while ($_ = shift @args){
if (/^file$/i || /^style$/i) { $state = lc $_ }
else { $action{$state}->($_) }
}
$stylize->(@style) if @style;
my %x = %stuff;
ref $x{$_} eq 'HASH' or delete $x{$_} for keys %x;
%stuff = ();
%x;
};
}
my $style = sub { shift->{___style} };
my $init;
{
my $unknown = 'Stylesheet refers to unknown method ';
$init = sub {
my $self = $_[0];
no strict 'refs';
for my $x (keys %{&$style}){
my $y = $self->can($x) or croak $unknown . $x;
*{$x} = sub { $self->$y( %{&$style->{$x}}, @_ ) };
}
};
}
sub new {
my $class = shift;
my %style = &$parse;
my %new = $style{new} ? %{$style{new}} : ();
my $self = $class->SUPER::new( %new );
delete $style{new};
$self->{___style} = \%style;
$self->$init();
$self;
}
sub Style { my $x = Storable::dclone(&$style); wantarray ? %$x : $x }
sub Edit {
my $x = &$style;
my %y = &$parse;
$x->{$_} = { (%{$x->{$_}||{}}, %{$y{$_}}) } for keys %y;
}
sub Alter {
my $x = &$style;
my %y = &$parse;
%$x = (%$x, %y);
}
sub Replace {
my $x = &$style;
my %y = &$parse;
%$x = %y;
}
sub AUTOLOAD {
no strict 'vars';
carp "Warning! $AUTOLOAD should not have been called!";
}
}
1;
=head1 NAME
Tk::Style - Stylesheet support for Perl/Tk
=head1 VERSION
This document describes version 0.4 of Tk::Style, which is
an alpha release. Both the name and the API of the module
are subject to change. Suggestions are welcome, even in
matters of style, though they may not be heeded.
0.4 released (admitted to?) August 16, 2001
=head1 SYNPOSIS
use Tk::Style;
my %style = ( # A plan to make Buttons, by
# default, utterly tasteless.
Button => {
-background => '#00FF00',
-activebackground => '#0000FF',
-foreground => '#FF00FF',
-activeforeground => '#FFFF00'
}
);
# Implement the plan
my $style = Tk::Style->new(
file => 'ugly.tkcss',
style => %style,
-background => '#00EEFF'
);
$style->title('Demo');
$style->Button(
-text => 'Exit',
-command => sub { exit }
)->pack;
MainLoop;
=head1 DESCRIPTION
Tk::Style inherits Tk::MainWindow, and adds the capacity
for supplying default parameters to MainWindow methods.
Explicitly supplied parameters override default ones,
providing a 'cascading' effect. Hopefully this module
may be of some use in the holy quest to separate presentation
from content, and in reducing the number of highly redundant
presentation details commonly mixed up with GUI program logic.
Style parameters may be supplied either from a TkCSS file
(ie. an appropriate XML document), or more directly in the
calling code.
=head1 PUBLIC METHODS
=head2 Interface
Of the five public methods, one (Style) takes no arguments
at all. The other four (new, Edit, Alter and Replace) all
expect the same two sorts of arguments. The structure of
these arguments is dictated by Tk::Style, but the content
is not; with any widget paramters that Tk::MainWindow will accept,
Tk::Style is perfectly happy.
Firstly, one may specify default parameters directly by
supplying widget-name / hashref-of-default-param pairs.
The following example should make this clear:
$style->method( Button => { -background => '#0000FF' } );
Here background of the Button widget is made bright blue by
default. Naturally multiple defaults may be set...
$style->method( Button => {
-background => '#0000FF',
-foreground => '#FF0000'
}
);
And multiple widgets may be specified as well:
$style->method(
Button => { -background => '#0000FF' },
Label => { -background => '#00FF00' }
);
It should be noted that style information will be applied
in the order that it is supplied, and that later information
will override earlier information. For instance, if you
said this:
$style->method(
Button => {
-background => '#FF0000',
-foreground => '#FF00FF'
}
Label => { -background => '#00FF00' }
Button => { -background => '#0000FF' },
);
The Button's default background would be set to green
(#00FF00) not red (#FF0000). The Button's default
foreground, however, would remain purple.
As the astute reader will have guessed, a list like this may
just as well be supplied by a hash:
my %style = (
Button => { -background => '#0000FF' },
Label => { -background => '#00FF00' }
);
$style->method( %style );
Or by several hashes:
my %style = ( Button => { -background => '#0000FF' } );
my %morestyle = ( Label => { -background => '#00FF00' } );
$style->method( %style, %morestyle );
Now, one of the nice things about stylesheets, of course,
is the ability to keep presentation information apart from
your content... Tk::Style accepts properly formatted XML
files full of style information. Lists of such files are
designated by the word 'file', like so:
$style->method( file => 'filename.tkcss' );
$style->method(
file => 'filename.tkcss',
'anotherfile.tkcss'
);
It is also possible to mix stylesheet files and explicitly
supplied style information in the same call; for this purpose
the designation 'style' is supplied.
So, these two calls are equivalent:
$style->method( style => %style );
$style->method( %style );
And here are some mixed calls:
$style->method(
file => 'file.tkcss',
'anotherfile.tkcss',
style => %style
);
$style->method(
file => 'file.tkcss',
style => %style,
%morestyle
);
$style->method(
file => 'file.tkcss',
style => %style,
Button => {
-text => 'Foo!',
-relief => 'groove'
}
);
$style->method(
file => 'file.tkcss',
style => %style,
file => 'file2.tkcss',
'file3.tkcss',
style => Button => { -background => '#00FF00' }
);
Again, order is important, and the last value supplied for
an attribute of a given widget will be the one that sticks.
Now, on to the actual methods...
=head2 Methods
=over
=item * new
new(), not surprisingly, is the constructor. The object
returned may then be used just as you'd use a MainWindow
object. The widgets it creates will use the default
paramters you've supplied, and any additional ones you
give the widget creation method. Explicitly supplied
parameters will automatically override defaults.
In addition to default parameters, this method will accept
a parameter called 'new', which will be taken as a parameter
to the inherited new constructor itself. This will not
become a default parameter for the new() method. This is
how you give Tk:Style those constructor parameters you used
to give to MainWindow->new().
=item * Style
Style() simply returns the style information the object
already contains. Called in list context, Style()
returns a list of key/value pairs, suitable for storing
in a hash. Called in scalar context, Style() returns
a reference to the object's style information.
=item * Edit
The Edit() method updates a widget's default parameters,
preserving old values for each where new values are not
supplied. So for instance, if you said:
my $style_object = Tk::Style->new(
Button => {
-text => 'Bar!',
-width => 10
}
);
and then said:
$style_object->Edit( Button => { -width => 20 } );
You will have increased the default width of a button,
while allowing the default background color to remain
green.
=item * Alter
The Alter() method is just like the Edit() method, but it
actually replaces the widget's entire paramter list with a
new one. If you took the object described above, for instance,
and said:
$style_object->Alter( Button => { -width => 40 } );
a Button's default width would likewise be increased to
40, but Buttons would no longer have any other default
parameters whatsoever. Labels, however, and other widgets
would retain any style information they had already been
given.
=item * Replace
The Replace() method replaces all style information for
the Tk::Style object entirely. If you were to say:
$style_object->Replace( Button => { -width => 40 } );
Then a Button would have a default width of 40, but no other
defaults... and neither would a Label or a Entry or any other
widget. Calling Replace() without parameters, therefore,
simply clears all style information from the object.
=back
=head1 STYLESHEET SYNTAX
=head2 Synopsis
=head2 Description
A "TkCSS" stylesheet is a simple XML document. The root
element is called 'tkcss', and it should contain only
empty nodes named after Tk widgets. The attributes of these
elements should be named after appropriate widget options,
and given appropriate values. Pretty simple, really.
So for instance, if the stylesheet says: