Whatpm/CSS/Parser.pm

package Whatpm::CSS::Parser;
use strict;
use Whatpm::CSS::Tokenizer qw(:token);
require Whatpm::CSS::SelectorsParser;

sub new ($) {
  my $self = bless {onerror => sub { }, must_level => 'm',
                    message_level => 'w',
                    unsupported_level => 'unsupported'}, shift;

  return $self;
} # new

sub BEFORE_STATEMENT_STATE () { 0 }
sub BEFORE_DECLARATION_STATE () { 1 }
sub IGNORED_STATEMENT_STATE () { 2 }
sub IGNORED_DECLARATION_STATE () { 3 }

our $Prop; ## By CSS property name
our $Attr; ## By CSSOM attribute name
our $Key; ## By internal key

sub parse_char_string ($$) {
  my $self = $_[0];

  my $s = $_[1];
  pos ($s) = 0;
  my $line = 1;
  my $column = 0;

  my $_onerror = $self->{onerror};
  my $onerror = sub {
    $_onerror->(@_, line => $line, column => $column);
  };
  
  my $tt = Whatpm::CSS::Tokenizer->new;
  $tt->{onerror} = $onerror;
  $tt->{get_char} = sub {
    if (pos $s < length $s) {
      my $c = ord substr $s, pos ($s)++, 1;
      if ($c == 0x000A) {
        $line++;
        $column = 0;
      } elsif ($c == 0x000D) {
        unless (substr ($s, pos ($s), 1) eq "\x0A") {
          $line++;
          $column = 0;
        } else {
          $column++;
        }
      } else {
        $column++;
      }
      return $c;
    } else {
      return -1;
    }
  }; # $tt->{get_char}
  $tt->init;

  my $sp = Whatpm::CSS::SelectorsParser->new;
  $sp->{onerror} = $onerror;
  $sp->{must_level} = $self->{must_level};
  $sp->{pseudo_element} = $self->{pseudo_element};
  $sp->{pseudo_class} = $self->{pseudo_class};

  my $nsmap = {};
  $sp->{lookup_namespace_uri} = sub {
    return $nsmap->{$_[0]}; # $_[0] is '' (default namespace) or prefix
  }; # $sp->{lookup_namespace_uri}

  ## TODO: Supported pseudo classes and elements...

  require Message::DOM::CSSStyleSheet;
  require Message::DOM::CSSRule;
  require Message::DOM::CSSStyleDeclaration;

  my $state = BEFORE_STATEMENT_STATE;
  my $t = $tt->get_next_token;

  my $open_rules = [[]];
  my $current_rules = $open_rules->[-1];
  my $current_decls;
  my $closing_tokens = [];
  my $charset_allowed = 1;
  my $namespace_allowed = 1;

  S: {
    if ($state == BEFORE_STATEMENT_STATE) {
      $t = $tt->get_next_token
          while $t->{type} == S_TOKEN or
              $t->{type} == CDO_TOKEN or
              $t->{type} == CDC_TOKEN;

      if ($t->{type} == ATKEYWORD_TOKEN) {
        if (lc $t->{value} eq 'namespace') { ## TODO: case folding
          $t = $tt->get_next_token;
          $t = $tt->get_next_token while $t->{type} == S_TOKEN;

          my $prefix;
          if ($t->{type} == IDENT_TOKEN) {
            $prefix = lc $t->{value};
            ## TODO: Unicode lowercase
            
            $t = $tt->get_next_token;
            $t = $tt->get_next_token while $t->{type} == S_TOKEN;
          }

          if ($t->{type} == STRING_TOKEN or $t->{type} == URI_TOKEN) {
            my $uri = $t->{value};
            
            $t = $tt->get_next_token;
            $t = $tt->get_next_token while $t->{type} == S_TOKEN;

            ## ISSUE: On handling of empty namespace URI, Firefox 2 and
            ## Opera 9 work differently (See SuikaWiki:namespace).
            ## TODO: We need to check what we do once it is specced.

            if ($t->{type} == SEMICOLON_TOKEN) {
              if ($namespace_allowed) {
                $nsmap->{defined $prefix ? $prefix : ''} = $uri;
                push @$current_rules,
                    Message::DOM::CSSNamespaceRule->____new ($prefix, $uri);
                undef $charset_allowed;
                undef $namespace_allowed;
              } else {
                $onerror->(type => 'at:namespace:not allowed',
                           level => $self->{must_level},
                           token => $t);
              }
              
              $t = $tt->get_next_token;
              ## Stay in the state.
              redo S;
            } else {
              #
            }
          } else {
            #
          }

          $onerror->(type => 'syntax error:at:namespace',
                     level => $self->{must_level},
                     token => $t);
          #
        } elsif (lc $t->{value} eq 'charset') { ## TODO: case folding
          $t = $tt->get_next_token;
          $t = $tt->get_next_token while $t->{type} == S_TOKEN;

          if ($t->{type} == STRING_TOKEN) {
            my $encoding = $t->{value};
            
            $t = $tt->get_next_token;
            $t = $tt->get_next_token while $t->{type} == S_TOKEN;
            
            if ($t->{type} == SEMICOLON_TOKEN) {
              if ($charset_allowed) {
                push @$current_rules,
                    Message::DOM::CSSCharsetRule->____new ($encoding);
                undef $charset_allowed;
              } else {
                 $onerror->(type => 'at:charset:not allowed',
                            level => $self->{must_level},
                            token => $t);
              }

              ## TODO: Detect the conformance errors for @charset...
              
              $t = $tt->get_next_token;
              ## Stay in the state.
              redo S;
            } else {
              #
            }
          } else {
            #
          }

          $onerror->(type => 'syntax error:at:charset',
                     level => $self->{must_level},
                     token => $t);
          #
        ## NOTE: When adding support for new at-rule, insert code
        ## "undef $charset_allowed" and "undef $namespace_token" as
        ## appropriate.
        } else {
          $onerror->(type => 'not supported:at:'.$t->{value},
                     level => $self->{unsupported_level},
                     token => $t);
        }

        $t = $tt->get_next_token;
        $state = IGNORED_STATEMENT_STATE;
        redo S;
      } elsif (@$open_rules > 1 and $t->{type} == RBRACE_TOKEN) {
        pop @$open_rules;
        ## Stay in the state.
        $t = $tt->get_next_token;
        redo S;
      } elsif ($t->{type} == EOF_TOKEN) {
        if (@$open_rules > 1) {
          $onerror->(type => 'syntax error:block not closed',
                     level => $self->{must_level},
                     token => $t);
        }

        last S;
      } else {
        undef $charset_allowed;
        undef $namespace_allowed;

        ($t, my $selectors) = $sp->_parse_selectors_with_tokenizer
            ($tt, LBRACE_TOKEN, $t);

        $t = $tt->get_next_token
            while $t->{type} != LBRACE_TOKEN and $t->{type} != EOF_TOKEN;

        if ($t->{type} == LBRACE_TOKEN) {
          $current_decls = Message::DOM::CSSStyleDeclaration->____new;
          my $rs = Message::DOM::CSSStyleRule->____new
              ($selectors, $current_decls);
          push @{$current_rules}, $rs if defined $selectors;

          $state = BEFORE_DECLARATION_STATE;
          $t = $tt->get_next_token;
          redo S;
        } else {
          $onerror->(type => 'syntax error:after selectors',
                     level => $self->{must_level},
                     token => $t);

          ## Stay in the state.
          $t = $tt->get_next_token;
          redo S;
        }
      }
    } elsif ($state == BEFORE_DECLARATION_STATE) {
      ## NOTE: DELIM? in declaration will be removed:
      ## <http://csswg.inkedblade.net/spec/css2.1?s=declaration%20delim#issue-2>.

      my $prop_def;
      my $prop_value;
      my $prop_flag;
      $t = $tt->get_next_token while $t->{type} == S_TOKEN;
      if ($t->{type} == IDENT_TOKEN) { # property
        my $prop_name = lc $t->{value}; ## TODO: case folding
        $t = $tt->get_next_token;
        if ($t->{type} == COLON_TOKEN) {
          $t = $tt->get_next_token;
          $t = $tt->get_next_token while $t->{type} == S_TOKEN;

          $prop_def = $Prop->{$prop_name};
          if ($prop_def and $self->{prop}->{$prop_name}) {
            ($t, $prop_value)
                = $prop_def->{parse}->($self, $prop_name, $tt, $t, $onerror);
            if ($prop_value) {
              ## NOTE: {parse} don't have to consume trailing spaces.
              $t = $tt->get_next_token while $t->{type} == S_TOKEN;

              if ($t->{type} == EXCLAMATION_TOKEN) {
                $t = $tt->get_next_token;
                $t = $tt->get_next_token while $t->{type} == S_TOKEN;
                if ($t->{type} == IDENT_TOKEN and
                    lc $t->{value} eq 'important') { ## TODO: case folding
                  $prop_flag = 'important';
                  
                  $t = $tt->get_next_token;
                  $t = $tt->get_next_token while $t->{type} == S_TOKEN;

                  #
                } else {
                  $onerror->(type => 'syntax error:important',
                             level => $self->{must_level},
                             token => $t);
                  
                  ## Reprocess.
                  $state = IGNORED_DECLARATION_STATE;
                  redo S;
                }
              }

              #
            } else {
              ## Syntax error.
        
              ## Reprocess.
              $state = IGNORED_DECLARATION_STATE;
              redo S;
            }
          } else {
            $onerror->(type => 'not supported:property',
                       level => $self->{unsupported_level},
                       token => $t, value => $prop_name);

            #
            $state = IGNORED_DECLARATION_STATE;
            redo S;
          }
        } else {
          $onerror->(type => 'syntax error:property colon',
                     level => $self->{must_level},
                     token => $t);

          #
          $state = IGNORED_DECLARATION_STATE;
          redo S;
        }
      }

      if ($t->{type} == RBRACE_TOKEN) {
        $t = $tt->get_next_token;
        $state = BEFORE_STATEMENT_STATE;
        #redo S;
      } elsif ($t->{type} == SEMICOLON_TOKEN) {
        $t = $tt->get_next_token;
        ## Stay in the state.
        #redo S;
      } elsif ($t->{type} == EOF_TOKEN) {
        $onerror->(type => 'syntax error:ruleset not closed',
                   level => $self->{must_level},
                   token => $t);
        ## Reprocess.
        $state = BEFORE_STATEMENT_STATE;
        #redo S;
      } else {
        if ($prop_value) {
          $onerror->(type => 'syntax error:property semicolon',
                     level => $self->{must_level},
                     token => $t);
        } else {
          $onerror->(type => 'syntax error:property name',
                     level => $self->{must_level},
                     token => $t);
        }

        #
        $state = IGNORED_DECLARATION_STATE;
        redo S;
      }

      my $important = (defined $prop_flag and $prop_flag eq 'important');
      for my $set_prop_name (keys %{$prop_value or {}}) {
        my $set_prop_def = $Prop->{$set_prop_name};
        $$current_decls->{$set_prop_def->{key}}
            = [$prop_value->{$set_prop_name}, $prop_flag]
            if $important or
                not $$current_decls->{$set_prop_def->{key}} or
                not defined $$current_decls->{$set_prop_def->{key}}->[1];
      }
      redo S;
    } elsif ($state == IGNORED_STATEMENT_STATE or
             $state == IGNORED_DECLARATION_STATE) {
      if (@$closing_tokens) { ## Something is yet in opening state.
        if ($t->{type} == EOF_TOKEN) {
          @$closing_tokens = ();
          ## Reprocess.
          $state = $state == IGNORED_STATEMENT_STATE
              ? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
          redo S;
        } elsif ($t->{type} == $closing_tokens->[-1]) {
          pop @$closing_tokens;
          if (@$closing_tokens == 0 and
              $t->{type} == RBRACE_TOKEN and
              $state == IGNORED_STATEMENT_STATE) {
            $t = $tt->get_next_token;
            $state = BEFORE_STATEMENT_STATE;
            redo S;
          } else {
            $t = $tt->get_next_token;
            ## Stay in the state.
            redo S;
          }
        } else {
          #
        }
      } else {
        if ($t->{type} == SEMICOLON_TOKEN) {
          $t = $tt->get_next_token;
          $state = $state == IGNORED_STATEMENT_STATE
              ? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
          redo S;
        } elsif ($state == IGNORED_DECLARATION_STATE and
                 $t->{type} == RBRACE_TOKEN) {
          $t = $tt->get_next_token;
          $state = BEFORE_STATEMENT_STATE;
          redo S;
        } elsif ($t->{type} == EOF_TOKEN) {
          ## Reprocess.
          $state = $state == IGNORED_STATEMENT_STATE
              ? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
          redo S;
        } else {
          #
        }
      }

      while (not {
        EOF_TOKEN, 1,
        RBRACE_TOKEN, 1,
        RBRACKET_TOKEN, 1,
        RPAREN_TOKEN, 1,
        SEMICOLON_TOKEN, 1,
      }->{$t->{type}}) {
        if ($t->{type} == LBRACE_TOKEN) {
          push @$closing_tokens, RBRACE_TOKEN;
        } elsif ($t->{type} == LBRACKET_TOKEN) {
          push @$closing_tokens, RBRACKET_TOKEN;
        } elsif ($t->{type} == LPAREN_TOKEN or $t->{type} == FUNCTION_TOKEN) {
          push @$closing_tokens, RPAREN_TOKEN;
        }

        $t = $tt->get_next_token;
      }

      #
      ## Stay in the state.
      redo S;
    } else {
      die "$0: parse_char_string: Unknown state: $state";
    }
  } # S

  my $ss = Message::DOM::CSSStyleSheet->____new
      (css_rules => $open_rules->[0],
       ## TODO: href
       ## TODO: owner_node
       ## TODO: media
       type => 'text/css', ## TODO: OK?
       _parser => $self);
  return $ss;
} # parse_char_string

