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

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

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

revision 1.2 by wakaba, Sun May 27 06:38:58 2007 UTC revision 1.11 by wakaba, Tue May 6 07:49:16 2008 UTC
# Line 2  package Whatpm::HTMLTable; Line 2  package Whatpm::HTMLTable;
2  use strict;  use strict;
3    
4  ## An implementation of "Forming a table" algorithm in HTML5  ## An implementation of "Forming a table" algorithm in HTML5
5  sub form_table ($$$) {  sub form_table ($$$;$) {
6    my (undef, $table_el, $onerror) = @_;    my (undef, $table_el, $onerror, $must_level) = @_;
7    $onerror ||= sub { };    $onerror ||= sub { };
8      $must_level ||= 'm';
9        
10    ## Step 1    ## Step 1
11    my $x_max = 0;    my $x_width = 0;
12    
13    ## Step 2    ## Step 2
14    my $y_max = 0;    my $y_height = 0;
15    my $y_max_node;    my $y_max_node;
16      
17    ## Step 3    ## Step 3
18      my $pending_tfoot = [];
19      
20      ## Step 4
21    my $table = {    my $table = {
22      #caption      #caption
23      column => [],      column => [],
24      column_group => [],      column_group => [],
25      # no |row| since HTML5 algorithm doesn't associate rows with <tr>s      row => [], ## NOTE: HTML5 algorithm doesn't associate rows with <tr>s.
26      row_group => [],      row_group => [],
27      cell => [],      cell => [],
28        height => 0,
29        width => 0,
30    };    };
31        
32    my @has_anchored_cell;    my @column_has_anchored_cell;
33      my @row_has_anchored_cell;
34    my @column_generated_by;    my @column_generated_by;
35    my $check_empty_column = sub {    my @row_generated_by;
36      for (1..$x_max) {    
37        unless ($has_anchored_cell[$_]) {    ## Step 5
38      my @table_child = @{$table_el->child_nodes};
39      return $table unless @table_child;
40    
41      ## Step 6
42      for (0..$#table_child) {
43        my $el = $table_child[$_];
44        next unless $el->node_type == 1; # ELEMENT_NODE
45        next unless $el->manakai_local_name eq 'caption';
46        my $nsuri = $el->namespace_uri;
47        next unless defined $nsuri;
48        next unless $nsuri eq q<http://www.w3.org/1999/xhtml>;
49        $table->{caption} = {element => $el};
50        splice @table_child, $_, 1, ();
51        last;
52      }
53    
54      my $process_row_group;
55      my $end = sub {
56        ## Step 19 (End)
57        for (@$pending_tfoot) {
58          $process_row_group->($_);
59        }
60        
61        ## Step 20
62        for (0 .. $x_width - 1) {
63          unless ($column_has_anchored_cell[$_]) {
64          if ($table->{column}->[$_]) {          if ($table->{column}->[$_]) {
65            $onerror->(type => 'column with no anchored cell',            $onerror->(type => 'column with no anchored cell',
66                       node => $table->{column}->[$_]->{element});                       node => $table->{column}->[$_]->{element},
67                         level => $must_level);
68          } else {          } else {
69            $onerror->(type => 'colspan makes column with no anchored cell',            $onerror->(type => 'colspan creates column with no anchored cell',
70                       node => $column_generated_by[$_]);                       node => $column_generated_by[$_],
71                        level => $must_level);
72          }          }
73            last; # only one error.
74        }        }
75      }      }
76    }; # $check_empty_column      for (0 .. $y_height - 1) {
77            unless ($row_has_anchored_cell[$_]) {
78    ## Step 4          if ($table->{row}->[$_]) {
79    ## "If the table element has no table children, then return the table (which will be empty), and abort these steps."            $onerror->(type => 'row with no anchored cell',
80    ## ISSUE: What is "table children"?                       node => $table->{row}->[$_]->{element},
81    my @table_child = @{$table_el->child_nodes};                       level => $must_level);
82    return unless @table_child; # don't call $check_empty_column          } else {
83              $onerror->(type => 'rowspan creates row with no anchored cell',
84                         node => $row_generated_by[$_],
85                         level => $must_level);
86            }
87            last; # only one error.
88          }
89        }
90        
91        ## Step 21
92        #return $table;
93      }; # $end
94    
95    ## Step 5, 6, 8    ## Step 7, 8
96    my $current_element;    my $current_element;
97    my $current_ln;    my $current_ln;
98    NEXT_CHILD: {    NEXT_CHILD: {
# Line 57  sub form_table ($$$) { Line 104  sub form_table ($$$) {
104          $nsuri eq q<http://www.w3.org/1999/xhtml>;          $nsuri eq q<http://www.w3.org/1999/xhtml>;
105        $current_ln = $current_element->manakai_local_name;        $current_ln = $current_element->manakai_local_name;
106    
       if ($current_ln eq 'caption' and not defined $table->{caption}) {  
         ## Step 7  
         $table->{caption} = {element => $current_element};  
         redo NEXT_CHILD; # Step 8  
       }  
   
107        redo NEXT_CHILD unless {        redo NEXT_CHILD unless {
         #caption => 1, ## Step 6  
108          colgroup => 1,          colgroup => 1,
109          thead => 1,          thead => 1,
110          tbody => 1,          tbody => 1,
# Line 72  sub form_table ($$$) { Line 112  sub form_table ($$$) {
112          tr => 1,          tr => 1,
113        }->{$current_ln};        }->{$current_ln};
114      } else {      } else {
115        ## End of subsection        ## Step 6 2nd paragraph
116        $check_empty_column->();        $end->();
117        ## Step 5 2nd paragraph        $table->{width} = $x_width;
118          $table->{height} = $y_height;
119        return $table;        return $table;
120      }      }
121    } # NEXT_CHILD    } # NEXT_CHILD
122    
   ## ISSUE: Step 9.1 /next column/ is not used.  
   
