/[suikacvs]/markup/html/whatpm/Whatpm/HTMLTable.pm
Suika

Contents of /markup/html/whatpm/Whatpm/HTMLTable.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (show annotations) (download)
Mon May 5 08:36:55 2008 UTC (18 years, 2 months ago) by wakaba
Branch: MAIN
Changes since 1.9: +31 -27 lines
++ whatpm/Whatpm/ChangeLog	5 May 2008 08:36:51 -0000
	* HTMLTable.pm: Robuster caption support (HTML5 revision 1393).

2008-05-05  Wakaba  <wakaba@suika.fam.cx>

1 package Whatpm::HTMLTable;
2 use strict;
3
4 ## An implementation of "Forming a table" algorithm in HTML5
5 sub form_table ($$$;$) {
6 my (undef, $table_el, $onerror, $must_level) = @_;
7 $onerror ||= sub { };
8 $must_level ||= 'm';
9
10 ## Step 1
11 my $x_width = 0;
12
13 ## Step 2
14 my $y_height = 0;
15 my $y_max_node;
16
17 ## Step 3
18 my $pending_tfoot = [];
19
20 ## Step 4
21 my $table = {
22 #caption
23 column => [],
24 column_group => [],
25 row => [], ## NOTE: HTML5 algorithm doesn't associate rows with <tr>s.
26 row_group => [],
27 cell => [],
28 };
29
30 my @column_has_anchored_cell;
31 my @row_has_anchored_cell;
32 my @column_generated_by;
33 my @row_generated_by;
34
35 ## Step 5
36 my @table_child = @{$table_el->child_nodes};
37 return $table unless @table_child;
38
39 ## Step 6
40 for (0..$#table_child) {
41 my $el = $table_child[$_];
42 next unless $el->node_type == 1; # ELEMENT_NODE
43 next unless $el->manakai_local_name eq 'caption';
44 my $nsuri = $el->namespace_uri;
45 next unless defined $nsuri;
46 next unless $nsuri eq q<http://www.w3.org/1999/xhtml>;
47 $table->{caption} = {element => $el};
48 splice @table_child, $_, 1, ();
49 last;
50 }
51
52 my $process_row_group;
53 my $end = sub {
54 ## Step 19 (End)
55 for (@$pending_tfoot) {
56 $process_row_group->($_);
57 }
58
59 ## Step 20
60 for (0 .. $x_width - 1) {
61 unless ($column_has_anchored_cell[$_]) {
62 if ($table->{column}->[$_]) {
63 $onerror->(type => 'column with no anchored cell',
64 node => $table->{column}->[$_]->{element},
65 level => $must_level);
66 } else {
67 $onerror->(type => 'colspan creates column with no anchored cell',
68 node => $column_generated_by[$_],
69 level => $must_level);
70 }
71 last; # only one error.
72 }
73 }
74 for (0 .. $y_height - 1) {
75 unless ($row_has_anchored_cell[$_]) {
76 if ($table->{row}->[$_]) {
77 $onerror->(type => 'row with no anchored cell',
78 node => $table->{row}->[$_]->{element},
79 level => $must_level);
80 } else {
81 $onerror->(type => 'rowspan creates row with no anchored cell',
82 node => $row_generated_by[$_],
83 level => $must_level);
84 }
85 last; # only one error.
86 }
87 }
88
89 ## Step 21
90 #return $table;
91 }; # $end
92
93 ## Step 7, 8
94 my $current_element;
95 my $current_ln;
96 NEXT_CHILD: {
97 $current_element = shift @table_child;
98 if (defined $current_element) {
99 redo NEXT_CHILD unless $current_element->node_type == 1;
100 my $nsuri = $current_element->namespace_uri;
101 redo NEXT_CHILD unless defined $nsuri and
102 $nsuri eq q<http://www.w3.org/1999/xhtml>;
103 $current_ln = $current_element->manakai_local_name;
104
105 redo NEXT_CHILD unless {
106 colgroup => 1,
107 thead => 1,
108 tbody => 1,
109 tfoot => 1,
110 tr => 1,
111 }->{$current_ln};
112 } else {
113 ## Step 6 2nd paragraph
114 $end->();
115 return $table;
116 }
117 } # NEXT_CHILD
118
119 ## Step 9
120 while ($current_ln eq 'colgroup') { # Step 9, Step 9.4
121 ## Step 9.1: column groups
122 my @col = grep {
123 $_->node_type == 1 and
124 defined $_->namespace_uri and
125 $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
126 $_->manakai_local_name eq 'col'
127 } @{$current_element->child_nodes};
128 if (@col) {
129 ## Step 1
130 my $x_start = $x_width;
131
132 ## Step 2, 6
133 while (@col) {
134 my $current_column = shift @col;
135
136 ## Step 3: columns
137 my $span = 1;
138 my $col_span = $current_column->get_attribute_ns (undef, 'span');
139 ## Parse non-negative integer
140 if (defined $col_span and $col_span =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
141 $span = $1 || 1;
142 }
143 ## ISSUE: If span=0, what is /span/ value?
144
145 ## Step 4, 5
146 $table->{column}->[++$x_width] = {element => $current_column}
147 for 1..$span;
148 }
149
150 ## Step 7
151 my $cg = {element => $current_element,
152 x => $x_start, y => 0,
153 width => $x_width - $x_start};
154 $table->{column_group}->[$_] = $cg for $x_start .. $x_width - 1;
155 } else { # no <col> children
156 ## Step 1
157 my $span = 1;
158 my $col_span = $current_element->get_attribute_ns (undef, 'span');
159 ## Parse non-negative integer
160 if (defined $col_span and $col_span =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
161 $span = $1 || 1;
162 }
163 ## ISSUE: If span=0, what is /span/ value?
164
165 ## Step 2
166 $x_width += $span;
167
168 ## Step 3
169 my $cg = {element => $current_element,
170 x => $x_width - $span, y => 0,
171 width => $span};
172 $table->{column_group}->[$_] = $cg for $cg->{x} .. $x_width - 1;
173 }
174
175 ## Step 9.2, 9.3
176 NEXT_CHILD: {
177 $current_element = shift @table_child;
178 if (defined $current_element) {
179 redo NEXT_CHILD unless $current_element->node_type == 1;
180 my $nsuri = $current_element->namespace_uri;
181 redo NEXT_CHILD unless defined $nsuri and
182 $nsuri eq q<http://www.w3.org/1999/xhtml>;
183 $current_ln = $current_element->manakai_local_name;
184
185 redo NEXT_CHILD unless {
186 colgroup => 1,
187 thead => 1,
188 tbody => 1,
189 tfoot => 1,
190 tr => 1,
191 }->{$current_ln};
192 } else {
193 ## End of subsection
194
195 ## Step 5 of overall steps 2nd paragraph
196 $end->();
197 return $table;
198 }
199 } # NEXT_CHILD
200 }
201
202 ## Step 10
203 my $y_current = 0;
204
205 ## Step 11
206 my @downward_growing_cells;
207
208 my $growing_downward_growing_cells = sub {
209 for (@downward_growing_cells) {
210 for my $x ($_->[1] .. ($_->[1] + $_->[2] - 1)) {
211 $table->{cell}->[$x]->[$y_current] = [$_->[0]];
212 $_->[0]->{height}++;
213 }
214 }
215 }; # $growing_downward_growing_cells
216
217 my $process_row = sub {
218 ## Step 1
219 $y_height++ if $y_height == $y_current;
220
221 ## Step 2
222 my $x_current = 0;
223
224 ## Step 3
225 my $tr = shift;
226 $table->{row}->[$y_current] = {element => $tr};
227 my @tdth = grep {
228 $_->node_type == 1 and
229 defined $_->namespace_uri and
230 $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
231 {td => 1, th => 1}->{$_->manakai_local_name}
232 } @{$tr->child_nodes};
233 my $current_cell = shift @tdth;
234
235 ## Step 4
236 $growing_downward_growing_cells->();
237
238 return unless $current_cell;
239 ## ISSUE: Support for empty <tr></tr> (removed at revision 1376).
240
241 CELL: while (1) {
242 ## Step 5: cells
243 $x_current++
244 while ($x_current < $x_width and
245 $table->{cell}->[$x_current]->[$y_current]);
246
247 ## Step 6
248 $x_width++ if $x_current == $x_width;
249
250 ## Step 7
251 my $colspan = 1;
252 my $attr_value = $current_cell->get_attribute_ns (undef, 'colspan');
253 if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
254 $colspan = $1 || 1;
255 }
256
257 ## Step 8
258 my $rowspan = 1;
259 my $attr_value = $current_cell->get_attribute_ns (undef, 'rowspan');
260 if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
261 $rowspan = $1;
262 }
263
264 ## Step 9
265 my $cell_grows_downward;
266 if ($rowspan == 0) {
267 $cell_grows_downward = 1;
268 $rowspan = 1;
269 }
270
271 ## Step 10
272 if ($x_width < $x_current + $colspan) {
273 @column_generated_by[$_] = $current_cell
274 for $x_width .. $x_current + $colspan - 1;
275 $x_width = $x_current + $colspan;
276 }
277
278 ## Step 11
279 if ($y_height < $y_current + $rowspan) {
280 @row_generated_by[$_] = $current_cell
281 for $y_height .. $y_current + $rowspan - 1;
282 $y_height = $y_current + $rowspan;
283 $y_max_node = $current_cell;
284 }
285
286 ## Step 12
287 my $cell = {
288 is_header => ($current_cell->manakai_local_name eq 'th'),
289 element => $current_cell,
290 x => $x_current, y => $y_current,
291 width => $colspan, height => $rowspan,
292 };
293 $column_has_anchored_cell[$x_current] = 1;
294 $row_has_anchored_cell[$y_current] = 1;
295 for my $x ($x_current .. ($x_current + $colspan - 1)) {
296 for my $y ($y_current .. ($y_current + $rowspan - 1)) {
297 unless ($table->{cell}->[$x]->[$y]) {
298 $table->{cell}->[$x]->[$y] = [$cell];
299 } else {
300 $onerror->(type => "cell overlapping:$x:$y", node => $current_cell,
301 level => $must_level);
302 push @{$table->{cell}->[$x]->[$y]}, $cell;
303 }
304 }
305 }
306
307 ## Step 13
308 if ($cell_grows_downward) {
309 push @downward_growing_cells, [$cell, $x_current, $colspan];
310 }
311
312 ## Step 14
313 $x_current += $colspan;
314
315 ## Step 15-17
316 $current_cell = shift @tdth;
317 if (defined $current_cell) {
318 ## Step 16-17
319 #
320 } else {
321 ## Step 15
322 $y_current++;
323 last CELL;
324 }
325 } # CELL
326 }; # $process_row
327
328 $process_row_group = sub ($) {
329 ## Step 1
330 my $y_start = $y_height;
331
332 ## Step 2
333 for (grep {
334 $_->node_type == 1 and
335 defined $_->namespace_uri and
336 $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
337 $_->manakai_local_name eq 'tr'
338 } @{$_[0]->child_nodes}) {
339 $process_row->($_);
340 }
341
342 ## Step 3
343 if ($y_height > $y_start) {
344 my $rg = {element => $current_element, ## ISSUE: "element being processed"?
345 x => 0, y => $y_start,
346 height => $y_height - $y_start};
347 $table->{row_group}->[$_] = $rg for $y_start .. $y_height - 1;
348 }
349
350 ## Step 4
351 ## Ending a row group
352 ## Step 1
353 while ($y_current < $y_height) {
354 ## Step 1
355 $growing_downward_growing_cells->();
356
357 ## Step 2
358 $y_current++;
359 }
360 ## Step 2
361 @downward_growing_cells = ();
362 }; # $process_row_group
363
364 ## Step 12: rows
365 unshift @table_child, $current_element;
366 ROWS: {
367 NEXT_CHILD: {
368 $current_element = shift @table_child;
369 if (defined $current_element) {
370 redo NEXT_CHILD unless $current_element->node_type == 1;
371 my $nsuri = $current_element->namespace_uri;
372 redo NEXT_CHILD unless defined $nsuri and
373 $nsuri eq q<http://www.w3.org/1999/xhtml>;
374 $current_ln = $current_element->manakai_local_name;
375
376 redo NEXT_CHILD unless {
377 thead => 1,
378 tbody => 1,
379 tfoot => 1,
380 tr => 1,
381 }->{$current_ln};
382 } else {
383 ## Step 6 2nd paragraph
384 $end->();
385 return $table;
386 }
387 } # NEXT_CHILD
388
389 ## Step 13
390 if ($current_ln eq 'tr') {
391 $process_row->($current_element);
392 # advance (done at the first of ROWS)
393 redo ROWS;
394 }
395
396 ## Step 14
397 ## Ending a row group
398 ## Step 1
399 while ($y_current < $y_height) {
400 ## Step 1
401 $growing_downward_growing_cells->();
402
403 ## Step 2
404 $y_current++;
405 }
406 ## Step 2
407 @downward_growing_cells = ();
408
409 ## Step 15
410 if ($current_ln eq 'tfoot') {
411 push @$pending_tfoot, $current_element;
412 # advance (done at the top of ROWS)
413 redo ROWS;
414 }
415
416 ## Step 16
417 # thead or tbody
418 $process_row_group->($current_element);
419
420 ## Step 17
421 # Advance (done at the top of ROWS).
422
423 ## Step 18
424 redo ROWS;
425 } # ROWS
426
427 $end->();
428 return $table;
429 } # form_table
430
431 ## TODO: Implement scope="" algorithm
432
433 1;
434 ## $Date: 2008/05/05 08:00:25 $

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24