$Prop->{color} = {
  css => 'color',
  dom => 'color',
  key => 'color',
  parse => sub {
    my ($self, $prop_name, $tt, $t, $onerror) = @_;

    if ($t->{type} == IDENT_TOKEN) {
      if (lc $t->{value} eq 'blue') { ## TODO: case folding
        $t = $tt->get_next_token;
        return ($t, {$prop_name => ["RGBA", 0, 0, 255, 1]});
      } else {
        #
      }
    } else {
      #
    }

    $onerror->(type => 'syntax error:color',
               level => $self->{must_level},
               token => $t);
    
    return ($t, undef);
  },
  serialize => sub {
    my ($self, $prop_name, $value) = @_;
    if ($value->[0] eq 'RGBA') { ## TODO: %d? %f?
      return sprintf 'rgba(%d, %d, %d, %f)', @$value[1, 2, 3, 4];
    } else {
      return undef;
    }
  },
};
$Attr->{color} = $Prop->{color};
$Key->{color} = $Prop->{color};

my $one_keyword_parser = sub {
  my ($self, $prop_name, $tt, $t, $onerror) = @_;

  if ($t->{type} == IDENT_TOKEN) {
    my $prop_value = lc $t->{value}; ## TODO: case folding
    $t = $tt->get_next_token;
    if ($Prop->{$prop_name}->{keyword}->{$prop_value} and
        $self->{prop_value}->{$prop_name}->{$prop_value}) {
      return ($t, {$prop_name => ["KEYWORD", $prop_value]});
    } elsif ($prop_value eq 'inherit') {
      return ($t, {$prop_name => ["KEYWORD", $prop_value]});
    }
  }
  
  $onerror->(type => 'syntax error:keyword:'.$prop_name,
             level => $self->{must_level},
             token => $t);
  return ($t, undef);
};