123    ## Step 9    ## Step 9
124    while ($current_ln eq 'colgroup') { # Step 9, Step 9.5    while ($current_ln eq 'colgroup') { # Step 9, Step 9.4
125      ## Step 2: column groups      ## Step 9.1: column groups
126      my @col = grep {      my @col = grep {
127        $_->node_type == 1 and        $_->node_type == 1 and
128        defined $_->namespace_uri and        defined $_->namespace_uri and
# Line 92  sub form_table ($$$) { Line 131  sub form_table ($$$) {
131      } @{$current_element->child_nodes};      } @{$current_element->child_nodes};
132      if (@col) {      if (@col) {
133        ## Step 1        ## Step 1
134        my $x_start = $x_max + 1;        my $x_start = $x_width;
135                
136        ## Step 2, 6        ## Step 2, 6
137        while (@col) {        while (@col) {
# Line 108  sub form_table ($$$) { Line 147  sub form_table ($$$) {
147          ## ISSUE: If span=0, what is /span/ value?          ## ISSUE: If span=0, what is /span/ value?
148                    
149          ## Step 4, 5          ## Step 4, 5
150          $table->{column}->[++$x_max] = {element => $current_column} for 1..$span;          $table->{column}->[$x_width++] = {element => $current_column}
151                for 1..$span;
152        }        }
153                
154        ## Step 7        ## Step 7
155        my $cg = {element => $current_element,        my $cg = {element => $current_element,
156                  x => $x_start, y => 1,                  x => $x_start, y => 0,
157                  width => $x_max - $x_start - 1}; ## ISSUE: Spec incorrect                  width => $x_width - $x_start};
158        $cg->{width} = $x_max - $x_start + 1;        $table->{column_group}->[$_] = $cg for $x_start .. $x_width - 1;
       $table->{column_group}->[$_] = $cg for $x_start .. $x_max;  
159      } else { # no <col> children      } else { # no <col> children
160        ## Step 1        ## Step 1
161        my $span = 1;        my $span = 1;
# Line 128  sub form_table ($$$) { Line 167  sub form_table ($$$) {
167        ## ISSUE: If span=0, what is /span/ value?        ## ISSUE: If span=0, what is /span/ value?
168                
169        ## Step 2        ## Step 2
170        $x_max += $span;        $x_width += $span;
171                
172        ## Step 3        ## Step 3
173        my $cg = {element => $current_element,        my $cg = {element => $current_element,
174                  x => $x_max - $span + 1, y => 1,                  x => $x_width - $span, y => 0,
175                  width => $span};                  width => $span};
176        $table->{column_group}->[$_] = $cg for (($x_max - $span + 1) .. $x_max);        $table->{column_group}->[$_] = $cg for $cg->{x} .. $x_width - 1;
177      }      }
178            
179      ## Step 3, 4      ## Step 9.2, 9.3
180      NEXT_CHILD: {      NEXT_CHILD: {
181        $current_element = shift @table_child;        $current_element = shift @table_child;
182        if (defined $current_element) {        if (defined $current_element) {
# Line 156  sub form_table ($$$) { Line 195  sub form_table ($$$) {
195          }->{$current_ln};          }->{$current_ln};
196        } else {        } else {
197          ## End of subsection          ## End of subsection
198          $check_empty_column->();          
199          ## Step 5 of overall steps 2nd paragraph          ## Step 5 of overall steps 2nd paragraph
200            $end->();
201            $table->{width} = $x_width;
202            $table->{height} = $y_height;
203          return $table;          return $table;
204        }        }
205      } # NEXT_CHILD      } # NEXT_CHILD
# Line 170  sub form_table ($$$) { Line 212  sub form_table ($$$) {
212    my @downward_growing_cells;    my @downward_growing_cells;
213    
214    my $growing_downward_growing_cells = sub {    my $growing_downward_growing_cells = sub {
     ## Step 1  
     return unless @downward_growing_cells;  
   
     ## Step 2  
     if ($y_max < $y_current) {  
       $y_max++;  
       undef $y_max_node;  
     }  
   
     ## Step 3  
215      for (@downward_growing_cells) {      for (@downward_growing_cells) {
216        for my $x ($_->[1] .. ($_->[1] + $_->[2] - 1)) {        for my $x ($_->[1] .. ($_->[1] + $_->[2] - 1)) {
217          $table->{cell}->[$x]->[$y_current] = [$_->[0]];          $table->{cell}->[$x]->[$y_current] = [$_->[0]];
# Line 190  sub form_table ($$$) { Line 222  sub form_table ($$$) {
222    
223    my $process_row = sub {    my $process_row = sub {
224      ## Step 1      ## Step 1
225      $y_current++;      $y_height++ if $y_height == $y_current;
226            
227      ## Step 2      ## Step 2
228      $growing_downward_growing_cells->();      my $x_current = 0;
       
     ## Step 3  
     my $x_current = 1;  
229    
230      ## Step 4      ## Step 3
231      my $tr = shift;      my $tr = shift;
232        $table->{row}->[$y_current] = {element => $tr};
233      my @tdth = grep {      my @tdth = grep {
234        $_->node_type == 1 and        $_->node_type == 1 and
235        defined $_->namespace_uri and        defined $_->namespace_uri and
236        $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and        $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
237        {td => 1, th => 1}->{$_->manakai_local_name}        {td => 1, th => 1}->{$_->manakai_local_name}
238      } @{$tr->child_nodes};      } @{$tr->child_nodes};
239      #return unless @tdth; # redundant with |while| below      my $current_cell = shift @tdth;
240    
241      ## Step 5, 16, 17, 18      ## Step 4
242      ## ISSUE: Step 18 says "step 5 (cells)" while "cells" is step 6.      $growing_downward_growing_cells->();
243      while (@tdth) {  
244        my $current_cell = shift @tdth;  return unless $current_cell;
245        ## ISSUE: Support for empty <tr></tr> (removed at revision 1376).
246        ## Step 6: cells  
247        CELL: while (1) {
248          ## Step 5: cells
249        $x_current++        $x_current++
250          while ($x_current <= $x_max and          while ($x_current < $x_width and
251                 $table->{cell}->[$x_current]->[$y_current]);                 $table->{cell}->[$x_current]->[$y_current]);
252    
253        ## Step 7        ## Step 6
254        if ($x_current > $x_max) {        $x_width++ if $x_current == $x_width;
         $x_max++;  
       }  
255    
256        ## Step 8        ## Step 7
       ## ISSUE: How to parse |colspan| is not explicitly specified  
       ## (while |span| was).  
257        my $colspan = 1;        my $colspan = 1;
258        my $attr_value = $current_cell->get_attribute_ns (undef, 'colspan');        my $attr_value = $current_cell->get_attribute_ns (undef, 'colspan');
259        if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {        if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
260          $colspan = $1 || 1;          $colspan = $1 || 1;
261        }        }
262                
263        ## Step 9        ## Step 8
264        my $rowspan = 1;        my $rowspan = 1;
       ## ISSUE: How to parse  
265        my $attr_value = $current_cell->get_attribute_ns (undef, 'rowspan');        my $attr_value = $current_cell->get_attribute_ns (undef, 'rowspan');
266        if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {        if (defined $attr_value and $attr_value =~ /^[\x09-\x0D\x20]*([0-9]+)/) {
267          $rowspan = $1;          $rowspan = $1;
268        }        }
269                
270        ## Step 10        ## Step 9
271        my $cell_grows_downward;        my $cell_grows_downward;
272        if ($rowspan == 0) {        if ($rowspan == 0) {
273          $cell_grows_downward = 1;          $cell_grows_downward = 1;
274          $rowspan = 1;          $rowspan = 1;
275        }        }
276                
277        ## Step 11        ## Step 10
278        if ($x_max < $x_current + $colspan - 1) {        if ($x_width < $x_current + $colspan) {
279          @column_generated_by[$_] = $current_cell          @column_generated_by[$_] = $current_cell
280            for $x_max + 1 .. $x_current + $colspan - 1;            for $x_width .. $x_current + $colspan - 1;
281          $x_max = $x_current + $colspan - 1;          $x_width = $x_current + $colspan;
282        }        }
283                
284        ## Step 12        ## Step 11
285        if ($y_max < $y_current + $rowspan - 1) {        if ($y_height < $y_current + $rowspan) {
286          $y_max = $y_current + $rowspan - 1;          @row_generated_by[$_] = $current_cell
287                for $y_height .. $y_current + $rowspan - 1;
288            $y_height = $y_current + $rowspan;
289          $y_max_node = $current_cell;          $y_max_node = $current_cell;
290        }        }
291                
292        ## Step 13        ## Step 12
293        my $cell = {        my $cell = {
294                    is_header => ($current_cell->manakai_local_name eq 'th'),                    is_header => ($current_cell->manakai_local_name eq 'th'),
295                    element => $current_cell,                    element => $current_cell,
296                    x => $x_current, y => $y_current,                    x => $x_current, y => $y_current,
297                    width => $colspan, height => $rowspan,                    width => $colspan, height => $rowspan,
298                   };                   };
299        $has_anchored_cell[$x_current] = 1;        $column_has_anchored_cell[$x_current] = 1;
300          $row_has_anchored_cell[$y_current] = 1;
301        for my $x ($x_current .. ($x_current + $colspan - 1)) {        for my $x ($x_current .. ($x_current + $colspan - 1)) {
302          for my $y ($y_current .. ($y_current + $rowspan - 1)) {          for my $y ($y_current .. ($y_current + $rowspan - 1)) {
303            unless ($table->{cell}->[$x]->[$y]) {            unless ($table->{cell}->[$x]->[$y]) {
304              $table->{cell}->[$x]->[$y] = [$cell];              $table->{cell}->[$x]->[$y] = [$cell];
305            } else {            } else {
306              $onerror->(type => "cell overlapping:$x:$y", node => $current_cell);              $onerror->(type => "cell overlapping:$x:$y", node => $current_cell,
307                           level => $must_level);
308              push @{$table->{cell}->[$x]->[$y]}, $cell;              push @{$table->{cell}->[$x]->[$y]}, $cell;
309            }            }
310          }          }
311        }        }
312    
313          ## Whether the cell is an empty data cell or not
314          if (not $cell->{is_header}) {
315            $cell->{is_empty} = 1;
316            for my $node (@{$current_cell->child_nodes}) {
317              my $nt = $node->node_type;
318              if ($nt == 3 or $nt == 4) { # TEXT_NODE / CDATA_SECTION_NODE
319                if ($node->data =~ /\P{Zs}/) { ## TOOD: non-Zs class
320                  delete $cell->{is_empty};
321                  last;
322                }
323              } elsif ($nt == 1) { # ELEMENT_NODE
324                delete $cell->{is_empty};
325                last;
326              }
327            }
328            ## NOTE: Entity references are not supported
329          }
330                
331        ## Step 14        ## Step 13
332        if ($cell_grows_downward) {        if ($cell_grows_downward) {
333          push @downward_growing_cells, [$cell, $x_current, $colspan];          push @downward_growing_cells, [$cell, $x_current, $colspan];
334        }        }
335                
336        ## Step 15        ## Step 14
337        $x_current += $colspan;        $x_current += $colspan;
338      }  
339          ## Step 15-17
340          $current_cell = shift @tdth;
341          if (defined $current_cell) {
342            ## Step 16-17
343            #
344          } else {
345            ## Step 15
346            $y_current++;
347            last CELL;
348          }
349        } # CELL
350    }; # $process_row    }; # $process_row
351    
352      $process_row_group = sub ($) {
353        ## Step 1
354        my $y_start = $y_height;
355    
356        ## Step 2
357        for (grep {
358          $_->node_type == 1 and
359          defined $_->namespace_uri and
360          $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and
361          $_->manakai_local_name eq 'tr'
362        } @{$_[0]->child_nodes}) {
363          $process_row->($_);
364        }
365    
366        ## Step 3
367        if ($y_height > $y_start) {
368          my $rg = {element => $current_element, ## ISSUE: "element being processed"?
369                    x => 0, y => $y_start,
370                    height => $y_height - $y_start};
371          $table->{row_group}->[$_] = $rg for $y_start .. $y_height - 1;
372        }
373    
374        ## Step 4
375        ## Ending a row group
376          ## Step 1
377          while ($y_current < $y_height) {
378            ## Step 1
379            $growing_downward_growing_cells->();
380    
381            ## Step 2
382            $y_current++;
383          }
384          ## Step 2
385          @downward_growing_cells = ();
386      }; # $process_row_group
387    
388    ## Step 12: rows    ## Step 12: rows
389    unshift @table_child, $current_element;    unshift @table_child, $current_element;
390    ROWS: {    ROWS: {
# Line 308  sub form_table ($$$) { Line 404  sub form_table ($$$) {
404            tr => 1,            tr => 1,
405          }->{$current_ln};          }->{$current_ln};
406        } else {        } else {
407          ## Step 10 2nd sentense          ## Step 6 2nd paragraph
408          if ($y_current != $y_max) {          $end->();
409            $onerror->(type => 'rowspan expands table',          $table->{width} = $x_width;
410                       node => $y_max_node);          $table->{height} = $y_height;
         }  
         ## End of subsection  
         $check_empty_column->();  
         ## Step 5 2nd paragraph  
411          return $table;          return $table;
412        }        }
413      } # NEXT_CHILD      } # NEXT_CHILD
# Line 323  sub form_table ($$$) { Line 415  sub form_table ($$$) {
415      ## Step 13      ## Step 13
416      if ($current_ln eq 'tr') {      if ($current_ln eq 'tr') {
417        $process_row->($current_element);        $process_row->($current_element);
418          # advance (done at the first of ROWS)
419        redo ROWS;        redo ROWS;
420      }      }
421    
422      ## Step 14      ## Step 14
423      ## Ending a row group      ## Ending a row group
424        ## Step 1        ## Step 1
425        if ($y_current < $y_max) {        while ($y_current < $y_height) {
         $onerror->(type => 'rowspan expands table', node => $y_max_node);  
       }  
       ## Step 2  
       while ($y_current < $y_max) {  
426          ## Step 1          ## Step 1
         $y_current++;  
427          $growing_downward_growing_cells->();          $growing_downward_growing_cells->();
428    
429            ## Step 2
430            $y_current++;
431        }        }
432        ## Step 3        ## Step 2
433        @downward_growing_cells = ();        @downward_growing_cells = ();
434          
435      ## Step 15      ## Step 15
436      my $y_start = $y_max + 1;      if ($current_ln eq 'tfoot') {
437          push @$pending_tfoot, $current_element;
438          # advance (done at the top of ROWS)
439          redo ROWS;
440        }
441    
442      ## Step 16      ## Step 16
443      for (grep {      # thead or tbody
444        $_->node_type == 1 and      $process_row_group->($current_element);
       defined $_->namespace_uri and  
       $_->namespace_uri eq q<http://www.w3.org/1999/xhtml> and  
       $_->manakai_local_name eq 'tr'  
     } @{$current_element->child_nodes}) {  
       $process_row->($_);  
     }  
445    
446      ## Step 17      ## Step 17
447      if ($y_max >= $y_start) {      # Advance (done at the top of ROWS).
       my $rg = {element => $current_element,  
                 x => 1, y => $y_start,  
                 height => $y_max - $y_start + 1};  
       $table->{row_group}->[$_] = $rg for $y_start .. $y_max;  
     }  
448    
449      ## Step 18      ## Step 18
450      ## Ending a row group      redo ROWS;
451        ## Step 1    } # ROWS
452        if ($y_current < $y_max) {  
453          $onerror->(type => 'rowspan expands table', node => $y_max_node);    $end->();
454      $table->{width} = $x_width;
455      $table->{height} = $y_height;
456      return $table;
457    } # form_table
458    
459    sub assign_header ($$;$$) {
460      my (undef, $table, $onerror, $must_level) = @_;
461      $onerror ||= sub { };
462      $must_level ||= 'm';
463    
464      my $assign_header = sub ($$$) {
465        my $_cell = shift;
466        my ($x, $y) = @_;
467    
468        for my $__cell (@{$_cell or []}) {
469          if ($__cell and $__cell->{element} and
470              not $__cell->{is_header} and
471              not $__cell->{element}->has_attribute_ns (undef, 'headers')) {
472            $__cell->{header}->{$x}->{$y} = 1;
473        }        }
474        ## Step 2      }
475        while ($y_current < $y_max) {    }; # $assign_header
476          ## Step 1  
477          $y_current++;    for my $x (0 .. $table->{width} - 1) {
478          $growing_downward_growing_cells->();      for my $y (0 .. $table->{height} - 1) {
479          my $cell = $table->{cell}->[$x]->[$y];
480          $cell = $cell->[0] if $cell; # anchored cell is always ->{cell}[][][0].
481          next if $cell->{x} != $x;
482          next if $cell->{y} != $y;
483          if ($cell) {
484            if ($cell->{is_header}) {
485              my $scope = $cell->{element}->get_attribute_ns (undef, 'scope');
486              $scope = $scope ? lc $scope : ''; ## TODO: case
487              if ($scope eq 'row') {
488                for my $_x ($x + $cell->{width} .. $table->{width} - 1) {
489                  for my $_y ($y .. $y + $cell->{height} - 1) {
490                    $assign_header->($table->{cell}->[$_x]->[$_y] => $x, $y);
491                  }
492                }
493              } elsif ($scope eq 'col') {
494                for my $_x ($x .. $x + $cell->{width} - 1) {
495                  for my $_y ($y .. $table->{height} - 1) {
496                    $assign_header->($table->{cell}->[$_x]->[$_y] => $x, $y);
497                  }
498                }
499              } elsif ($scope eq 'rowgroup') {
500                ## NOTE: A cell cannot exceed across a row group boundary.
501                if ($table->{row_group}->[$y] and
502                    $table->{row_group}->[$y]->{height}) {
503                  for my $_x ($x .. $table->{width} - 1) {
504                    for my $_y ($y ..
505                                $table->{row_group}->[$y]->{y} +
506                                $table->{row_group}->[$y]->{height} - 1) {
507                      $assign_header->($table->{cell}->[$_x]->[$_y] => $x, $y);
508                    }
509                  }
510                }
511                ## TODO: Should we raise a warning?
512              } elsif ($scope eq 'colgroup') {
513                if ($table->{column_group}->[$x] and
514                    $table->{column_group}->{width} and
515                    $table->{column_group}->[$x]->{x} == $x) { # anchored
516                  for my $_x ($x ..
517                              $table->{column_group}->[$x]->{x} +
518                              $table->{column_group}->[$x]->{width} - 1) {
519                    for my $_y ($y .. $table->{height} - 1) {
520                      $assign_header->($table->{cell}->[$_x]->[$_y] => $x, $y);
521                    }
522                  }
523                }
524                ## TODO: Warning?
525              } else { # auto
526                ## 1.
527                my $header_width = $cell->{width};
528                W: for ($x + $cell->{width} .. $table->{width} - 1) {
529                  my $_cell = $table->{cell}->[$_]->[$y];
530                  for (@{$_cell or []}) {
531                    if ($_->{element} and not $_->{is_empty}) {
532                      last W; # not empty
533                    }
534                  }
535                  $header_width++;
536                } # W
537    
538                ## 2.
539                my $_x = $x + $header_width;
540    
541                ## 3.
542                HORIZONTAL: {
543                  last HORIZONTAL if $_x == $table->{width}; # goto Vertical
544    
545                  ## 4. # goto Vertical
546                  last HORIZONTAL
547                      if $table->{cell}->[$_x]->[$y] and
548                          $table->{cell}->[$_x]->[$y]->[0] and # anchored
549                          $table->{cell}->[$_x]->[$y]->[0]->{is_header};
550    
551                  ## 5.
552                  for my $_y ($y .. $y + $cell->{height} - 1) {
553                    $assign_header->($table->{cell}->[$_x]->[$_y] => $x, $y);
554                  }
555    
556                  ## 6.
557                  $_x++;
558    
559                  ## 7.
560                  redo HORIZONTAL;
561                } # HORIZONTAL
562    
563                ## 8. Vertical
564                my $_y = $y + $cell->{height};
565    
566                VERTICAL: {
567                  ## 9. # goto END
568                  last VERTICAL if $_y == $table->{height};
569    
570                  ## 10.
571                  if ($table->{cell}->[$x]->[$_y]) {
572                    my $h_cell = $table->{cell}->[$x]->[$_y]->[0]; # anchored cell
573                    if ($h_cell and $h_cell->{is_header}) {
574                      ## 10.1.
575                      my $width = $h_cell->{width};
576                      W: for ($h_cell->{x} + $width .. $table->{width} - 1) {
577                        my $_cell = $table->{cell}->[$_]->[$y];
578                        for (@{$_cell or []}) {
579                          if ($_->{element} and not $_->{is_empty}) {
580                            last W; # not empty
581                          }
582                        }
583                        $width++;
584                      } # W
585                        
586                      ## 10.2. # goto end
587                      last VERTICAL if $width == $header_width;
588                    } # 10.
589                  }
590    
591                  ## 11.
592                  for my $_x ($x .. $x + $header_width - 1) {
593                    $assign_header->($table->{cell}->[$_x]->[$_y] => $x, $y);
594                  }
595    
596                  ## 12.
597                  $_y++;
598    
599                  ## 13. # goto vertical (wrong)
600                  redo VERTICAL;
601                } # VERTICAL
602    
603                ## 14. End
604                # (we have already done)
605              }
606            } else { # data cell
607              
608            }
609        }        }
610        ## Step 3      }
611        @downward_growing_cells = ();    }
612    
     ## Step 19  
     redo ROWS; # Step 12  
   } # ROWS  
 } # form_table  
613    
614  ## TODO: Implement scope="" algorithm    ## NOTE: The "tree order" constraints in the spec algorithm are irrelevant
615      ## in fact.
616    } # assign_header
617    
618  1;  1;
619  ## $Date$  ## $Date$
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.11
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24