package POE::XUL::Style;
# $Id$
# Copyright Philip Gwyn 2008.  All rights reserved.

use strict;
use warnings;

use Scalar::Util qw( refaddr );

use Carp;

use overload '""' => sub { $_[0]->as_string }, 
             '+'  => sub { refaddr $_[0] },
             'bool' => sub { 1 };

use constant DEBUG => 0;

our $VERSION = '0.01';

my %EQUIV = qw(
    border-top border
    border-left border
    border-bottom border
    border-right border
    overflow-x overflow
    overflow-y overflow
    -moz-outline outline
);

my %SUBSET = (          # property ... offsets 
    'margin-top'    => [ 'margin', 0, 0, 0, 0 ],
    'margin-right'  => [ 'margin', 0, 1, 1, 1 ],
    'margin-bottom' => [ 'margin', 0, 0, 2, 2 ],
    'margin-left'   => [ 'margin', 0, 1, 1, 3 ],
    'padding-top'    => [ 'padding', 0, 0, 0, 0 ],
    'padding-right'  => [ 'padding', 0, 1, 1, 1 ],
    'padding-bottom' => [ 'padding', 0, 0, 2, 2 ],
    'padding-left'   => [ 'padding', 0, 1, 1, 3 ],
    'border-width' => [ 'border', 0, 0, 0 ],
    'border-style' => [ 'border', 1, 1, 1 ],
    'border-color' => [ 'border', 2, 2, 2 ],
    'border-top-width' => [ 'border-top', 0, 0, 0 ],
    'border-top-style' => [ 'border-top', 1, 1, 1 ],
    'border-top-color' => [ 'border-top', 2, 2, 2 ],
    'border-right-width' => [ 'border-right', 0, 0, 0 ],
    'border-right-style' => [ 'border-right', 1, 1, 1 ],
    'border-right-color' => [ 'border-right', 2, 2, 2 ],
    'border-bottom-width' => [ 'border-bottom', 0, 0, 0 ],
    'border-bottom-style' => [ 'border-bottom', 1, 1, 1 ],
    'border-bottom-color' => [ 'border-bottom', 2, 2, 2 ],
    'border-left-width' => [ 'border-left', 0, 0, 0 ],
    'border-left-style' => [ 'border-left', 1, 1, 1 ],
    'border-left-color' => [ 'border-left', 2, 2, 2 ],
    'outline-width' => [ 'outline', 0, 0, 0 ],
    'outline-style' => [ 'outline', 1, 1, 1 ],
    'outline-color' => [ 'outline', 2, 2, 2 ],
    '-moz-outline-width' => [ '-moz-outline', 0, 0, 0 ],
    '-moz-outline-style' => [ '-moz-outline', 1, 1, 1 ],
    '-moz-outline-color' => [ '-moz-outline', 2, 2, 2 ],
    'list-style-type'     => [ 'list-style', 0, 0, 0 ],
    'list-style-position' => [ 'list-style', 1, 1, 1 ],
    'list-style-image'    => [ 'list-style', 2, 2, 2 ],
    # http://developer.mozilla.org/en/docs/CSS:-moz-border-radius says:
    # "If fewer than 4 values are given, the list of values is repeated
    # to fill the remaining values."
    # I take this to mean:
    # 1       -> tl=1 tr=1 br=1 bl=1
    # 1 2     -> tl=1 tr=2 br=1 bl=2
    # 1 2 3   -> tl=1 tr=2 br=3 bl=1
    '-moz-border-radius-topleft'     => [ '-moz-border-radius', 0, 0, 0, 0 ],
    '-moz-border-radius-topright'    => [ '-moz-border-radius', 0, 1, 1, 1 ],
    '-moz-border-radius-bottomright' => [ '-moz-border-radius', 0, 0, 2, 2 ],
    '-moz-border-radius-bottomleft'  => [ '-moz-border-radius', 0, 1, 0, 3 ],
);