my $one_keyword_serializer = sub {
  my ($self, $prop_name, $value) = @_;
  if ($value->[0] eq 'KEYWORD') {
    return $value->[1];
  } else {
    return undef;
  }
};

$Prop->{display} = {
  css => 'display',
  dom => 'display',
  key => 'display',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => {
    block => 1, inline => 1, 'inline-block' => 1, 'inline-table' => 1,
    'list-item' => 1, none => 1,
    table => 1, 'table-caption' => 1, 'table-cell' => 1, 'table-column' => 1,
    'table-column-group' => 1, 'table-header-group' => 1,
    'table-footer-group' => 1, 'table-row' => 1, 'table-row-group' => 1,
  },
};
$Attr->{display} = $Prop->{display};
$Key->{display} = $Prop->{display};

$Prop->{position} = {
  css => 'position',
  dom => 'position',
  key => 'position',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => {
    static => 1, relative => 1, absolute => 1, fixed => 1,
  },
};
$Attr->{position} = $Prop->{position};
$Key->{position} = $Prop->{position};

$Prop->{float} = {
  css => 'float',
  dom => 'css_float',
  key => 'float',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => {
    left => 1, right => 1, none => 1,
  },
};
$Attr->{css_float} = $Prop->{float};
$Attr->{style_float} = $Prop->{float}; ## NOTE: IEism
$Key->{float} = $Prop->{float};

$Prop->{clear} = {
  css => 'clear',
  dom => 'clear',
  key => 'clear',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => {
    left => 1, right => 1, none => 1, both => 1,
  },
};
$Attr->{clear} = $Prop->{clear};
$Key->{clear} = $Prop->{clear};

$Prop->{direction} = {
  css => 'direction',
  dom => 'direction',
  key => 'direction',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => {
    ltr => 1, rtl => 1,
  },
};
$Attr->{direction} = $Prop->{direction};
$Key->{direction} = $Prop->{direction};

$Prop->{'unicode-bidi'} = {
  css => 'unicode-bidi',
  dom => 'unicode_bidi',
  key => 'unicode_bidi',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => {
    normal => 1, embed => 1, 'bidi-override' => 1,
  },
};
$Attr->{unicode_bidi} = $Prop->{'unicode-bidi'};
$Key->{unicode_bidi} = $Prop->{'unicode-bidi'};

my $border_style_keyword = {
  none => 1, hidden => 1, dotted => 1, dashed => 1, solid => 1,
  double => 1, groove => 1, ridge => 1, inset => 1, outset => 1,
};

$Prop->{'border-top-style'} = {
  css => 'border-top-style',
  dom => 'border_top_style',
  key => 'border_top_style',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => $border_style_keyword,
};
$Attr->{border_top_style} = $Prop->{'border-top-style'};
$Key->{border_top_style} = $Prop->{'border-top-style'};

