/[suikacvs]/messaging/manakai/lib/Message/DOM/CSSStyleDeclaration.pm
Suika

Diff of /messaging/manakai/lib/Message/DOM/CSSStyleDeclaration.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by wakaba, Fri Jan 4 14:45:29 2008 UTC revision 1.12 by wakaba, Mon Jan 14 13:56:35 2008 UTC
# Line 1  Line 1 
1  package Message::DOM::CSSStyleDeclaration;  package Message::DOM::CSSStyleDeclaration;
2  use strict;  use strict;
3  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  our $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
4  push our @ISA, 'Message::IF::CSSStyleDeclaration';  push our @ISA, 'Message::IF::CSSStyleDeclaration',
5        'Message::IF::CSS2Properties';
6    
7  sub ____new ($) {  sub ____new ($) {
8    return bless \{}, $_[0];    return bless \{}, $_[0];
# Line 25  sub AUTOLOAD { Line 26  sub AUTOLOAD {
26        if ($value) {        if ($value) {
27          return $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);          return $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);
28        } else {        } else {
29          return undef;          return "";
30        }        }
31        ## TODO: null? ""? ... if not set?        ## ISSUE: If one of shorthand component properties is !important?
32      };      };
33      goto &{ $AUTOLOAD };      goto &{ $AUTOLOAD };
34    } else {    } else {
# Line 36  sub AUTOLOAD { Line 37  sub AUTOLOAD {
37    }    }
38  } # AUTOLOAD  } # AUTOLOAD
39    
40    use overload
41        '@{}' => sub {
42          tie my @list, ref $_[0], $_[0];
43          return \@list;
44        },
45        fallback => 1;
46    
47    sub TIEARRAY ($$) { $_[1] }
48    
49  ## |CSSStyleDeclaration| attributes  ## |CSSStyleDeclaration| attributes
50    
51  sub css_text ($;$) {  sub css_text ($;$) {
52    ## TODO: setter    ## TODO: setter
53    
54      ## NOTE: Where and how white space characters are inserted are
55      ## intentionally changed from those in browsers so that properties are
56      ## more prettily printed.
57      ## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
58      ## TODO: Ordering issue.
59    require Whatpm::CSS::Parser;    require Whatpm::CSS::Parser;
60    my $self = $_[0];    my $self = $_[0];
61    my $r = '';    my $r = '';
62      my %serialized;
63    for (grep {$$self->{$_}} keys %$$self) {    for (grep {$$self->{$_}} keys %$$self) {
64      my $prop_def = $Whatpm::CSS::Parser::Key->{$_};      my $prop_def = $Whatpm::CSS::Parser::Key->{$_};
65      next unless $prop_def;      next unless $prop_def;
66      my $value = $$self->{$_};  
67      my $s = $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);      if ($prop_def->{serialize_multiple}) {
68      if (defined $s) {        unless ($serialized{$prop_def->{serialize_multiple}}) {
69        $r .= '  ' . $prop_def->{css} . ': ' . $s;          $serialized{$prop_def->{serialize_multiple}} = 1;
70        $r .= ' !' . $value->[1] if defined $value->[1];          my $v = $prop_def->{serialize_multiple}->($self);
71        $r .= ";\n";          for my $prop_name (sort {$a cmp $b} keys %$v) {
72              $r .= '  ' . $prop_name . ': ' . $v->{$prop_name} . ";\n"
73            }
74          }
75        } else {
76          my $value = $$self->{$_};
77          my $s = $prop_def->{serialize}->($self, $prop_def->{css}, $value->[0]);
78          if (length $s) {
79            $r .= '  ' . $prop_def->{css} . ': ' . $s;
80            $r .= ' ! ' . $value->[1] if length $value->[1];
81            $r .= ";\n";
82          }
83      }      }
84    }    }
   ## TODO: shorthands  
85    return $r;    return $r;
86  } # css_text  } # css_text
87    
88    sub length ($) {
89      require Whatpm::CSS::Parser;
90      return scalar @{[grep {$_}
91                       map { $Whatpm::CSS::Parser::Key->{$_} }
92                       keys %${$_[0]}]->[$_[1]]};
93    } # length
94    *FETCHSIZE = \&length;
95    
96    ## TODO: STORESIZE
97    
98  sub parent_rule ($) {  sub parent_rule ($) {
99    return ${$_[0]}->{parent_rule};    return ${$_[0]}->{parent_rule};
100  } # parent_rule  } # parent_rule
101    
102    ## |CSSStyleDeclaration| methods
103    
104    sub get_property_priority ($$) {
105      my $prop_name = ''.$_[1];
106    
107      require Whatpm::CSS::Parser;
108      my $prop_def = $Whatpm::CSS::Parser::Prop->{$prop_name};
109      return '' unless defined $prop_def;
110    
111      my $v = ${$_[0]}->{$prop_def->{key}};
112      return $v ? $v->[1] : '';
113    } # get_property_priority
114    
115    sub item ($$) {
116      require Whatpm::CSS::Parser;
117      return '' if $_[1] < 0;
118      ## TODO: ordering (should be same as that in |css_text|.
119      my $v = [map {$_->{key}}
120               grep {$_}
121               map { $Whatpm::CSS::Parser::Key->{$_} }
122               keys %${$_[0]}]->[$_[1]];
123      return defined $v ? $v : '';
124    } # item
125    *FETCH = \&item;
126    
127    ## TODO: STORE, DELETE
128    
129    sub EXISTS ($$) {
130      return length $_[0]->item;
131    } # EXISTS
132    
133  ## TODO: Implement other methods and attributes  ## TODO: Implement other methods and attributes
134    
135  package Message::DOM::CSSComputedStyleDeclaration;  package Message::DOM::CSSComputedStyleDeclaration;
136  push our @ISA, 'Message::IF::CSSStyleDeclaration';  push our @ISA, 'Message::IF::CSSStyleDeclaration',
137        'Message::IF::CSS2Properties';
138    
139  sub ____new ($$$) {  sub ____new ($$$) {
140    my $self = bless \{}, shift;    my $self = bless \{}, shift;
# Line 75  sub ____new ($$$) { Line 143  sub ____new ($$$) {
143    return $self;    return $self;
144  } # ____new  } # ____new
145    
146    sub AUTOLOAD {
147      my $method_name = our $AUTOLOAD;
148      $method_name =~ s/.*:://;
149      return if $method_name eq 'DESTROY';
150    
151      require Whatpm::CSS::Parser;
152      my $prop_def = $Whatpm::CSS::Parser::Attr->{$method_name};
153    
154      if ($prop_def) {
155        no strict 'refs';
156        *{ $method_name } = sub {
157          ## TODO: setter
158    
159          my $self = $_[0];
160          if ($prop_def->{compute} or $prop_def->{compute_multiple}) {
161            my $value = $$self->{cascade}->get_computed_value
162                ($$self->{element}, $prop_def->{css});
163            if ($value) {
164              return $prop_def->{serialize}->($self, $prop_def->{css}, $value);
165            } else {
166              return '';
167            }
168          } elsif ($prop_def->{serialize_multiple}) {
169            my $v = $prop_def->{serialize_multiple}->($self);
170            if (defined $v->{$prop_def->{css}}) {
171              return $v->{$prop_def->{css}};
172            } else {
173              return '';
174            }
175          } else {
176            ## TODO: This should be an error of the implementation.
177            ## However, currently some shorthand properties does not have
178            ## serializer.
179            ## TODO: Remove {serialize} from shorthand properties, since
180            ## they have no effect.
181            warn "$0: No computed value function for $method_name";
182            #die "$0: No computed value function for $method_name";
183          }
184        };
185        goto &{ $AUTOLOAD };
186      } else {
187        require Carp;
188        Carp::croak (qq<Can't locate method "$AUTOLOAD">);
189      }
190    } # AUTOLOAD
191    
192    use overload
193        '@{}' => sub {
194          tie my @list, ref $_[0], $_[0];
195          return \@list;
196        },
197        fallback => 1;
198    
199    sub TIEARRAY ($$) { $_[1] }
200    
201    ## |CSSStyleDeclaration| attributes
202    
203  sub css_text ($;$) {  sub css_text ($;$) {
204    ## TODO: error if modified    ## TODO: error if modified
205    
206    my $self = shift;    my $self = shift;
207    require Whatpm::CSS::Parser;    require Whatpm::CSS::Parser;
208    
209      ## NOTE: Where and how white space characters are inserted are
210      ## intentionally changed from those in browsers so that properties are
211      ## more prettily printed.
212      ## See <http://suika.fam.cx/gate/2005/sw/cssText> for what browsers do.
213    ## TODO: ordering    ## TODO: ordering
214    ## TODO: any spec?    ## TODO: any spec?
215    my $r = '';    my $r = '';
216      my %serialized;
217    for my $prop_def (sort {$a->{css} cmp $b->{css}}    for my $prop_def (sort {$a->{css} cmp $b->{css}}
218                      grep {$_->{compute} or $_->{compute_multiple}}                      grep {$_->{compute} or
219                              $_->{compute_multiple} or
220                              $_->{serialize_multiple}}
221                      values %$Whatpm::CSS::Parser::Prop) {                      values %$Whatpm::CSS::Parser::Prop) {
222      my $prop_value = $$self->{cascade}->get_computed_value      if ($prop_def->{serialize_multiple}) {
223          ($$self->{element}, $prop_def->{css});        unless ($serialized{$prop_def->{serialize_multiple}}) {
224      my $s = $prop_def->{serialize}->($self, $prop_def->{css}, $prop_value);          $serialized{$prop_def->{serialize_multiple}} = 1;
225      if (defined $s) {          my $v = $prop_def->{serialize_multiple}->($self);
226        $r .= '  ' . $prop_def->{css} . ': ' . $s;          for my $prop_name (sort {$a cmp $b} keys %$v) {
227        $r .= ";\n";            $r .= '  ' . $prop_name . ': ' . $v->{$prop_name} . ";\n"
228            }
229          }
230      } else {      } else {
231        ## NOTE: This should be an error of the implementation.        my $prop_value = $$self->{cascade}->get_computed_value
232        $r .= "  /* $prop_def->{css}: ???; */\n";            ($$self->{element}, $prop_def->{css});
233          my $s = $prop_def->{serialize}->($self, $prop_def->{css}, $prop_value);
234          if (length $s) {
235            $r .= '  ' . $prop_def->{css} . ': ' . $s;
236            $r .= ";\n";
237          } else {
238            ## NOTE: This should be an error of the implementation.
239            $r .= "  /* $prop_def->{css}: ???; */\n";
240          }
241      }      }
242    }    }
243    
# Line 104  sub css_text ($;$) { Line 246  sub css_text ($;$) {
246    return $r;    return $r;
247  } # css_text  } # css_text
248    
249    ## TODO: What should we enumerate is unclear.
250    sub length ($) {
251      require Whatpm::CSS::Parser;
252      return scalar @{[grep {$_}
253                       values %$Whatpm::CSS::Parser::Key]};
254    } # length
255    *FETCHSIZE = \&length;
256    
257    ## TODO: STORESIZE
258    
259    ## |CSSStyleDeclaration| methods
260    
261    sub get_property_priority ($$) { '' }
262    
263    sub item ($$) {
264      require Whatpm::CSS::Parser;
265      return '' if $_[1] < 0;
266      ## TODO: ordering (should be same as that in |css_text|.
267      my $v = [sort {$a cmp $b}
268               map {$_->{css}}
269               grep {$_}
270               values %$Whatpm::CSS::Parser::Key]->[$_[1]];
271      return defined $v ? $v : '';
272    } # item
273    *FETCH = \&item;
274    
275    ## TODO: STORE, DELETE
276    
277    sub EXISTS ($$) {
278      return length $_[0]->item;
279    } # EXISTS
280    
281  ## TODO: members  ## TODO: members
282    
283  package Message::IF::CSSStyleDeclaration;  package Message::IF::CSSStyleDeclaration;
284    package Message::IF::CSS2Properties;
285    
286  1;  1;
287  ## $Date$  ## $Date$
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.12
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24