##############################################################
sub new
{
    my( $package, $init ) = @_;
    my $self = bless { properties => {}, text => [] }, $package;
    $self->parse( $init ) if $init;
    return $self;
}

##############################################################
sub as_string
{
    my( $self ) = @_;
    return join '', @{ $self->{text} };
}

##############################################################
sub parse
{
    my( $self, $string ) = @_;
    return unless defined $string;
    # TODO : add ; to last property text
    while( $string ) {
        # line starts with a comment
        if( $string =~ s,^(\s*/\*[^*]*\*+([^/*][^*]*\*+)*/\s*),,s ) {
            push @{ $self->{text} }, $1;
        }
        # line start with whitespace
        elsif( $string =~ s,^(\s+),,s ) {
            my $ws = $1;
            if( @{ $self->{text} } and  $self->{text}[-1] =~ /\s+$/ ) {
                $self->{text}[-1] .= $ws;
            }
            else {
                push @{ $self->{text} }, $ws;
            }
        }
        # property: value
        # Note that this fails for property: "some; value"; SO DON'T DO THAT
        elsif( $string =~ s,^((-?[_a-z][-_a-zA-Z]*)\s*:\s*(.*?)\s*(\Z|;\s*)),,is ) {
            push @{ $self->{text} }, $1;
            $self->{prop}{lc $2} = { 
                                  # name => lc( $2 ),
                                  text=>\$self->{text}[-1],
                                  value => $3
                                };
        }
    }
}

##############################################################
sub get
{
    my( $self, $key ) = @_;
    $key = lc $key;
    my $rv;
    if( $self->{prop}{ $key } ) {
        $rv = $self->{prop}{ $key }{value};
    }
    elsif( $EQUIV{$key} and $self->{prop}{ $EQUIV{$key} } ) {
        $rv = $self->{prop}{ $EQUIV{$key} }{value};
    }
    elsif( $SUBSET{ $key } ) {
        my $subset = $SUBSET{$key};
        my $value = $self->get( $subset->[0] );
        if( $value ) {
            my @values = split ' ', $value, $#$subset;
            my $n = 0+@values;
            $rv = $values[ $subset->[$n] ] if $n > 0;
        }
    }
    $rv = '' unless defined $rv;
    return $rv;
}


##############################################################
sub set
{
    my( $self, $key, $value ) = @_;
    $key = lc $key;
    my $prop = $self->{prop}{ $key };
    $value =~ s/;\s*$//;
    unless( $prop ) {
        # special case...
        return if !$value and $key eq 'display';

        $self->{text}[-1] .= ";" 
                if @{$self->{text}} and $self->{text}[-1] !~ m([;/]\s*$)s;
        push @{ $self->{text} }, "$key: $value;\n";
        $self->{prop}{ $key } = {  value => $value,
                                   # name => $key,
                                   text => \$self->{text}[-1]
                                };
    }
    else {
        # special case...
        if( !$value and $key eq 'display' ) {
            ${ $prop->{text} } = '';
            delete $self->{prop}{ lc $key };
        }
        else {
            ${ $prop->{text} } =~ s/\Q$prop->{value}/$value/;
            $prop->{value} = $value;
        }
    }
    $POE::XUL::Node::CM->after_style_change( $self, $key, $value )
            if $POE::XUL::Node::CM;
    return;
}

##############################################################
sub AUTOLOAD
{
    my( $self, $value ) = @_;
    my $key = our $AUTOLOAD;
    return if $key =~ /DESTROY$/;
	$key =~ s/^.*:://;

    $key =~ s/([A-Z])/-\L$1/g;
    if( 1 == @_ ) {
        return $self->get( $key );
    }
    else {
        return $self->set( $key, $value );
    }
    
}

1;

__END__

=head1 NAME

POE::XUL::Style - XUL style object

=head1 SYNOPSIS

    use POE::XUL::Node;

    my $node = Description( style   => "color: red; font-weight: bold", 
                            content => "YES!" 
                          );
    print $node->style->color;          # prints 'red'
    print $node->style->fontWeight;     # prints 'bold'

    $node->style->fontSize( '150%' );

    $node->style( "overflow: hidden;" );    # DOM spec tells us this is bad
    print $node->style->color;          # now it prints ''
    

=head1 DESCRIPTION

POE::XUL::Style is a DOM-like object that encapsulates the CSS style of a
XUL element. It uses L<POE::XUL::ChangeManager> to make sure all style are
mirrored in the browser's DOM.  However, style changes in the browser's DOM
are not mirrored in the POE::XUL app.

CSS parsing is round-trip safe;  All formating and comments are preserved.

The POE::XUL::Style object will I<stringize> as a full CSS declaration.
This means the old-school code that follows should still work.

    my $css = $node->style;
    $css .= "overflow-y: auto;"
                unless $css =~ s/(overflow-y: ).+?;/${1}auto/;
    $node->style( $css );

But please update your code to the following:

    $node->style->overflowY( 'auto' );

Isn't that much, much nicer?


=head1 EQUIVALENTS

If missing, the C<margin-top>, C<margin-left>, C<margin-right>,
C<margin-bottom> properties will be filled in from C<margin> property. 
The C<padding> and C<border> properties also support this.

    my $style = $node->style;
    $style->margin( '1px' );
    my $top = $style->marginTop();       # will be 1px

    $style->padding( '1px 3px 2px' );
    my $left = $style->marginLeft();     # will be 3px

    $style->border( 'thin solid red' );
    my $right = $style->borderRight();   # will be 'thin solid red'

What's more, the various sub-fields of the border property (C<-width>,
C<-style>, C<-color>) will be automaticaly found.

    $style->border( 'thin dotted black' );
    $style->borderBottom( '3px inset threedface' );
    my $topW = $style->borderTopWidth;        # will be 'thin'
    my $bottomS = $style->borderBottomStyle;  # will be 'inset'

The sub-fields of C<outline> and C<list-style> also support this:

    $style->outline( 'this dotted orange' );
    my $X = $style->outlineColor;       # will be 'orange'
    $style->listStyle( 'circle inside' );
    my $X = $style->outlinePosition;    # will be 'inside'

The C<overflow-x> and C<overflow-y> properties default to C<overflow>.

The C<-moz-border-radius-topleft>, C<-moz-border-radius-topright>, 
C<-moz-border-radius-bottomright> and C<-moz-border-radius-bottomleft>
properties default to sub-fields of C<-moz-border-radius>.

There are currently no equivalents for the C<font> property.


=head1 LIMITATIONS

=over 4

=item *

Setting a sub-fields of the border property will not modify the
corresponding border property.

    $style->borderBottom( '3px inset puce' );
    $style->borderBottomStyle( 'groove' );
    my $bottom = $style->borderBottom;  
    # $bottom will still be '3px inset puce', not '3px groove puce'

Likewise with C<padding> and C<margin>.

    $style->margin( '1px 5px 1px 0' );
    $style->marginRight( 0 );
    my $margin = $style->margin;      # still '1px 5px 1px 0'

=item *

If you set a sub-property, and then set the parent property,  the
sub-property is not changed to reflect the new parent.

    $style->marginRight( 0 );
    $style->margin( '1px 5px 1px 0' );
    my $R = $style->marginRight;      # still 0, not 5px

=item *

No attempt is made to ensure that values are valid.  The CSS spec limits
various values to a set of keywords, like C<inset, groove, solid>, etc for
C<border-style>.  Any value outside of the specification will be merrily
passed on to the browser.

=back

=head1 SEE ALSO

L<POE::XUL::Node>

L<http://developer.mozilla.org/en/docs/CSS>
has a good XUL reference.

L<http://www.w3.org/TR/CSS/>
the CSS specification.

=head1 AUTHOR

Philip Gwyn E<lt>gwyn-at-cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2008 by Philip Gwyn.  All rights reserved;

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