$Prop->{'border-right-style'} = {
  css => 'border-right-style',
  dom => 'border_right_style',
  key => 'border_right_style',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => $border_style_keyword,
};
$Attr->{border_right_style} = $Prop->{'border-right-style'};
$Key->{border_right_style} = $Prop->{'border-right-style'};

$Prop->{'border-bottom-style'} = {
  css => 'border-bottom-style',
  dom => 'border_bottom_style',
  key => 'border_bottom_style',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => $border_style_keyword,
};
$Attr->{border_bottom_style} = $Prop->{'border-bottom-style'};
$Key->{border_bottom_style} = $Prop->{'border-bottom-style'};

$Prop->{'border-left-style'} = {
  css => 'border-left-style',
  dom => 'border_left_style',
  key => 'border_left_style',
  parse => $one_keyword_parser,
  serialize => $one_keyword_serializer,
  keyword => $border_style_keyword,
};
$Attr->{border_left_style} = $Prop->{'border-left-style'};
$Key->{border_left_style} = $Prop->{'border-left-style'};

$Prop->{'border-style'} = {
  css => 'border-style',
  dom => 'border_style',
  parse => sub {
    my ($self, $prop_name, $tt, $t, $onerror) = @_;

    my %prop_value;
    my $has_inherit;
    if ($t->{type} == IDENT_TOKEN) {
      my $prop_value = lc $t->{value}; ## TODO: case folding
      $t = $tt->get_next_token;
      if ($border_style_keyword->{$prop_value} and
          $self->{prop_value}->{'border-top-style'}->{$prop_value}) {
        $prop_value{'border-top-style'} = ["KEYWORD", $prop_value];
      } elsif ($prop_value eq 'inherit') {
        $prop_value{'border-top-style'} = ["KEYWORD", $prop_value];
        $has_inherit = 1;
      } else {
        $onerror->(type => 'syntax error:keyword:'.$prop_name,
                   level => $self->{must_level},
                   token => $t);
        return ($t, undef);
      }
      $prop_value{'border-right-style'} = $prop_value{'border-top-style'};
      $prop_value{'border-bottom-style'} = $prop_value{'border-top-style'};
      $prop_value{'border-left-style'} = $prop_value{'border-right-style'};
    } else {
      $onerror->(type => 'syntax error:keyword:'.$prop_name,
                 level => $self->{must_level},
                 token => $t);
      return ($t, undef);
    }

    $t = $tt->get_next_token while $t->{type} == S_TOKEN;
    if ($t->{type} == IDENT_TOKEN) {
      my $prop_value = lc $t->{value}; ## TODO: case folding
      $t = $tt->get_next_token;
      if (not $has_inherit and
          $border_style_keyword->{$prop_value} and
          $self->{prop_value}->{'border-right-style'}->{$prop_value}) {
        $prop_value{'border-right-style'} = ["KEYWORD", $prop_value];
      } else {
        $onerror->(type => 'syntax error:keyword:'.$prop_name,
                   level => $self->{must_level},
                   token => $t);
        return ($t, undef);
      }
      $prop_value{'border-left-style'} = $prop_value{'border-right-style'};

      $t = $tt->get_next_token while $t->{type} == S_TOKEN;
      if ($t->{type} == IDENT_TOKEN) {
        my $prop_value = lc $t->{value}; ## TODO: case folding
        $t = $tt->get_next_token;
        if ($border_style_keyword->{$prop_value} and
            $self->{prop_value}->{'border-bottom-style'}->{$prop_value}) {
          $prop_value{'border-bottom-style'} = ["KEYWORD", $prop_value];
        } else {
          $onerror->(type => 'syntax error:keyword:'.$prop_name,
                     level => $self->{must_level},
                     token => $t);
          return ($t, undef);
        }
        
        $t = $tt->get_next_token while $t->{type} == S_TOKEN;
        if ($t->{type} == IDENT_TOKEN) {
          my $prop_value = lc $t->{value}; ## TODO: case folding
          $t = $tt->get_next_token;
          if ($border_style_keyword->{$prop_value} and
              $self->{prop_value}->{'border-left-style'}->{$prop_value}) {
            $prop_value{'border-left-style'} = ["KEYWORD", $prop_value];
          } else {
            $onerror->(type => 'syntax error:keyword:'.$prop_name,
                       level => $self->{must_level},
                       token => $t);
            return ($t, undef);
          }
        }
      }
    }        

    return ($t, \%prop_value);
  },
  serialize => sub {
    my ($self, $prop_name, $value) = @_;
    
    local $Error::Depth = $Error::Depth + 1;
    my @v;
    push @v, $self->border_top_style;
    return undef unless defined $v[-1];
    push @v, $self->border_right_style;
    return undef unless defined $v[-1];
    push @v, $self->border_bottom_style;
    return undef unless defined $v[-1];
    push @v, $self->border_bottom_style;
    return undef unless defined $v[-1];

    pop @v if $v[1] eq $v[3];
    pop @v if $v[0] eq $v[2];
    pop @v if $v[0] eq $v[1];
    return join ' ', @v;
  },
};
$Attr->{border_style} = $Prop->{'border-style'};

