| 1 |
package Whatpm::CSS::Cascade; |
| 2 |
use strict; |
| 3 |
|
| 4 |
require Whatpm::CSS::Parser; ## NOTE: For property definitions. |
| 5 |
require Whatpm::CSS::SelectorsSerializer; |
| 6 |
use Scalar::Util qw/refaddr/; |
| 7 |
|
| 8 |
## Cascading and value computations |
| 9 |
|
| 10 |
sub new ($$) { |
| 11 |
my $self = bless {style_sheets => []}, shift; |
| 12 |
$self->{document} = shift; |
| 13 |
return $self; |
| 14 |
} # new |
| 15 |
|
| 16 |
## NOTE: This version does not support dynamic addition --- style |
| 17 |
## sheets must be added before any other operation. |
| 18 |
## NOTE: The $ss argument must be a value that can be interpreted as |
| 19 |
## an array reference of CSSStyleSheet objects. |
| 20 |
## NOTE: |type| and |media| attributes are not accounted by this |
| 21 |
## method (and any others in the class); CSSStyleSheet objects must |
| 22 |
## be filtered before they are passed to this method. |
| 23 |
sub add_style_sheets ($$) { |
| 24 |
my ($self, $ss) = @_; |
| 25 |
|
| 26 |
push @{$self->{style_sheets}}, @$ss; |
| 27 |
} # add_style_sheets |
| 28 |
|
| 29 |
## TODO: non-CSS presentation hints |
| 30 |
## TODO: style="" |
| 31 |
|
| 32 |
sub ___associate_rules ($) { |
| 33 |
my $self = shift; |
| 34 |
|
| 35 |
my $selectors_to_elements; |
| 36 |
|
| 37 |
for my $sheet (@{$self->{style_sheets}}) { |
| 38 |
## TODO: @media |
| 39 |
## TODO: @import |
| 40 |
## TODO: style sheet sources |
| 41 |
|
| 42 |
for my $rule (@{$sheet->css_rules}) { |
| 43 |
next if $rule->type != 1; # STYLE_RULE |
| 44 |
|
| 45 |
my $elements_to_specificity = {}; |
| 46 |
|
| 47 |
for my $selector (@{$$rule->{_selectors}}) { |
| 48 |
my $selector_str = Whatpm::CSS::SelectorsSerializer->serialize_test |
| 49 |
([$selector]); |
| 50 |
unless ($selectors_to_elements->{$selector_str}) { |
| 51 |
$selectors_to_elements->{$selector_str} |
| 52 |
= $self->{document}->___query_selector_all ([$selector]); |
| 53 |
} |
| 54 |
next unless @{$selectors_to_elements->{$selector_str}}; |
| 55 |
|
| 56 |
my $selector_specificity |
| 57 |
= Whatpm::CSS::SelectorsParser->get_selector_specificity |
| 58 |
($selector); |
| 59 |
for (@{$selectors_to_elements->{$selector_str}}) { |
| 60 |
my $current_specificity = $elements_to_specificity->{refaddr $_}; |
| 61 |
if ($selector_specificity->[0] > $current_specificity->[0] or |
| 62 |
$selector_specificity->[1] > $current_specificity->[1] or |
| 63 |
$selector_specificity->[2] > $current_specificity->[2] or |
| 64 |
$selector_specificity->[3] > $current_specificity->[3]) { |
| 65 |
$elements_to_specificity->{refaddr $_} = $selector_specificity; |
| 66 |
} |
| 67 |
} |
| 68 |
} |
| 69 |
|
| 70 |
my $sd = $rule->style; |
| 71 |
for (keys %$elements_to_specificity) { |
| 72 |
push @{$self->{element_to_sds}->{$_} ||= []}, |
| 73 |
[$sd, $elements_to_specificity->{$_}]; |
| 74 |
} |
| 75 |
} |
| 76 |
} |
| 77 |
|
| 78 |
for my $eid (keys %{$self->{element_to_sds} or {}}) { |
| 79 |
$self->{element_to_sds}->{$eid} = [sort { |
| 80 |
$a->[1]->[0] <=> $b->[1]->[0] or |
| 81 |
$a->[1]->[1] <=> $b->[1]->[1] or |
| 82 |
$a->[1]->[2] <=> $b->[1]->[2] or |
| 83 |
$a->[1]->[3] <=> $b->[1]->[3] |
| 84 |
## NOTE: Perl |sort| is stable. |
| 85 |
} @{$self->{element_to_sds}->{$eid} or []}]; |
| 86 |
} |
| 87 |
} # associate_rules |
| 88 |
|
| 89 |
sub get_cascaded_value ($$$) { |
| 90 |
my ($self, $element, $prop_name) = @_; |
| 91 |
return undef unless $Whatpm::CSS::Parser::Prop->{$prop_name}; |
| 92 |
|
| 93 |
my $key = $Whatpm::CSS::Parser::Prop->{$prop_name}->{key}; |
| 94 |
return undef unless defined $key; ## Shorthand property or some. |
| 95 |
|
| 96 |
my $value; |
| 97 |
for my $sds (reverse @{$self->{element_to_sds}->{refaddr $element} or []}) { |
| 98 |
my $vp = ${$sds->[0]}->{$key}; |
| 99 |
if (defined $vp->[1] and $vp->[1] eq 'important') { |
| 100 |
return $vp->[0]; |
| 101 |
} else { |
| 102 |
$value = $vp->[0] unless defined $value; |
| 103 |
} |
| 104 |
} |
| 105 |
|
| 106 |
return $value; # might be |undef|. |
| 107 |
} # get_cascaded_value |
| 108 |
|
| 109 |
sub get_specified_value ($$$) { |
| 110 |
my ($self, $element, $prop_name) = @_; |
| 111 |
|
| 112 |
## TODO: Remove {specified_value} caching, once we implement most |
| 113 |
## of CSS 2.1 properties and confirm that it makes almost non sence |
| 114 |
## because of its duplication with {computed_value} caching. |
| 115 |
|
| 116 |
my $eid = refaddr $element; |
| 117 |
unless (exists $self->{specified_value}->{$eid}->{$prop_name}) { |
| 118 |
my $cascaded = $self->get_cascaded_value ($element, $prop_name); |
| 119 |
$self->{specified_value}->{$eid}->{$prop_name} = $cascaded; |
| 120 |
|
| 121 |
unless (defined $cascaded) { |
| 122 |
my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name}; |
| 123 |
if (defined $prop_def) { |
| 124 |
if ($prop_def->{inherited}) { |
| 125 |
my $parent_element = $element->manakai_parent_element; |
| 126 |
if (defined $parent_element) { |
| 127 |
$self->{specified_value}->{$eid}->{$prop_name} |
| 128 |
= $self->get_computed_value ($parent_element, $prop_name); |
| 129 |
} else { |
| 130 |
$self->{specified_value}->{$eid}->{$prop_name} |
| 131 |
= $prop_def->{initial}; |
| 132 |
} |
| 133 |
} else { |
| 134 |
$self->{specified_value}->{$eid}->{$prop_name} |
| 135 |
= $prop_def->{initial}; |
| 136 |
} |
| 137 |
} else { |
| 138 |
$self->{specified_value}->{$eid}->{$prop_name} = undef; |
| 139 |
} |
| 140 |
} |
| 141 |
} |
| 142 |
|
| 143 |
## NOTE: Always |undef| for shorthand properties. |
| 144 |
|
| 145 |
return $self->{specified_value}->{$eid}->{$prop_name}; |
| 146 |
} # get_specified_value |
| 147 |
|
| 148 |
sub get_computed_value ($$$) { |
| 149 |
my ($self, $element, $prop_name) = @_; |
| 150 |
|
| 151 |
my $eid = refaddr $element; |
| 152 |
unless (exists $self->{computed_value}->{$eid}->{$prop_name}) { |
| 153 |
my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name}; |
| 154 |
if (defined $prop_def) { |
| 155 |
my $specified = $self->get_specified_value ($element, $prop_name); |
| 156 |
if (defined $specified and $specified->[0] eq 'INHERIT') { |
| 157 |
## ISSUE: CSS 2.1 does not say to resolve computed value of the parent. |
| 158 |
## However, it is necessary for some cases (see |
| 159 |
## <http://suika.fam.cx/gate/2005/sw/inherit>). In addition, |
| 160 |
## the initial value is not a computed value for some properties. |
| 161 |
my $parent_element = $element->manakai_parent_element; |
| 162 |
if (defined $parent_element) { |
| 163 |
$specified = $self->get_computed_value ($parent_element, $prop_name); |
| 164 |
} else { |
| 165 |
$specified = $prop_def->{compute}->($self, $element, $prop_name, |
| 166 |
$prop_def->{initial}); |
| 167 |
} |
| 168 |
## NOTE: Because of this handling, {compute} codes must be |
| 169 |
## idempotent. |
| 170 |
} |
| 171 |
|
| 172 |
$self->{computed_value}->{$eid}->{$prop_name} |
| 173 |
= $prop_def->{compute}->($self, $element, $prop_name, $specified); |
| 174 |
} else { |
| 175 |
$self->{computed_value}->{$eid}->{$prop_name} = undef; |
| 176 |
} |
| 177 |
} |
| 178 |
|
| 179 |
## NOTE: Always |undef| for shorthand properties. |
| 180 |
|
| 181 |
return $self->{computed_value}->{$eid}->{$prop_name}; |
| 182 |
} # get_computed_value |
| 183 |
|
| 184 |
1; |
| 185 |
## $Date: 2008/01/01 15:43:47 $ |
Parent Directory
| 
Revision Log