Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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 <?xml version="1.0"?> <tkcss> <Button FOREGROUND="#00FFFF" BACKGROUND="#FF00FF" ACTIVEBACKGROUND="#0000FF" ACTIVEFOREGROUND="#FFFF00" WIDTH="30" /> <Label FOREGROUND="#FFFF00" BACKGROUND="#FF0044" RELIEF="groove" /> <new BACKGROUND="#000044"/> </tkcss> =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: <Button FOREGROUND="#00FFFF"> It is the equivalent of coding: $style->method( Button => { -foreground => "#00FFFF" } ); Use your creativity here, and be sure to let the author know if you run into strange behavior. =head1 DEPENDENCIES This module is implemented using XML::Parser, Storable, and Tk::MainWindow (which means you should install Tk generally). =head1 QUALMS, QUIRKS AND QUANDRIES There are various shortcomings to this module. Most notably, it only works at present for TopLevel widgets, because of the very strange nature of Tk. It would be good to correct this, but rather than let the module sit around my hard drive any longer, I've decided to get it out the door. Perhaps others will have improvements. It should be noted that this module does slightly Weird Things(tm) with inheritance. Not all modules are written in a way that makes them easy to inherit; certainly Tk isn't. It is possbile that you could encounter strange, hard-to-track bugs. I haven't, and it seems to work well enough, but it's possible. Edit, Alter, and Replace aren't exactly the best names for methods. Suggestions are welcome. It is even possible that someone will convince me that this isn't a good idea in the first place. I'm all ears. The author is cognizant of the absurdity of having far more documentation than code. Oh well. Even this list of shortcomings is incomplete. Hey, what do you want for nothing? A rubber biscuit? =head1 CHANGELOG =item 0.4 Realized the private method &$amend was unnecessary; it was assimilated into &$handler. More minor progress in the eternal quest for eloquence. =item 0.3 Released to PerlMonks August 16, 2001. Because of the streamlining done in 0.2, it was easy to see that the private method &$validate was unnecessary; it has been assimilated by &$parse. Slight improvment made in terms of shrinking the scope of a particular closure. =item 0.2 Released to PerlMonks August 16, 2001. The Style method was added. The API for creating or changing the style data was changed to allow one to arbitrarily mix 'style' and 'file' designators. The root element of a TkCSS stylesheet was changed from 'Tk_Stylesheet' to 'tkcss', in the great geek tradition of favoring the brief and the obscure. The code was tightened in a number of ways. The supporting package Tk::Style::XML_HANDLER was made unnecessary and removed, for instance. All private methods were made unreachable from the outside by implementing them with closures. Numerous expressions were streamlined, and program logic was improved. All in all, it came to suit the author's tastes much better. =item 0.1 Released to PerlMonks August 14, 2001. =head1 BUGS None known. Ignorance is bliss. =head1 AUTHOR Ray Brinzer (Petruchio of PerlMonks) <rbrinzer@avalon.net> =head1 COPYRIGHT Copyright 2001, Ray Brinzer. All Rights Reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. <http://www.gnu.org/copyleft/gpl.html>

In reply to Tk::Style by Petruchio

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others drinking their drinks and smoking their pipes about the Monastery: (5)
    As of 2014-07-25 05:26 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite superfluous repetitious redundant duplicative phrase is:









      Results (167 votes), past polls