1;
## $Date: 2007/12/31 07:26:35 $
1	package Whatpm::CSS::Parser;
2	use strict;
3	use Whatpm::CSS::Tokenizer qw(:token);
4	require Whatpm::CSS::SelectorsParser;
5
6	sub new ($) {
7	my $self = bless {onerror => sub { }, must_level => 'm',
8	message_level => 'w',
9	unsupported_level => 'unsupported'}, shift;
10
11	return $self;
12	} # new
13
14	sub BEFORE_STATEMENT_STATE () { 0 }
15	sub BEFORE_DECLARATION_STATE () { 1 }
16	sub IGNORED_STATEMENT_STATE () { 2 }
17	sub IGNORED_DECLARATION_STATE () { 3 }
18
19	our $Prop; ## By CSS property name
20	our $Attr; ## By CSSOM attribute name
21	our $Key; ## By internal key
22
23	sub parse_char_string ($$) {
24	my $self = $_[0];
25
26	my $s = $_[1];
27	pos ($s) = 0;
28	my $line = 1;
29	my $column = 0;
30
31	my $_onerror = $self->{onerror};
32	my $onerror = sub {
33	$_onerror->(@_, line => $line, column => $column);
34	};
35
36	my $tt = Whatpm::CSS::Tokenizer->new;
37	$tt->{onerror} = $onerror;
38	$tt->{get_char} = sub {
39	if (pos $s < length $s) {
40	my $c = ord substr $s, pos ($s)++, 1;
41	if ($c == 0x000A) {
42	$line++;
43	$column = 0;
44	} elsif ($c == 0x000D) {
45	unless (substr ($s, pos ($s), 1) eq "\x0A") {
46	$line++;
47	$column = 0;
48	} else {
49	$column++;
50	}
51	} else {
52	$column++;
53	}
54	return $c;
55	} else {
56	return -1;
57	}
58	}; # $tt->{get_char}
59	$tt->init;
60
61	my $sp = Whatpm::CSS::SelectorsParser->new;
62	$sp->{onerror} = $onerror;
63	$sp->{must_level} = $self->{must_level};
64	$sp->{pseudo_element} = $self->{pseudo_element};
65	$sp->{pseudo_class} = $self->{pseudo_class};
66
67	my $nsmap = {};
68	$sp->{lookup_namespace_uri} = sub {
69	return $nsmap->{$_[0]}; # $_[0] is '' (default namespace) or prefix
70	}; # $sp->{lookup_namespace_uri}
71
72	## TODO: Supported pseudo classes and elements...
73
74	require Message::DOM::CSSStyleSheet;
75	require Message::DOM::CSSRule;
76	require Message::DOM::CSSStyleDeclaration;
77
78	my $state = BEFORE_STATEMENT_STATE;
79	my $t = $tt->get_next_token;
80
81	my $open_rules = [[]];
82	my $current_rules = $open_rules->[-1];
83	my $current_decls;
84	my $closing_tokens = [];
85	my $charset_allowed = 1;
86	my $namespace_allowed = 1;
87
88	S: {
89	if ($state == BEFORE_STATEMENT_STATE) {
90	$t = $tt->get_next_token
91	while $t->{type} == S_TOKEN or
92	$t->{type} == CDO_TOKEN or
93	$t->{type} == CDC_TOKEN;
94
95	if ($t->{type} == ATKEYWORD_TOKEN) {
96	if (lc $t->{value} eq 'namespace') { ## TODO: case folding
97	$t = $tt->get_next_token;
98	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
99
100	my $prefix;
101	if ($t->{type} == IDENT_TOKEN) {
102	$prefix = lc $t->{value};
103	## TODO: Unicode lowercase
104
105	$t = $tt->get_next_token;
106	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
107	}
108
109	if ($t->{type} == STRING_TOKEN or $t->{type} == URI_TOKEN) {
110	my $uri = $t->{value};
111
112	$t = $tt->get_next_token;
113	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
114
115	## ISSUE: On handling of empty namespace URI, Firefox 2 and
116	## Opera 9 work differently (See SuikaWiki:namespace).
117	## TODO: We need to check what we do once it is specced.
118
119	if ($t->{type} == SEMICOLON_TOKEN) {
120	if ($namespace_allowed) {
121	$nsmap->{defined $prefix ? $prefix : ''} = $uri;
122	push @$current_rules,
123	Message::DOM::CSSNamespaceRule->____new ($prefix, $uri);
124	undef $charset_allowed;
125	undef $namespace_allowed;
126	} else {
127	$onerror->(type => 'at:namespace:not allowed',
128	level => $self->{must_level},
129	token => $t);
130	}
131
132	$t = $tt->get_next_token;
133	## Stay in the state.
134	redo S;
135	} else {
136	#
137	}
138	} else {
139	#
140	}
141
142	$onerror->(type => 'syntax error:at:namespace',
143	level => $self->{must_level},
144	token => $t);
145	#
146	} elsif (lc $t->{value} eq 'charset') { ## TODO: case folding
147	$t = $tt->get_next_token;
148	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
149
150	if ($t->{type} == STRING_TOKEN) {
151	my $encoding = $t->{value};
152
153	$t = $tt->get_next_token;
154	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
155
156	if ($t->{type} == SEMICOLON_TOKEN) {
157	if ($charset_allowed) {
158	push @$current_rules,
159	Message::DOM::CSSCharsetRule->____new ($encoding);
160	undef $charset_allowed;
161	} else {
162	$onerror->(type => 'at:charset:not allowed',
163	level => $self->{must_level},
164	token => $t);
165	}
166
167	## TODO: Detect the conformance errors for @charset...
168
169	$t = $tt->get_next_token;
170	## Stay in the state.
171	redo S;
172	} else {
173	#
174	}
175	} else {
176	#
177	}
178
179	$onerror->(type => 'syntax error:at:charset',
180	level => $self->{must_level},
181	token => $t);
182	#
183	## NOTE: When adding support for new at-rule, insert code
184	## "undef $charset_allowed" and "undef $namespace_token" as
185	## appropriate.
186	} else {
187	$onerror->(type => 'not supported:at:'.$t->{value},
188	level => $self->{unsupported_level},
189	token => $t);
190	}
191
192	$t = $tt->get_next_token;
193	$state = IGNORED_STATEMENT_STATE;
194	redo S;
195	} elsif (@$open_rules > 1 and $t->{type} == RBRACE_TOKEN) {
196	pop @$open_rules;
197	## Stay in the state.
198	$t = $tt->get_next_token;
199	redo S;
200	} elsif ($t->{type} == EOF_TOKEN) {
201	if (@$open_rules > 1) {
202	$onerror->(type => 'syntax error:block not closed',
203	level => $self->{must_level},
204	token => $t);
205	}
206
207	last S;
208	} else {
209	undef $charset_allowed;
210	undef $namespace_allowed;
211
212	($t, my $selectors) = $sp->_parse_selectors_with_tokenizer
213	($tt, LBRACE_TOKEN, $t);
214
215	$t = $tt->get_next_token
216	while $t->{type} != LBRACE_TOKEN and $t->{type} != EOF_TOKEN;
217
218	if ($t->{type} == LBRACE_TOKEN) {
219	$current_decls = Message::DOM::CSSStyleDeclaration->____new;
220	my $rs = Message::DOM::CSSStyleRule->____new
221	($selectors, $current_decls);
222	push @{$current_rules}, $rs if defined $selectors;
223
224	$state = BEFORE_DECLARATION_STATE;
225	$t = $tt->get_next_token;
226	redo S;
227	} else {
228	$onerror->(type => 'syntax error:after selectors',
229	level => $self->{must_level},
230	token => $t);
231
232	## Stay in the state.
233	$t = $tt->get_next_token;
234	redo S;
235	}
236	}
237	} elsif ($state == BEFORE_DECLARATION_STATE) {
238	## NOTE: DELIM? in declaration will be removed:
239	## <http://csswg.inkedblade.net/spec/css2.1?s=declaration%20delim#issue-2>.
240
241	my $prop_def;
242	my $prop_value;
243	my $prop_flag;
244	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
245	if ($t->{type} == IDENT_TOKEN) { # property
246	my $prop_name = lc $t->{value}; ## TODO: case folding
247	$t = $tt->get_next_token;
248	if ($t->{type} == COLON_TOKEN) {
249	$t = $tt->get_next_token;
250	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
251
252	$prop_def = $Prop->{$prop_name};
253	if ($prop_def and $self->{prop}->{$prop_name}) {
254	($t, $prop_value)
255	= $prop_def->{parse}->($self, $prop_name, $tt, $t, $onerror);
256	if ($prop_value) {
257	## NOTE: {parse} don't have to consume trailing spaces.
258	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
259
260	if ($t->{type} == EXCLAMATION_TOKEN) {
261	$t = $tt->get_next_token;
262	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
263	if ($t->{type} == IDENT_TOKEN and
264	lc $t->{value} eq 'important') { ## TODO: case folding
265	$prop_flag = 'important';
266
267	$t = $tt->get_next_token;
268	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
269
270	#
271	} else {
272	$onerror->(type => 'syntax error:important',
273	level => $self->{must_level},
274	token => $t);
275
276	## Reprocess.
277	$state = IGNORED_DECLARATION_STATE;
278	redo S;
279	}
280	}
281
282	#
283	} else {
284	## Syntax error.
285
286	## Reprocess.
287	$state = IGNORED_DECLARATION_STATE;
288	redo S;
289	}
290	} else {
291	$onerror->(type => 'not supported:property',
292	level => $self->{unsupported_level},
293	token => $t, value => $prop_name);
294
295	#
296	$state = IGNORED_DECLARATION_STATE;
297	redo S;
298	}
299	} else {
300	$onerror->(type => 'syntax error:property colon',
301	level => $self->{must_level},
302	token => $t);
303
304	#
305	$state = IGNORED_DECLARATION_STATE;
306	redo S;
307	}
308	}
309
310	if ($t->{type} == RBRACE_TOKEN) {
311	$t = $tt->get_next_token;
312	$state = BEFORE_STATEMENT_STATE;
313	#redo S;
314	} elsif ($t->{type} == SEMICOLON_TOKEN) {
315	$t = $tt->get_next_token;
316	## Stay in the state.
317	#redo S;
318	} elsif ($t->{type} == EOF_TOKEN) {
319	$onerror->(type => 'syntax error:ruleset not closed',
320	level => $self->{must_level},
321	token => $t);
322	## Reprocess.
323	$state = BEFORE_STATEMENT_STATE;
324	#redo S;
325	} else {
326	if ($prop_value) {
327	$onerror->(type => 'syntax error:property semicolon',
328	level => $self->{must_level},
329	token => $t);
330	} else {
331	$onerror->(type => 'syntax error:property name',
332	level => $self->{must_level},
333	token => $t);
334	}
335
336	#
337	$state = IGNORED_DECLARATION_STATE;
338	redo S;
339	}
340
341	my $important = (defined $prop_flag and $prop_flag eq 'important');
342	for my $set_prop_name (keys %{$prop_value or {}}) {
343	my $set_prop_def = $Prop->{$set_prop_name};
344	$$current_decls->{$set_prop_def->{key}}
345	= [$prop_value->{$set_prop_name}, $prop_flag]
346	if $important or
347	not $$current_decls->{$set_prop_def->{key}} or
348	not defined $$current_decls->{$set_prop_def->{key}}->[1];
349	}
350	redo S;
351	} elsif ($state == IGNORED_STATEMENT_STATE or
352	$state == IGNORED_DECLARATION_STATE) {
353	if (@$closing_tokens) { ## Something is yet in opening state.
354	if ($t->{type} == EOF_TOKEN) {
355	@$closing_tokens = ();
356	## Reprocess.
357	$state = $state == IGNORED_STATEMENT_STATE
358	? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
359	redo S;
360	} elsif ($t->{type} == $closing_tokens->[-1]) {
361	pop @$closing_tokens;
362	if (@$closing_tokens == 0 and
363	$t->{type} == RBRACE_TOKEN and
364	$state == IGNORED_STATEMENT_STATE) {
365	$t = $tt->get_next_token;
366	$state = BEFORE_STATEMENT_STATE;
367	redo S;
368	} else {
369	$t = $tt->get_next_token;
370	## Stay in the state.
371	redo S;
372	}
373	} else {
374	#
375	}
376	} else {
377	if ($t->{type} == SEMICOLON_TOKEN) {
378	$t = $tt->get_next_token;
379	$state = $state == IGNORED_STATEMENT_STATE
380	? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
381	redo S;
382	} elsif ($state == IGNORED_DECLARATION_STATE and
383	$t->{type} == RBRACE_TOKEN) {
384	$t = $tt->get_next_token;
385	$state = BEFORE_STATEMENT_STATE;
386	redo S;
387	} elsif ($t->{type} == EOF_TOKEN) {
388	## Reprocess.
389	$state = $state == IGNORED_STATEMENT_STATE
390	? BEFORE_STATEMENT_STATE : BEFORE_DECLARATION_STATE;
391	redo S;
392	} else {
393	#
394	}
395	}
396
397	while (not {
398	EOF_TOKEN, 1,
399	RBRACE_TOKEN, 1,
400	RBRACKET_TOKEN, 1,
401	RPAREN_TOKEN, 1,
402	SEMICOLON_TOKEN, 1,
403	}->{$t->{type}}) {
404	if ($t->{type} == LBRACE_TOKEN) {
405	push @$closing_tokens, RBRACE_TOKEN;
406	} elsif ($t->{type} == LBRACKET_TOKEN) {
407	push @$closing_tokens, RBRACKET_TOKEN;
408	} elsif ($t->{type} == LPAREN_TOKEN or $t->{type} == FUNCTION_TOKEN) {
409	push @$closing_tokens, RPAREN_TOKEN;
410	}
411
412	$t = $tt->get_next_token;
413	}
414
415	#
416	## Stay in the state.
417	redo S;
418	} else {
419	die "$0: parse_char_string: Unknown state: $state";
420	}
421	} # S
422
423	my $ss = Message::DOM::CSSStyleSheet->____new
424	(css_rules => $open_rules->[0],
425	## TODO: href
426	## TODO: owner_node
427	## TODO: media
428	type => 'text/css', ## TODO: OK?
429	_parser => $self);
430	return $ss;
431	} # parse_char_string
432
433	$Prop->{color} = {
434	css => 'color',
435	dom => 'color',
436	key => 'color',
437	parse => sub {
438	my ($self, $prop_name, $tt, $t, $onerror) = @_;
439
440	if ($t->{type} == IDENT_TOKEN) {
441	if (lc $t->{value} eq 'blue') { ## TODO: case folding
442	$t = $tt->get_next_token;
443	return ($t, {$prop_name => ["RGBA", 0, 0, 255, 1]});
444	} else {
445	#
446	}
447	} else {
448	#
449	}
450
451	$onerror->(type => 'syntax error:color',
452	level => $self->{must_level},
453	token => $t);
454
455	return ($t, undef);
456	},
457	serialize => sub {
458	my ($self, $prop_name, $value) = @_;
459	if ($value->[0] eq 'RGBA') { ## TODO: %d? %f?
460	return sprintf 'rgba(%d, %d, %d, %f)', @$value[1, 2, 3, 4];
461	} else {
462	return undef;
463	}
464	},
465	};
466	$Attr->{color} = $Prop->{color};
467	$Key->{color} = $Prop->{color};
468
469	my $one_keyword_parser = sub {
470	my ($self, $prop_name, $tt, $t, $onerror) = @_;
471
472	if ($t->{type} == IDENT_TOKEN) {
473	my $prop_value = lc $t->{value}; ## TODO: case folding
474	$t = $tt->get_next_token;
475	if ($Prop->{$prop_name}->{keyword}->{$prop_value} and
476	$self->{prop_value}->{$prop_name}->{$prop_value}) {
477	return ($t, {$prop_name => ["KEYWORD", $prop_value]});
478	} elsif ($prop_value eq 'inherit') {
479	return ($t, {$prop_name => ["KEYWORD", $prop_value]});
480	}
481	}
482
483	$onerror->(type => 'syntax error:keyword:'.$prop_name,
484	level => $self->{must_level},
485	token => $t);
486	return ($t, undef);
487	};
488
489	my $one_keyword_serializer = sub {
490	my ($self, $prop_name, $value) = @_;
491	if ($value->[0] eq 'KEYWORD') {
492	return $value->[1];
493	} else {
494	return undef;
495	}
496	};
497
498	$Prop->{display} = {
499	css => 'display',
500	dom => 'display',
501	key => 'display',
502	parse => $one_keyword_parser,
503	serialize => $one_keyword_serializer,
504	keyword => {
505	block => 1, inline => 1, 'inline-block' => 1, 'inline-table' => 1,
506	'list-item' => 1, none => 1,
507	table => 1, 'table-caption' => 1, 'table-cell' => 1, 'table-column' => 1,
508	'table-column-group' => 1, 'table-header-group' => 1,
509	'table-footer-group' => 1, 'table-row' => 1, 'table-row-group' => 1,
510	},
511	};
512	$Attr->{display} = $Prop->{display};
513	$Key->{display} = $Prop->{display};
514
515	$Prop->{position} = {
516	css => 'position',
517	dom => 'position',
518	key => 'position',
519	parse => $one_keyword_parser,
520	serialize => $one_keyword_serializer,
521	keyword => {
522	static => 1, relative => 1, absolute => 1, fixed => 1,
523	},
524	};
525	$Attr->{position} = $Prop->{position};
526	$Key->{position} = $Prop->{position};
527
528	$Prop->{float} = {
529	css => 'float',
530	dom => 'css_float',
531	key => 'float',
532	parse => $one_keyword_parser,
533	serialize => $one_keyword_serializer,
534	keyword => {
535	left => 1, right => 1, none => 1,
536	},
537	};
538	$Attr->{css_float} = $Prop->{float};
539	$Attr->{style_float} = $Prop->{float}; ## NOTE: IEism
540	$Key->{float} = $Prop->{float};
541
542	$Prop->{clear} = {
543	css => 'clear',
544	dom => 'clear',
545	key => 'clear',
546	parse => $one_keyword_parser,
547	serialize => $one_keyword_serializer,
548	keyword => {
549	left => 1, right => 1, none => 1, both => 1,
550	},
551	};
552	$Attr->{clear} = $Prop->{clear};
553	$Key->{clear} = $Prop->{clear};
554
555	$Prop->{direction} = {
556	css => 'direction',
557	dom => 'direction',
558	key => 'direction',
559	parse => $one_keyword_parser,
560	serialize => $one_keyword_serializer,
561	keyword => {
562	ltr => 1, rtl => 1,
563	},
564	};
565	$Attr->{direction} = $Prop->{direction};
566	$Key->{direction} = $Prop->{direction};
567
568	$Prop->{'unicode-bidi'} = {
569	css => 'unicode-bidi',
570	dom => 'unicode_bidi',
571	key => 'unicode_bidi',
572	parse => $one_keyword_parser,
573	serialize => $one_keyword_serializer,
574	keyword => {
575	normal => 1, embed => 1, 'bidi-override' => 1,
576	},
577	};
578	$Attr->{unicode_bidi} = $Prop->{'unicode-bidi'};
579	$Key->{unicode_bidi} = $Prop->{'unicode-bidi'};
580
581	my $border_style_keyword = {
582	none => 1, hidden => 1, dotted => 1, dashed => 1, solid => 1,
583	double => 1, groove => 1, ridge => 1, inset => 1, outset => 1,
584	};
585
586	$Prop->{'border-top-style'} = {
587	css => 'border-top-style',
588	dom => 'border_top_style',
589	key => 'border_top_style',
590	parse => $one_keyword_parser,
591	serialize => $one_keyword_serializer,
592	keyword => $border_style_keyword,
593	};
594	$Attr->{border_top_style} = $Prop->{'border-top-style'};
595	$Key->{border_top_style} = $Prop->{'border-top-style'};
596
597	$Prop->{'border-right-style'} = {
598	css => 'border-right-style',
599	dom => 'border_right_style',
600	key => 'border_right_style',
601	parse => $one_keyword_parser,
602	serialize => $one_keyword_serializer,
603	keyword => $border_style_keyword,
604	};
605	$Attr->{border_right_style} = $Prop->{'border-right-style'};
606	$Key->{border_right_style} = $Prop->{'border-right-style'};
607
608	$Prop->{'border-bottom-style'} = {
609	css => 'border-bottom-style',
610	dom => 'border_bottom_style',
611	key => 'border_bottom_style',
612	parse => $one_keyword_parser,
613	serialize => $one_keyword_serializer,
614	keyword => $border_style_keyword,
615	};
616	$Attr->{border_bottom_style} = $Prop->{'border-bottom-style'};
617	$Key->{border_bottom_style} = $Prop->{'border-bottom-style'};
618
619	$Prop->{'border-left-style'} = {
620	css => 'border-left-style',
621	dom => 'border_left_style',
622	key => 'border_left_style',
623	parse => $one_keyword_parser,
624	serialize => $one_keyword_serializer,
625	keyword => $border_style_keyword,
626	};
627	$Attr->{border_left_style} = $Prop->{'border-left-style'};
628	$Key->{border_left_style} = $Prop->{'border-left-style'};
629
630	$Prop->{'border-style'} = {
631	css => 'border-style',
632	dom => 'border_style',
633	parse => sub {
634	my ($self, $prop_name, $tt, $t, $onerror) = @_;
635
636	my %prop_value;
637	my $has_inherit;
638	if ($t->{type} == IDENT_TOKEN) {
639	my $prop_value = lc $t->{value}; ## TODO: case folding
640	$t = $tt->get_next_token;
641	if ($border_style_keyword->{$prop_value} and
642	$self->{prop_value}->{'border-top-style'}->{$prop_value}) {
643	$prop_value{'border-top-style'} = ["KEYWORD", $prop_value];
644	} elsif ($prop_value eq 'inherit') {
645	$prop_value{'border-top-style'} = ["KEYWORD", $prop_value];
646	$has_inherit = 1;
647	} else {
648	$onerror->(type => 'syntax error:keyword:'.$prop_name,
649	level => $self->{must_level},
650	token => $t);
651	return ($t, undef);
652	}
653	$prop_value{'border-right-style'} = $prop_value{'border-top-style'};
654	$prop_value{'border-bottom-style'} = $prop_value{'border-top-style'};
655	$prop_value{'border-left-style'} = $prop_value{'border-right-style'};
656	} else {
657	$onerror->(type => 'syntax error:keyword:'.$prop_name,
658	level => $self->{must_level},
659	token => $t);
660	return ($t, undef);
661	}
662
663	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
664	if ($t->{type} == IDENT_TOKEN) {
665	my $prop_value = lc $t->{value}; ## TODO: case folding
666	$t = $tt->get_next_token;
667	if (not $has_inherit and
668	$border_style_keyword->{$prop_value} and
669	$self->{prop_value}->{'border-right-style'}->{$prop_value}) {
670	$prop_value{'border-right-style'} = ["KEYWORD", $prop_value];
671	} else {
672	$onerror->(type => 'syntax error:keyword:'.$prop_name,
673	level => $self->{must_level},
674	token => $t);
675	return ($t, undef);
676	}
677	$prop_value{'border-left-style'} = $prop_value{'border-right-style'};
678
679	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
680	if ($t->{type} == IDENT_TOKEN) {
681	my $prop_value = lc $t->{value}; ## TODO: case folding
682	$t = $tt->get_next_token;
683	if ($border_style_keyword->{$prop_value} and
684	$self->{prop_value}->{'border-bottom-style'}->{$prop_value}) {
685	$prop_value{'border-bottom-style'} = ["KEYWORD", $prop_value];
686	} else {
687	$onerror->(type => 'syntax error:keyword:'.$prop_name,
688	level => $self->{must_level},
689	token => $t);
690	return ($t, undef);
691	}
692
693	$t = $tt->get_next_token while $t->{type} == S_TOKEN;
694	if ($t->{type} == IDENT_TOKEN) {
695	my $prop_value = lc $t->{value}; ## TODO: case folding
696	$t = $tt->get_next_token;
697	if ($border_style_keyword->{$prop_value} and
698	$self->{prop_value}->{'border-left-style'}->{$prop_value}) {
699	$prop_value{'border-left-style'} = ["KEYWORD", $prop_value];
700	} else {
701	$onerror->(type => 'syntax error:keyword:'.$prop_name,
702	level => $self->{must_level},
703	token => $t);
704	return ($t, undef);
705	}
706	}
707	}
708	}
709
710	return ($t, \%prop_value);
711	},
712	serialize => sub {
713	my ($self, $prop_name, $value) = @_;
714
715	local $Error::Depth = $Error::Depth + 1;
716	my @v;
717	push @v, $self->border_top_style;
718	return undef unless defined $v[-1];
719	push @v, $self->border_right_style;
720	return undef unless defined $v[-1];
721	push @v, $self->border_bottom_style;
722	return undef unless defined $v[-1];
723	push @v, $self->border_bottom_style;
724	return undef unless defined $v[-1];
725
726	pop @v if $v[1] eq $v[3];
727	pop @v if $v[0] eq $v[2];
728	pop @v if $v[0] eq $v[1];
729	return join ' ', @v;
730	},
731	};
732	$Attr->{border_style} = $Prop->{'border-style'};
733
734	1;
735	## $Date: 2007/12/31 07:26:35 $