/[suikacvs]/markup/html/whatpm/Whatpm/HTML.pm.src
Suika

Diff of /markup/html/whatpm/Whatpm/HTML.pm.src

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

revision 1.1 by wakaba, Tue May 1 10:36:06 2007 UTC revision 1.36 by wakaba, Mon Jul 16 04:51:22 2007 UTC
# Line 1  Line 1 
1  package What::HTML;  package Whatpm::HTML;
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    
5  ## This is an early version of an HTML parser.  ## ISSUE:
6    ## var doc = implementation.createDocument (null, null, null);
7    ## doc.write ('');
8    ## alert (doc.compatMode);
9    
10    ## ISSUE: HTML5 revision 967 says that the encoding layer MUST NOT
11    ## strip BOM and the HTML layer MUST ignore it.  Whether we can do it
12    ## is not yet clear.
13    ## "{U+FEFF}..." in UTF-16BE/UTF-16LE is three or four characters?
14    ## "{U+FEFF}..." in GB18030?
15    
16  my $permitted_slash_tag_name = {  my $permitted_slash_tag_name = {
17    base => 1,    base => 1,
# Line 18  my $permitted_slash_tag_name = { Line 27  my $permitted_slash_tag_name = {
27    input => 1,    input => 1,
28  };  };
29    
30  my $entity_char = {  my $c1_entity_char = {
31    AElig => "\x{00C6}",    0x80 => 0x20AC,
32    Aacute => "\x{00C1}",    0x81 => 0xFFFD,
33    Acirc => "\x{00C2}",    0x82 => 0x201A,
34    Agrave => "\x{00C0}",    0x83 => 0x0192,
35    Alpha => "\x{0391}",    0x84 => 0x201E,
36    Aring => "\x{00C5}",    0x85 => 0x2026,
37    Atilde => "\x{00C3}",    0x86 => 0x2020,
38    Auml => "\x{00C4}",    0x87 => 0x2021,
39    Beta => "\x{0392}",    0x88 => 0x02C6,
40    Ccedil => "\x{00C7}",    0x89 => 0x2030,
41    Chi => "\x{03A7}",    0x8A => 0x0160,
42    Dagger => "\x{2021}",    0x8B => 0x2039,
43    Delta => "\x{0394}",    0x8C => 0x0152,
44    ETH => "\x{00D0}",    0x8D => 0xFFFD,
45    Eacute => "\x{00C9}",    0x8E => 0x017D,
46    Ecirc => "\x{00CA}",    0x8F => 0xFFFD,
47    Egrave => "\x{00C8}",    0x90 => 0xFFFD,
48    Epsilon => "\x{0395}",    0x91 => 0x2018,
49    Eta => "\x{0397}",    0x92 => 0x2019,
50    Euml => "\x{00CB}",    0x93 => 0x201C,
51    Gamma => "\x{0393}",    0x94 => 0x201D,
52    Iacute => "\x{00CD}",    0x95 => 0x2022,
53    Icirc => "\x{00CE}",    0x96 => 0x2013,
54    Igrave => "\x{00CC}",    0x97 => 0x2014,
55    Iota => "\x{0399}",    0x98 => 0x02DC,
56    Iuml => "\x{00CF}",    0x99 => 0x2122,
57    Kappa => "\x{039A}",    0x9A => 0x0161,
58    Lambda => "\x{039B}",    0x9B => 0x203A,
59    Mu => "\x{039C}",    0x9C => 0x0153,
60    Ntilde => "\x{00D1}",    0x9D => 0xFFFD,
61    Nu => "\x{039D}",    0x9E => 0x017E,
62    OElig => "\x{0152}",    0x9F => 0x0178,
63    Oacute => "\x{00D3}",  }; # $c1_entity_char
   Ocirc => "\x{00D4}",  
   Ograve => "\x{00D2}",  
   Omega => "\x{03A9}",  
   Omicron => "\x{039F}",  
   Oslash => "\x{00D8}",  
   Otilde => "\x{00D5}",  
   Ouml => "\x{00D6}",  
   Phi => "\x{03A6}",  
   Pi => "\x{03A0}",  
   Prime => "\x{2033}",  
   Psi => "\x{03A8}",  
   Rho => "\x{03A1}",  
   Scaron => "\x{0160}",  
   Sigma => "\x{03A3}",  
   THORN => "\x{00DE}",  
   Tau => "\x{03A4}",  
   Theta => "\x{0398}",  
   Uacute => "\x{00DA}",  
   Ucirc => "\x{00DB}",  
   Ugrave => "\x{00D9}",  
   Upsilon => "\x{03A5}",  
   Uuml => "\x{00DC}",  
   Xi => "\x{039E}",  
   Yacute => "\x{00DD}",  
   Yuml => "\x{0178}",  
   Zeta => "\x{0396}",  
   aacute => "\x{00E1}",  
   acirc => "\x{00E2}",  
   acute => "\x{00B4}",  
   aelig => "\x{00E6}",  
   agrave => "\x{00E0}",  
   alefsym => "\x{2135}",  
   alpha => "\x{03B1}",  
   amp => "\x{0026}",  
   AMP => "\x{0026}",  
   and => "\x{2227}",  
   ang => "\x{2220}",  
   apos => "\x{0027}",  
   aring => "\x{00E5}",  
   asymp => "\x{2248}",  
   atilde => "\x{00E3}",  
   auml => "\x{00E4}",  
   bdquo => "\x{201E}",  
   beta => "\x{03B2}",  
   brvbar => "\x{00A6}",  
   bull => "\x{2022}",  
   cap => "\x{2229}",  
   ccedil => "\x{00E7}",  
   cedil => "\x{00B8}",  
   cent => "\x{00A2}",  
   chi => "\x{03C7}",  
   circ => "\x{02C6}",  
   clubs => "\x{2663}",  
   cong => "\x{2245}",  
   copy => "\x{00A9}",  
   COPY => "\x{00A9}",  
   crarr => "\x{21B5}",  
   cup => "\x{222A}",  
   curren => "\x{00A4}",  
   dArr => "\x{21D3}",  
   dagger => "\x{2020}",  
   darr => "\x{2193}",  
   deg => "\x{00B0}",  
   delta => "\x{03B4}",  
   diams => "\x{2666}",  
   divide => "\x{00F7}",  
   eacute => "\x{00E9}",  
   ecirc => "\x{00EA}",  
   egrave => "\x{00E8}",  
   empty => "\x{2205}",  
   emsp => "\x{2003}",  
   ensp => "\x{2002}",  
   epsilon => "\x{03B5}",  
   equiv => "\x{2261}",  
   eta => "\x{03B7}",  
   eth => "\x{00F0}",  
   euml => "\x{00EB}",  
   euro => "\x{20AC}",  
   exist => "\x{2203}",  
   fnof => "\x{0192}",  
   forall => "\x{2200}",  
   frac12 => "\x{00BD}",  
   frac14 => "\x{00BC}",  
   frac34 => "\x{00BE}",  
   frasl => "\x{2044}",  
   gamma => "\x{03B3}",  
   ge => "\x{2265}",  
   gt => "\x{003E}",  
   GT => "\x{003E}",  
   hArr => "\x{21D4}",  
   harr => "\x{2194}",  
   hearts => "\x{2665}",  
   hellip => "\x{2026}",  
   iacute => "\x{00ED}",  
   icirc => "\x{00EE}",  
   iexcl => "\x{00A1}",  
   igrave => "\x{00EC}",  
   image => "\x{2111}",  
   infin => "\x{221E}",  
   int => "\x{222B}",  
   iota => "\x{03B9}",  
   iquest => "\x{00BF}",  
   isin => "\x{2208}",  
   iuml => "\x{00EF}",  
   kappa => "\x{03BA}",  
   lArr => "\x{21D0}",  
   lambda => "\x{03BB}",  
   lang => "\x{2329}",  
   laquo => "\x{00AB}",  
   larr => "\x{2190}",  
   lceil => "\x{2308}",  
   ldquo => "\x{201C}",  
   le => "\x{2264}",  
   lfloor => "\x{230A}",  
   lowast => "\x{2217}",  
   loz => "\x{25CA}",  
   lrm => "\x{200E}",  
   lsaquo => "\x{2039}",  
   lsquo => "\x{2018}",  
   lt => "\x{003C}",  
   LT => "\x{003C}",  
   macr => "\x{00AF}",  
   mdash => "\x{2014}",  
   micro => "\x{00B5}",  
   middot => "\x{00B7}",  
   minus => "\x{2212}",  
   mu => "\x{03BC}",  
   nabla => "\x{2207}",  
   nbsp => "\x{00A0}",  
   ndash => "\x{2013}",  
   ne => "\x{2260}",  
   ni => "\x{220B}",  
   not => "\x{00AC}",  
   notin => "\x{2209}",  
   nsub => "\x{2284}",  
   ntilde => "\x{00F1}",  
   nu => "\x{03BD}",  
   oacute => "\x{00F3}",  
   ocirc => "\x{00F4}",  
   oelig => "\x{0153}",  
   ograve => "\x{00F2}",  
   oline => "\x{203E}",  
   omega => "\x{03C9}",  
   omicron => "\x{03BF}",  
   oplus => "\x{2295}",  
   or => "\x{2228}",  
   ordf => "\x{00AA}",  
   ordm => "\x{00BA}",  
   oslash => "\x{00F8}",  
   otilde => "\x{00F5}",  
   otimes => "\x{2297}",  
   ouml => "\x{00F6}",  
   para => "\x{00B6}",  
   part => "\x{2202}",  
   permil => "\x{2030}",  
   perp => "\x{22A5}",  
   phi => "\x{03C6}",  
   pi => "\x{03C0}",  
   piv => "\x{03D6}",  
   plusmn => "\x{00B1}",  
   pound => "\x{00A3}",  
   prime => "\x{2032}",  
   prod => "\x{220F}",  
   prop => "\x{221D}",  
   psi => "\x{03C8}",  
   quot => "\x{0022}",  
   QUOT => "\x{0022}",  
   rArr => "\x{21D2}",  
   radic => "\x{221A}",  
   rang => "\x{232A}",  
   raquo => "\x{00BB}",  
   rarr => "\x{2192}",  
   rceil => "\x{2309}",  
   rdquo => "\x{201D}",  
   real => "\x{211C}",  
   reg => "\x{00AE}",  
   REG => "\x{00AE}",  
   rfloor => "\x{230B}",  
   rho => "\x{03C1}",  
   rlm => "\x{200F}",  
   rsaquo => "\x{203A}",  
   rsquo => "\x{2019}",  
   sbquo => "\x{201A}",  
   scaron => "\x{0161}",  
   sdot => "\x{22C5}",  
   sect => "\x{00A7}",  
   shy => "\x{00AD}",  
   sigma => "\x{03C3}",  
   sigmaf => "\x{03C2}",  
   sim => "\x{223C}",  
   spades => "\x{2660}",  
   sub => "\x{2282}",  
   sube => "\x{2286}",  
   sum => "\x{2211}",  
   sup => "\x{2283}",  
   sup1 => "\x{00B9}",  
   sup2 => "\x{00B2}",  
   sup3 => "\x{00B3}",  
   supe => "\x{2287}",  
   szlig => "\x{00DF}",  
   tau => "\x{03C4}",  
   there4 => "\x{2234}",  
   theta => "\x{03B8}",  
   thetasym => "\x{03D1}",  
   thinsp => "\x{2009}",  
   thorn => "\x{00FE}",  
   tilde => "\x{02DC}",  
   times => "\x{00D7}",  
   trade => "\x{2122}",  
   uArr => "\x{21D1}",  
   uacute => "\x{00FA}",  
   uarr => "\x{2191}",  
   ucirc => "\x{00FB}",  
   ugrave => "\x{00F9}",  
   uml => "\x{00A8}",  
   upsih => "\x{03D2}",  
   upsilon => "\x{03C5}",  
   uuml => "\x{00FC}",  
   weierp => "\x{2118}",  
   xi => "\x{03BE}",  
   yacute => "\x{00FD}",  
   yen => "\x{00A5}",  
   yuml => "\x{00FF}",  
   zeta => "\x{03B6}",  
   zwj => "\x{200D}",  
   zwnj => "\x{200C}",  
 };  
64    
65  my $special_category = {  my $special_category = {
66    address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,    address => 1, area => 1, base => 1, basefont => 1, bgsound => 1,
# Line 307  sub parse_string ($$$;$) { Line 89  sub parse_string ($$$;$) {
89    my $s = \$_[0];    my $s = \$_[0];
90    $self->{document} = $_[1];    $self->{document} = $_[1];
91    
92    my $i;    ## NOTE: |set_inner_html| copies most of this method's code
93    
94    my $i = 0;    my $i = 0;
95      my $line = 1;
96      my $column = 0;
97    $self->{set_next_input_character} = sub {    $self->{set_next_input_character} = sub {
98      my $self = shift;      my $self = shift;
99    
100        pop @{$self->{prev_input_character}};
101        unshift @{$self->{prev_input_character}}, $self->{next_input_character};
102    
103      $self->{next_input_character} = -1 and return if $i >= length $$s;      $self->{next_input_character} = -1 and return if $i >= length $$s;
104      $self->{next_input_character} = ord substr $$s, $i++, 1;      $self->{next_input_character} = ord substr $$s, $i++, 1;
105        $column++;
106            
107      if ($self->{next_input_character} == 0x000D) { # CR      if ($self->{next_input_character} == 0x000A) { # LF
108        if ($i >= length $$s) {        $line++;
109          #        $column = 0;
110        } else {      } elsif ($self->{next_input_character} == 0x000D) { # CR
111          my $next_char = ord substr $$s, $i++, 1;        $i++ if substr ($$s, $i, 1) eq "\x0A";
         if ($next_char == 0x000A) { # LF  
           #  
         } else {  
           push @{$self->{char}}, $next_char;  
         }  
       }  
112        $self->{next_input_character} = 0x000A; # LF # MUST        $self->{next_input_character} = 0x000A; # LF # MUST
113          $line++;
114          $column = 0;
115      } elsif ($self->{next_input_character} > 0x10FFFF) {      } elsif ($self->{next_input_character} > 0x10FFFF) {
116        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
117      } elsif ($self->{next_input_character} == 0x0000) { # NULL      } elsif ($self->{next_input_character} == 0x0000) { # NULL
118          !!!parse-error (type => 'NULL');
119        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST        $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
120      }      }
121    };    };
122      $self->{prev_input_character} = [-1, -1, -1];
123      $self->{next_input_character} = -1;
124    
125    $self->{parse_error} = $_[2] || sub {    my $onerror = $_[2] || sub {
126      warn "Parse error at character $i\n"; ## TODO: Report (line, column) pair      my (%opt) = @_;
127        warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
128      };
129      $self->{parse_error} = sub {
130        $onerror->(@_, line => $line, column => $column);
131    };    };
132    
133    $self->_initialize_tokenizer;    $self->_initialize_tokenizer;
# Line 371  sub _initialize_tokenizer ($) { Line 164  sub _initialize_tokenizer ($) {
164    # $self->{next_input_character}    # $self->{next_input_character}
165    !!!next-input-character;    !!!next-input-character;
166    $self->{token} = [];    $self->{token} = [];
167      # $self->{escape}
168  } # _initialize_tokenizer  } # _initialize_tokenizer
169    
170  ## A token has:  ## A token has:
171  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',  ##   ->{type} eq 'DOCTYPE', 'start tag', 'end tag', 'comment',
172  ##       'character', or 'end-of-file'  ##       'character', or 'end-of-file'
173  ##   ->{name} (DOCTYPE, start tag (tagname), end tag (tagname))  ##   ->{name} (DOCTYPE, start tag (tag name), end tag (tag name))
174      ## ISSUE: the spec need s/tagname/tag name/  ##   ->{public_identifier} (DOCTYPE)
175  ##   ->{error} == 1 or 0 (DOCTYPE)  ##   ->{system_identifier} (DOCTYPE)
176    ##   ->{correct} == 1 or 0 (DOCTYPE)
177  ##   ->{attributes} isa HASH (start tag, end tag)  ##   ->{attributes} isa HASH (start tag, end tag)
178  ##   ->{data} (comment, character)  ##   ->{data} (comment, character)
179    
 ## Macros  
 ##   Macros MUST be preceded by three EXCLAMATION MARKs.  
 ##   emit ($token)  
 ##     Emits the specified token.  
   
180  ## Emitted token MUST immediately be handled by the tree construction state.  ## Emitted token MUST immediately be handled by the tree construction state.
181    
182  ## Before each step, UA MAY check to see if either one of the scripts in  ## Before each step, UA MAY check to see if either one of the scripts in
# Line 412  sub _get_next_token ($) { Line 202  sub _get_next_token ($) {
202          } else {          } else {
203            #            #
204          }          }
205          } elsif ($self->{next_input_character} == 0x002D) { # -
206            if ($self->{content_model_flag} eq 'RCDATA' or
207                $self->{content_model_flag} eq 'CDATA') {
208              unless ($self->{escape}) {
209                if ($self->{prev_input_character}->[0] == 0x002D and # -
210                    $self->{prev_input_character}->[1] == 0x0021 and # !
211                    $self->{prev_input_character}->[2] == 0x003C) { # <
212                  $self->{escape} = 1;
213                }
214              }
215            }
216            
217            #
218        } elsif ($self->{next_input_character} == 0x003C) { # <        } elsif ($self->{next_input_character} == 0x003C) { # <
219          if ($self->{content_model_flag} ne 'PLAINTEXT') {          if ($self->{content_model_flag} eq 'PCDATA' or
220                (($self->{content_model_flag} eq 'CDATA' or
221                  $self->{content_model_flag} eq 'RCDATA') and
222                 not $self->{escape})) {
223            $self->{state} = 'tag open';            $self->{state} = 'tag open';
224            !!!next-input-character;            !!!next-input-character;
225            redo A;            redo A;
226          } else {          } else {
227            #            #
228          }          }
229          } elsif ($self->{next_input_character} == 0x003E) { # >
230            if ($self->{escape} and
231                ($self->{content_model_flag} eq 'RCDATA' or
232                 $self->{content_model_flag} eq 'CDATA')) {
233              if ($self->{prev_input_character}->[0] == 0x002D and # -
234                  $self->{prev_input_character}->[1] == 0x002D) { # -
235                delete $self->{escape};
236              }
237            }
238            
239            #
240        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
241          !!!emit ({type => 'end-of-file'});          !!!emit ({type => 'end-of-file'});
242          last A; ## TODO: ok?          last A; ## TODO: ok?
# Line 436  sub _get_next_token ($) { Line 253  sub _get_next_token ($) {
253      } elsif ($self->{state} eq 'entity data') {      } elsif ($self->{state} eq 'entity data') {
254        ## (cannot happen in CDATA state)        ## (cannot happen in CDATA state)
255                
256        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (0);
257    
258        $self->{state} = 'data';        $self->{state} = 'data';
259        # next-input-character is already done        # next-input-character is already done
# Line 488  sub _get_next_token ($) { Line 305  sub _get_next_token ($) {
305            !!!next-input-character;            !!!next-input-character;
306            redo A;            redo A;
307          } elsif ($self->{next_input_character} == 0x003E) { # >          } elsif ($self->{next_input_character} == 0x003E) { # >
308            !!!parse-error;            !!!parse-error (type => 'empty start tag');
309            $self->{state} = 'data';            $self->{state} = 'data';
310            !!!next-input-character;            !!!next-input-character;
311    
# Line 496  sub _get_next_token ($) { Line 313  sub _get_next_token ($) {
313    
314            redo A;            redo A;
315          } elsif ($self->{next_input_character} == 0x003F) { # ?          } elsif ($self->{next_input_character} == 0x003F) { # ?
316            !!!parse-error;            !!!parse-error (type => 'pio');
317            $self->{state} = 'bogus comment';            $self->{state} = 'bogus comment';
318            ## $self->{next_input_character} is intentionally left as is            ## $self->{next_input_character} is intentionally left as is
319            redo A;            redo A;
320          } else {          } else {
321            !!!parse-error;            !!!parse-error (type => 'bare stago');
322            $self->{state} = 'data';            $self->{state} = 'data';
323            ## reconsume            ## reconsume
324    
# Line 515  sub _get_next_token ($) { Line 332  sub _get_next_token ($) {
332      } elsif ($self->{state} eq 'close tag open') {      } elsif ($self->{state} eq 'close tag open') {
333        if ($self->{content_model_flag} eq 'RCDATA' or        if ($self->{content_model_flag} eq 'RCDATA' or
334            $self->{content_model_flag} eq 'CDATA') {            $self->{content_model_flag} eq 'CDATA') {
335          my @next_char;          if (defined $self->{last_emitted_start_tag_name}) {
336          TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {            ## NOTE: <http://krijnhoetmer.nl/irc-logs/whatwg/20070626#l-564>
337              my @next_char;
338              TAGNAME: for (my $i = 0; $i < length $self->{last_emitted_start_tag_name}; $i++) {
339                push @next_char, $self->{next_input_character};
340                my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);
341                my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;
342                if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {
343                  !!!next-input-character;
344                  next TAGNAME;
345                } else {
346                  $self->{next_input_character} = shift @next_char; # reconsume
347                  !!!back-next-input-character (@next_char);
348                  $self->{state} = 'data';
349    
350                  !!!emit ({type => 'character', data => '</'});
351      
352                  redo A;
353                }
354              }
355            push @next_char, $self->{next_input_character};            push @next_char, $self->{next_input_character};
356            my $c = ord substr ($self->{last_emitted_start_tag_name}, $i, 1);        
357            my $C = 0x0061 <= $c && $c <= 0x007A ? $c - 0x0020 : $c;            unless ($self->{next_input_character} == 0x0009 or # HT
358            if ($self->{next_input_character} == $c or $self->{next_input_character} == $C) {                    $self->{next_input_character} == 0x000A or # LF
359              !!!next-input-character;                    $self->{next_input_character} == 0x000B or # VT
360              next TAGNAME;                    $self->{next_input_character} == 0x000C or # FF
361            } else {                    $self->{next_input_character} == 0x0020 or # SP
362              !!!parse-error;                    $self->{next_input_character} == 0x003E or # >
363                      $self->{next_input_character} == 0x002F or # /
364                      $self->{next_input_character} == -1) {
365              $self->{next_input_character} = shift @next_char; # reconsume              $self->{next_input_character} = shift @next_char; # reconsume
366              !!!back-next-input-character (@next_char);              !!!back-next-input-character (@next_char);
367              $self->{state} = 'data';              $self->{state} = 'data';
   
368              !!!emit ({type => 'character', data => '</'});              !!!emit ({type => 'character', data => '</'});
   
369              redo A;              redo A;
370              } else {
371                $self->{next_input_character} = shift @next_char;
372                !!!back-next-input-character (@next_char);
373                # and consume...
374            }            }
375          }          } else {
376          push @next_char, $self->{next_input_character};            ## No start tag token has ever been emitted
377                  # next-input-character is already done
         unless ($self->{next_input_character} == 0x0009 or # HT  
                 $self->{next_input_character} == 0x000A or # LF  
                 $self->{next_input_character} == 0x000B or # VT  
                 $self->{next_input_character} == 0x000C or # FF  
                 $self->{next_input_character} == 0x0020 or # SP  
                 $self->{next_input_character} == 0x003E or # >  
                 $self->{next_input_character} == 0x002F or # /  
                 $self->{next_input_character} == 0x003C or # <  
                 $self->{next_input_character} == -1) {  
           !!!parse-error;  
           $self->{next_input_character} = shift @next_char; # reconsume  
           !!!back-next-input-character (@next_char);  
378            $self->{state} = 'data';            $self->{state} = 'data';
   
379            !!!emit ({type => 'character', data => '</'});            !!!emit ({type => 'character', data => '</'});
   
380            redo A;            redo A;
         } else {  
           $self->{next_input_character} = shift @next_char;  
           !!!back-next-input-character (@next_char);  
           # and consume...  
381          }          }
382        }        }
383                
# Line 575  sub _get_next_token ($) { Line 396  sub _get_next_token ($) {
396          !!!next-input-character;          !!!next-input-character;
397          redo A;          redo A;
398        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
399          !!!parse-error;          !!!parse-error (type => 'empty end tag');
400          $self->{state} = 'data';          $self->{state} = 'data';
401          !!!next-input-character;          !!!next-input-character;
402          redo A;          redo A;
403        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
404          !!!parse-error;          !!!parse-error (type => 'bare etago');
405          $self->{state} = 'data';          $self->{state} = 'data';
406          # reconsume          # reconsume
407    
# Line 588  sub _get_next_token ($) { Line 409  sub _get_next_token ($) {
409    
410          redo A;          redo A;
411        } else {        } else {
412          !!!parse-error;          !!!parse-error (type => 'bogus end tag');
413          $self->{state} = 'bogus comment';          $self->{state} = 'bogus comment';
414          ## $self->{next_input_character} is intentionally left as is          ## $self->{next_input_character} is intentionally left as is
415          redo A;          redo A;
# Line 604  sub _get_next_token ($) { Line 425  sub _get_next_token ($) {
425          redo A;          redo A;
426        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
427          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
428              $self->{current_token}->{first_start_tag}
429                  = not defined $self->{last_emitted_start_tag_name};
430            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
431          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
432            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
433            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
434              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
435            }            }
436          } else {          } else {
437            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 617  sub _get_next_token ($) { Line 440  sub _get_next_token ($) {
440          !!!next-input-character;          !!!next-input-character;
441    
442          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
443    
444          redo A;          redo A;
445        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 627  sub _get_next_token ($) { Line 449  sub _get_next_token ($) {
449          ## Stay in this state          ## Stay in this state
450          !!!next-input-character;          !!!next-input-character;
451          redo A;          redo A;
452        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
453                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
454          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
455              $self->{current_token}->{first_start_tag}
456                  = not defined $self->{last_emitted_start_tag_name};
457            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
458          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
459            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
460            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
461              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
462            }            }
463          } else {          } else {
464            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 644  sub _get_next_token ($) { Line 467  sub _get_next_token ($) {
467          # reconsume          # reconsume
468    
469          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
470    
471          redo A;          redo A;
472        } elsif ($self->{next_input_character} == 0x002F) { # /        } elsif ($self->{next_input_character} == 0x002F) { # /
# Line 655  sub _get_next_token ($) { Line 477  sub _get_next_token ($) {
477            # permitted slash            # permitted slash
478            #            #
479          } else {          } else {
480            !!!parse-error;            !!!parse-error (type => 'nestc');
481          }          }
482          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
483          # next-input-character is already done          # next-input-character is already done
# Line 678  sub _get_next_token ($) { Line 500  sub _get_next_token ($) {
500          redo A;          redo A;
501        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
502          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
503              $self->{current_token}->{first_start_tag}
504                  = not defined $self->{last_emitted_start_tag_name};
505            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
506          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
507            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
508            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
509              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
510            }            }
511          } else {          } else {
512            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 691  sub _get_next_token ($) { Line 515  sub _get_next_token ($) {
515          !!!next-input-character;          !!!next-input-character;
516    
517          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
518    
519          redo A;          redo A;
520        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 709  sub _get_next_token ($) { Line 532  sub _get_next_token ($) {
532            # permitted slash            # permitted slash
533            #            #
534          } else {          } else {
535            !!!parse-error;            !!!parse-error (type => 'nestc');
536          }          }
537          ## Stay in the state          ## Stay in the state
538          # next-input-character is already done          # next-input-character is already done
539          redo A;          redo A;
540        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
541                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
542          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
543              $self->{current_token}->{first_start_tag}
544                  = not defined $self->{last_emitted_start_tag_name};
545            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
546          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
547            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
548            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
549              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
550            }            }
551          } else {          } else {
552            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 731  sub _get_next_token ($) { Line 555  sub _get_next_token ($) {
555          # reconsume          # reconsume
556    
557          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
558    
559          redo A;          redo A;
560        } else {        } else {
# Line 745  sub _get_next_token ($) { Line 568  sub _get_next_token ($) {
568        my $before_leave = sub {        my $before_leave = sub {
569          if (exists $self->{current_token}->{attributes} # start tag or end tag          if (exists $self->{current_token}->{attributes} # start tag or end tag
570              ->{$self->{current_attribute}->{name}}) { # MUST              ->{$self->{current_attribute}->{name}}) { # MUST
571            !!!parse-error;            !!!parse-error (type => 'dupulicate attribute');
572            ## Discard $self->{current_attribute} # MUST            ## Discard $self->{current_attribute} # MUST
573          } else {          } else {
574            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}            $self->{current_token}->{attributes}->{$self->{current_attribute}->{name}}
# Line 770  sub _get_next_token ($) { Line 593  sub _get_next_token ($) {
593        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
594          $before_leave->();          $before_leave->();
595          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
596              $self->{current_token}->{first_start_tag}
597                  = not defined $self->{last_emitted_start_tag_name};
598            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
599          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
600            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
601            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
602              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
603            }            }
604          } else {          } else {
605            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 783  sub _get_next_token ($) { Line 608  sub _get_next_token ($) {
608          !!!next-input-character;          !!!next-input-character;
609    
610          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
611    
612          redo A;          redo A;
613        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 801  sub _get_next_token ($) { Line 625  sub _get_next_token ($) {
625            # permitted slash            # permitted slash
626            #            #
627          } else {          } else {
628            !!!parse-error;            !!!parse-error (type => 'nestc');
629          }          }
630          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
631          # next-input-character is already done          # next-input-character is already done
632          redo A;          redo A;
633        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
634                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
635          $before_leave->();          $before_leave->();
636          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
637              $self->{current_token}->{first_start_tag}
638                  = not defined $self->{last_emitted_start_tag_name};
639            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
640          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
641            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
642            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
643              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
644            }            }
645          } else {          } else {
646            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 824  sub _get_next_token ($) { Line 649  sub _get_next_token ($) {
649          # reconsume          # reconsume
650    
651          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
652    
653          redo A;          redo A;
654        } else {        } else {
# Line 848  sub _get_next_token ($) { Line 672  sub _get_next_token ($) {
672          redo A;          redo A;
673        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
674          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
675              $self->{current_token}->{first_start_tag}
676                  = not defined $self->{last_emitted_start_tag_name};
677            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
678          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
679            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
680            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
681              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
682            }            }
683          } else {          } else {
684            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 861  sub _get_next_token ($) { Line 687  sub _get_next_token ($) {
687          !!!next-input-character;          !!!next-input-character;
688    
689          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
690    
691          redo A;          redo A;
692        } elsif (0x0041 <= $self->{next_input_character} and        } elsif (0x0041 <= $self->{next_input_character} and
# Line 879  sub _get_next_token ($) { Line 704  sub _get_next_token ($) {
704            # permitted slash            # permitted slash
705            #            #
706          } else {          } else {
707            !!!parse-error;            !!!parse-error (type => 'nestc');
708              ## TODO: Different error type for <aa / bb> than <aa/>
709          }          }
710          $self->{state} = 'before attribute name';          $self->{state} = 'before attribute name';
711          # next-input-character is already done          # next-input-character is already done
712          redo A;          redo A;
713        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
714                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
715          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
716              $self->{current_token}->{first_start_tag}
717                  = not defined $self->{last_emitted_start_tag_name};
718            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
719          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
720            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
721            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
722              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
723            }            }
724          } else {          } else {
725            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 901  sub _get_next_token ($) { Line 728  sub _get_next_token ($) {
728          # reconsume          # reconsume
729    
730          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
731    
732          redo A;          redo A;
733        } else {        } else {
# Line 934  sub _get_next_token ($) { Line 760  sub _get_next_token ($) {
760          redo A;          redo A;
761        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
762          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
763              $self->{current_token}->{first_start_tag}
764                  = not defined $self->{last_emitted_start_tag_name};
765            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
766          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
767            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
768            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
769              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
770            }            }
771          } else {          } else {
772            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 947  sub _get_next_token ($) { Line 775  sub _get_next_token ($) {
775          !!!next-input-character;          !!!next-input-character;
776    
777          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
778    
779          redo A;          redo A;
780        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
781                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
782          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
783              $self->{current_token}->{first_start_tag}
784                  = not defined $self->{last_emitted_start_tag_name};
785            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
786          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
787            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
788            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
789              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
790            }            }
791          } else {          } else {
792            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 967  sub _get_next_token ($) { Line 795  sub _get_next_token ($) {
795          ## reconsume          ## reconsume
796    
797          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
798    
799          redo A;          redo A;
800        } else {        } else {
# Line 987  sub _get_next_token ($) { Line 814  sub _get_next_token ($) {
814          !!!next-input-character;          !!!next-input-character;
815          redo A;          redo A;
816        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
817          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
818          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
819              $self->{current_token}->{first_start_tag}
820                  = not defined $self->{last_emitted_start_tag_name};
821            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
822          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
823            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
824            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
825              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
826            }            }
827          } else {          } else {
828            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1002  sub _get_next_token ($) { Line 831  sub _get_next_token ($) {
831          ## reconsume          ## reconsume
832    
833          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
834    
835          redo A;          redo A;
836        } else {        } else {
# Line 1022  sub _get_next_token ($) { Line 850  sub _get_next_token ($) {
850          !!!next-input-character;          !!!next-input-character;
851          redo A;          redo A;
852        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
853          !!!parse-error;          !!!parse-error (type => 'unclosed attribute value');
854          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
855              $self->{current_token}->{first_start_tag}
856                  = not defined $self->{last_emitted_start_tag_name};
857            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
858          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
859            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
860            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
861              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
862            }            }
863          } else {          } else {
864            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1037  sub _get_next_token ($) { Line 867  sub _get_next_token ($) {
867          ## reconsume          ## reconsume
868    
869          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
870    
871          redo A;          redo A;
872        } else {        } else {
# Line 1062  sub _get_next_token ($) { Line 891  sub _get_next_token ($) {
891          redo A;          redo A;
892        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
893          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
894              $self->{current_token}->{first_start_tag}
895                  = not defined $self->{last_emitted_start_tag_name};
896            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
897          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
898            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
899            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
900              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
901            }            }
902          } else {          } else {
903            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1075  sub _get_next_token ($) { Line 906  sub _get_next_token ($) {
906          !!!next-input-character;          !!!next-input-character;
907    
908          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
909    
910          redo A;          redo A;
911        } elsif ($self->{next_input_character} == 0x003C or # <        } elsif ($self->{next_input_character} == -1) {
912                 $self->{next_input_character} == -1) {          !!!parse-error (type => 'unclosed tag');
         !!!parse-error;  
913          if ($self->{current_token}->{type} eq 'start tag') {          if ($self->{current_token}->{type} eq 'start tag') {
914              $self->{current_token}->{first_start_tag}
915                  = not defined $self->{last_emitted_start_tag_name};
916            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};            $self->{last_emitted_start_tag_name} = $self->{current_token}->{tag_name};
917          } elsif ($self->{current_token}->{type} eq 'end tag') {          } elsif ($self->{current_token}->{type} eq 'end tag') {
918            $self->{content_model_flag} = 'PCDATA'; # MUST            $self->{content_model_flag} = 'PCDATA'; # MUST
919            if ($self->{current_token}->{attributes}) {            if ($self->{current_token}->{attributes}) {
920              !!!parse-error;              !!!parse-error (type => 'end tag attribute');
921            }            }
922          } else {          } else {
923            die "$0: $self->{current_token}->{type}: Unknown token type";            die "$0: $self->{current_token}->{type}: Unknown token type";
# Line 1095  sub _get_next_token ($) { Line 926  sub _get_next_token ($) {
926          ## reconsume          ## reconsume
927    
928          !!!emit ($self->{current_token}); # start tag or end tag          !!!emit ($self->{current_token}); # start tag or end tag
         undef $self->{current_token};  
929    
930          redo A;          redo A;
931        } else {        } else {
# Line 1105  sub _get_next_token ($) { Line 935  sub _get_next_token ($) {
935          redo A;          redo A;
936        }        }
937      } elsif ($self->{state} eq 'entity in attribute value') {      } elsif ($self->{state} eq 'entity in attribute value') {
938        my $token = $self->_tokenize_attempt_to_consume_an_entity;        my $token = $self->_tokenize_attempt_to_consume_an_entity (1);
939    
940        unless (defined $token) {        unless (defined $token) {
941          $self->{current_attribute}->{value} .= '&';          $self->{current_attribute}->{value} .= '&';
# Line 1154  sub _get_next_token ($) { Line 984  sub _get_next_token ($) {
984          push @next_char, $self->{next_input_character};          push @next_char, $self->{next_input_character};
985          if ($self->{next_input_character} == 0x002D) { # -          if ($self->{next_input_character} == 0x002D) { # -
986            $self->{current_token} = {type => 'comment', data => ''};            $self->{current_token} = {type => 'comment', data => ''};
987            $self->{state} = 'comment';            $self->{state} = 'comment start';
988            !!!next-input-character;            !!!next-input-character;
989            redo A;            redo A;
990          }          }
# Line 1196  sub _get_next_token ($) { Line 1026  sub _get_next_token ($) {
1026          }          }
1027        }        }
1028    
1029        !!!parse-error;        !!!parse-error (type => 'bogus comment');
1030        $self->{next_input_character} = shift @next_char;        $self->{next_input_character} = shift @next_char;
1031        !!!back-next-input-character (@next_char);        !!!back-next-input-character (@next_char);
1032        $self->{state} = 'bogus comment';        $self->{state} = 'bogus comment';
# Line 1204  sub _get_next_token ($) { Line 1034  sub _get_next_token ($) {
1034                
1035        ## ISSUE: typos in spec: chacacters, is is a parse error        ## ISSUE: typos in spec: chacacters, is is a parse error
1036        ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?        ## ISSUE: spec is somewhat unclear on "is the first character that will be in the comment"; what is "that will be in the comment" is what the algorithm defines, isn't it?
1037        } elsif ($self->{state} eq 'comment start') {
1038          if ($self->{next_input_character} == 0x002D) { # -
1039            $self->{state} = 'comment start dash';
1040            !!!next-input-character;
1041            redo A;
1042          } elsif ($self->{next_input_character} == 0x003E) { # >
1043            !!!parse-error (type => 'bogus comment');
1044            $self->{state} = 'data';
1045            !!!next-input-character;
1046    
1047            !!!emit ($self->{current_token}); # comment
1048    
1049            redo A;
1050          } elsif ($self->{next_input_character} == -1) {
1051            !!!parse-error (type => 'unclosed comment');
1052            $self->{state} = 'data';
1053            ## reconsume
1054    
1055            !!!emit ($self->{current_token}); # comment
1056    
1057            redo A;
1058          } else {
1059            $self->{current_token}->{data} # comment
1060                .= chr ($self->{next_input_character});
1061            $self->{state} = 'comment';
1062            !!!next-input-character;
1063            redo A;
1064          }
1065        } elsif ($self->{state} eq 'comment start dash') {
1066          if ($self->{next_input_character} == 0x002D) { # -
1067            $self->{state} = 'comment end';
1068            !!!next-input-character;
1069            redo A;
1070          } elsif ($self->{next_input_character} == 0x003E) { # >
1071            !!!parse-error (type => 'bogus comment');
1072            $self->{state} = 'data';
1073            !!!next-input-character;
1074    
1075            !!!emit ($self->{current_token}); # comment
1076    
1077            redo A;
1078          } elsif ($self->{next_input_character} == -1) {
1079            !!!parse-error (type => 'unclosed comment');
1080            $self->{state} = 'data';
1081            ## reconsume
1082    
1083            !!!emit ($self->{current_token}); # comment
1084    
1085            redo A;
1086          } else {
1087            $self->{current_token}->{data} # comment
1088                .= '-' . chr ($self->{next_input_character});
1089            $self->{state} = 'comment';
1090            !!!next-input-character;
1091            redo A;
1092          }
1093      } elsif ($self->{state} eq 'comment') {      } elsif ($self->{state} eq 'comment') {
1094        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1095          $self->{state} = 'comment dash';          $self->{state} = 'comment end dash';
1096          !!!next-input-character;          !!!next-input-character;
1097          redo A;          redo A;
1098        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1099          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1100          $self->{state} = 'data';          $self->{state} = 'data';
1101          ## reconsume          ## reconsume
1102    
1103          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1104    
1105          redo A;          redo A;
1106        } else {        } else {
# Line 1224  sub _get_next_token ($) { Line 1109  sub _get_next_token ($) {
1109          !!!next-input-character;          !!!next-input-character;
1110          redo A;          redo A;
1111        }        }
1112      } elsif ($self->{state} eq 'comment dash') {      } elsif ($self->{state} eq 'comment end dash') {
1113        if ($self->{next_input_character} == 0x002D) { # -        if ($self->{next_input_character} == 0x002D) { # -
1114          $self->{state} = 'comment end';          $self->{state} = 'comment end';
1115          !!!next-input-character;          !!!next-input-character;
1116          redo A;          redo A;
1117        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1118          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1119          $self->{state} = 'data';          $self->{state} = 'data';
1120          ## reconsume          ## reconsume
1121    
1122          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1123    
1124          redo A;          redo A;
1125        } else {        } else {
# Line 1250  sub _get_next_token ($) { Line 1134  sub _get_next_token ($) {
1134          !!!next-input-character;          !!!next-input-character;
1135    
1136          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1137    
1138          redo A;          redo A;
1139        } elsif ($self->{next_input_character} == 0x002D) { # -        } elsif ($self->{next_input_character} == 0x002D) { # -
1140          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1141          $self->{current_token}->{data} .= '-'; # comment          $self->{current_token}->{data} .= '-'; # comment
1142          ## Stay in the state          ## Stay in the state
1143          !!!next-input-character;          !!!next-input-character;
1144          redo A;          redo A;
1145        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1146          !!!parse-error;          !!!parse-error (type => 'unclosed comment');
1147          $self->{state} = 'data';          $self->{state} = 'data';
1148          ## reconsume          ## reconsume
1149    
1150          !!!emit ($self->{current_token}); # comment          !!!emit ($self->{current_token}); # comment
         undef $self->{current_token};  
1151    
1152          redo A;          redo A;
1153        } else {        } else {
1154          !!!parse-error;          !!!parse-error (type => 'dash in comment');
1155          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment          $self->{current_token}->{data} .= '--' . chr ($self->{next_input_character}); # comment
1156          $self->{state} = 'comment';          $self->{state} = 'comment';
1157          !!!next-input-character;          !!!next-input-character;
# Line 1285  sub _get_next_token ($) { Line 1167  sub _get_next_token ($) {
1167          !!!next-input-character;          !!!next-input-character;
1168          redo A;          redo A;
1169        } else {        } else {
1170          !!!parse-error;          !!!parse-error (type => 'no space before DOCTYPE name');
1171          $self->{state} = 'before DOCTYPE name';          $self->{state} = 'before DOCTYPE name';
1172          ## reconsume          ## reconsume
1173          redo A;          redo A;
# Line 1299  sub _get_next_token ($) { Line 1181  sub _get_next_token ($) {
1181          ## Stay in the state          ## Stay in the state
1182          !!!next-input-character;          !!!next-input-character;
1183          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
         $self->{current_token} = {type => 'DOCTYPE',  
                           name => chr ($self->{next_input_character} - 0x0020),  
                           error => 1};  
         $self->{state} = 'DOCTYPE name';  
         !!!next-input-character;  
         redo A;  
1184        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
1185          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1186          $self->{state} = 'data';          $self->{state} = 'data';
1187          !!!next-input-character;          !!!next-input-character;
1188    
1189          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1190    
1191          redo A;          redo A;
1192        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1193          !!!parse-error;          !!!parse-error (type => 'no DOCTYPE name');
1194          $self->{state} = 'data';          $self->{state} = 'data';
1195          ## reconsume          ## reconsume
1196    
1197          !!!emit ({type => 'DOCTYPE', name => '', error => 1});          !!!emit ({type => 'DOCTYPE'}); # incorrect
1198    
1199          redo A;          redo A;
1200        } else {        } else {
1201          $self->{current_token} = {type => 'DOCTYPE',          $self->{current_token}
1202                            name => chr ($self->{next_input_character}),              = {type => 'DOCTYPE',
1203                            error => 1};                 name => chr ($self->{next_input_character}),
1204                   correct => 1};
1205    ## ISSUE: "Set the token's name name to the" in the spec
1206          $self->{state} = 'DOCTYPE name';          $self->{state} = 'DOCTYPE name';
1207          !!!next-input-character;          !!!next-input-character;
1208          redo A;          redo A;
1209        }        }
1210      } elsif ($self->{state} eq 'DOCTYPE name') {      } elsif ($self->{state} eq 'DOCTYPE name') {
1211    ## ISSUE: Redundant "First," in the spec.
1212        if ($self->{next_input_character} == 0x0009 or # HT        if ($self->{next_input_character} == 0x0009 or # HT
1213            $self->{next_input_character} == 0x000A or # LF            $self->{next_input_character} == 0x000A or # LF
1214            $self->{next_input_character} == 0x000B or # VT            $self->{next_input_character} == 0x000B or # VT
1215            $self->{next_input_character} == 0x000C or # FF            $self->{next_input_character} == 0x000C or # FF
1216            $self->{next_input_character} == 0x0020) { # SP            $self->{next_input_character} == 0x0020) { # SP
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1217          $self->{state} = 'after DOCTYPE name';          $self->{state} = 'after DOCTYPE name';
1218          !!!next-input-character;          !!!next-input-character;
1219          redo A;          redo A;
1220        } elsif ($self->{next_input_character} == 0x003E) { # >        } elsif ($self->{next_input_character} == 0x003E) { # >
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1221          $self->{state} = 'data';          $self->{state} = 'data';
1222          !!!next-input-character;          !!!next-input-character;
1223    
1224          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1225    
1226          redo A;          redo A;
       } elsif (0x0061 <= $self->{next_input_character} and  
                $self->{next_input_character} <= 0x007A) { # a..z  
         $self->{current_token}->{name} .= chr ($self->{next_input_character} - 0x0020); # DOCTYPE  
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
         ## Stay in the state  
         !!!next-input-character;  
         redo A;  
1227        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1228          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
         $self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML'); # DOCTYPE  
1229          $self->{state} = 'data';          $self->{state} = 'data';
1230          ## reconsume          ## reconsume
1231    
1232          !!!emit ($self->{current_token});          delete $self->{current_token}->{correct};
1233          undef $self->{current_token};          !!!emit ($self->{current_token}); # DOCTYPE
1234    
1235          redo A;          redo A;
1236        } else {        } else {
1237          $self->{current_token}->{name}          $self->{current_token}->{name}
1238            .= chr ($self->{next_input_character}); # DOCTYPE            .= chr ($self->{next_input_character}); # DOCTYPE
         #$self->{current_token}->{error} = ($self->{current_token}->{name} ne 'HTML');  
1239          ## Stay in the state          ## Stay in the state
1240          !!!next-input-character;          !!!next-input-character;
1241          redo A;          redo A;
# Line 1389  sub _get_next_token ($) { Line 1254  sub _get_next_token ($) {
1254          !!!next-input-character;          !!!next-input-character;
1255    
1256          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1257    
1258          redo A;          redo A;
1259        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1260          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1261          $self->{state} = 'data';          $self->{state} = 'data';
1262          ## reconsume          ## reconsume
1263    
1264            delete $self->{current_token}->{correct};
1265            !!!emit ($self->{current_token}); # DOCTYPE
1266    
1267            redo A;
1268          } elsif ($self->{next_input_character} == 0x0050 or # P
1269                   $self->{next_input_character} == 0x0070) { # p
1270            !!!next-input-character;
1271            if ($self->{next_input_character} == 0x0055 or # U
1272                $self->{next_input_character} == 0x0075) { # u
1273              !!!next-input-character;
1274              if ($self->{next_input_character} == 0x0042 or # B
1275                  $self->{next_input_character} == 0x0062) { # b
1276                !!!next-input-character;
1277                if ($self->{next_input_character} == 0x004C or # L
1278                    $self->{next_input_character} == 0x006C) { # l
1279                  !!!next-input-character;
1280                  if ($self->{next_input_character} == 0x0049 or # I
1281                      $self->{next_input_character} == 0x0069) { # i
1282                    !!!next-input-character;
1283                    if ($self->{next_input_character} == 0x0043 or # C
1284                        $self->{next_input_character} == 0x0063) { # c
1285                      $self->{state} = 'before DOCTYPE public identifier';
1286                      !!!next-input-character;
1287                      redo A;
1288                    }
1289                  }
1290                }
1291              }
1292            }
1293    
1294            #
1295          } elsif ($self->{next_input_character} == 0x0053 or # S
1296                   $self->{next_input_character} == 0x0073) { # s
1297            !!!next-input-character;
1298            if ($self->{next_input_character} == 0x0059 or # Y
1299                $self->{next_input_character} == 0x0079) { # y
1300              !!!next-input-character;
1301              if ($self->{next_input_character} == 0x0053 or # S
1302                  $self->{next_input_character} == 0x0073) { # s
1303                !!!next-input-character;
1304                if ($self->{next_input_character} == 0x0054 or # T
1305                    $self->{next_input_character} == 0x0074) { # t
1306                  !!!next-input-character;
1307                  if ($self->{next_input_character} == 0x0045 or # E
1308                      $self->{next_input_character} == 0x0065) { # e
1309                    !!!next-input-character;
1310                    if ($self->{next_input_character} == 0x004D or # M
1311                        $self->{next_input_character} == 0x006D) { # m
1312                      $self->{state} = 'before DOCTYPE system identifier';
1313                      !!!next-input-character;
1314                      redo A;
1315                    }
1316                  }
1317                }
1318              }
1319            }
1320    
1321            #
1322          } else {
1323            !!!next-input-character;
1324            #
1325          }
1326    
1327          !!!parse-error (type => 'string after DOCTYPE name');
1328          $self->{state} = 'bogus DOCTYPE';
1329          # next-input-character is already done
1330          redo A;
1331        } elsif ($self->{state} eq 'before DOCTYPE public identifier') {
1332          if ({
1333                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1334                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1335              }->{$self->{next_input_character}}) {
1336            ## Stay in the state
1337            !!!next-input-character;
1338            redo A;
1339          } elsif ($self->{next_input_character} eq 0x0022) { # "
1340            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1341            $self->{state} = 'DOCTYPE public identifier (double-quoted)';
1342            !!!next-input-character;
1343            redo A;
1344          } elsif ($self->{next_input_character} eq 0x0027) { # '
1345            $self->{current_token}->{public_identifier} = ''; # DOCTYPE
1346            $self->{state} = 'DOCTYPE public identifier (single-quoted)';
1347            !!!next-input-character;
1348            redo A;
1349          } elsif ($self->{next_input_character} eq 0x003E) { # >
1350            !!!parse-error (type => 'no PUBLIC literal');
1351    
1352            $self->{state} = 'data';
1353            !!!next-input-character;
1354    
1355            delete $self->{current_token}->{correct};
1356            !!!emit ($self->{current_token}); # DOCTYPE
1357    
1358            redo A;
1359          } elsif ($self->{next_input_character} == -1) {
1360            !!!parse-error (type => 'unclosed DOCTYPE');
1361    
1362            $self->{state} = 'data';
1363            ## reconsume
1364    
1365            delete $self->{current_token}->{correct};
1366            !!!emit ($self->{current_token}); # DOCTYPE
1367    
1368            redo A;
1369          } else {
1370            !!!parse-error (type => 'string after PUBLIC');
1371            $self->{state} = 'bogus DOCTYPE';
1372            !!!next-input-character;
1373            redo A;
1374          }
1375        } elsif ($self->{state} eq 'DOCTYPE public identifier (double-quoted)') {
1376          if ($self->{next_input_character} == 0x0022) { # "
1377            $self->{state} = 'after DOCTYPE public identifier';
1378            !!!next-input-character;
1379            redo A;
1380          } elsif ($self->{next_input_character} == -1) {
1381            !!!parse-error (type => 'unclosed PUBLIC literal');
1382    
1383            $self->{state} = 'data';
1384            ## reconsume
1385    
1386            delete $self->{current_token}->{correct};
1387            !!!emit ($self->{current_token}); # DOCTYPE
1388    
1389            redo A;
1390          } else {
1391            $self->{current_token}->{public_identifier} # DOCTYPE
1392                .= chr $self->{next_input_character};
1393            ## Stay in the state
1394            !!!next-input-character;
1395            redo A;
1396          }
1397        } elsif ($self->{state} eq 'DOCTYPE public identifier (single-quoted)') {
1398          if ($self->{next_input_character} == 0x0027) { # '
1399            $self->{state} = 'after DOCTYPE public identifier';
1400            !!!next-input-character;
1401            redo A;
1402          } elsif ($self->{next_input_character} == -1) {
1403            !!!parse-error (type => 'unclosed PUBLIC literal');
1404    
1405            $self->{state} = 'data';
1406            ## reconsume
1407    
1408            delete $self->{current_token}->{correct};
1409          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1410    
1411          redo A;          redo A;
1412        } else {        } else {
1413          !!!parse-error;          $self->{current_token}->{public_identifier} # DOCTYPE
1414          $self->{current_token}->{error} = 1; # DOCTYPE              .= chr $self->{next_input_character};
1415            ## Stay in the state
1416            !!!next-input-character;
1417            redo A;
1418          }
1419        } elsif ($self->{state} eq 'after DOCTYPE public identifier') {
1420          if ({
1421                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1422                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1423              }->{$self->{next_input_character}}) {
1424            ## Stay in the state
1425            !!!next-input-character;
1426            redo A;
1427          } elsif ($self->{next_input_character} == 0x0022) { # "
1428            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1429            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1430            !!!next-input-character;
1431            redo A;
1432          } elsif ($self->{next_input_character} == 0x0027) { # '
1433            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1434            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1435            !!!next-input-character;
1436            redo A;
1437          } elsif ($self->{next_input_character} == 0x003E) { # >
1438            $self->{state} = 'data';
1439            !!!next-input-character;
1440    
1441            !!!emit ($self->{current_token}); # DOCTYPE
1442    
1443            redo A;
1444          } elsif ($self->{next_input_character} == -1) {
1445            !!!parse-error (type => 'unclosed DOCTYPE');
1446    
1447            $self->{state} = 'data';
1448            ## reconsume
1449    
1450            delete $self->{current_token}->{correct};
1451            !!!emit ($self->{current_token}); # DOCTYPE
1452    
1453            redo A;
1454          } else {
1455            !!!parse-error (type => 'string after PUBLIC literal');
1456            $self->{state} = 'bogus DOCTYPE';
1457            !!!next-input-character;
1458            redo A;
1459          }
1460        } elsif ($self->{state} eq 'before DOCTYPE system identifier') {
1461          if ({
1462                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1463                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1464              }->{$self->{next_input_character}}) {
1465            ## Stay in the state
1466            !!!next-input-character;
1467            redo A;
1468          } elsif ($self->{next_input_character} == 0x0022) { # "
1469            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1470            $self->{state} = 'DOCTYPE system identifier (double-quoted)';
1471            !!!next-input-character;
1472            redo A;
1473          } elsif ($self->{next_input_character} == 0x0027) { # '
1474            $self->{current_token}->{system_identifier} = ''; # DOCTYPE
1475            $self->{state} = 'DOCTYPE system identifier (single-quoted)';
1476            !!!next-input-character;
1477            redo A;
1478          } elsif ($self->{next_input_character} == 0x003E) { # >
1479            !!!parse-error (type => 'no SYSTEM literal');
1480            $self->{state} = 'data';
1481            !!!next-input-character;
1482    
1483            delete $self->{current_token}->{correct};
1484            !!!emit ($self->{current_token}); # DOCTYPE
1485    
1486            redo A;
1487          } elsif ($self->{next_input_character} == -1) {
1488            !!!parse-error (type => 'unclosed DOCTYPE');
1489    
1490            $self->{state} = 'data';
1491            ## reconsume
1492    
1493            delete $self->{current_token}->{correct};
1494            !!!emit ($self->{current_token}); # DOCTYPE
1495    
1496            redo A;
1497          } else {
1498            !!!parse-error (type => 'string after SYSTEM');
1499            $self->{state} = 'bogus DOCTYPE';
1500            !!!next-input-character;
1501            redo A;
1502          }
1503        } elsif ($self->{state} eq 'DOCTYPE system identifier (double-quoted)') {
1504          if ($self->{next_input_character} == 0x0022) { # "
1505            $self->{state} = 'after DOCTYPE system identifier';
1506            !!!next-input-character;
1507            redo A;
1508          } elsif ($self->{next_input_character} == -1) {
1509            !!!parse-error (type => 'unclosed SYSTEM literal');
1510    
1511            $self->{state} = 'data';
1512            ## reconsume
1513    
1514            delete $self->{current_token}->{correct};
1515            !!!emit ($self->{current_token}); # DOCTYPE
1516    
1517            redo A;
1518          } else {
1519            $self->{current_token}->{system_identifier} # DOCTYPE
1520                .= chr $self->{next_input_character};
1521            ## Stay in the state
1522            !!!next-input-character;
1523            redo A;
1524          }
1525        } elsif ($self->{state} eq 'DOCTYPE system identifier (single-quoted)') {
1526          if ($self->{next_input_character} == 0x0027) { # '
1527            $self->{state} = 'after DOCTYPE system identifier';
1528            !!!next-input-character;
1529            redo A;
1530          } elsif ($self->{next_input_character} == -1) {
1531            !!!parse-error (type => 'unclosed SYSTEM literal');
1532    
1533            $self->{state} = 'data';
1534            ## reconsume
1535    
1536            delete $self->{current_token}->{correct};
1537            !!!emit ($self->{current_token}); # DOCTYPE
1538    
1539            redo A;
1540          } else {
1541            $self->{current_token}->{system_identifier} # DOCTYPE
1542                .= chr $self->{next_input_character};
1543            ## Stay in the state
1544            !!!next-input-character;
1545            redo A;
1546          }
1547        } elsif ($self->{state} eq 'after DOCTYPE system identifier') {
1548          if ({
1549                0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, 0x0020 => 1,
1550                #0x000D => 1, # HT, LF, VT, FF, SP, CR
1551              }->{$self->{next_input_character}}) {
1552            ## Stay in the state
1553            !!!next-input-character;
1554            redo A;
1555          } elsif ($self->{next_input_character} == 0x003E) { # >
1556            $self->{state} = 'data';
1557            !!!next-input-character;
1558    
1559            !!!emit ($self->{current_token}); # DOCTYPE
1560    
1561            redo A;
1562          } elsif ($self->{next_input_character} == -1) {
1563            !!!parse-error (type => 'unclosed DOCTYPE');
1564    
1565            $self->{state} = 'data';
1566            ## reconsume
1567    
1568            delete $self->{current_token}->{correct};
1569            !!!emit ($self->{current_token}); # DOCTYPE
1570    
1571            redo A;
1572          } else {
1573            !!!parse-error (type => 'string after SYSTEM literal');
1574          $self->{state} = 'bogus DOCTYPE';          $self->{state} = 'bogus DOCTYPE';
1575          !!!next-input-character;          !!!next-input-character;
1576          redo A;          redo A;
# Line 1413  sub _get_next_token ($) { Line 1580  sub _get_next_token ($) {
1580          $self->{state} = 'data';          $self->{state} = 'data';
1581          !!!next-input-character;          !!!next-input-character;
1582    
1583            delete $self->{current_token}->{correct};
1584          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1585    
1586          redo A;          redo A;
1587        } elsif ($self->{next_input_character} == -1) {        } elsif ($self->{next_input_character} == -1) {
1588          !!!parse-error;          !!!parse-error (type => 'unclosed DOCTYPE');
1589          $self->{state} = 'data';          $self->{state} = 'data';
1590          ## reconsume          ## reconsume
1591    
1592            delete $self->{current_token}->{correct};
1593          !!!emit ($self->{current_token}); # DOCTYPE          !!!emit ($self->{current_token}); # DOCTYPE
         undef $self->{current_token};  
1594    
1595          redo A;          redo A;
1596        } else {        } else {
# Line 1439  sub _get_next_token ($) { Line 1606  sub _get_next_token ($) {
1606    die "$0: _get_next_token: unexpected case";    die "$0: _get_next_token: unexpected case";
1607  } # _get_next_token  } # _get_next_token
1608    
1609  sub _tokenize_attempt_to_consume_an_entity ($) {  sub _tokenize_attempt_to_consume_an_entity ($$) {
1610    my $self = shift;    my ($self, $in_attr) = @_;
1611      
1612    if ($self->{next_input_character} == 0x0023) { # #    if ({
1613           0x0009 => 1, 0x000A => 1, 0x000B => 1, 0x000C => 1, # HT, LF, VT, FF,
1614           0x0020 => 1, 0x003C => 1, 0x0026 => 1, -1 => 1, # SP, <, & # 0x000D # CR
1615          }->{$self->{next_input_character}}) {
1616        ## Don't consume
1617        ## No error
1618        return undef;
1619      } elsif ($self->{next_input_character} == 0x0023) { # #
1620      !!!next-input-character;      !!!next-input-character;
     my $num;  
1621      if ($self->{next_input_character} == 0x0078 or # x      if ($self->{next_input_character} == 0x0078 or # x
1622          $self->{next_input_character} == 0x0058) { # X          $self->{next_input_character} == 0x0058) { # X
1623          my $code;
1624        X: {        X: {
1625          my $x_char = $self->{next_input_character};          my $x_char = $self->{next_input_character};
1626          !!!next-input-character;          !!!next-input-character;
1627          if (0x0030 <= $self->{next_input_character} and          if (0x0030 <= $self->{next_input_character} and
1628              $self->{next_input_character} <= 0x0039) { # 0..9              $self->{next_input_character} <= 0x0039) { # 0..9
1629            $num ||= 0;            $code ||= 0;
1630            $num *= 0x10;            $code *= 0x10;
1631            $num += $self->{next_input_character} - 0x0030;            $code += $self->{next_input_character} - 0x0030;
1632            redo X;            redo X;
1633          } elsif (0x0061 <= $self->{next_input_character} and          } elsif (0x0061 <= $self->{next_input_character} and
1634                   $self->{next_input_character} <= 0x0066) { # a..f                   $self->{next_input_character} <= 0x0066) { # a..f
1635            ## ISSUE: the spec says U+0078, which is apparently incorrect            $code ||= 0;
1636            $num ||= 0;            $code *= 0x10;
1637            $num *= 0x10;            $code += $self->{next_input_character} - 0x0060 + 9;
           $num += $self->{next_input_character} - 0x0060 + 9;  
1638            redo X;            redo X;
1639          } elsif (0x0041 <= $self->{next_input_character} and          } elsif (0x0041 <= $self->{next_input_character} and
1640                   $self->{next_input_character} <= 0x0046) { # A..F                   $self->{next_input_character} <= 0x0046) { # A..F
1641            ## ISSUE: the spec says U+0058, which is apparently incorrect            $code ||= 0;
1642            $num ||= 0;            $code *= 0x10;
1643            $num *= 0x10;            $code += $self->{next_input_character} - 0x0040 + 9;
           $num += $self->{next_input_character} - 0x0040 + 9;  
1644            redo X;            redo X;
1645          } elsif (not defined $num) { # no hexadecimal digit          } elsif (not defined $code) { # no hexadecimal digit
1646            !!!parse-error;            !!!parse-error (type => 'bare hcro');
1647            $self->{next_input_character} = 0x0023; # #            $self->{next_input_character} = 0x0023; # #
1648            !!!back-next-input-character ($x_char);            !!!back-next-input-character ($x_char);
1649            return undef;            return undef;
1650          } elsif ($self->{next_input_character} == 0x003B) { # ;          } elsif ($self->{next_input_character} == 0x003B) { # ;
1651            !!!next-input-character;            !!!next-input-character;
1652          } else {          } else {
1653            !!!parse-error;            !!!parse-error (type => 'no refc');
1654          }          }
1655    
1656          ## TODO: check the definition for |a valid Unicode character|.          if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1657          if ($num > 1114111 or $num == 0) {            !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1658            $num = 0xFFFD; # REPLACEMENT CHARACTER            $code = 0xFFFD;
1659            ## ISSUE: Why this is not an error?          } elsif ($code > 0x10FFFF) {
1660              !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1661              $code = 0xFFFD;
1662            } elsif ($code == 0x000D) {
1663              !!!parse-error (type => 'CR character reference');
1664              $code = 0x000A;
1665            } elsif (0x80 <= $code and $code <= 0x9F) {
1666              !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1667              $code = $c1_entity_char->{$code};
1668          }          }
1669    
1670          return {type => 'character', data => chr $num};          return {type => 'character', data => chr $code};
1671        } # X        } # X
1672      } elsif (0x0030 <= $self->{next_input_character} and      } elsif (0x0030 <= $self->{next_input_character} and
1673               $self->{next_input_character} <= 0x0039) { # 0..9               $self->{next_input_character} <= 0x0039) { # 0..9
# Line 1505  sub _tokenize_attempt_to_consume_an_enti Line 1685  sub _tokenize_attempt_to_consume_an_enti
1685        if ($self->{next_input_character} == 0x003B) { # ;        if ($self->{next_input_character} == 0x003B) { # ;
1686          !!!next-input-character;          !!!next-input-character;
1687        } else {        } else {
1688          !!!parse-error;          !!!parse-error (type => 'no refc');
1689        }        }
1690    
1691        ## TODO: check the definition for |a valid Unicode character|.        if ($code == 0 or (0xD800 <= $code and $code <= 0xDFFF)) {
1692        if ($code > 1114111 or $code == 0) {          !!!parse-error (type => sprintf 'invalid character reference:U+%04X', $code);
1693          $code = 0xFFFD; # REPLACEMENT CHARACTER          $code = 0xFFFD;
1694          ## ISSUE: Why this is not an error?        } elsif ($code > 0x10FFFF) {
1695            !!!parse-error (type => sprintf 'invalid character reference:U-%08X', $code);
1696            $code = 0xFFFD;
1697          } elsif ($code == 0x000D) {
1698            !!!parse-error (type => 'CR character reference');
1699            $code = 0x000A;
1700          } elsif (0x80 <= $code and $code <= 0x9F) {
1701            !!!parse-error (type => sprintf 'C1 character reference:U+%04X', $code);
1702            $code = $c1_entity_char->{$code};
1703        }        }
1704                
1705        return {type => 'character', data => chr $code};        return {type => 'character', data => chr $code};
1706      } else {      } else {
1707        !!!parse-error;        !!!parse-error (type => 'bare nero');
1708        !!!back-next-input-character ($self->{next_input_character});        !!!back-next-input-character ($self->{next_input_character});
1709        $self->{next_input_character} = 0x0023; # #        $self->{next_input_character} = 0x0023; # #
1710        return undef;        return undef;
# Line 1530  sub _tokenize_attempt_to_consume_an_enti Line 1718  sub _tokenize_attempt_to_consume_an_enti
1718    
1719      my $value = $entity_name;      my $value = $entity_name;
1720      my $match;      my $match;
1721        require Whatpm::_NamedEntityList;
1722        our $EntityChar;
1723    
1724      while (length $entity_name < 10 and      while (length $entity_name < 10 and
1725             ## NOTE: Some number greater than the maximum length of entity name             ## NOTE: Some number greater than the maximum length of entity name
1726             ((0x0041 <= $self->{next_input_character} and             ((0x0041 <= $self->{next_input_character} and # a
1727               $self->{next_input_character} <= 0x005A) or               $self->{next_input_character} <= 0x005A) or # x
1728              (0x0061 <= $self->{next_input_character} and              (0x0061 <= $self->{next_input_character} and # a
1729               $self->{next_input_character} <= 0x007A) or               $self->{next_input_character} <= 0x007A) or # z
1730              (0x0030 <= $self->{next_input_character} and              (0x0030 <= $self->{next_input_character} and # 0
1731               $self->{next_input_character} <= 0x0039))) {               $self->{next_input_character} <= 0x0039) or # 9
1732                $self->{next_input_character} == 0x003B)) { # ;
1733        $entity_name .= chr $self->{next_input_character};        $entity_name .= chr $self->{next_input_character};
1734        if (defined $entity_char->{$entity_name}) {        if (defined $EntityChar->{$entity_name}) {
1735          $value = $entity_char->{$entity_name};          if ($self->{next_input_character} == 0x003B) { # ;
1736          $match = 1;            $value = $EntityChar->{$entity_name};
1737              $match = 1;
1738              !!!next-input-character;
1739              last;
1740            } elsif (not $in_attr) {
1741              $value = $EntityChar->{$entity_name};
1742              $match = -1;
1743            } else {
1744              $value .= chr $self->{next_input_character};
1745            }
1746        } else {        } else {
1747          $value .= chr $self->{next_input_character};          $value .= chr $self->{next_input_character};
1748        }        }
1749        !!!next-input-character;        !!!next-input-character;
1750      }      }
1751            
1752      if ($match) {      if ($match > 0) {
1753        if ($self->{next_input_character} == 0x003B) { # ;        return {type => 'character', data => $value};
1754          !!!next-input-character;      } elsif ($match < 0) {
1755        } else {        !!!parse-error (type => 'no refc');
         !!!parse-error;  
       }  
   
1756        return {type => 'character', data => $value};        return {type => 'character', data => $value};
1757      } else {      } else {
1758        !!!parse-error;        !!!parse-error (type => 'bare ero');
1759        ## NOTE: No characters are consumed in the spec.        ## NOTE: No characters are consumed in the spec.
1760        !!!back-token ({type => 'character', data => $value});        return {type => 'character', data => '&'.$value};
       return undef;  
1761      }      }
1762    } else {    } else {
1763      ## no characters are consumed      ## no characters are consumed
1764      !!!parse-error;      !!!parse-error (type => 'bare ero');
1765      return undef;      return undef;
1766    }    }
1767  } # _tokenize_attempt_to_consume_an_entity  } # _tokenize_attempt_to_consume_an_entity
# Line 1576  sub _initialize_tree_constructor ($) { Line 1772  sub _initialize_tree_constructor ($) {
1772    $self->{document}->strict_error_checking (0);    $self->{document}->strict_error_checking (0);
1773    ## TODO: Turn mutation events off # MUST    ## TODO: Turn mutation events off # MUST
1774    ## TODO: Turn loose Document option (manakai extension) on    ## TODO: Turn loose Document option (manakai extension) on
1775    ## TODO: Mark the Document as an HTML document # MUST    $self->{document}->manakai_is_html (1); # MUST
1776  } # _initialize_tree_constructor  } # _initialize_tree_constructor
1777    
1778  sub _terminate_tree_constructor ($) {  sub _terminate_tree_constructor ($) {
# Line 1587  sub _terminate_tree_constructor ($) { Line 1783  sub _terminate_tree_constructor ($) {
1783    
1784  ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?  ## ISSUE: Should append_child (for example) in script executed in tree construction stage fire mutation events?
1785    
1786    { # tree construction stage
1787      my $token;
1788    
1789  sub _construct_tree ($) {  sub _construct_tree ($) {
1790    my ($self) = @_;    my ($self) = @_;
1791    
# Line 1598  sub _construct_tree ($) { Line 1797  sub _construct_tree ($) {
1797    ## characters and insert one Text node whose data is concatenation    ## characters and insert one Text node whose data is concatenation
1798    ## of all those characters. # MUST    ## of all those characters. # MUST
1799        
   my $token;  
1800    !!!next-token;    !!!next-token;
1801    
1802    my $phase = 'initial'; # MUST    $self->{insertion_mode} = 'before head';
1803      undef $self->{form_element};
1804      undef $self->{head_element};
1805      $self->{open_elements} = [];
1806      undef $self->{inner_html_node};
1807    
1808      $self->_tree_construction_initial; # MUST
1809      $self->_tree_construction_root_element;
1810      $self->_tree_construction_main;
1811    } # _construct_tree
1812    
1813    sub _tree_construction_initial ($) {
1814      my $self = shift;
1815      INITIAL: {
1816        if ($token->{type} eq 'DOCTYPE') {
1817          ## NOTE: Conformance checkers MAY, instead of reporting "not HTML5"
1818          ## error, switch to a conformance checking mode for another
1819          ## language.
1820          my $doctype_name = $token->{name};
1821          $doctype_name = '' unless defined $doctype_name;
1822          $doctype_name =~ tr/a-z/A-Z/;
1823          if (not defined $token->{name} or # <!DOCTYPE>
1824              defined $token->{public_identifier} or
1825              defined $token->{system_identifier}) {
1826            !!!parse-error (type => 'not HTML5');
1827          } elsif ($doctype_name ne 'HTML') {
1828            ## ISSUE: ASCII case-insensitive? (in fact it does not matter)
1829            !!!parse-error (type => 'not HTML5');
1830          }
1831          
1832          my $doctype = $self->{document}->create_document_type_definition
1833            ($token->{name}); ## ISSUE: If name is missing (e.g. <!DOCTYPE>)?
1834          $doctype->public_id ($token->{public_identifier})
1835              if defined $token->{public_identifier};
1836          $doctype->system_id ($token->{system_identifier})
1837              if defined $token->{system_identifier};
1838          ## NOTE: Other DocumentType attributes are null or empty lists.
1839          ## ISSUE: internalSubset = null??
1840          $self->{document}->append_child ($doctype);
1841          
1842          if (not $token->{correct} or $doctype_name ne 'HTML') {
1843            $self->{document}->manakai_compat_mode ('quirks');
1844          } elsif (defined $token->{public_identifier}) {
1845            my $pubid = $token->{public_identifier};
1846            $pubid =~ tr/a-z/A-z/;
1847            if ({
1848              "+//SILMARIL//DTD HTML PRO V0R11 19970101//EN" => 1,
1849              "-//ADVASOFT LTD//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1850              "-//AS//DTD HTML 3.0 ASWEDIT + EXTENSIONS//EN" => 1,
1851              "-//IETF//DTD HTML 2.0 LEVEL 1//EN" => 1,
1852              "-//IETF//DTD HTML 2.0 LEVEL 2//EN" => 1,
1853              "-//IETF//DTD HTML 2.0 STRICT LEVEL 1//EN" => 1,
1854              "-//IETF//DTD HTML 2.0 STRICT LEVEL 2//EN" => 1,
1855              "-//IETF//DTD HTML 2.0 STRICT//EN" => 1,
1856              "-//IETF//DTD HTML 2.0//EN" => 1,
1857              "-//IETF//DTD HTML 2.1E//EN" => 1,
1858              "-//IETF//DTD HTML 3.0//EN" => 1,
1859              "-//IETF//DTD HTML 3.0//EN//" => 1,
1860              "-//IETF//DTD HTML 3.2 FINAL//EN" => 1,
1861              "-//IETF//DTD HTML 3.2//EN" => 1,
1862              "-//IETF//DTD HTML 3//EN" => 1,
1863              "-//IETF//DTD HTML LEVEL 0//EN" => 1,
1864              "-//IETF//DTD HTML LEVEL 0//EN//2.0" => 1,
1865              "-//IETF//DTD HTML LEVEL 1//EN" => 1,
1866              "-//IETF//DTD HTML LEVEL 1//EN//2.0" => 1,
1867              "-//IETF//DTD HTML LEVEL 2//EN" => 1,
1868              "-//IETF//DTD HTML LEVEL 2//EN//2.0" => 1,
1869              "-//IETF//DTD HTML LEVEL 3//EN" => 1,
1870              "-//IETF//DTD HTML LEVEL 3//EN//3.0" => 1,
1871              "-//IETF//DTD HTML STRICT LEVEL 0//EN" => 1,
1872              "-//IETF//DTD HTML STRICT LEVEL 0//EN//2.0" => 1,
1873              "-//IETF//DTD HTML STRICT LEVEL 1//EN" => 1,
1874              "-//IETF//DTD HTML STRICT LEVEL 1//EN//2.0" => 1,
1875              "-//IETF//DTD HTML STRICT LEVEL 2//EN" => 1,
1876              "-//IETF//DTD HTML STRICT LEVEL 2//EN//2.0" => 1,
1877              "-//IETF//DTD HTML STRICT LEVEL 3//EN" => 1,
1878              "-//IETF//DTD HTML STRICT LEVEL 3//EN//3.0" => 1,
1879              "-//IETF//DTD HTML STRICT//EN" => 1,
1880              "-//IETF//DTD HTML STRICT//EN//2.0" => 1,
1881              "-//IETF//DTD HTML STRICT//EN//3.0" => 1,
1882              "-//IETF//DTD HTML//EN" => 1,
1883              "-//IETF//DTD HTML//EN//2.0" => 1,
1884              "-//IETF//DTD HTML//EN//3.0" => 1,
1885              "-//METRIUS//DTD METRIUS PRESENTATIONAL//EN" => 1,
1886              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML STRICT//EN" => 1,
1887              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 HTML//EN" => 1,
1888              "-//MICROSOFT//DTD INTERNET EXPLORER 2.0 TABLES//EN" => 1,
1889              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML STRICT//EN" => 1,
1890              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 HTML//EN" => 1,
1891              "-//MICROSOFT//DTD INTERNET EXPLORER 3.0 TABLES//EN" => 1,
1892              "-//NETSCAPE COMM. CORP.//DTD HTML//EN" => 1,
1893              "-//NETSCAPE COMM. CORP.//DTD STRICT HTML//EN" => 1,
1894              "-//O'REILLY AND ASSOCIATES//DTD HTML 2.0//EN" => 1,
1895              "-//O'REILLY AND ASSOCIATES//DTD HTML EXTENDED 1.0//EN" => 1,
1896              "-//SPYGLASS//DTD HTML 2.0 EXTENDED//EN" => 1,
1897              "-//SQ//DTD HTML 2.0 HOTMETAL + EXTENSIONS//EN" => 1,
1898              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA HTML//EN" => 1,
1899              "-//SUN MICROSYSTEMS CORP.//DTD HOTJAVA STRICT HTML//EN" => 1,
1900              "-//W3C//DTD HTML 3 1995-03-24//EN" => 1,
1901              "-//W3C//DTD HTML 3.2 DRAFT//EN" => 1,
1902              "-//W3C//DTD HTML 3.2 FINAL//EN" => 1,
1903              "-//W3C//DTD HTML 3.2//EN" => 1,
1904              "-//W3C//DTD HTML 3.2S DRAFT//EN" => 1,
1905              "-//W3C//DTD HTML 4.0 FRAMESET//EN" => 1,
1906              "-//W3C//DTD HTML 4.0 TRANSITIONAL//EN" => 1,
1907              "-//W3C//DTD HTML EXPERIMETNAL 19960712//EN" => 1,
1908              "-//W3C//DTD HTML EXPERIMENTAL 970421//EN" => 1,
1909              "-//W3C//DTD W3 HTML//EN" => 1,
1910              "-//W3O//DTD W3 HTML 3.0//EN" => 1,
1911              "-//W3O//DTD W3 HTML 3.0//EN//" => 1,
1912              "-//W3O//DTD W3 HTML STRICT 3.0//EN//" => 1,
1913              "-//WEBTECHS//DTD MOZILLA HTML 2.0//EN" => 1,
1914              "-//WEBTECHS//DTD MOZILLA HTML//EN" => 1,
1915              "-/W3C/DTD HTML 4.0 TRANSITIONAL/EN" => 1,
1916              "HTML" => 1,
1917            }->{$pubid}) {
1918              $self->{document}->manakai_compat_mode ('quirks');
1919            } elsif ($pubid eq "-//W3C//DTD HTML 4.01 FRAMESET//EN" or
1920                     $pubid eq "-//W3C//DTD HTML 4.01 TRANSITIONAL//EN") {
1921              if (defined $token->{system_identifier}) {
1922                $self->{document}->manakai_compat_mode ('quirks');
1923              } else {
1924                $self->{document}->manakai_compat_mode ('limited quirks');
1925              }
1926            } elsif ($pubid eq "-//W3C//DTD XHTML 1.0 Frameset//EN" or
1927                     $pubid eq "-//W3C//DTD XHTML 1.0 Transitional//EN") {
1928              $self->{document}->manakai_compat_mode ('limited quirks');
1929            }
1930          }
1931          if (defined $token->{system_identifier}) {
1932            my $sysid = $token->{system_identifier};
1933            $sysid =~ tr/A-Z/a-z/;
1934            if ($sysid eq "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd") {
1935              $self->{document}->manakai_compat_mode ('quirks');
1936            }
1937          }
1938          
1939          ## Go to the root element phase.
1940          !!!next-token;
1941          return;
1942        } elsif ({
1943                  'start tag' => 1,
1944                  'end tag' => 1,
1945                  'end-of-file' => 1,
1946                 }->{$token->{type}}) {
1947          !!!parse-error (type => 'no DOCTYPE');
1948          $self->{document}->manakai_compat_mode ('quirks');
1949          ## Go to the root element phase
1950          ## reprocess
1951          return;
1952        } elsif ($token->{type} eq 'character') {
1953          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1954            ## Ignore the token
1955    
1956            unless (length $token->{data}) {
1957              ## Stay in the phase
1958              !!!next-token;
1959              redo INITIAL;
1960            }
1961          }
1962    
1963          !!!parse-error (type => 'no DOCTYPE');
1964          $self->{document}->manakai_compat_mode ('quirks');
1965          ## Go to the root element phase
1966          ## reprocess
1967          return;
1968        } elsif ($token->{type} eq 'comment') {
1969          my $comment = $self->{document}->create_comment ($token->{data});
1970          $self->{document}->append_child ($comment);
1971          
1972          ## Stay in the phase.
1973          !!!next-token;
1974          redo INITIAL;
1975        } else {
1976          die "$0: $token->{type}: Unknown token";
1977        }
1978      } # INITIAL
1979    } # _tree_construction_initial
1980    
1981    sub _tree_construction_root_element ($) {
1982      my $self = shift;
1983      
1984      B: {
1985          if ($token->{type} eq 'DOCTYPE') {
1986            !!!parse-error (type => 'in html:#DOCTYPE');
1987            ## Ignore the token
1988            ## Stay in the phase
1989            !!!next-token;
1990            redo B;
1991          } elsif ($token->{type} eq 'comment') {
1992            my $comment = $self->{document}->create_comment ($token->{data});
1993            $self->{document}->append_child ($comment);
1994            ## Stay in the phase
1995            !!!next-token;
1996            redo B;
1997          } elsif ($token->{type} eq 'character') {
1998            if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) { # \x0D
1999              ## Ignore the token.
2000    
2001              unless (length $token->{data}) {
2002                ## Stay in the phase
2003                !!!next-token;
2004                redo B;
2005              }
2006            }
2007            #
2008          } elsif ({
2009                    'start tag' => 1,
2010                    'end tag' => 1,
2011                    'end-of-file' => 1,
2012                   }->{$token->{type}}) {
2013            ## ISSUE: There is an issue in the spec
2014            #
2015          } else {
2016            die "$0: $token->{type}: Unknown token";
2017          }
2018          my $root_element; !!!create-element ($root_element, 'html');
2019          $self->{document}->append_child ($root_element);
2020          push @{$self->{open_elements}}, [$root_element, 'html'];
2021          ## reprocess
2022          #redo B;
2023          return; ## Go to the main phase.
2024      } # B
2025    } # _tree_construction_root_element
2026    
2027    sub _reset_insertion_mode ($) {
2028      my $self = shift;
2029    
2030        ## Step 1
2031        my $last;
2032        
2033        ## Step 2
2034        my $i = -1;
2035        my $node = $self->{open_elements}->[$i];
2036        
2037        ## Step 3
2038        S3: {
2039          ## ISSUE: Oops! "If node is the first node in the stack of open
2040          ## elements, then set last to true. If the context element of the
2041          ## HTML fragment parsing algorithm is neither a td element nor a
2042          ## th element, then set node to the context element. (fragment case)":
2043          ## The second "if" is in the scope of the first "if"!?
2044          if ($self->{open_elements}->[0]->[0] eq $node->[0]) {
2045            $last = 1;
2046            if (defined $self->{inner_html_node}) {
2047              if ($self->{inner_html_node}->[1] eq 'td' or
2048                  $self->{inner_html_node}->[1] eq 'th') {
2049                #
2050              } else {
2051                $node = $self->{inner_html_node};
2052              }
2053            }
2054          }
2055        
2056          ## Step 4..13
2057          my $new_mode = {
2058                          select => 'in select',
2059                          td => 'in cell',
2060                          th => 'in cell',
2061                          tr => 'in row',
2062                          tbody => 'in table body',
2063                          thead => 'in table head',
2064                          tfoot => 'in table foot',
2065                          caption => 'in caption',
2066                          colgroup => 'in column group',
2067                          table => 'in table',
2068                          head => 'in body', # not in head!
2069                          body => 'in body',
2070                          frameset => 'in frameset',
2071                         }->{$node->[1]};
2072          $self->{insertion_mode} = $new_mode and return if defined $new_mode;
2073          
2074          ## Step 14
2075          if ($node->[1] eq 'html') {
2076            unless (defined $self->{head_element}) {
2077              $self->{insertion_mode} = 'before head';
2078            } else {
2079              $self->{insertion_mode} = 'after head';
2080            }
2081            return;
2082          }
2083          
2084          ## Step 15
2085          $self->{insertion_mode} = 'in body' and return if $last;
2086          
2087          ## Step 16
2088          $i--;
2089          $node = $self->{open_elements}->[$i];
2090          
2091          ## Step 17
2092          redo S3;
2093        } # S3
2094    } # _reset_insertion_mode
2095    
2096    sub _tree_construction_main ($) {
2097      my $self = shift;
2098    
2099      my $previous_insertion_mode;
2100    
   my $open_elements = [];  
2101    my $active_formatting_elements = [];    my $active_formatting_elements = [];
   my $head_element;  
   my $form_element;  
   my $insertion_mode = 'before head';  
2102    
2103    my $reconstruct_active_formatting_elements = sub { # MUST    my $reconstruct_active_formatting_elements = sub { # MUST
2104      my $insert = shift;      my $insert = shift;
# Line 1621  sub _construct_tree ($) { Line 2112  sub _construct_tree ($) {
2112    
2113      ## Step 2      ## Step 2
2114      return if $entry->[0] eq '#marker';      return if $entry->[0] eq '#marker';
2115      for (@$open_elements) {      for (@{$self->{open_elements}}) {
2116        if ($entry->[0] eq $_->[0]) {        if ($entry->[0] eq $_->[0]) {
2117          return;          return;
2118        }        }
# Line 1640  sub _construct_tree ($) { Line 2131  sub _construct_tree ($) {
2131          #          #
2132        } else {        } else {
2133          my $in_open_elements;          my $in_open_elements;
2134          OE: for (@$open_elements) {          OE: for (@{$self->{open_elements}}) {
2135            if ($entry->[0] eq $_->[0]) {            if ($entry->[0] eq $_->[0]) {
2136              $in_open_elements = 1;              $in_open_elements = 1;
2137              last OE;              last OE;
# Line 1664  sub _construct_tree ($) { Line 2155  sub _construct_tree ($) {
2155            
2156        ## Step 9        ## Step 9
2157        $insert->($clone->[0]);        $insert->($clone->[0]);
2158        push @$open_elements, $clone;        push @{$self->{open_elements}}, $clone;
2159                
2160        ## Step 10        ## Step 10
2161        $active_formatting_elements->[$i] = $open_elements->[-1];        $active_formatting_elements->[$i] = $self->{open_elements}->[-1];
2162    
2163        ## Step 11        ## Step 11
2164        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {        unless ($clone->[0] eq $active_formatting_elements->[-1]->[0]) {
# Line 1689  sub _construct_tree ($) { Line 2180  sub _construct_tree ($) {
2180      }      }
2181    }; # $clear_up_to_marker    }; # $clear_up_to_marker
2182    
2183    my $reset_insertion_mode = sub {    my $parse_rcdata = sub ($$) {
2184        my ($content_model_flag, $insert) = @_;
2185    
2186      ## Step 1      ## Step 1
2187      my $last;      my $start_tag_name = $token->{tag_name};
2188            my $el;
2189        !!!create-element ($el, $start_tag_name, $token->{attributes});
2190    
2191      ## Step 2      ## Step 2
2192      my $i = -1;      $insert->($el); # /context node/->append_child ($el)
2193      my $node = $open_elements->[$i];  
       
2194      ## Step 3      ## Step 3
2195      S3: {      $self->{content_model_flag} = $content_model_flag; # CDATA or RCDATA
2196        $last = 1 if $open_elements->[0]->[0] eq $node->[0];      delete $self->{escape}; # MUST
       ## TODO: the element whose inner_html is set is neither td nor th, then $node = the element  
       
       ## Step 4..13  
       my $new_mode = {  
                       select => 'in select',  
                       td => 'in cell',  
                       th => 'in cell',  
                       tr => 'in row',  
                       tbody => 'in table body',  
                       thead => 'in table head',  
                       tfoot => 'in table foot',  
                       caption => 'in caption',  
                       colgroup => 'in column group',  
                       table => 'in table',  
                       head => 'in body', # not in head!  
                       body => 'in body',  
                       frameset => 'in frameset',  
                      }->{$node->[1]};  
       $insertion_mode = $new_mode and return if defined $new_mode;  
         
       ## Step 14  
       if ($node->[1] eq 'html') {  
         unless (defined $head_element) {  
           $insertion_mode = 'before head';  
         } else {  
           $insertion_mode = 'after head';  
         }  
         return;  
       }  
         
       ## Step 15  
       $insertion_mode = 'in body' and return if $last;  
         
       ## Step 16  
       $i--;  
       $node = $open_elements->[$i];  
         
       ## Step 17  
       redo S3;  
     } # S3  
   }; # $reset_insertion_mode  
2197    
2198    my $style_start_tag = sub {      ## Step 4
     my $style_el; !!!create-element ($style_el, 'style');  
     ## $insertion_mode eq 'in head' and ... (always true)  
     (($insertion_mode eq 'in head' and defined $head_element)  
      ? $head_element : $open_elements->[-1]->[0])  
       ->append_child ($style_el);  
     $self->{content_model_flag} = 'CDATA';  
                 
2199      my $text = '';      my $text = '';
2200      !!!next-token;      !!!next-token;
2201      while ($token->{type} eq 'character') {      while ($token->{type} eq 'character') { # or until stop tokenizing
2202        $text .= $token->{data};        $text .= $token->{data};
2203        !!!next-token;        !!!next-token;
2204      } # stop if non-character token or tokenizer stops tokenising      }
2205    
2206        ## Step 5
2207      if (length $text) {      if (length $text) {
2208        $style_el->manakai_append_text ($text);        my $text = $self->{document}->create_text_node ($text);
2209          $el->append_child ($text);
2210      }      }
2211        
2212        ## Step 6
2213      $self->{content_model_flag} = 'PCDATA';      $self->{content_model_flag} = 'PCDATA';
2214                  
2215      if ($token->{type} eq 'end tag' and $token->{tag_name} eq 'style') {      ## Step 7
2216        if ($token->{type} eq 'end tag' and $token->{tag_name} eq $start_tag_name) {
2217        ## Ignore the token        ## Ignore the token
2218      } else {      } else {
2219        !!!parse-error;        !!!parse-error (type => 'in '.$content_model_flag.':#'.$token->{type});
       ## ISSUE: And ignore?  
2220      }      }
2221      !!!next-token;      !!!next-token;
2222    }; # $style_start_tag    }; # $parse_rcdata
2223    
2224    my $script_start_tag = sub {    my $script_start_tag = sub ($) {
2225        my $insert = $_[0];
2226      my $script_el;      my $script_el;
2227      !!!create-element ($script_el, 'script', $token->{attributes});      !!!create-element ($script_el, 'script', $token->{attributes});
2228      ## TODO: mark as "parser-inserted"      ## TODO: mark as "parser-inserted"
2229    
2230      $self->{content_model_flag} = 'CDATA';      $self->{content_model_flag} = 'CDATA';
2231        delete $self->{escape}; # MUST
2232            
2233      my $text = '';      my $text = '';
2234      !!!next-token;      !!!next-token;
# Line 1794  sub _construct_tree ($) { Line 2246  sub _construct_tree ($) {
2246          $token->{tag_name} eq 'script') {          $token->{tag_name} eq 'script') {
2247        ## Ignore the token        ## Ignore the token
2248      } else {      } else {
2249        !!!parse-error;        !!!parse-error (type => 'in CDATA:#'.$token->{type});
2250        ## ISSUE: And ignore?        ## ISSUE: And ignore?
2251        ## TODO: mark as "already executed"        ## TODO: mark as "already executed"
2252      }      }
2253            
2254      ## TODO: inner_html mode then mark as "already executed" and skip      if (defined $self->{inner_html_node}) {
2255      if (1) {        ## TODO: mark as "already executed"
2256        } else {
2257        ## TODO: $old_insertion_point = current insertion point        ## TODO: $old_insertion_point = current insertion point
2258        ## TODO: insertion point = just before the next input character        ## TODO: insertion point = just before the next input character
2259          
2260        (($insertion_mode eq 'in head' and defined $head_element)        $insert->($script_el);
        ? $head_element : $open_elements->[-1]->[0])->append_child ($script_el);  
2261                
2262        ## TODO: insertion point = $old_insertion_point (might be "undefined")        ## TODO: insertion point = $old_insertion_point (might be "undefined")
2263                
# Line 1832  sub _construct_tree ($) { Line 2284  sub _construct_tree ($) {
2284          }          }
2285        } # AFE        } # AFE
2286        unless (defined $formatting_element) {        unless (defined $formatting_element) {
2287          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$tag_name);
2288          ## Ignore the token          ## Ignore the token
2289          !!!next-token;          !!!next-token;
2290          return;          return;
# Line 1840  sub _construct_tree ($) { Line 2292  sub _construct_tree ($) {
2292        ## has an element in scope        ## has an element in scope
2293        my $in_scope = 1;        my $in_scope = 1;
2294        my $formatting_element_i_in_open;          my $formatting_element_i_in_open;  
2295        INSCOPE: for (reverse 0..$#$open_elements) {        INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2296          my $node = $open_elements->[$_];          my $node = $self->{open_elements}->[$_];
2297          if ($node->[0] eq $formatting_element->[0]) {          if ($node->[0] eq $formatting_element->[0]) {
2298            if ($in_scope) {            if ($in_scope) {
2299              $formatting_element_i_in_open = $_;              $formatting_element_i_in_open = $_;
2300              last INSCOPE;              last INSCOPE;
2301            } else { # in open elements but not in scope            } else { # in open elements but not in scope
2302              !!!parse-error;              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
2303              ## Ignore the token              ## Ignore the token
2304              !!!next-token;              !!!next-token;
2305              return;              return;
# Line 1860  sub _construct_tree ($) { Line 2312  sub _construct_tree ($) {
2312          }          }
2313        } # INSCOPE        } # INSCOPE
2314        unless (defined $formatting_element_i_in_open) {        unless (defined $formatting_element_i_in_open) {
2315          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
2316          pop @$active_formatting_elements; # $formatting_element          pop @$active_formatting_elements; # $formatting_element
2317          !!!next-token; ## TODO: ok?          !!!next-token; ## TODO: ok?
2318          return;          return;
2319        }        }
2320        if (not $open_elements->[-1]->[0] eq $formatting_element->[0]) {        if (not $self->{open_elements}->[-1]->[0] eq $formatting_element->[0]) {
2321          !!!parse-error;          !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
2322        }        }
2323                
2324        ## Step 2        ## Step 2
2325        my $furthest_block;        my $furthest_block;
2326        my $furthest_block_i_in_open;        my $furthest_block_i_in_open;
2327        OE: for (reverse 0..$#$open_elements) {        OE: for (reverse 0..$#{$self->{open_elements}}) {
2328          my $node = $open_elements->[$_];          my $node = $self->{open_elements}->[$_];
2329          if (not $formatting_category->{$node->[1]} and          if (not $formatting_category->{$node->[1]} and
2330              #not $phrasing_category->{$node->[1]} and              #not $phrasing_category->{$node->[1]} and
2331              ($special_category->{$node->[1]} or              ($special_category->{$node->[1]} or
# Line 1887  sub _construct_tree ($) { Line 2339  sub _construct_tree ($) {
2339                
2340        ## Step 3        ## Step 3
2341        unless (defined $furthest_block) { # MUST        unless (defined $furthest_block) { # MUST
2342          splice @$open_elements, $formatting_element_i_in_open;          splice @{$self->{open_elements}}, $formatting_element_i_in_open;
2343          splice @$active_formatting_elements, $formatting_element_i_in_active, 1;          splice @$active_formatting_elements, $formatting_element_i_in_active, 1;
2344          !!!next-token;          !!!next-token;
2345          return;          return;
2346        }        }
2347                
2348        ## Step 4        ## Step 4
2349        my $common_ancestor_node = $open_elements->[$formatting_element_i_in_open - 1];        my $common_ancestor_node = $self->{open_elements}->[$formatting_element_i_in_open - 1];
2350                
2351        ## Step 5        ## Step 5
2352        my $furthest_block_parent = $furthest_block->[0]->parent_node;        my $furthest_block_parent = $furthest_block->[0]->parent_node;
# Line 1914  sub _construct_tree ($) { Line 2366  sub _construct_tree ($) {
2366        S7: {        S7: {
2367          ## Step 1          ## Step 1
2368          $node_i_in_open--;          $node_i_in_open--;
2369          $node = $open_elements->[$node_i_in_open];          $node = $self->{open_elements}->[$node_i_in_open];
2370                    
2371          ## Step 2          ## Step 2
2372          my $node_i_in_active;          my $node_i_in_active;
# Line 1925  sub _construct_tree ($) { Line 2377  sub _construct_tree ($) {
2377                last S7S2;                last S7S2;
2378              }              }
2379            }            }
2380            splice @$open_elements, $node_i_in_open, 1;            splice @{$self->{open_elements}}, $node_i_in_open, 1;
2381            redo S7;            redo S7;
2382          } # S7S2          } # S7S2
2383                    
# Line 1941  sub _construct_tree ($) { Line 2393  sub _construct_tree ($) {
2393          if ($node->[0]->has_child_nodes ()) {          if ($node->[0]->has_child_nodes ()) {
2394            my $clone = [$node->[0]->clone_node (0), $node->[1]];            my $clone = [$node->[0]->clone_node (0), $node->[1]];
2395            $active_formatting_elements->[$node_i_in_active] = $clone;            $active_formatting_elements->[$node_i_in_active] = $clone;
2396            $open_elements->[$node_i_in_open] = $clone;            $self->{open_elements}->[$node_i_in_open] = $clone;
2397            $node = $clone;            $node = $clone;
2398          }          }
2399                    
# Line 1983  sub _construct_tree ($) { Line 2435  sub _construct_tree ($) {
2435                
2436        ## Step 13        ## Step 13
2437        undef $i;        undef $i;
2438        OE: for (reverse 0..$#$open_elements) {        OE: for (reverse 0..$#{$self->{open_elements}}) {
2439          if ($open_elements->[$_]->[0] eq $formatting_element->[0]) {          if ($self->{open_elements}->[$_]->[0] eq $formatting_element->[0]) {
2440            splice @$open_elements, $_, 1;            splice @{$self->{open_elements}}, $_, 1;
2441            $i-- and last OE if defined $i;            $i-- and last OE if defined $i;
2442          } elsif ($open_elements->[$_]->[0] eq $furthest_block->[0]) {          } elsif ($self->{open_elements}->[$_]->[0] eq $furthest_block->[0]) {
2443            $i = $_;            $i = $_;
2444          }          }
2445        } # OE        } # OE
2446        splice @$open_elements, $i + 1, 1, $clone;        splice @{$self->{open_elements}}, $i + 1, 1, $clone;
2447                
2448        ## Step 14        ## Step 14
2449        redo FET;        redo FET;
# Line 1999  sub _construct_tree ($) { Line 2451  sub _construct_tree ($) {
2451    }; # $formatting_end_tag    }; # $formatting_end_tag
2452    
2453    my $insert_to_current = sub {    my $insert_to_current = sub {
2454      $open_elements->[-1]->[0]->append_child (shift);      $self->{open_elements}->[-1]->[0]->append_child ($_[0]);
2455    }; # $insert_to_current    }; # $insert_to_current
2456    
2457    my $insert_to_foster = sub {    my $insert_to_foster = sub {
# Line 2007  sub _construct_tree ($) { Line 2459  sub _construct_tree ($) {
2459                         if ({                         if ({
2460                              table => 1, tbody => 1, tfoot => 1,                              table => 1, tbody => 1, tfoot => 1,
2461                              thead => 1, tr => 1,                              thead => 1, tr => 1,
2462                             }->{$open_elements->[-1]->[1]}) {                             }->{$self->{open_elements}->[-1]->[1]}) {
2463                           # MUST                           # MUST
2464                           my $foster_parent_element;                           my $foster_parent_element;
2465                           my $next_sibling;                           my $next_sibling;
2466                           OE: for (reverse 0..$#$open_elements) {                           OE: for (reverse 0..$#{$self->{open_elements}}) {
2467                             if ($open_elements->[$_]->[1] eq 'table') {                             if ($self->{open_elements}->[$_]->[1] eq 'table') {
2468                               my $parent = $open_elements->[$_]->[0]->parent_node;                               my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
2469                               if (defined $parent and $parent->node_type == 1) {                               if (defined $parent and $parent->node_type == 1) {
2470                                 $foster_parent_element = $parent;                                 $foster_parent_element = $parent;
2471                                 $next_sibling = $open_elements->[$_]->[0];                                 $next_sibling = $self->{open_elements}->[$_]->[0];
2472                               } else {                               } else {
2473                                 $foster_parent_element                                 $foster_parent_element
2474                                   = $open_elements->[$_ - 1]->[0];                                   = $self->{open_elements}->[$_ - 1]->[0];
2475                               }                               }
2476                               last OE;                               last OE;
2477                             }                             }
2478                           } # OE                           } # OE
2479                           $foster_parent_element = $open_elements->[0]->[0]                           $foster_parent_element = $self->{open_elements}->[0]->[0]
2480                             unless defined $foster_parent_element;                             unless defined $foster_parent_element;
2481                           $foster_parent_element->insert_before                           $foster_parent_element->insert_before
2482                             ($child, $next_sibling);                             ($child, $next_sibling);
2483                         } else {                         } else {
2484                           $open_elements->[-1]->[0]->append_child ($child);                           $self->{open_elements}->[-1]->[0]->append_child ($child);
2485                         }                         }
2486    }; # $insert_to_foster    }; # $insert_to_foster
2487    
# Line 2037  sub _construct_tree ($) { Line 2489  sub _construct_tree ($) {
2489      my $insert = shift;      my $insert = shift;
2490      if ($token->{type} eq 'start tag') {      if ($token->{type} eq 'start tag') {
2491        if ($token->{tag_name} eq 'script') {        if ($token->{tag_name} eq 'script') {
2492          $script_start_tag->();          ## NOTE: This is an "as if in head" code clone
2493            $script_start_tag->($insert);
2494          return;          return;
2495        } elsif ($token->{tag_name} eq 'style') {        } elsif ($token->{tag_name} eq 'style') {
2496          $style_start_tag->();          ## NOTE: This is an "as if in head" code clone
2497            $parse_rcdata->('CDATA', $insert);
2498          return;          return;
2499        } elsif ({        } elsif ({
2500                  base => 1, link => 1, meta => 1,                  base => 1, link => 1,
2501                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2502          !!!parse-error ($token->{tag_name}.' in body');          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2503          ## NOTE: This is an "as if in head" code clone          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2504          my $el;          pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
         !!!create-element ($el, $token->{tag_name}, $token->{attributes});  
         if (defined $head_element) {  
           $head_element->append_child ($el);  
         } else {  
           $insert->($el);  
         }  
           
2505          !!!next-token;          !!!next-token;
2506          return;          return;
2507        } elsif ($token->{tag_name} eq 'title') {        } elsif ($token->{tag_name} eq 'meta') {
2508          !!!parse-error ('title in body');          ## NOTE: This is an "as if in head" code clone, only "-t" differs
2509          ## NOTE: There is an "as if in head" code clone          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2510          my $title_el;          pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
2511          !!!create-element ($title_el, 'title', $token->{attributes});  
2512          (defined $head_element ? $head_element : $open_elements->[-1]->[0])          unless ($self->{confident}) {
2513            ->append_child ($title_el);            my $charset;
2514          $self->{content_model_flag} = 'RCDATA';            if ($token->{attributes}->{charset}) { ## TODO: And if supported
2515                        $charset = $token->{attributes}->{charset}->{value};
2516          my $text = '';            }
2517          !!!next-token;            if ($token->{attributes}->{'http-equiv'}) {
2518          while ($token->{type} eq 'character') {              ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.
2519            $text .= $token->{data};              if ($token->{attributes}->{'http-equiv'}->{value}
2520            !!!next-token;                  =~ /\A[^;]*;[\x09-\x0D\x20]*charset[\x09-\x0D\x20]*=
2521          }                      [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
2522          if (length $text) {                      ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {
2523            $title_el->manakai_append_text ($text);                $charset = defined $1 ? $1 : defined $2 ? $2 : $3;
2524          }              } ## TODO: And if supported
2525                      }
2526          $self->{content_model_flag} = 'PCDATA';            ## TODO: Change the encoding
           
         if ($token->{type} eq 'end tag' and  
             $token->{tag_name} eq 'title') {  
           ## Ignore the token  
         } else {  
           !!!parse-error;  
           ## ISSUE: And ignore?  
2527          }          }
2528    
2529          !!!next-token;          !!!next-token;
2530          return;          return;
2531          } elsif ($token->{tag_name} eq 'title') {
2532            !!!parse-error (type => 'in body:title');
2533            ## NOTE: This is an "as if in head" code clone
2534            $parse_rcdata->('RCDATA', sub {
2535              if (defined $self->{head_element}) {
2536                $self->{head_element}->append_child ($_[0]);
2537              } else {
2538                $insert->($_[0]);
2539              }
2540            });
2541            return;
2542        } elsif ($token->{tag_name} eq 'body') {        } elsif ($token->{tag_name} eq 'body') {
2543          !!!parse-error;          !!!parse-error (type => 'in body:body');
2544                                
2545          if (@$open_elements == 1 or          if (@{$self->{open_elements}} == 1 or
2546              $open_elements->[1]->[1] ne 'body') {              $self->{open_elements}->[1]->[1] ne 'body') {
2547            ## Ignore the token            ## Ignore the token
2548          } else {          } else {
2549            my $body_el = $open_elements->[1]->[0];            my $body_el = $self->{open_elements}->[1]->[0];
2550            for my $attr_name (keys %{$token->{attributes}}) {            for my $attr_name (keys %{$token->{attributes}}) {
2551              unless ($body_el->has_attribute_ns (undef, $attr_name)) {              unless ($body_el->has_attribute_ns (undef, $attr_name)) {
2552                $body_el->set_attribute_ns                $body_el->set_attribute_ns
# Line 2112  sub _construct_tree ($) { Line 2564  sub _construct_tree ($) {
2564                  pre => 1,                  pre => 1,
2565                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2566          ## has a p element in scope          ## has a p element in scope
2567          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2568            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2569              !!!back-token;              !!!back-token;
2570              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2139  sub _construct_tree ($) { Line 2591  sub _construct_tree ($) {
2591          }          }
2592          return;          return;
2593        } elsif ($token->{tag_name} eq 'form') {        } elsif ($token->{tag_name} eq 'form') {
2594          if (defined $form_element) {          if (defined $self->{form_element}) {
2595            !!!parse-error;            !!!parse-error (type => 'in form:form');
2596            ## Ignore the token            ## Ignore the token
2597              !!!next-token;
2598              return;
2599          } else {          } else {
2600            ## has a p element in scope            ## has a p element in scope
2601            INSCOPE: for (reverse @$open_elements) {            INSCOPE: for (reverse @{$self->{open_elements}}) {
2602              if ($_->[1] eq 'p') {              if ($_->[1] eq 'p') {
2603                !!!back-token;                !!!back-token;
2604                $token = {type => 'end tag', tag_name => 'p'};                $token = {type => 'end tag', tag_name => 'p'};
# Line 2158  sub _construct_tree ($) { Line 2612  sub _construct_tree ($) {
2612            } # INSCOPE            } # INSCOPE
2613                            
2614            !!!insert-element-t ($token->{tag_name}, $token->{attributes});            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2615            $form_element = $open_elements->[-1]->[0];            $self->{form_element} = $self->{open_elements}->[-1]->[0];
2616            !!!next-token;            !!!next-token;
2617            return;            return;
2618          }          }
2619        } elsif ($token->{tag_name} eq 'li') {        } elsif ($token->{tag_name} eq 'li') {
2620          ## has a p element in scope          ## has a p element in scope
2621          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2622            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2623              !!!back-token;              !!!back-token;
2624              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2179  sub _construct_tree ($) { Line 2633  sub _construct_tree ($) {
2633                        
2634          ## Step 1          ## Step 1
2635          my $i = -1;          my $i = -1;
2636          my $node = $open_elements->[$i];          my $node = $self->{open_elements}->[$i];
2637          LI: {          LI: {
2638            ## Step 2            ## Step 2
2639            if ($node->[1] eq 'li') {            if ($node->[1] eq 'li') {
2640              splice @$open_elements, $i;              if ($i != -1) {
2641                  !!!parse-error (type => 'end tag missing:'.
2642                                  $self->{open_elements}->[-1]->[1]);
2643                }
2644                splice @{$self->{open_elements}}, $i;
2645              last LI;              last LI;
2646            }            }
2647                        
# Line 2198  sub _construct_tree ($) { Line 2656  sub _construct_tree ($) {
2656                        
2657            ## Step 4            ## Step 4
2658            $i--;            $i--;
2659            $node = $open_elements->[$i];            $node = $self->{open_elements}->[$i];
2660            redo LI;            redo LI;
2661          } # LI          } # LI
2662                        
# Line 2207  sub _construct_tree ($) { Line 2665  sub _construct_tree ($) {
2665          return;          return;
2666        } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {        } elsif ($token->{tag_name} eq 'dd' or $token->{tag_name} eq 'dt') {
2667          ## has a p element in scope          ## has a p element in scope
2668          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2669            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2670              !!!back-token;              !!!back-token;
2671              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2222  sub _construct_tree ($) { Line 2680  sub _construct_tree ($) {
2680                        
2681          ## Step 1          ## Step 1
2682          my $i = -1;          my $i = -1;
2683          my $node = $open_elements->[$i];          my $node = $self->{open_elements}->[$i];
2684          LI: {          LI: {
2685            ## Step 2            ## Step 2
2686            if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {            if ($node->[1] eq 'dt' or $node->[1] eq 'dd') {
2687              splice @$open_elements, $i;              if ($i != -1) {
2688                  !!!parse-error (type => 'end tag missing:'.
2689                                  $self->{open_elements}->[-1]->[1]);
2690                }
2691                splice @{$self->{open_elements}}, $i;
2692              last LI;              last LI;
2693            }            }
2694                        
# Line 2241  sub _construct_tree ($) { Line 2703  sub _construct_tree ($) {
2703                        
2704            ## Step 4            ## Step 4
2705            $i--;            $i--;
2706            $node = $open_elements->[$i];            $node = $self->{open_elements}->[$i];
2707            redo LI;            redo LI;
2708          } # LI          } # LI
2709                        
# Line 2250  sub _construct_tree ($) { Line 2712  sub _construct_tree ($) {
2712          return;          return;
2713        } elsif ($token->{tag_name} eq 'plaintext') {        } elsif ($token->{tag_name} eq 'plaintext') {
2714          ## has a p element in scope          ## has a p element in scope
2715          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2716            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2717              !!!back-token;              !!!back-token;
2718              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2273  sub _construct_tree ($) { Line 2735  sub _construct_tree ($) {
2735                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2736                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2737          ## has a p element in scope          ## has a p element in scope
2738          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2739            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
2740            if ($node->[1] eq 'p') {            if ($node->[1] eq 'p') {
2741              !!!back-token;              !!!back-token;
2742              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2287  sub _construct_tree ($) { Line 2749  sub _construct_tree ($) {
2749            }            }
2750          } # INSCOPE          } # INSCOPE
2751                        
2752            ## NOTE: See <http://html5.org/tools/web-apps-tracker?from=925&to=926>
2753          ## has an element in scope          ## has an element in scope
2754          my $i;          #my $i;
2755          INSCOPE: for (reverse 0..$#$open_elements) {          #INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2756            my $node = $open_elements->[$_];          #  my $node = $self->{open_elements}->[$_];
2757            if ({          #  if ({
2758                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,          #       h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
2759                }->{$node->[1]}) {          #      }->{$node->[1]}) {
2760              $i = $_;          #    $i = $_;
2761              last INSCOPE;          #    last INSCOPE;
2762            } elsif ({          #  } elsif ({
2763                      table => 1, caption => 1, td => 1, th => 1,          #            table => 1, caption => 1, td => 1, th => 1,
2764                      button => 1, marquee => 1, object => 1, html => 1,          #            button => 1, marquee => 1, object => 1, html => 1,
2765                     }->{$node->[1]}) {          #           }->{$node->[1]}) {
2766              last INSCOPE;          #    last INSCOPE;
2767            }          #  }
2768          } # INSCOPE          #} # INSCOPE
2769                      #  
2770          if (defined $i) {          #if (defined $i) {
2771            !!!parse-error;          #  !!! parse-error (type => 'in hn:hn');
2772            splice @$open_elements, $i;          #  splice @{$self->{open_elements}}, $i;
2773          }          #}
2774                        
2775          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2776                        
# Line 2317  sub _construct_tree ($) { Line 2780  sub _construct_tree ($) {
2780          AFE: for my $i (reverse 0..$#$active_formatting_elements) {          AFE: for my $i (reverse 0..$#$active_formatting_elements) {
2781            my $node = $active_formatting_elements->[$i];            my $node = $active_formatting_elements->[$i];
2782            if ($node->[1] eq 'a') {            if ($node->[1] eq 'a') {
2783              !!!parse-error ('a in a');              !!!parse-error (type => 'in a:a');
2784                            
2785              !!!back-token;              !!!back-token;
2786              $token = {type => 'end tag', tag_name => 'a'};              $token = {type => 'end tag', tag_name => 'a'};
# Line 2329  sub _construct_tree ($) { Line 2792  sub _construct_tree ($) {
2792                  last AFE2;                  last AFE2;
2793                }                }
2794              } # AFE2              } # AFE2
2795              OE: for (reverse 0..$#$open_elements) {              OE: for (reverse 0..$#{$self->{open_elements}}) {
2796                if ($open_elements->[$_]->[0] eq $node->[0]) {                if ($self->{open_elements}->[$_]->[0] eq $node->[0]) {
2797                  splice @$open_elements, $_, 1;                  splice @{$self->{open_elements}}, $_, 1;
2798                  last OE;                  last OE;
2799                }                }
2800              } # OE              } # OE
# Line 2344  sub _construct_tree ($) { Line 2807  sub _construct_tree ($) {
2807          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2808    
2809          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2810          push @$active_formatting_elements, $open_elements->[-1];          push @$active_formatting_elements, $self->{open_elements}->[-1];
2811    
2812          !!!next-token;          !!!next-token;
2813          return;          return;
2814        } elsif ({        } elsif ({
2815                  b => 1, big => 1, em => 1, font => 1, i => 1,                  b => 1, big => 1, em => 1, font => 1, i => 1,
2816                  nobr => 1, s => 1, small => 1, strile => 1,                  s => 1, small => 1, strile => 1,
2817                  strong => 1, tt => 1, u => 1,                  strong => 1, tt => 1, u => 1,
2818                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2819          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2820                    
2821          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2822          push @$active_formatting_elements, $open_elements->[-1];          push @$active_formatting_elements, $self->{open_elements}->[-1];
2823            
2824            !!!next-token;
2825            return;
2826          } elsif ($token->{tag_name} eq 'nobr') {
2827            $reconstruct_active_formatting_elements->($insert_to_current);
2828    
2829            ## has a |nobr| element in scope
2830            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2831              my $node = $self->{open_elements}->[$_];
2832              if ($node->[1] eq 'nobr') {
2833                !!!parse-error (type => 'not closed:nobr');
2834                !!!back-token;
2835                $token = {type => 'end tag', tag_name => 'nobr'};
2836                return;
2837              } elsif ({
2838                        table => 1, caption => 1, td => 1, th => 1,
2839                        button => 1, marquee => 1, object => 1, html => 1,
2840                       }->{$node->[1]}) {
2841                last INSCOPE;
2842              }
2843            } # INSCOPE
2844            
2845            !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2846            push @$active_formatting_elements, $self->{open_elements}->[-1];
2847                    
2848          !!!next-token;          !!!next-token;
2849          return;          return;
2850        } elsif ($token->{tag_name} eq 'button') {        } elsif ($token->{tag_name} eq 'button') {
2851          ## has a button element in scope          ## has a button element in scope
2852          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
2853            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
2854            if ($node->[1] eq 'button') {            if ($node->[1] eq 'button') {
2855              !!!parse-error;              !!!parse-error (type => 'in button:button');
2856              !!!back-token;              !!!back-token;
2857              $token = {type => 'end tag', tag_name => 'button'};              $token = {type => 'end tag', tag_name => 'button'};
2858              return;              return;
# Line 2395  sub _construct_tree ($) { Line 2882  sub _construct_tree ($) {
2882          return;          return;
2883        } elsif ($token->{tag_name} eq 'xmp') {        } elsif ($token->{tag_name} eq 'xmp') {
2884          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2885                    $parse_rcdata->('CDATA', $insert);
         !!!insert-element-t ($token->{tag_name}, $token->{attributes});  
           
         $self->{content_model_flag} = 'CDATA';  
           
         !!!next-token;  
2886          return;          return;
2887        } elsif ($token->{tag_name} eq 'table') {        } elsif ($token->{tag_name} eq 'table') {
2888          ## has a p element in scope          ## has a p element in scope
2889          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2890            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2891              !!!back-token;              !!!back-token;
2892              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2419  sub _construct_tree ($) { Line 2901  sub _construct_tree ($) {
2901                        
2902          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2903                        
2904          $insertion_mode = 'in table';          $self->{insertion_mode} = 'in table';
2905                        
2906          !!!next-token;          !!!next-token;
2907          return;          return;
# Line 2429  sub _construct_tree ($) { Line 2911  sub _construct_tree ($) {
2911                  image => 1,                  image => 1,
2912                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
2913          if ($token->{tag_name} eq 'image') {          if ($token->{tag_name} eq 'image') {
2914            !!!parse-error;            !!!parse-error (type => 'image');
2915            $token->{tag_name} = 'img';            $token->{tag_name} = 'img';
2916          }          }
2917            
2918            ## NOTE: There is an "as if <br>" code clone.
2919          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2920                    
2921          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2922          pop @$open_elements;          pop @{$self->{open_elements}};
2923                    
2924          !!!next-token;          !!!next-token;
2925          return;          return;
2926        } elsif ($token->{tag_name} eq 'hr') {        } elsif ($token->{tag_name} eq 'hr') {
2927          ## has a p element in scope          ## has a p element in scope
2928          INSCOPE: for (reverse @$open_elements) {          INSCOPE: for (reverse @{$self->{open_elements}}) {
2929            if ($_->[1] eq 'p') {            if ($_->[1] eq 'p') {
2930              !!!back-token;              !!!back-token;
2931              $token = {type => 'end tag', tag_name => 'p'};              $token = {type => 'end tag', tag_name => 'p'};
# Line 2456  sub _construct_tree ($) { Line 2939  sub _construct_tree ($) {
2939          } # INSCOPE          } # INSCOPE
2940                        
2941          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2942          pop @$open_elements;          pop @{$self->{open_elements}};
2943                        
2944          !!!next-token;          !!!next-token;
2945          return;          return;
# Line 2464  sub _construct_tree ($) { Line 2947  sub _construct_tree ($) {
2947          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
2948                    
2949          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
2950          ## TODO: associate with $form_element if defined          ## TODO: associate with $self->{form_element} if defined
2951          pop @$open_elements;          pop @{$self->{open_elements}};
2952                    
2953          !!!next-token;          !!!next-token;
2954          return;          return;
2955        } elsif ($token->{tag_name} eq 'isindex') {        } elsif ($token->{tag_name} eq 'isindex') {
2956          !!!parse-error;          !!!parse-error (type => 'isindex');
2957                    
2958          if (defined $form_element) {          if (defined $self->{form_element}) {
2959            ## Ignore the token            ## Ignore the token
2960            !!!next-token;            !!!next-token;
2961            return;            return;
2962          } else {          } else {
2963            my $at = $token->{attributes};            my $at = $token->{attributes};
2964              my $form_attrs;
2965              $form_attrs->{action} = $at->{action} if $at->{action};
2966              my $prompt_attr = $at->{prompt};
2967            $at->{name} = {name => 'name', value => 'isindex'};            $at->{name} = {name => 'name', value => 'isindex'};
2968              delete $at->{action};
2969              delete $at->{prompt};
2970            my @tokens = (            my @tokens = (
2971                          {type => 'start tag', tag_name => 'form'},                          {type => 'start tag', tag_name => 'form',
2972                             attributes => $form_attrs},
2973                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2974                          {type => 'start tag', tag_name => 'p'},                          {type => 'start tag', tag_name => 'p'},
2975                          {type => 'start tag', tag_name => 'label'},                          {type => 'start tag', tag_name => 'label'},
2976                          {type => 'character',                         );
2977                           data => 'This is a searchable index. Insert your search keywords here: '}, # SHOULD            if ($prompt_attr) {
2978                          ## TODO: make this configurable              push @tokens, {type => 'character', data => $prompt_attr->{value}};
2979              } else {
2980                push @tokens, {type => 'character',
2981                               data => 'This is a searchable index. Insert your search keywords here: '}; # SHOULD
2982                ## TODO: make this configurable
2983              }
2984              push @tokens,
2985                          {type => 'start tag', tag_name => 'input', attributes => $at},                          {type => 'start tag', tag_name => 'input', attributes => $at},
2986                          #{type => 'character', data => ''}, # SHOULD                          #{type => 'character', data => ''}, # SHOULD
2987                          {type => 'end tag', tag_name => 'label'},                          {type => 'end tag', tag_name => 'label'},
2988                          {type => 'end tag', tag_name => 'p'},                          {type => 'end tag', tag_name => 'p'},
2989                          {type => 'start tag', tag_name => 'hr'},                          {type => 'start tag', tag_name => 'hr'},
2990                          {type => 'end tag', tag_name => 'form'},                          {type => 'end tag', tag_name => 'form'};
                        );  
2991            $token = shift @tokens;            $token = shift @tokens;
2992            !!!back-token (@tokens);            !!!back-token (@tokens);
2993            return;            return;
2994          }          }
2995        } elsif ({        } elsif ($token->{tag_name} eq 'textarea') {
                 textarea => 1,  
                 noembed => 1,  
                 noframes => 1,  
                 noscript => 0, ## TODO: 1 if scripting is enabled  
                }->{$token->{tag_name}}) {  
2996          my $tag_name = $token->{tag_name};          my $tag_name = $token->{tag_name};
2997          my $el;          my $el;
2998          !!!create-element ($el, $token->{tag_name}, $token->{attributes});          !!!create-element ($el, $token->{tag_name}, $token->{attributes});
2999                    
3000          if ($token->{tag_name} eq 'textarea') {          ## TODO: $self->{form_element} if defined
3001            ## TODO: form_element if defined          $self->{content_model_flag} = 'RCDATA';
3002            $self->{content_model_flag} = 'RCDATA';          delete $self->{escape}; # MUST
         } else {  
           $self->{content_model_flag} = 'CDATA';  
         }  
3003                    
3004          $insert->($el);          $insert->($el);
3005                    
3006          my $text = '';          my $text = '';
3007          !!!next-token;          !!!next-token;
3008            if ($token->{type} eq 'character') {
3009              $token->{data} =~ s/^\x0A//;
3010              unless (length $token->{data}) {
3011                !!!next-token;
3012              }
3013            }
3014          while ($token->{type} eq 'character') {          while ($token->{type} eq 'character') {
3015            $text .= $token->{data};            $text .= $token->{data};
3016            !!!next-token;            !!!next-token;
# Line 2533  sub _construct_tree ($) { Line 3025  sub _construct_tree ($) {
3025              $token->{tag_name} eq $tag_name) {              $token->{tag_name} eq $tag_name) {
3026            ## Ignore the token            ## Ignore the token
3027          } else {          } else {
3028            !!!parse-error;            !!!parse-error (type => 'in RCDATA:#'.$token->{type});
           ## ISSUE: And ignore?  
3029          }          }
3030          !!!next-token;          !!!next-token;
3031          return;          return;
3032          } elsif ({
3033                    iframe => 1,
3034                    noembed => 1,
3035                    noframes => 1,
3036                    noscript => 0, ## TODO: 1 if scripting is enabled
3037                   }->{$token->{tag_name}}) {
3038            $parse_rcdata->('CDATA', $insert);
3039            return;
3040        } elsif ($token->{tag_name} eq 'select') {        } elsif ($token->{tag_name} eq 'select') {
3041          $reconstruct_active_formatting_elements->($insert_to_current);          $reconstruct_active_formatting_elements->($insert_to_current);
3042                    
3043          !!!insert-element-t ($token->{tag_name}, $token->{attributes});          !!!insert-element-t ($token->{tag_name}, $token->{attributes});
3044                    
3045          $insertion_mode = 'in select';          $self->{insertion_mode} = 'in select';
3046          !!!next-token;          !!!next-token;
3047          return;          return;
3048        } elsif ({        } elsif ({
# Line 2552  sub _construct_tree ($) { Line 3051  sub _construct_tree ($) {
3051                  tbody => 1, td => 1, tfoot => 1, th => 1,                  tbody => 1, td => 1, tfoot => 1, th => 1,
3052                  thead => 1, tr => 1,                  thead => 1, tr => 1,
3053                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3054          !!!parse-error;          !!!parse-error (type => 'in body:'.$token->{tag_name});
3055          ## Ignore the token          ## Ignore the token
3056          !!!next-token;          !!!next-token;
3057          return;          return;
# Line 2568  sub _construct_tree ($) { Line 3067  sub _construct_tree ($) {
3067        }        }
3068      } elsif ($token->{type} eq 'end tag') {      } elsif ($token->{type} eq 'end tag') {
3069        if ($token->{tag_name} eq 'body') {        if ($token->{tag_name} eq 'body') {
3070          if (@$open_elements > 1 and $open_elements->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and
3071            ## ISSUE: There is an issue in the spec.              $self->{open_elements}->[1]->[1] eq 'body') {
3072            if ($open_elements->[-1]->[1] ne 'body') {            for (@{$self->{open_elements}}) {
3073              !!!parse-error;              unless ({
3074                           dd => 1, dt => 1, li => 1, p => 1, td => 1,
3075                           th => 1, tr => 1, body => 1, html => 1,
3076                         tbody => 1, tfoot => 1, thead => 1,
3077                        }->{$_->[1]}) {
3078                  !!!parse-error (type => 'not closed:'.$_->[1]);
3079                }
3080            }            }
3081            $insertion_mode = 'after body';  
3082              $self->{insertion_mode} = 'after body';
3083            !!!next-token;            !!!next-token;
3084            return;            return;
3085          } else {          } else {
3086            !!!parse-error;            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3087            ## Ignore the token            ## Ignore the token
3088            !!!next-token;            !!!next-token;
3089            return;            return;
3090          }          }
3091        } elsif ($token->{tag_name} eq 'html') {        } elsif ($token->{tag_name} eq 'html') {
3092          if (@$open_elements > 1 and $open_elements->[1]->[1] eq 'body') {          if (@{$self->{open_elements}} > 1 and $self->{open_elements}->[1]->[1] eq 'body') {
3093            ## ISSUE: There is an issue in the spec.            ## ISSUE: There is an issue in the spec.
3094            if ($open_elements->[-1]->[1] ne 'body') {            if ($self->{open_elements}->[-1]->[1] ne 'body') {
3095              !!!parse-error;              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[1]->[1]);
3096            }            }
3097            $insertion_mode = 'after body';            $self->{insertion_mode} = 'after body';
3098            ## reprocess            ## reprocess
3099            return;            return;
3100          } else {          } else {
3101            !!!parse-error;            !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3102            ## Ignore the token            ## Ignore the token
3103            !!!next-token;            !!!next-token;
3104            return;            return;
# Line 2601  sub _construct_tree ($) { Line 3107  sub _construct_tree ($) {
3107                  address => 1, blockquote => 1, center => 1, dir => 1,                  address => 1, blockquote => 1, center => 1, dir => 1,
3108                  div => 1, dl => 1, fieldset => 1, listing => 1,                  div => 1, dl => 1, fieldset => 1, listing => 1,
3109                  menu => 1, ol => 1, pre => 1, ul => 1,                  menu => 1, ol => 1, pre => 1, ul => 1,
                 form => 1,  
3110                  p => 1,                  p => 1,
3111                  dd => 1, dt => 1, li => 1,                  dd => 1, dt => 1, li => 1,
3112                  button => 1, marquee => 1, object => 1,                  button => 1, marquee => 1, object => 1,
3113                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3114          ## has an element in scope          ## has an element in scope
3115          my $i;          my $i;
3116          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3117            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
3118            if ($node->[1] eq $token->{tag_name}) {            if ($node->[1] eq $token->{tag_name}) {
3119              ## generate implied end tags              ## generate implied end tags
3120              if ({              if ({
# Line 2618  sub _construct_tree ($) { Line 3123  sub _construct_tree ($) {
3123                   li => ($token->{tag_name} ne 'li'),                   li => ($token->{tag_name} ne 'li'),
3124                   p => ($token->{tag_name} ne 'p'),                   p => ($token->{tag_name} ne 'p'),
3125                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3126                  }->{$open_elements->[-1]->[1]}) {                   tbody => 1, tfoot=> 1, thead => 1,
3127                    }->{$self->{open_elements}->[-1]->[1]}) {
3128                !!!back-token;                !!!back-token;
3129                $token = {type => 'end tag',                $token = {type => 'end tag',
3130                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3131                return;                return;
3132              }              }
3133              $i = $_;              $i = $_;
# Line 2634  sub _construct_tree ($) { Line 3140  sub _construct_tree ($) {
3140            }            }
3141          } # INSCOPE          } # INSCOPE
3142                    
3143          if ($open_elements->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3144            !!!parse-error;            if (defined $i) {
3145                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3146              } else {
3147                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3148              }
3149          }          }
3150                    
3151          splice @$open_elements, $i if defined $i;          if (defined $i) {
3152          undef $form_element if $token->{tag_name} eq 'form';            splice @{$self->{open_elements}}, $i;
3153            } elsif ($token->{tag_name} eq 'p') {
3154              ## As if <p>, then reprocess the current token
3155              my $el;
3156              !!!create-element ($el, 'p');
3157              $insert->($el);
3158            }
3159          $clear_up_to_marker->()          $clear_up_to_marker->()
3160            if {            if {
3161              button => 1, marquee => 1, object => 1,              button => 1, marquee => 1, object => 1,
3162            }->{$token->{tag_name}};            }->{$token->{tag_name}};
3163          !!!next-token;          !!!next-token;
3164          return;          return;
3165          } elsif ($token->{tag_name} eq 'form') {
3166            ## has an element in scope
3167            INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3168              my $node = $self->{open_elements}->[$_];
3169              if ($node->[1] eq $token->{tag_name}) {
3170                ## generate implied end tags
3171                if ({
3172                     dd => 1, dt => 1, li => 1, p => 1,
3173                     td => 1, th => 1, tr => 1,
3174                     tbody => 1, tfoot=> 1, thead => 1,
3175                    }->{$self->{open_elements}->[-1]->[1]}) {
3176                  !!!back-token;
3177                  $token = {type => 'end tag',
3178                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3179                  return;
3180                }
3181                last INSCOPE;
3182              } elsif ({
3183                        table => 1, caption => 1, td => 1, th => 1,
3184                        button => 1, marquee => 1, object => 1, html => 1,
3185                       }->{$node->[1]}) {
3186                last INSCOPE;
3187              }
3188            } # INSCOPE
3189            
3190            if ($self->{open_elements}->[-1]->[1] eq $token->{tag_name}) {
3191              pop @{$self->{open_elements}};
3192            } else {
3193              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3194            }
3195    
3196            undef $self->{form_element};
3197            !!!next-token;
3198            return;
3199        } elsif ({        } elsif ({
3200                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                  h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3201                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3202          ## has an element in scope          ## has an element in scope
3203          my $i;          my $i;
3204          INSCOPE: for (reverse 0..$#$open_elements) {          INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3205            my $node = $open_elements->[$_];            my $node = $self->{open_elements}->[$_];
3206            if ({            if ({
3207                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,                 h1 => 1, h2 => 1, h3 => 1, h4 => 1, h5 => 1, h6 => 1,
3208                }->{$node->[1]}) {                }->{$node->[1]}) {
# Line 2660  sub _construct_tree ($) { Line 3210  sub _construct_tree ($) {
3210              if ({              if ({
3211                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3212                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3213                  }->{$open_elements->[-1]->[1]}) {                   tbody => 1, tfoot=> 1, thead => 1,
3214                    }->{$self->{open_elements}->[-1]->[1]}) {
3215                !!!back-token;                !!!back-token;
3216                $token = {type => 'end tag',                $token = {type => 'end tag',
3217                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3218                return;                return;
3219              }              }
3220              $i = $_;              $i = $_;
# Line 2676  sub _construct_tree ($) { Line 3227  sub _construct_tree ($) {
3227            }            }
3228          } # INSCOPE          } # INSCOPE
3229                    
3230          if ($open_elements->[-1]->[1] ne $token->{tag_name}) {          if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
3231            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3232          }          }
3233                    
3234          splice @$open_elements, $i if defined $i;          splice @{$self->{open_elements}}, $i if defined $i;
3235          !!!next-token;          !!!next-token;
3236          return;          return;
3237        } elsif ({        } elsif ({
# Line 2691  sub _construct_tree ($) { Line 3242  sub _construct_tree ($) {
3242                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3243          $formatting_end_tag->($token->{tag_name});          $formatting_end_tag->($token->{tag_name});
3244          return;          return;
3245          } elsif ($token->{tag_name} eq 'br') {
3246            !!!parse-error (type => 'unmatched end tag:br');
3247    
3248            ## As if <br>
3249            $reconstruct_active_formatting_elements->($insert_to_current);
3250            
3251            my $el;
3252            !!!create-element ($el, 'br');
3253            $insert->($el);
3254            
3255            ## Ignore the token.
3256            !!!next-token;
3257            return;
3258        } elsif ({        } elsif ({
3259                  caption => 1, col => 1, colgroup => 1, frame => 1,                  caption => 1, col => 1, colgroup => 1, frame => 1,
3260                  frameset => 1, head => 1, option => 1, optgroup => 1,                  frameset => 1, head => 1, option => 1, optgroup => 1,
3261                  tbody => 1, td => 1, tfoot => 1, th => 1,                  tbody => 1, td => 1, tfoot => 1, th => 1,
3262                  thead => 1, tr => 1,                  thead => 1, tr => 1,
3263                  area => 1, basefont => 1, bgsound => 1, br => 1,                  area => 1, basefont => 1, bgsound => 1,
3264                  embed => 1, hr => 1, iframe => 1, image => 1,                  embed => 1, hr => 1, iframe => 1, image => 1,
3265                  img => 1, input => 1, isindex=> 1, noembed => 1,                  img => 1, input => 1, isindex => 1, noembed => 1,
3266                  noframes => 1, param => 1, select => 1, spacer => 1,                  noframes => 1, param => 1, select => 1, spacer => 1,
3267                  table => 1, textarea => 1, wbr => 1,                  table => 1, textarea => 1, wbr => 1,
3268                  noscript => 0, ## TODO: if scripting is enabled                  noscript => 0, ## TODO: if scripting is enabled
3269                 }->{$token->{tag_name}}) {                 }->{$token->{tag_name}}) {
3270          !!!parse-error;          !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3271          ## Ignore the token          ## Ignore the token
3272          !!!next-token;          !!!next-token;
3273          return;          return;
# Line 2713  sub _construct_tree ($) { Line 3277  sub _construct_tree ($) {
3277        } else {        } else {
3278          ## Step 1          ## Step 1
3279          my $node_i = -1;          my $node_i = -1;
3280          my $node = $open_elements->[$node_i];          my $node = $self->{open_elements}->[$node_i];
3281    
3282          ## Step 2          ## Step 2
3283          S2: {          S2: {
# Line 2723  sub _construct_tree ($) { Line 3287  sub _construct_tree ($) {
3287              if ({              if ({
3288                   dd => 1, dt => 1, li => 1, p => 1,                   dd => 1, dt => 1, li => 1, p => 1,
3289                   td => 1, th => 1, tr => 1,                   td => 1, th => 1, tr => 1,
3290                  }->{$open_elements->[-1]->[1]}) {                   tbody => 1, tfoot=> 1, thead => 1,
3291                    }->{$self->{open_elements}->[-1]->[1]}) {
3292                !!!back-token;                !!!back-token;
3293                $token = {type => 'end tag',                $token = {type => 'end tag',
3294                          tag_name => $open_elements->[-1]->[1]}; # MUST                          tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3295                return;                return;
3296              }              }
3297                    
3298              ## Step 2              ## Step 2
3299              if ($token->{tag_name} ne $open_elements->[-1]->[1]) {              if ($token->{tag_name} ne $self->{open_elements}->[-1]->[1]) {
3300                !!!parse-error;                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3301              }              }
3302                            
3303              ## Step 3              ## Step 3
3304              splice @$open_elements, $node_i;              splice @{$self->{open_elements}}, $node_i;
3305    
3306                !!!next-token;
3307              last S2;              last S2;
3308            } else {            } else {
3309              ## Step 3              ## Step 3
# Line 2744  sub _construct_tree ($) { Line 3311  sub _construct_tree ($) {
3311                  #not $phrasing_category->{$node->[1]} and                  #not $phrasing_category->{$node->[1]} and
3312                  ($special_category->{$node->[1]} or                  ($special_category->{$node->[1]} or
3313                   $scoping_category->{$node->[1]})) {                   $scoping_category->{$node->[1]})) {
3314                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3315                ## Ignore the token                ## Ignore the token
3316                !!!next-token;                !!!next-token;
3317                last S2;                last S2;
# Line 2753  sub _construct_tree ($) { Line 3320  sub _construct_tree ($) {
3320                        
3321            ## Step 4            ## Step 4
3322            $node_i--;            $node_i--;
3323            $node = $open_elements->[$node_i];            $node = $self->{open_elements}->[$node_i];
3324                        
3325            ## Step 5;            ## Step 5;
3326            redo S2;            redo S2;
3327          } # S2          } # S2
3328            return;
3329        }        }
3330      }      }
3331    }; # $in_body    }; # $in_body
3332    
3333    B: {    B: {
3334      if ($phase eq 'initial') {      if ($token->{type} eq 'DOCTYPE') {
3335        if ($token->{type} eq 'DOCTYPE') {        !!!parse-error (type => 'DOCTYPE in the middle');
3336          if ($token->{error}) {        ## Ignore the token
3337            ## ISSUE: Spec currently left this case undefined.        ## Stay in the phase
3338            !!!parse-error ('bogus DOCTYPE');        !!!next-token;
         }  
         my $doctype = $self->{document}->create_document_type_definition  
           ($token->{name});  
         $self->{document}->append_child ($doctype);  
         $phase = 'root element';  
         !!!next-token;  
         redo B;  
       } elsif ({  
                 comment => 1,  
                 'start tag' => 1,  
                 'end tag' => 1,  
                 'end-of-file' => 1,  
                }->{$token->{type}}) {  
         ## ISSUE: Spec currently left this case undefined.  
         !!!parse-error ('missing DOCTYPE');  
         $phase = 'root element';  
         ## reprocess  
         redo B;  
       } elsif ($token->{type} eq 'character') {  
         if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
           $self->{document}->manakai_append_text ($1);  
           ## ISSUE: DOM3 Core does not allow Document > Text  
           unless (length $token->{data}) {  
             ## Stay in the phase  
             !!!next-token;  
             redo B;  
           }  
         }  
         ## ISSUE: Spec currently left this case undefined.  
         !!!parse-error ('missing DOCTYPE');  
         $phase = 'root element';  
         ## reprocess  
         redo B;  
       } else {  
         die "$0: $token->{type}: Unknown token";  
       }  
     } elsif ($phase eq 'root element') {  
       if ($token->{type} eq 'DOCTYPE') {  
         !!!parse-error;  
         ## Ignore the token  
         ## Stay in the phase  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'comment') {  
         my $comment = $self->{document}->create_comment ($token->{data});  
         $self->{document}->append_child ($comment);  
         ## Stay in the phase  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'character') {  
         if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
           $self->{document}->manakai_append_text ($1);  
           ## ISSUE: DOM3 Core does not allow Document > Text  
           unless (length $token->{data}) {  
             ## Stay in the phase  
             !!!next-token;  
             redo B;  
           }  
         }  
         #  
       } elsif ({  
                 'start tag' => 1,  
                 'end tag' => 1,  
                 'end-of-file' => 1,  
                }->{$token->{type}}) {  
         ## ISSUE: There is an issue in the spec  
         #  
       } else {  
         die "$0: $token->{type}: Unknown token";  
       }  
       my $root_element; !!!create-element ($root_element, 'html');  
       $self->{document}->append_child ($root_element);  
       $open_elements = [[$root_element, 'html']];  
       $phase = 'main';  
       ## reprocess  
3339        redo B;        redo B;
3340      } elsif ($phase eq 'main') {      } elsif ($token->{type} eq 'end-of-file') {
3341        if ($token->{type} eq 'DOCTYPE') {        if ($token->{insertion_mode} ne 'trailing end') {
         !!!parse-error;  
         ## Ignore the token  
         ## Stay in the phase  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'start tag' and  
                $token->{tag_name} eq 'html') {  
         ## TODO: unless it is the first start tag token, parse-error  
         my $top_el = $open_elements->[0]->[0];  
         for my $attr_name (keys %{$token->{attributes}}) {  
           unless ($top_el->has_attribute_ns (undef, $attr_name)) {  
             $top_el->set_attribute_ns  
               (undef, [undef, $attr_name],  
                $token->{attributes}->{$attr_name}->{value});  
           }  
         }  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'end-of-file') {  
3342          ## Generate implied end tags          ## Generate implied end tags
3343          if ({          if ({
3344               dd => 1, dt => 1, li => 1, p => 1, td => 1, th => 1, tr => 1,               dd => 1, dt => 1, li => 1, p => 1, td => 1, th => 1, tr => 1,
3345              }->{$open_elements->[-1]->[1]}) {               tbody => 1, tfoot=> 1, thead => 1,
3346                }->{$self->{open_elements}->[-1]->[1]}) {
3347            !!!back-token;            !!!back-token;
3348            $token = {type => 'end tag', tag_name => $open_elements->[-1]->[1]};            $token = {type => 'end tag', tag_name => $self->{open_elements}->[-1]->[1]};
3349            redo B;            redo B;
3350          }          }
3351                    
3352          if (@$open_elements > 2 or          if (@{$self->{open_elements}} > 2 or
3353              (@$open_elements == 2 and $open_elements->[1]->[1] ne 'body')) {              (@{$self->{open_elements}} == 2 and $self->{open_elements}->[1]->[1] ne 'body')) {
3354            !!!parse-error;            !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3355          } else {          } elsif (defined $self->{inner_html_node} and
3356            ## TODO: inner_html parser and @$open_elements > 1 and $open_elements->[1] ne 'body', then parse-error                   @{$self->{open_elements}} > 1 and
3357                     $self->{open_elements}->[1]->[1] ne 'body') {
3358              !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3359          }          }
3360    
         ## Stop parsing  
         last B;  
   
3361          ## ISSUE: There is an issue in the spec.          ## ISSUE: There is an issue in the spec.
3362          }
3363    
3364          ## Stop parsing
3365          last B;
3366        } elsif ($token->{type} eq 'start tag' and
3367                 $token->{tag_name} eq 'html') {
3368          if ($self->{insertion_mode} eq 'trailing end') {
3369            ## Turn into the main phase
3370            !!!parse-error (type => 'after html:html');
3371            $self->{insertion_mode} = $previous_insertion_mode;
3372          }
3373    
3374    ## ISSUE: "aa<html>" is not a parse error.
3375    ## ISSUE: "<html>" in fragment is not a parse error.
3376          unless ($token->{first_start_tag}) {
3377            !!!parse-error (type => 'not first start tag');
3378          }
3379          my $top_el = $self->{open_elements}->[0]->[0];
3380          for my $attr_name (keys %{$token->{attributes}}) {
3381            unless ($top_el->has_attribute_ns (undef, $attr_name)) {
3382              $top_el->set_attribute_ns
3383                (undef, [undef, $attr_name],
3384                 $token->{attributes}->{$attr_name}->{value});
3385            }
3386          }
3387          !!!next-token;
3388          redo B;
3389        } elsif ($token->{type} eq 'comment') {
3390          my $comment = $self->{document}->create_comment ($token->{data});
3391          if ($self->{insertion_mode} eq 'trailing end') {
3392            $self->{document}->append_child ($comment);
3393          } elsif ($self->{insertion_mode} eq 'after body') {
3394            $self->{open_elements}->[0]->[0]->append_child ($comment);
3395        } else {        } else {
3396          if ($insertion_mode eq 'before head') {          $self->{open_elements}->[-1]->[0]->append_child ($comment);
3397          }
3398          !!!next-token;
3399          redo B;
3400        } elsif ($self->{insertion_mode} eq 'before head') {
3401            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3402              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3403                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3404                unless (length $token->{data}) {                unless (length $token->{data}) {
3405                  !!!next-token;                  !!!next-token;
3406                  redo B;                  redo B;
3407                }                }
3408              }              }
3409              ## As if <head>              ## As if <head>
3410              !!!create-element ($head_element, 'head');              !!!create-element ($self->{head_element}, 'head');
3411              $open_elements->[-1]->[0]->append_child ($head_element);              $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3412              push @$open_elements, [$head_element, 'head'];              push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3413              $insertion_mode = 'in head';              $self->{insertion_mode} = 'in head';
3414              ## reprocess              ## reprocess
3415              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3416            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3417              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};              my $attr = $token->{tag_name} eq 'head' ? $token->{attributes} : {};
3418              !!!create-element ($head_element, 'head', $attr);              !!!create-element ($self->{head_element}, 'head', $attr);
3419              $open_elements->[-1]->[0]->append_child ($head_element);              $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3420              push @$open_elements, [$head_element, 'head'];              push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3421              $insertion_mode = 'in head';              $self->{insertion_mode} = 'in head';
3422              if ($token->{tag_name} eq 'head') {              if ($token->{tag_name} eq 'head') {
3423                !!!next-token;                !!!next-token;
3424              #} elsif ({              #} elsif ({
# Line 2925  sub _construct_tree ($) { Line 3431  sub _construct_tree ($) {
3431              }              }
3432              redo B;              redo B;
3433            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3434              if ($token->{tag_name} eq 'html') {              if ({
3435                     head => 1, body => 1, html => 1,
3436                     p => 1, br => 1,
3437                    }->{$token->{tag_name}}) {
3438                ## As if <head>                ## As if <head>
3439                !!!create-element ($head_element, 'head');                !!!create-element ($self->{head_element}, 'head');
3440                $open_elements->[-1]->[0]->append_child ($head_element);                $self->{open_elements}->[-1]->[0]->append_child ($self->{head_element});
3441                push @$open_elements, [$head_element, 'head'];                push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3442                $insertion_mode = 'in head';                $self->{insertion_mode} = 'in head';
3443                ## reprocess                ## reprocess
3444                redo B;                redo B;
3445              } else {              } else {
3446                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3447                ## Ignore the token                ## Ignore the token ## ISSUE: An issue in the spec.
3448                !!!next-token;                !!!next-token;
3449                redo B;                redo B;
3450              }              }
3451            } else {            } else {
3452              die "$0: $token->{type}: Unknown type";              die "$0: $token->{type}: Unknown type";
3453            }            }
3454          } elsif ($insertion_mode eq 'in head') {          } elsif ($self->{insertion_mode} eq 'in head' or
3455                     $self->{insertion_mode} eq 'in head noscript' or
3456                     $self->{insertion_mode} eq 'after head') {
3457            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3458              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3459                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3460                unless (length $token->{data}) {                unless (length $token->{data}) {
3461                  !!!next-token;                  !!!next-token;
3462                  redo B;                  redo B;
# Line 2953  sub _construct_tree ($) { Line 3464  sub _construct_tree ($) {
3464              }              }
3465                            
3466              #              #
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3467            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3468              if ($token->{tag_name} eq 'title') {              if ({base => ($self->{insertion_mode} eq 'in head' or
3469                ## NOTE: There is an "as if in head" code clone                            $self->{insertion_mode} eq 'after head'),
3470                my $title_el;                   link => 1}->{$token->{tag_name}}) {
3471                !!!create-element ($title_el, 'title', $token->{attributes});                ## NOTE: There is a "as if in head" code clone.
3472                (defined $head_element ? $head_element : $open_elements->[-1]->[0])                if ($self->{insertion_mode} eq 'after head') {
3473                  ->append_child ($title_el);                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3474                $self->{content_model_flag} = 'RCDATA';                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3475                  }
3476                my $text = '';                !!!insert-element ($token->{tag_name}, $token->{attributes});
3477                  pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3478                  pop @{$self->{open_elements}}
3479                      if $self->{insertion_mode} eq 'after head';
3480                !!!next-token;                !!!next-token;
3481                while ($token->{type} eq 'character') {                redo B;
3482                  $text .= $token->{data};              } elsif ($token->{tag_name} eq 'meta') {
3483                  !!!next-token;                ## NOTE: There is a "as if in head" code clone.
3484                  if ($self->{insertion_mode} eq 'after head') {
3485                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3486                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3487                }                }
3488                if (length $text) {                !!!insert-element ($token->{tag_name}, $token->{attributes});
3489                  $title_el->manakai_append_text ($text);                pop @{$self->{open_elements}}; ## ISSUE: This step is missing in the spec.
3490    
3491                  unless ($self->{confident}) {
3492                    my $charset;
3493                    if ($token->{attributes}->{charset}) { ## TODO: And if supported
3494                      $charset = $token->{attributes}->{charset}->{value};
3495                    }
3496                    if ($token->{attributes}->{'http-equiv'}) {
3497                      ## ISSUE: Algorithm name in the spec was incorrect so that not linked to the definition.
3498                      if ($token->{attributes}->{'http-equiv'}->{value}
3499                          =~ /\A[^;]*;[\x09-\x0D\x20]*charset[\x09-\x0D\x20]*=
3500                              [\x09-\x0D\x20]*(?>"([^"]*)"|'([^']*)'|
3501                              ([^"'\x09-\x0D\x20][^\x09-\x0D\x20]*))/x) {
3502                        $charset = defined $1 ? $1 : defined $2 ? $2 : $3;
3503                      } ## TODO: And if supported
3504                    }
3505                    ## TODO: Change the encoding
3506                }                }
3507                  
3508                $self->{content_model_flag} = 'PCDATA';                ## TODO: Extracting |charset| from |meta|.
3509                                pop @{$self->{open_elements}}
3510                if ($token->{type} eq 'end tag' and                    if $self->{insertion_mode} eq 'after head';
3511                    $token->{tag_name} eq 'title') {                !!!next-token;
3512                  redo B;
3513                } elsif ($token->{tag_name} eq 'title' and
3514                         $self->{insertion_mode} eq 'in head') {
3515                  ## NOTE: There is a "as if in head" code clone.
3516                  if ($self->{insertion_mode} eq 'after head') {
3517                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3518                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3519                  }
3520                  my $parent = defined $self->{head_element} ? $self->{head_element}
3521                      : $self->{open_elements}->[-1]->[0];
3522                  $parse_rcdata->('RCDATA', sub { $parent->append_child ($_[0]) });
3523                  pop @{$self->{open_elements}}
3524                      if $self->{insertion_mode} eq 'after head';
3525                  redo B;
3526                } elsif ($token->{tag_name} eq 'style') {
3527                  ## NOTE: Or (scripting is enabled and tag_name eq 'noscript' and
3528                  ## insertion mode 'in head')
3529                  ## NOTE: There is a "as if in head" code clone.
3530                  if ($self->{insertion_mode} eq 'after head') {
3531                    !!!parse-error (type => 'after head:'.$token->{tag_name});
3532                    push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3533                  }
3534                  $parse_rcdata->('CDATA', $insert_to_current);
3535                  pop @{$self->{open_elements}}
3536                      if $self->{insertion_mode} eq 'after head';
3537                  redo B;
3538                } elsif ($token->{tag_name} eq 'noscript') {
3539                  if ($self->{insertion_mode} eq 'in head') {
3540                    ## NOTE: and scripting is disalbed
3541                    !!!insert-element ($token->{tag_name}, $token->{attributes});
3542                    $self->{insertion_mode} = 'in head noscript';
3543                    !!!next-token;
3544                    redo B;
3545                  } elsif ($self->{insertion_mode} eq 'in head noscript') {
3546                    !!!parse-error (type => 'in noscript:noscript');
3547                  ## Ignore the token                  ## Ignore the token
3548                    redo B;
3549                } else {                } else {
3550                  !!!parse-error;                  #
                 ## ISSUE: And ignore?  
3551                }                }
3552                } elsif ($token->{tag_name} eq 'head' and
3553                         $self->{insertion_mode} ne 'after head') {
3554                  !!!parse-error (type => 'in head:head'); # or in head noscript
3555                  ## Ignore the token
3556                !!!next-token;                !!!next-token;
3557                redo B;                redo B;
3558              } elsif ($token->{tag_name} eq 'style') {              } elsif ($self->{insertion_mode} ne 'in head noscript' and
3559                $style_start_tag->();                       $token->{tag_name} eq 'script') {
3560                redo B;                if ($self->{insertion_mode} eq 'after head') {
3561              } elsif ($token->{tag_name} eq 'script') {                  !!!parse-error (type => 'after head:'.$token->{tag_name});
3562                $script_start_tag->();                  push @{$self->{open_elements}}, [$self->{head_element}, 'head'];
3563                  }
3564                  ## NOTE: There is a "as if in head" code clone.
3565                  $script_start_tag->($insert_to_current);
3566                  pop @{$self->{open_elements}}
3567                      if $self->{insertion_mode} eq 'after head';
3568                redo B;                redo B;
3569              } elsif ({base => 1, link => 1, meta => 1}->{$token->{tag_name}}) {              } elsif ($self->{insertion_mode} eq 'after head' and
3570                ## NOTE: There are "as if in head" code clones                       $token->{tag_name} eq 'body') {
3571                my $el;                !!!insert-element ('body', $token->{attributes});
3572                !!!create-element ($el, $token->{tag_name}, $token->{attributes});                $self->{insertion_mode} = 'in body';
               (defined $head_element ? $head_element : $open_elements->[-1]->[0])  
                 ->append_child ($el);  
   
3573                !!!next-token;                !!!next-token;
3574                redo B;                redo B;
3575              } elsif ($token->{tag_name} eq 'head') {              } elsif ($self->{insertion_mode} eq 'after head' and
3576                !!!parse-error;                       $token->{tag_name} eq 'frameset') {
3577                ## Ignore the token                !!!insert-element ('frameset', $token->{attributes});
3578                  $self->{insertion_mode} = 'in frameset';
3579                !!!next-token;                !!!next-token;
3580                redo B;                redo B;
3581              } else {              } else {
3582                #                #
3583              }              }
3584            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
3585              if ($token->{tag_name} eq 'head') {              if ($self->{insertion_mode} eq 'in head' and
3586                if ($open_elements->[-1]->[1] eq 'head') {                  $token->{tag_name} eq 'head') {
3587                  pop @$open_elements;                pop @{$self->{open_elements}};
3588                } else {                $self->{insertion_mode} = 'after head';
3589                  !!!parse-error;                !!!next-token;
3590                }                redo B;
3591                $insertion_mode = 'after head';              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3592                    $token->{tag_name} eq 'noscript') {
3593                  pop @{$self->{open_elements}};
3594                  $self->{insertion_mode} = 'in head';
3595                !!!next-token;                !!!next-token;
3596                redo B;                redo B;
3597              } elsif ($token->{tag_name} eq 'html') {              } elsif ($self->{insertion_mode} eq 'in head' and
3598                         {
3599                          body => 1, html => 1,
3600                          p => 1, br => 1,
3601                         }->{$token->{tag_name}}) {
3602                #                #
3603              } else {              } elsif ($self->{insertion_mode} eq 'in head noscript' and
3604                !!!parse-error;                       {
3605                          p => 1, br => 1,
3606                         }->{$token->{tag_name}}) {
3607                  #
3608                } elsif ($self->{insertion_mode} ne 'after head') {
3609                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3610                ## Ignore the token                ## Ignore the token
3611                !!!next-token;                !!!next-token;
3612                redo B;                redo B;
3613                } else {
3614                  #
3615              }              }
3616            } else {            } else {
3617              #              #
3618            }            }
3619    
3620            if ($open_elements->[-1]->[1] eq 'head') {            ## As if </head> or </noscript> or <body>
3621              ## As if </head>            if ($self->{insertion_mode} eq 'in head') {
3622              pop @$open_elements;              pop @{$self->{open_elements}};
3623                $self->{insertion_mode} = 'after head';
3624              } elsif ($self->{insertion_mode} eq 'in head noscript') {
3625                pop @{$self->{open_elements}};
3626                !!!parse-error (type => 'in noscript:'.(defined $token->{tag_name} ? ($token->{type} eq 'end tag' ? '/' : '') . $token->{tag_name} : '#' . $token->{type}));
3627                $self->{insertion_mode} = 'in head';
3628              } else { # 'after head'
3629                !!!insert-element ('body');
3630                $self->{insertion_mode} = 'in body';
3631            }            }
           $insertion_mode = 'after head';  
3632            ## reprocess            ## reprocess
3633            redo B;            redo B;
3634    
3635            ## ISSUE: An issue in the spec.            ## ISSUE: An issue in the spec.
3636          } elsif ($insertion_mode eq 'after head') {          } elsif ($self->{insertion_mode} eq 'in body') {
           if ($token->{type} eq 'character') {  
             if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {  
               $open_elements->[-1]->[0]->manakai_append_text ($1);  
               unless (length $token->{data}) {  
                 !!!next-token;  
                 redo B;  
               }  
             }  
               
             #  
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
           } elsif ($token->{type} eq 'start tag') {  
             if ($token->{tag_name} eq 'body') {  
               !!!insert-element ('body', $token->{attributes});  
               $insertion_mode = 'in body';  
               !!!next-token;  
               redo B;  
             } elsif ($token->{tag_name} eq 'frameset') {  
               !!!insert-element ('frameset', $token->{attributes});  
               $insertion_mode = 'in frameset';  
               !!!next-token;  
               redo B;  
             } elsif ({  
                       base => 1, link => 1, meta => 1,  
                       script=> 1, style => 1, title => 1,  
                      }->{$token->{tag_name}}) {  
               !!!parse-error;  
                $insertion_mode = 'in head';  
               ## reprocess  
               redo B;  
             } else {  
               #  
             }  
           } else {  
             #  
           }  
             
           ## As if <body>  
           !!!insert-element ('body');  
           $insertion_mode = 'in body';  
           ## reprocess  
           redo B;  
         } elsif ($insertion_mode eq 'in body') {  
3637            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3638              ## NOTE: There is a code clone of "character in body".              ## NOTE: There is a code clone of "character in body".
3639              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
3640                            
3641              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3642    
3643              !!!next-token;              !!!next-token;
3644              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## NOTE: There is a code clone of "comment in body".  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3645            } else {            } else {
3646              $in_body->($insert_to_current);              $in_body->($insert_to_current);
3647              redo B;              redo B;
3648            }            }
3649          } elsif ($insertion_mode eq 'in table') {          } elsif ($self->{insertion_mode} eq 'in table') {
3650            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3651              ## NOTE: There are "character in table" code clones.              ## NOTE: There are "character in table" code clones.
3652              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
3653                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
3654                                
3655                unless (length $token->{data}) {                unless (length $token->{data}) {
3656                  !!!next-token;                  !!!next-token;
# Line 3120  sub _construct_tree ($) { Line 3658  sub _construct_tree ($) {
3658                }                }
3659              }              }
3660    
3661                !!!parse-error (type => 'in table:#character');
3662    
3663              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
3664              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
3665              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3129  sub _construct_tree ($) { Line 3669  sub _construct_tree ($) {
3669              if ({              if ({
3670                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
3671                   thead => 1, tr => 1,                   thead => 1, tr => 1,
3672                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
3673                # MUST                # MUST
3674                my $foster_parent_element;                my $foster_parent_element;
3675                my $next_sibling;                my $next_sibling;
3676                my $prev_sibling;                my $prev_sibling;
3677                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
3678                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
3679                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
3680                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
3681                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
3682                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
3683                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
3684                    } else {                    } else {
3685                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
3686                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
3687                    }                    }
3688                    last OE;                    last OE;
3689                  }                  }
3690                } # OE                } # OE
3691                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
3692                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
3693                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
3694                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3160  sub _construct_tree ($) { Line 3700  sub _construct_tree ($) {
3700                     $next_sibling);                     $next_sibling);
3701                }                }
3702              } else {              } else {
3703                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3704              }              }
3705                            
3706              !!!next-token;              !!!next-token;
3707              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3708            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3709              if ({              if ({
3710                   caption => 1,                   caption => 1,
# Line 3177  sub _construct_tree ($) { Line 3712  sub _construct_tree ($) {
3712                   tbody => 1, tfoot => 1, thead => 1,                   tbody => 1, tfoot => 1, thead => 1,
3713                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
3714                ## Clear back to table context                ## Clear back to table context
3715                while ($open_elements->[-1]->[1] ne 'table' and                while ($self->{open_elements}->[-1]->[1] ne 'table' and
3716                       $open_elements->[-1]->[1] ne 'html') {                       $self->{open_elements}->[-1]->[1] ne 'html') {
3717                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3718                  pop @$open_elements;                  pop @{$self->{open_elements}};
3719                }                }
3720    
3721                push @$active_formatting_elements, ['#marker', '']                push @$active_formatting_elements, ['#marker', '']
3722                  if $token->{tag_name} eq 'caption';                  if $token->{tag_name} eq 'caption';
3723    
3724                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
3725                $insertion_mode = {                $self->{insertion_mode} = {
3726                                   caption => 'in caption',                                   caption => 'in caption',
3727                                   colgroup => 'in column group',                                   colgroup => 'in column group',
3728                                   tbody => 'in table body',                                   tbody => 'in table body',
# Line 3201  sub _construct_tree ($) { Line 3736  sub _construct_tree ($) {
3736                        td => 1, th => 1, tr => 1,                        td => 1, th => 1, tr => 1,
3737                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3738                ## Clear back to table context                ## Clear back to table context
3739                while ($open_elements->[-1]->[1] ne 'table' and                while ($self->{open_elements}->[-1]->[1] ne 'table' and
3740                       $open_elements->[-1]->[1] ne 'html') {                       $self->{open_elements}->[-1]->[1] ne 'html') {
3741                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3742                  pop @$open_elements;                  pop @{$self->{open_elements}};
3743                }                }
3744    
3745                !!!insert-element ($token->{tag_name} eq 'col' ? 'colgroup' : 'tbody');                !!!insert-element ($token->{tag_name} eq 'col' ? 'colgroup' : 'tbody');
3746                $insertion_mode = $token->{tag_name} eq 'col'                $self->{insertion_mode} = $token->{tag_name} eq 'col'
3747                  ? 'in column group' : 'in table body';                  ? 'in column group' : 'in table body';
3748                ## reprocess                ## reprocess
3749                redo B;                redo B;
3750              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
3751                ## NOTE: There are code clones for this "table in table"                ## NOTE: There are code clones for this "table in table"
3752                !!!parse-error;                !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3753    
3754                ## As if </table>                ## As if </table>
3755                ## have a table element in table scope                ## have a table element in table scope
3756                my $i;                my $i;
3757                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3758                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3759                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
3760                    $i = $_;                    $i = $_;
3761                    last INSCOPE;                    last INSCOPE;
# Line 3231  sub _construct_tree ($) { Line 3766  sub _construct_tree ($) {
3766                  }                  }
3767                } # INSCOPE                } # INSCOPE
3768                unless (defined $i) {                unless (defined $i) {
3769                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
3770                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
3771                  !!!next-token;                  !!!next-token;
3772                  redo B;                  redo B;
# Line 3241  sub _construct_tree ($) { Line 3776  sub _construct_tree ($) {
3776                if ({                if ({
3777                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3778                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3779                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3780                      }->{$self->{open_elements}->[-1]->[1]}) {
3781                  !!!back-token; # <table>                  !!!back-token; # <table>
3782                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
3783                  !!!back-token;                  !!!back-token;
3784                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3785                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3786                  redo B;                  redo B;
3787                }                }
3788    
3789                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
3790                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3791                }                }
3792    
3793                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3794    
3795                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
3796    
3797                ## reprocess                ## reprocess
3798                redo B;                redo B;
# Line 3267  sub _construct_tree ($) { Line 3803  sub _construct_tree ($) {
3803              if ($token->{tag_name} eq 'table') {              if ($token->{tag_name} eq 'table') {
3804                ## have a table element in table scope                ## have a table element in table scope
3805                my $i;                my $i;
3806                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3807                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3808                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
3809                    $i = $_;                    $i = $_;
3810                    last INSCOPE;                    last INSCOPE;
# Line 3279  sub _construct_tree ($) { Line 3815  sub _construct_tree ($) {
3815                  }                  }
3816                } # INSCOPE                } # INSCOPE
3817                unless (defined $i) {                unless (defined $i) {
3818                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3819                  ## Ignore the token                  ## Ignore the token
3820                  !!!next-token;                  !!!next-token;
3821                  redo B;                  redo B;
# Line 3289  sub _construct_tree ($) { Line 3825  sub _construct_tree ($) {
3825                if ({                if ({
3826                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3827                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3828                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3829                      }->{$self->{open_elements}->[-1]->[1]}) {
3830                  !!!back-token;                  !!!back-token;
3831                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3832                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3833                  redo B;                  redo B;
3834                }                }
3835    
3836                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
3837                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3838                }                }
3839    
3840                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3841    
3842                $reset_insertion_mode->();                $self->_reset_insertion_mode;
3843    
3844                !!!next-token;                !!!next-token;
3845                redo B;                redo B;
# Line 3311  sub _construct_tree ($) { Line 3848  sub _construct_tree ($) {
3848                        html => 1, tbody => 1, td => 1, tfoot => 1, th => 1,                        html => 1, tbody => 1, td => 1, tfoot => 1, th => 1,
3849                        thead => 1, tr => 1,                        thead => 1, tr => 1,
3850                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
3851                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3852                ## Ignore the token                ## Ignore the token
3853                !!!next-token;                !!!next-token;
3854                redo B;                redo B;
# Line 3322  sub _construct_tree ($) { Line 3859  sub _construct_tree ($) {
3859              #              #
3860            }            }
3861    
3862            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
3863            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
3864            redo B;            redo B;
3865          } elsif ($insertion_mode eq 'in caption') {          } elsif ($self->{insertion_mode} eq 'in caption') {
3866            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
3867              ## NOTE: This is a code clone of "character in body".              ## NOTE: This is a code clone of "character in body".
3868              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
3869                            
3870              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
3871    
3872              !!!next-token;              !!!next-token;
3873              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## NOTE: This is a code clone of "comment in body".  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
3874            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
3875              if ({              if ({
3876                   caption => 1, col => 1, colgroup => 1, tbody => 1,                   caption => 1, col => 1, colgroup => 1, tbody => 1,
3877                   td => 1, tfoot => 1, th => 1, thead => 1, tr => 1,                   td => 1, tfoot => 1, th => 1, thead => 1, tr => 1,
3878                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
3879                !!!parse-error;                !!!parse-error (type => 'not closed:caption');
3880    
3881                ## As if </caption>                ## As if </caption>
3882                ## have a table element in table scope                ## have a table element in table scope
3883                my $i;                my $i;
3884                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3885                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3886                  if ($node->[1] eq 'caption') {                  if ($node->[1] eq 'caption') {
3887                    $i = $_;                    $i = $_;
3888                    last INSCOPE;                    last INSCOPE;
# Line 3362  sub _construct_tree ($) { Line 3893  sub _construct_tree ($) {
3893                  }                  }
3894                } # INSCOPE                } # INSCOPE
3895                unless (defined $i) {                unless (defined $i) {
3896                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:caption');
3897                  ## Ignore the token                  ## Ignore the token
3898                  !!!next-token;                  !!!next-token;
3899                  redo B;                  redo B;
# Line 3372  sub _construct_tree ($) { Line 3903  sub _construct_tree ($) {
3903                if ({                if ({
3904                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3905                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3906                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3907                      }->{$self->{open_elements}->[-1]->[1]}) {
3908                  !!!back-token; # <?>                  !!!back-token; # <?>
3909                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
3910                  !!!back-token;                  !!!back-token;
3911                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3912                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3913                  redo B;                  redo B;
3914                }                }
3915    
3916                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3917                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3918                }                }
3919    
3920                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3921    
3922                $clear_up_to_marker->();                $clear_up_to_marker->();
3923    
3924                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3925    
3926                ## reprocess                ## reprocess
3927                redo B;                redo B;
# Line 3400  sub _construct_tree ($) { Line 3932  sub _construct_tree ($) {
3932              if ($token->{tag_name} eq 'caption') {              if ($token->{tag_name} eq 'caption') {
3933                ## have a table element in table scope                ## have a table element in table scope
3934                my $i;                my $i;
3935                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3936                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3937                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
3938                    $i = $_;                    $i = $_;
3939                    last INSCOPE;                    last INSCOPE;
# Line 3412  sub _construct_tree ($) { Line 3944  sub _construct_tree ($) {
3944                  }                  }
3945                } # INSCOPE                } # INSCOPE
3946                unless (defined $i) {                unless (defined $i) {
3947                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
3948                  ## Ignore the token                  ## Ignore the token
3949                  !!!next-token;                  !!!next-token;
3950                  redo B;                  redo B;
# Line 3422  sub _construct_tree ($) { Line 3954  sub _construct_tree ($) {
3954                if ({                if ({
3955                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
3956                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
3957                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
3958                      }->{$self->{open_elements}->[-1]->[1]}) {
3959                  !!!back-token;                  !!!back-token;
3960                  $token = {type => 'end tag',                  $token = {type => 'end tag',
3961                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
3962                  redo B;                  redo B;
3963                }                }
3964    
3965                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
3966                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
3967                }                }
3968    
3969                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
3970    
3971                $clear_up_to_marker->();                $clear_up_to_marker->();
3972    
3973                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
3974    
3975                !!!next-token;                !!!next-token;
3976                redo B;                redo B;
3977              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
3978                !!!parse-error;                !!!parse-error (type => 'not closed:caption');
3979    
3980                ## As if </caption>                ## As if </caption>
3981                ## have a table element in table scope                ## have a table element in table scope
3982                my $i;                my $i;
3983                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
3984                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
3985                  if ($node->[1] eq 'caption') {                  if ($node->[1] eq 'caption') {
3986                    $i = $_;                    $i = $_;
3987                    last INSCOPE;                    last INSCOPE;
# Line 3459  sub _construct_tree ($) { Line 3992  sub _construct_tree ($) {
3992                  }                  }
3993                } # INSCOPE                } # INSCOPE
3994                unless (defined $i) {                unless (defined $i) {
3995                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:caption');
3996                  ## Ignore the token                  ## Ignore the token
3997                  !!!next-token;                  !!!next-token;
3998                  redo B;                  redo B;
# Line 3469  sub _construct_tree ($) { Line 4002  sub _construct_tree ($) {
4002                if ({                if ({
4003                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4004                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4005                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4006                      }->{$self->{open_elements}->[-1]->[1]}) {
4007                  !!!back-token; # </table>                  !!!back-token; # </table>
4008                  $token = {type => 'end tag', tag_name => 'caption'};                  $token = {type => 'end tag', tag_name => 'caption'};
4009                  !!!back-token;                  !!!back-token;
4010                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4011                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4012                  redo B;                  redo B;
4013                }                }
4014    
4015                if ($open_elements->[-1]->[1] ne 'caption') {                if ($self->{open_elements}->[-1]->[1] ne 'caption') {
4016                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4017                }                }
4018    
4019                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4020    
4021                $clear_up_to_marker->();                $clear_up_to_marker->();
4022    
4023                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4024    
4025                ## reprocess                ## reprocess
4026                redo B;                redo B;
# Line 3495  sub _construct_tree ($) { Line 4029  sub _construct_tree ($) {
4029                        html => 1, tbody => 1, td => 1, tfoot => 1,                        html => 1, tbody => 1, td => 1, tfoot => 1,
4030                        th => 1, thead => 1, tr => 1,                        th => 1, thead => 1, tr => 1,
4031                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4032                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4033                ## Ignore the token                ## Ignore the token
4034                redo B;                redo B;
4035              } else {              } else {
# Line 3507  sub _construct_tree ($) { Line 4041  sub _construct_tree ($) {
4041                                
4042            $in_body->($insert_to_current);            $in_body->($insert_to_current);
4043            redo B;            redo B;
4044          } elsif ($insertion_mode eq 'in column group') {          } elsif ($self->{insertion_mode} eq 'in column group') {
4045            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4046              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4047                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4048                unless (length $token->{data}) {                unless (length $token->{data}) {
4049                  !!!next-token;                  !!!next-token;
4050                  redo B;                  redo B;
# Line 3518  sub _construct_tree ($) { Line 4052  sub _construct_tree ($) {
4052              }              }
4053                            
4054              #              #
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4055            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4056              if ($token->{tag_name} eq 'col') {              if ($token->{tag_name} eq 'col') {
4057                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4058                pop @$open_elements;                pop @{$self->{open_elements}};
4059                !!!next-token;                !!!next-token;
4060                redo B;                redo B;
4061              } else {              } else {
# Line 3534  sub _construct_tree ($) { Line 4063  sub _construct_tree ($) {
4063              }              }
4064            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4065              if ($token->{tag_name} eq 'colgroup') {              if ($token->{tag_name} eq 'colgroup') {
4066                if ($open_elements->[-1]->[1] eq 'html') {                if ($self->{open_elements}->[-1]->[1] eq 'html') {
4067                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:colgroup');
4068                  ## Ignore the token                  ## Ignore the token
4069                  !!!next-token;                  !!!next-token;
4070                  redo B;                  redo B;
4071                } else {                } else {
4072                  pop @$open_elements; # colgroup                  pop @{$self->{open_elements}}; # colgroup
4073                  $insertion_mode = 'in table';                  $self->{insertion_mode} = 'in table';
4074                  !!!next-token;                  !!!next-token;
4075                  redo B;                              redo B;            
4076                }                }
4077              } elsif ($token->{tag_name} eq 'col') {              } elsif ($token->{tag_name} eq 'col') {
4078                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:col');
4079                ## Ignore the token                ## Ignore the token
4080                !!!next-token;                !!!next-token;
4081                redo B;                redo B;
# Line 3558  sub _construct_tree ($) { Line 4087  sub _construct_tree ($) {
4087            }            }
4088    
4089            ## As if </colgroup>            ## As if </colgroup>
4090            if ($open_elements->[-1]->[1] eq 'html') {            if ($self->{open_elements}->[-1]->[1] eq 'html') {
4091              !!!parse-error;              !!!parse-error (type => 'unmatched end tag:colgroup');
4092              ## Ignore the token              ## Ignore the token
4093              !!!next-token;              !!!next-token;
4094              redo B;              redo B;
4095            } else {            } else {
4096              pop @$open_elements; # colgroup              pop @{$self->{open_elements}}; # colgroup
4097              $insertion_mode = 'in table';              $self->{insertion_mode} = 'in table';
4098              ## reprocess              ## reprocess
4099              redo B;              redo B;
4100            }            }
4101          } elsif ($insertion_mode eq 'in table body') {          } elsif ($self->{insertion_mode} eq 'in table body') {
4102            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4103              ## NOTE: This is a "character in table" code clone.              ## NOTE: This is a "character in table" code clone.
4104              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4105                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4106                                
4107                unless (length $token->{data}) {                unless (length $token->{data}) {
4108                  !!!next-token;                  !!!next-token;
# Line 3581  sub _construct_tree ($) { Line 4110  sub _construct_tree ($) {
4110                }                }
4111              }              }
4112    
4113                !!!parse-error (type => 'in table:#character');
4114    
4115              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
4116              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
4117              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3590  sub _construct_tree ($) { Line 4121  sub _construct_tree ($) {
4121              if ({              if ({
4122                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
4123                   thead => 1, tr => 1,                   thead => 1, tr => 1,
4124                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
4125                # MUST                # MUST
4126                my $foster_parent_element;                my $foster_parent_element;
4127                my $next_sibling;                my $next_sibling;
4128                my $prev_sibling;                my $prev_sibling;
4129                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
4130                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
4131                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
4132                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
4133                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
4134                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
4135                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
4136                    } else {                    } else {
4137                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
4138                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
4139                    }                    }
4140                    last OE;                    last OE;
4141                  }                  }
4142                } # OE                } # OE
4143                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
4144                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
4145                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
4146                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3621  sub _construct_tree ($) { Line 4152  sub _construct_tree ($) {
4152                     $next_sibling);                     $next_sibling);
4153                }                }
4154              } else {              } else {
4155                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4156              }              }
4157                            
4158              !!!next-token;              !!!next-token;
4159              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## Copied from 'in table'  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4160            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4161              if ({              if ({
4162                   tr => 1,                   tr => 1,
4163                   th => 1, td => 1,                   th => 1, td => 1,
4164                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4165                  unless ($token->{tag_name} eq 'tr') {
4166                    !!!parse-error (type => 'missing start tag:tr');
4167                  }
4168    
4169                ## Clear back to table body context                ## Clear back to table body context
4170                while (not {                while (not {
4171                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4172                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4173                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4174                  pop @$open_elements;                  pop @{$self->{open_elements}};
4175                }                }
4176                                
4177                $insertion_mode = 'in row';                $self->{insertion_mode} = 'in row';
4178                if ($token->{tag_name} eq 'tr') {                if ($token->{tag_name} eq 'tr') {
4179                  !!!insert-element ($token->{tag_name}, $token->{attributes});                  !!!insert-element ($token->{tag_name}, $token->{attributes});
4180                  !!!next-token;                  !!!next-token;
# Line 3660  sub _construct_tree ($) { Line 4189  sub _construct_tree ($) {
4189                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4190                ## have an element in table scope                ## have an element in table scope
4191                my $i;                my $i;
4192                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4193                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4194                  if ({                  if ({
4195                       tbody => 1, thead => 1, tfoot => 1,                       tbody => 1, thead => 1, tfoot => 1,
4196                      }->{$node->[1]}) {                      }->{$node->[1]}) {
# Line 3674  sub _construct_tree ($) { Line 4203  sub _construct_tree ($) {
4203                  }                  }
4204                } # INSCOPE                } # INSCOPE
4205                unless (defined $i) {                unless (defined $i) {
4206                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4207                  ## Ignore the token                  ## Ignore the token
4208                  !!!next-token;                  !!!next-token;
4209                  redo B;                  redo B;
# Line 3683  sub _construct_tree ($) { Line 4212  sub _construct_tree ($) {
4212                ## Clear back to table body context                ## Clear back to table body context
4213                while (not {                while (not {
4214                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4215                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4216                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4217                  pop @$open_elements;                  pop @{$self->{open_elements}};
4218                }                }
4219    
4220                ## As if <{current node}>                ## As if <{current node}>
# Line 3695  sub _construct_tree ($) { Line 4224  sub _construct_tree ($) {
4224                ## Clear back to table body context                ## Clear back to table body context
4225                ## nop by definition                ## nop by definition
4226    
4227                pop @$open_elements;                pop @{$self->{open_elements}};
4228                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4229                ## reprocess                ## reprocess
4230                redo B;                redo B;
4231              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4232                ## NOTE: This is a code clone of "table in table"                ## NOTE: This is a code clone of "table in table"
4233                !!!parse-error;                !!!parse-error (type => 'not closed:table');
4234    
4235                ## As if </table>                ## As if </table>
4236                ## have a table element in table scope                ## have a table element in table scope
4237                my $i;                my $i;
4238                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4239                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4240                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
4241                    $i = $_;                    $i = $_;
4242                    last INSCOPE;                    last INSCOPE;
# Line 3718  sub _construct_tree ($) { Line 4247  sub _construct_tree ($) {
4247                  }                  }
4248                } # INSCOPE                } # INSCOPE
4249                unless (defined $i) {                unless (defined $i) {
4250                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
4251                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
4252                  !!!next-token;                  !!!next-token;
4253                  redo B;                  redo B;
# Line 3728  sub _construct_tree ($) { Line 4257  sub _construct_tree ($) {
4257                if ({                if ({
4258                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4259                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4260                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4261                      }->{$self->{open_elements}->[-1]->[1]}) {
4262                  !!!back-token; # <table>                  !!!back-token; # <table>
4263                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
4264                  !!!back-token;                  !!!back-token;
4265                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4266                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4267                  redo B;                  redo B;
4268                }                }
4269    
4270                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
4271                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4272                }                }
4273    
4274                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4275    
4276                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
4277    
4278                ## reprocess                ## reprocess
4279                redo B;                redo B;
# Line 3756  sub _construct_tree ($) { Line 4286  sub _construct_tree ($) {
4286                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4287                ## have an element in table scope                ## have an element in table scope
4288                my $i;                my $i;
4289                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4290                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4291                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4292                    $i = $_;                    $i = $_;
4293                    last INSCOPE;                    last INSCOPE;
# Line 3768  sub _construct_tree ($) { Line 4298  sub _construct_tree ($) {
4298                  }                  }
4299                } # INSCOPE                } # INSCOPE
4300                unless (defined $i) {                unless (defined $i) {
4301                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4302                  ## Ignore the token                  ## Ignore the token
4303                  !!!next-token;                  !!!next-token;
4304                  redo B;                  redo B;
# Line 3777  sub _construct_tree ($) { Line 4307  sub _construct_tree ($) {
4307                ## Clear back to table body context                ## Clear back to table body context
4308                while (not {                while (not {
4309                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4310                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4311                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4312                  pop @$open_elements;                  pop @{$self->{open_elements}};
4313                }                }
4314    
4315                pop @$open_elements;                pop @{$self->{open_elements}};
4316                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4317                !!!next-token;                !!!next-token;
4318                redo B;                redo B;
4319              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4320                ## have an element in table scope                ## have an element in table scope
4321                my $i;                my $i;
4322                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4323                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4324                  if ({                  if ({
4325                       tbody => 1, thead => 1, tfoot => 1,                       tbody => 1, thead => 1, tfoot => 1,
4326                      }->{$node->[1]}) {                      }->{$node->[1]}) {
# Line 3803  sub _construct_tree ($) { Line 4333  sub _construct_tree ($) {
4333                  }                  }
4334                } # INSCOPE                } # INSCOPE
4335                unless (defined $i) {                unless (defined $i) {
4336                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4337                  ## Ignore the token                  ## Ignore the token
4338                  !!!next-token;                  !!!next-token;
4339                  redo B;                  redo B;
# Line 3812  sub _construct_tree ($) { Line 4342  sub _construct_tree ($) {
4342                ## Clear back to table body context                ## Clear back to table body context
4343                while (not {                while (not {
4344                  tbody => 1, tfoot => 1, thead => 1, html => 1,                  tbody => 1, tfoot => 1, thead => 1, html => 1,
4345                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4346                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4347                  pop @$open_elements;                  pop @{$self->{open_elements}};
4348                }                }
4349    
4350                ## As if <{current node}>                ## As if <{current node}>
# Line 3824  sub _construct_tree ($) { Line 4354  sub _construct_tree ($) {
4354                ## Clear back to table body context                ## Clear back to table body context
4355                ## nop by definition                ## nop by definition
4356    
4357                pop @$open_elements;                pop @{$self->{open_elements}};
4358                $insertion_mode = 'in table';                $self->{insertion_mode} = 'in table';
4359                ## reprocess                ## reprocess
4360                redo B;                redo B;
4361              } elsif ({              } elsif ({
4362                        body => 1, caption => 1, col => 1, colgroup => 1,                        body => 1, caption => 1, col => 1, colgroup => 1,
4363                        html => 1, td => 1, th => 1, tr => 1,                        html => 1, td => 1, th => 1, tr => 1,
4364                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4365                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4366                ## Ignore the token                ## Ignore the token
4367                !!!next-token;                !!!next-token;
4368                redo B;                redo B;
# Line 3844  sub _construct_tree ($) { Line 4374  sub _construct_tree ($) {
4374            }            }
4375                        
4376            ## As if in table            ## As if in table
4377            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
4378            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
4379            redo B;            redo B;
4380          } elsif ($insertion_mode eq 'in row') {          } elsif ($self->{insertion_mode} eq 'in row') {
4381            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4382              ## NOTE: This is a "character in table" code clone.              ## NOTE: This is a "character in table" code clone.
4383              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
4384                $open_elements->[-1]->[0]->manakai_append_text ($1);                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
4385                                
4386                unless (length $token->{data}) {                unless (length $token->{data}) {
4387                  !!!next-token;                  !!!next-token;
# Line 3859  sub _construct_tree ($) { Line 4389  sub _construct_tree ($) {
4389                }                }
4390              }              }
4391    
4392                !!!parse-error (type => 'in table:#character');
4393    
4394              ## As if in body, but insert into foster parent element              ## As if in body, but insert into foster parent element
4395              ## ISSUE: Spec says that "whenever a node would be inserted              ## ISSUE: Spec says that "whenever a node would be inserted
4396              ## into the current node" while characters might not be              ## into the current node" while characters might not be
# Line 3868  sub _construct_tree ($) { Line 4400  sub _construct_tree ($) {
4400              if ({              if ({
4401                   table => 1, tbody => 1, tfoot => 1,                   table => 1, tbody => 1, tfoot => 1,
4402                   thead => 1, tr => 1,                   thead => 1, tr => 1,
4403                  }->{$open_elements->[-1]->[1]}) {                  }->{$self->{open_elements}->[-1]->[1]}) {
4404                # MUST                # MUST
4405                my $foster_parent_element;                my $foster_parent_element;
4406                my $next_sibling;                my $next_sibling;
4407                my $prev_sibling;                my $prev_sibling;
4408                OE: for (reverse 0..$#$open_elements) {                OE: for (reverse 0..$#{$self->{open_elements}}) {
4409                  if ($open_elements->[$_]->[1] eq 'table') {                  if ($self->{open_elements}->[$_]->[1] eq 'table') {
4410                    my $parent = $open_elements->[$_]->[0]->parent_node;                    my $parent = $self->{open_elements}->[$_]->[0]->parent_node;
4411                    if (defined $parent and $parent->node_type == 1) {                    if (defined $parent and $parent->node_type == 1) {
4412                      $foster_parent_element = $parent;                      $foster_parent_element = $parent;
4413                      $next_sibling = $open_elements->[$_]->[0];                      $next_sibling = $self->{open_elements}->[$_]->[0];
4414                      $prev_sibling = $next_sibling->previous_sibling;                      $prev_sibling = $next_sibling->previous_sibling;
4415                    } else {                    } else {
4416                      $foster_parent_element = $open_elements->[$_ - 1]->[0];                      $foster_parent_element = $self->{open_elements}->[$_ - 1]->[0];
4417                      $prev_sibling = $foster_parent_element->last_child;                      $prev_sibling = $foster_parent_element->last_child;
4418                    }                    }
4419                    last OE;                    last OE;
4420                  }                  }
4421                } # OE                } # OE
4422                $foster_parent_element = $open_elements->[0]->[0] and                $foster_parent_element = $self->{open_elements}->[0]->[0] and
4423                $prev_sibling = $foster_parent_element->last_child                $prev_sibling = $foster_parent_element->last_child
4424                  unless defined $foster_parent_element;                  unless defined $foster_parent_element;
4425                if (defined $prev_sibling and                if (defined $prev_sibling and
# Line 3899  sub _construct_tree ($) { Line 4431  sub _construct_tree ($) {
4431                     $next_sibling);                     $next_sibling);
4432                }                }
4433              } else {              } else {
4434                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4435              }              }
4436                            
4437              !!!next-token;              !!!next-token;
4438              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## Copied from 'in table'  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4439            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4440              if ($token->{tag_name} eq 'th' or              if ($token->{tag_name} eq 'th' or
4441                  $token->{tag_name} eq 'td') {                  $token->{tag_name} eq 'td') {
4442                ## Clear back to table row context                ## Clear back to table row context
4443                while (not {                while (not {
4444                  tr => 1, html => 1,                  tr => 1, html => 1,
4445                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4446                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4447                  pop @$open_elements;                  pop @{$self->{open_elements}};
4448                }                }
4449                                
4450                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4451                $insertion_mode = 'in cell';                $self->{insertion_mode} = 'in cell';
4452    
4453                push @$active_formatting_elements, ['#marker', ''];                push @$active_formatting_elements, ['#marker', ''];
4454                                
# Line 3935  sub _construct_tree ($) { Line 4461  sub _construct_tree ($) {
4461                ## As if </tr>                ## As if </tr>
4462                ## have an element in table scope                ## have an element in table scope
4463                my $i;                my $i;
4464                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4465                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4466                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4467                    $i = $_;                    $i = $_;
4468                    last INSCOPE;                    last INSCOPE;
# Line 3947  sub _construct_tree ($) { Line 4473  sub _construct_tree ($) {
4473                  }                  }
4474                } # INSCOPE                } # INSCOPE
4475                unless (defined $i) {                unless (defined $i) {
4476                  !!!parse-error;                  !!!parse-error (type => 'unmacthed end tag:'.$token->{tag_name});
4477                  ## Ignore the token                  ## Ignore the token
4478                  !!!next-token;                  !!!next-token;
4479                  redo B;                  redo B;
# Line 3956  sub _construct_tree ($) { Line 4482  sub _construct_tree ($) {
4482                ## Clear back to table row context                ## Clear back to table row context
4483                while (not {                while (not {
4484                  tr => 1, html => 1,                  tr => 1, html => 1,
4485                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4486                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4487                  pop @$open_elements;                  pop @{$self->{open_elements}};
4488                }                }
4489    
4490                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4491                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4492                ## reprocess                ## reprocess
4493                redo B;                redo B;
4494              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4495                ## NOTE: This is a code clone of "table in table"                ## NOTE: This is a code clone of "table in table"
4496                !!!parse-error;                !!!parse-error (type => 'not closed:table');
4497    
4498                ## As if </table>                ## As if </table>
4499                ## have a table element in table scope                ## have a table element in table scope
4500                my $i;                my $i;
4501                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4502                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4503                  if ($node->[1] eq 'table') {                  if ($node->[1] eq 'table') {
4504                    $i = $_;                    $i = $_;
4505                    last INSCOPE;                    last INSCOPE;
# Line 3984  sub _construct_tree ($) { Line 4510  sub _construct_tree ($) {
4510                  }                  }
4511                } # INSCOPE                } # INSCOPE
4512                unless (defined $i) {                unless (defined $i) {
4513                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:table');
4514                  ## Ignore tokens </table><table>                  ## Ignore tokens </table><table>
4515                  !!!next-token;                  !!!next-token;
4516                  redo B;                  redo B;
# Line 3994  sub _construct_tree ($) { Line 4520  sub _construct_tree ($) {
4520                if ({                if ({
4521                     dd => 1, dt => 1, li => 1, p => 1,                     dd => 1, dt => 1, li => 1, p => 1,
4522                     td => 1, th => 1, tr => 1,                     td => 1, th => 1, tr => 1,
4523                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4524                      }->{$self->{open_elements}->[-1]->[1]}) {
4525                  !!!back-token; # <table>                  !!!back-token; # <table>
4526                  $token = {type => 'end tag', tag_name => 'table'};                  $token = {type => 'end tag', tag_name => 'table'};
4527                  !!!back-token;                  !!!back-token;
4528                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4529                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4530                  redo B;                  redo B;
4531                }                }
4532    
4533                if ($open_elements->[-1]->[1] ne 'table') {                if ($self->{open_elements}->[-1]->[1] ne 'table') {
4534                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4535                }                }
4536    
4537                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4538    
4539                $reset_insertion_mode->();                              $self->_reset_insertion_mode;
4540    
4541                ## reprocess                ## reprocess
4542                redo B;                redo B;
# Line 4020  sub _construct_tree ($) { Line 4547  sub _construct_tree ($) {
4547              if ($token->{tag_name} eq 'tr') {              if ($token->{tag_name} eq 'tr') {
4548                ## have an element in table scope                ## have an element in table scope
4549                my $i;                my $i;
4550                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4551                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4552                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4553                    $i = $_;                    $i = $_;
4554                    last INSCOPE;                    last INSCOPE;
# Line 4032  sub _construct_tree ($) { Line 4559  sub _construct_tree ($) {
4559                  }                  }
4560                } # INSCOPE                } # INSCOPE
4561                unless (defined $i) {                unless (defined $i) {
4562                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4563                  ## Ignore the token                  ## Ignore the token
4564                  !!!next-token;                  !!!next-token;
4565                  redo B;                  redo B;
# Line 4041  sub _construct_tree ($) { Line 4568  sub _construct_tree ($) {
4568                ## Clear back to table row context                ## Clear back to table row context
4569                while (not {                while (not {
4570                  tr => 1, html => 1,                  tr => 1, html => 1,
4571                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4572                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4573                  pop @$open_elements;                  pop @{$self->{open_elements}};
4574                }                }
4575    
4576                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4577                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4578                !!!next-token;                !!!next-token;
4579                redo B;                redo B;
4580              } elsif ($token->{tag_name} eq 'table') {              } elsif ($token->{tag_name} eq 'table') {
4581                ## As if </tr>                ## As if </tr>
4582                ## have an element in table scope                ## have an element in table scope
4583                my $i;                my $i;
4584                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4585                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4586                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4587                    $i = $_;                    $i = $_;
4588                    last INSCOPE;                    last INSCOPE;
# Line 4066  sub _construct_tree ($) { Line 4593  sub _construct_tree ($) {
4593                  }                  }
4594                } # INSCOPE                } # INSCOPE
4595                unless (defined $i) {                unless (defined $i) {
4596                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{type});
4597                  ## Ignore the token                  ## Ignore the token
4598                  !!!next-token;                  !!!next-token;
4599                  redo B;                  redo B;
# Line 4075  sub _construct_tree ($) { Line 4602  sub _construct_tree ($) {
4602                ## Clear back to table row context                ## Clear back to table row context
4603                while (not {                while (not {
4604                  tr => 1, html => 1,                  tr => 1, html => 1,
4605                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4606                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4607                  pop @$open_elements;                  pop @{$self->{open_elements}};
4608                }                }
4609    
4610                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4611                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4612                ## reprocess                ## reprocess
4613                redo B;                redo B;
4614              } elsif ({              } elsif ({
# Line 4089  sub _construct_tree ($) { Line 4616  sub _construct_tree ($) {
4616                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4617                ## have an element in table scope                ## have an element in table scope
4618                my $i;                my $i;
4619                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4620                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4621                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4622                    $i = $_;                    $i = $_;
4623                    last INSCOPE;                    last INSCOPE;
# Line 4101  sub _construct_tree ($) { Line 4628  sub _construct_tree ($) {
4628                  }                  }
4629                } # INSCOPE                } # INSCOPE
4630                unless (defined $i) {                unless (defined $i) {
4631                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4632                  ## Ignore the token                  ## Ignore the token
4633                  !!!next-token;                  !!!next-token;
4634                  redo B;                  redo B;
# Line 4110  sub _construct_tree ($) { Line 4637  sub _construct_tree ($) {
4637                ## As if </tr>                ## As if </tr>
4638                ## have an element in table scope                ## have an element in table scope
4639                my $i;                my $i;
4640                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4641                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4642                  if ($node->[1] eq 'tr') {                  if ($node->[1] eq 'tr') {
4643                    $i = $_;                    $i = $_;
4644                    last INSCOPE;                    last INSCOPE;
# Line 4122  sub _construct_tree ($) { Line 4649  sub _construct_tree ($) {
4649                  }                  }
4650                } # INSCOPE                } # INSCOPE
4651                unless (defined $i) {                unless (defined $i) {
4652                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:tr');
4653                  ## Ignore the token                  ## Ignore the token
4654                  !!!next-token;                  !!!next-token;
4655                  redo B;                  redo B;
# Line 4131  sub _construct_tree ($) { Line 4658  sub _construct_tree ($) {
4658                ## Clear back to table row context                ## Clear back to table row context
4659                while (not {                while (not {
4660                  tr => 1, html => 1,                  tr => 1, html => 1,
4661                }->{$open_elements->[-1]->[1]}) {                }->{$self->{open_elements}->[-1]->[1]}) {
4662                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4663                  pop @$open_elements;                  pop @{$self->{open_elements}};
4664                }                }
4665    
4666                pop @$open_elements; # tr                pop @{$self->{open_elements}}; # tr
4667                $insertion_mode = 'in table body';                $self->{insertion_mode} = 'in table body';
4668                ## reprocess                ## reprocess
4669                redo B;                redo B;
4670              } elsif ({              } elsif ({
4671                        body => 1, caption => 1, col => 1,                        body => 1, caption => 1, col => 1,
4672                        colgroup => 1, html => 1, td => 1, th => 1,                        colgroup => 1, html => 1, td => 1, th => 1,
4673                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4674                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4675                ## Ignore the token                ## Ignore the token
4676                !!!next-token;                !!!next-token;
4677                redo B;                redo B;
# Line 4156  sub _construct_tree ($) { Line 4683  sub _construct_tree ($) {
4683            }            }
4684    
4685            ## As if in table            ## As if in table
4686            !!!parse-error;            !!!parse-error (type => 'in table:'.$token->{tag_name});
4687            $in_body->($insert_to_foster);            $in_body->($insert_to_foster);
4688            redo B;            redo B;
4689          } elsif ($insertion_mode eq 'in cell') {          } elsif ($self->{insertion_mode} eq 'in cell') {
4690            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4691              ## NOTE: This is a code clone of "character in body".              ## NOTE: This is a code clone of "character in body".
4692              $reconstruct_active_formatting_elements->($insert_to_current);              $reconstruct_active_formatting_elements->($insert_to_current);
4693                            
4694              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
4695    
4696              !!!next-token;              !!!next-token;
4697              redo B;              redo B;
           } elsif ($token->{type} eq 'comment') {  
             ## NOTE: This is a code clone of "comment in body".  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
             !!!next-token;  
             redo B;  
4698            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4699              if ({              if ({
4700                   caption => 1, col => 1, colgroup => 1,                   caption => 1, col => 1, colgroup => 1,
# Line 4182  sub _construct_tree ($) { Line 4703  sub _construct_tree ($) {
4703                  }->{$token->{tag_name}}) {                  }->{$token->{tag_name}}) {
4704                ## have an element in table scope                ## have an element in table scope
4705                my $tn;                my $tn;
4706                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4707                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4708                  if ($node->[1] eq 'td' or $node->[1] eq 'th') {                  if ($node->[1] eq 'td' or $node->[1] eq 'th') {
4709                    $tn = $node->[1];                    $tn = $node->[1];
4710                    last INSCOPE;                    last INSCOPE;
# Line 4194  sub _construct_tree ($) { Line 4715  sub _construct_tree ($) {
4715                  }                  }
4716                } # INSCOPE                } # INSCOPE
4717                unless (defined $tn) {                unless (defined $tn) {
4718                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4719                  ## Ignore the token                  ## Ignore the token
4720                  !!!next-token;                  !!!next-token;
4721                  redo B;                  redo B;
# Line 4211  sub _construct_tree ($) { Line 4732  sub _construct_tree ($) {
4732              if ($token->{tag_name} eq 'td' or $token->{tag_name} eq 'th') {              if ($token->{tag_name} eq 'td' or $token->{tag_name} eq 'th') {
4733                ## have an element in table scope                ## have an element in table scope
4734                my $i;                my $i;
4735                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4736                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4737                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4738                    $i = $_;                    $i = $_;
4739                    last INSCOPE;                    last INSCOPE;
# Line 4223  sub _construct_tree ($) { Line 4744  sub _construct_tree ($) {
4744                  }                  }
4745                } # INSCOPE                } # INSCOPE
4746                unless (defined $i) {                unless (defined $i) {
4747                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4748                  ## Ignore the token                  ## Ignore the token
4749                  !!!next-token;                  !!!next-token;
4750                  redo B;                  redo B;
# Line 4235  sub _construct_tree ($) { Line 4756  sub _construct_tree ($) {
4756                     td => ($token->{tag_name} eq 'th'),                     td => ($token->{tag_name} eq 'th'),
4757                     th => ($token->{tag_name} eq 'td'),                     th => ($token->{tag_name} eq 'td'),
4758                     tr => 1,                     tr => 1,
4759                    }->{$open_elements->[-1]->[1]}) {                     tbody => 1, tfoot=> 1, thead => 1,
4760                      }->{$self->{open_elements}->[-1]->[1]}) {
4761                  !!!back-token;                  !!!back-token;
4762                  $token = {type => 'end tag',                  $token = {type => 'end tag',
4763                            tag_name => $open_elements->[-1]->[1]}; # MUST                            tag_name => $self->{open_elements}->[-1]->[1]}; # MUST
4764                  redo B;                  redo B;
4765                }                }
4766    
4767                if ($open_elements->[-1]->[1] ne $token->{tag_name}) {                if ($self->{open_elements}->[-1]->[1] ne $token->{tag_name}) {
4768                  !!!parse-error;                  !!!parse-error (type => 'not closed:'.$self->{open_elements}->[-1]->[1]);
4769                }                }
4770    
4771                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4772    
4773                $clear_up_to_marker->();                $clear_up_to_marker->();
4774    
4775                $insertion_mode = 'in row';                $self->{insertion_mode} = 'in row';
4776    
4777                !!!next-token;                !!!next-token;
4778                redo B;                redo B;
# Line 4258  sub _construct_tree ($) { Line 4780  sub _construct_tree ($) {
4780                        body => 1, caption => 1, col => 1,                        body => 1, caption => 1, col => 1,
4781                        colgroup => 1, html => 1,                        colgroup => 1, html => 1,
4782                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4783                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4784                ## Ignore the token                ## Ignore the token
4785                !!!next-token;                !!!next-token;
4786                redo B;                redo B;
# Line 4269  sub _construct_tree ($) { Line 4791  sub _construct_tree ($) {
4791                ## have an element in table scope                ## have an element in table scope
4792                my $i;                my $i;
4793                my $tn;                my $tn;
4794                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4795                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4796                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4797                    $i = $_;                    $i = $_;
4798                    last INSCOPE;                    last INSCOPE;
# Line 4285  sub _construct_tree ($) { Line 4807  sub _construct_tree ($) {
4807                  }                  }
4808                } # INSCOPE                } # INSCOPE
4809                unless (defined $i) {                unless (defined $i) {
4810                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4811                  ## Ignore the token                  ## Ignore the token
4812                  !!!next-token;                  !!!next-token;
4813                  redo B;                  redo B;
# Line 4304  sub _construct_tree ($) { Line 4826  sub _construct_tree ($) {
4826                        
4827            $in_body->($insert_to_current);            $in_body->($insert_to_current);
4828            redo B;            redo B;
4829          } elsif ($insertion_mode eq 'in select') {          } elsif ($self->{insertion_mode} eq 'in select') {
4830            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
4831              $open_elements->[-1]->[0]->manakai_append_text ($token->{data});              $self->{open_elements}->[-1]->[0]->manakai_append_text ($token->{data});
             !!!next-token;  
             redo B;  
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
4832              !!!next-token;              !!!next-token;
4833              redo B;              redo B;
4834            } elsif ($token->{type} eq 'start tag') {            } elsif ($token->{type} eq 'start tag') {
4835              if ($token->{tag_name} eq 'option') {              if ($token->{tag_name} eq 'option') {
4836                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4837                  ## As if </option>                  ## As if </option>
4838                  pop @$open_elements;                  pop @{$self->{open_elements}};
4839                }                }
4840    
4841                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4842                !!!next-token;                !!!next-token;
4843                redo B;                redo B;
4844              } elsif ($token->{tag_name} eq 'optgroup') {              } elsif ($token->{tag_name} eq 'optgroup') {
4845                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4846                  ## As if </option>                  ## As if </option>
4847                  pop @$open_elements;                  pop @{$self->{open_elements}};
4848                }                }
4849    
4850                if ($open_elements->[-1]->[1] eq 'optgroup') {                if ($self->{open_elements}->[-1]->[1] eq 'optgroup') {
4851                  ## As if </optgroup>                  ## As if </optgroup>
4852                  pop @$open_elements;                  pop @{$self->{open_elements}};
4853                }                }
4854    
4855                !!!insert-element ($token->{tag_name}, $token->{attributes});                !!!insert-element ($token->{tag_name}, $token->{attributes});
4856                !!!next-token;                !!!next-token;
4857                redo B;                redo B;
4858              } elsif ($token->{tag_name} eq 'select') {              } elsif ($token->{tag_name} eq 'select') {
4859                !!!parse-error;                !!!parse-error (type => 'not closed:select');
4860                ## As if </select> instead                ## As if </select> instead
4861                ## have an element in table scope                ## have an element in table scope
4862                my $i;                my $i;
4863                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4864                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4865                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4866                    $i = $_;                    $i = $_;
4867                    last INSCOPE;                    last INSCOPE;
# Line 4355  sub _construct_tree ($) { Line 4872  sub _construct_tree ($) {
4872                  }                  }
4873                } # INSCOPE                } # INSCOPE
4874                unless (defined $i) {                unless (defined $i) {
4875                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:select');
4876                  ## Ignore the token                  ## Ignore the token
4877                  !!!next-token;                  !!!next-token;
4878                  redo B;                  redo B;
4879                }                }
4880                                
4881                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4882    
4883                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4884    
4885                !!!next-token;                !!!next-token;
4886                redo B;                redo B;
# Line 4372  sub _construct_tree ($) { Line 4889  sub _construct_tree ($) {
4889              }              }
4890            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
4891              if ($token->{tag_name} eq 'optgroup') {              if ($token->{tag_name} eq 'optgroup') {
4892                if ($open_elements->[-1]->[1] eq 'option' and                if ($self->{open_elements}->[-1]->[1] eq 'option' and
4893                    $open_elements->[-2]->[1] eq 'optgroup') {                    $self->{open_elements}->[-2]->[1] eq 'optgroup') {
4894                  ## As if </option>                  ## As if </option>
4895                  splice @$open_elements, -2;                  splice @{$self->{open_elements}}, -2;
4896                } elsif ($open_elements->[-1]->[1] eq 'optgroup') {                } elsif ($self->{open_elements}->[-1]->[1] eq 'optgroup') {
4897                  pop @$open_elements;                  pop @{$self->{open_elements}};
4898                } else {                } else {
4899                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4900                  ## Ignore the token                  ## Ignore the token
4901                }                }
4902                !!!next-token;                !!!next-token;
4903                redo B;                redo B;
4904              } elsif ($token->{tag_name} eq 'option') {              } elsif ($token->{tag_name} eq 'option') {
4905                if ($open_elements->[-1]->[1] eq 'option') {                if ($self->{open_elements}->[-1]->[1] eq 'option') {
4906                  pop @$open_elements;                  pop @{$self->{open_elements}};
4907                } else {                } else {
4908                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4909                  ## Ignore the token                  ## Ignore the token
4910                }                }
4911                !!!next-token;                !!!next-token;
# Line 4396  sub _construct_tree ($) { Line 4913  sub _construct_tree ($) {
4913              } elsif ($token->{tag_name} eq 'select') {              } elsif ($token->{tag_name} eq 'select') {
4914                ## have an element in table scope                ## have an element in table scope
4915                my $i;                my $i;
4916                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4917                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4918                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4919                    $i = $_;                    $i = $_;
4920                    last INSCOPE;                    last INSCOPE;
# Line 4408  sub _construct_tree ($) { Line 4925  sub _construct_tree ($) {
4925                  }                  }
4926                } # INSCOPE                } # INSCOPE
4927                unless (defined $i) {                unless (defined $i) {
4928                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4929                  ## Ignore the token                  ## Ignore the token
4930                  !!!next-token;                  !!!next-token;
4931                  redo B;                  redo B;
4932                }                }
4933                                
4934                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4935    
4936                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4937    
4938                !!!next-token;                !!!next-token;
4939                redo B;                redo B;
# Line 4424  sub _construct_tree ($) { Line 4941  sub _construct_tree ($) {
4941                        caption => 1, table => 1, tbody => 1,                        caption => 1, table => 1, tbody => 1,
4942                        tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,                        tfoot => 1, thead => 1, tr => 1, td => 1, th => 1,
4943                       }->{$token->{tag_name}}) {                       }->{$token->{tag_name}}) {
4944                !!!parse-error;                !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
4945                                
4946                ## have an element in table scope                ## have an element in table scope
4947                my $i;                my $i;
4948                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4949                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4950                  if ($node->[1] eq $token->{tag_name}) {                  if ($node->[1] eq $token->{tag_name}) {
4951                    $i = $_;                    $i = $_;
4952                    last INSCOPE;                    last INSCOPE;
# Line 4448  sub _construct_tree ($) { Line 4965  sub _construct_tree ($) {
4965                ## As if </select>                ## As if </select>
4966                ## have an element in table scope                ## have an element in table scope
4967                undef $i;                undef $i;
4968                INSCOPE: for (reverse 0..$#$open_elements) {                INSCOPE: for (reverse 0..$#{$self->{open_elements}}) {
4969                  my $node = $open_elements->[$_];                  my $node = $self->{open_elements}->[$_];
4970                  if ($node->[1] eq 'select') {                  if ($node->[1] eq 'select') {
4971                    $i = $_;                    $i = $_;
4972                    last INSCOPE;                    last INSCOPE;
# Line 4460  sub _construct_tree ($) { Line 4977  sub _construct_tree ($) {
4977                  }                  }
4978                } # INSCOPE                } # INSCOPE
4979                unless (defined $i) {                unless (defined $i) {
4980                  !!!parse-error;                  !!!parse-error (type => 'unmatched end tag:select');
4981                  ## Ignore the </select> token                  ## Ignore the </select> token
4982                  !!!next-token; ## TODO: ok?                  !!!next-token; ## TODO: ok?
4983                  redo B;                  redo B;
4984                }                }
4985                                
4986                splice @$open_elements, $i;                splice @{$self->{open_elements}}, $i;
4987    
4988                $reset_insertion_mode->();                $self->_reset_insertion_mode;
4989    
4990                ## reprocess                ## reprocess
4991                redo B;                redo B;
# Line 4479  sub _construct_tree ($) { Line 4996  sub _construct_tree ($) {
4996              #              #
4997            }            }
4998    
4999            !!!parse-error;            !!!parse-error (type => 'in select:'.$token->{tag_name});
5000            ## Ignore the token            ## Ignore the token
5001            !!!next-token;            !!!next-token;
5002            redo B;            redo B;
5003          } elsif ($insertion_mode eq 'after body') {          } elsif ($self->{insertion_mode} eq 'after body') {
5004            if ($token->{type} eq 'character') {            if ($token->{type} eq 'character') {
5005              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5006                  my $data = $1;
5007                ## As if in body                ## As if in body
5008                $reconstruct_active_formatting_elements->($insert_to_current);                $reconstruct_active_formatting_elements->($insert_to_current);
5009                                
5010                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
5011    
5012                unless (length $token->{data}) {                unless (length $token->{data}) {
5013                  !!!next-token;                  !!!next-token;
# Line 4498  sub _construct_tree ($) { Line 5016  sub _construct_tree ($) {
5016              }              }
5017                            
5018              #              #
5019            } elsif ($token->{type} eq 'comment') {              !!!parse-error (type => 'after body:#character');
5020              my $comment = $self->{document}->create_comment ($token->{data});            } elsif ($token->{type} eq 'start tag') {
5021              $open_elements->[0]->[0]->append_child ($comment);              !!!parse-error (type => 'after body:'.$token->{tag_name});
5022              !!!next-token;              #
             redo B;  
5023            } elsif ($token->{type} eq 'end tag') {            } elsif ($token->{type} eq 'end tag') {
5024              if ($token->{tag_name} eq 'html') {              if ($token->{tag_name} eq 'html') {
5025                ## TODO: if inner_html, parse-error, ignore the token; otherwise,                if (defined $self->{inner_html_node}) {
5026                    !!!parse-error (type => 'unmatched end tag:html');
5027                $phase = 'trailing end';                  ## Ignore the token
5028                !!!next-token;                  !!!next-token;
5029                redo B;                  redo B;
5030                  } else {
5031                    $previous_insertion_mode = $self->{insertion_mode};
5032                    $self->{insertion_mode} = 'trailing end';
5033                    !!!next-token;
5034                    redo B;
5035                  }
5036              } else {              } else {
5037                #                !!!parse-error (type => 'after body:/'.$token->{tag_name});
5038              }              }
5039            } else {            } else {
5040              #              die "$0: $token->{type}: Unknown token type";
5041            }            }
5042    
5043            !!!parse-error ('data after body');            $self->{insertion_mode} = 'in body';
           $insertion_mode = 'in body';  
5044            ## reprocess            ## reprocess
5045            redo B;            redo B;
5046          } elsif ($insertion_mode eq 'in frameset') {      } elsif ($self->{insertion_mode} eq 'in frameset') {
5047            if ($token->{type} eq 'character') {        if ($token->{type} eq 'character') {
5048              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5049                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});            $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
   
               unless (length $token->{data}) {  
                 !!!next-token;  
                 redo B;  
               }  
             }  
5050    
5051              #            unless (length $token->{data}) {
           } elsif ($token->{type} eq 'comment') {  
             my $comment = $self->{document}->create_comment ($token->{data});  
             $open_elements->[-1]->[0]->append_child ($comment);  
5052              !!!next-token;              !!!next-token;
5053              redo B;              redo B;
5054            } elsif ($token->{type} eq 'start tag') {            }
5055              if ($token->{tag_name} eq 'frameset') {          }
5056                !!!insert-element ($token->{tag_name}, $token->{attributes});  
5057                !!!next-token;          !!!parse-error (type => 'in frameset:#character');
5058                redo B;          ## Ignore the token
5059              } elsif ($token->{tag_name} eq 'frame') {          !!!next-token;
5060                !!!insert-element ($token->{tag_name}, $token->{attributes});          redo B;
5061                pop @$open_elements;        } elsif ($token->{type} eq 'start tag') {
5062                !!!next-token;          if ($token->{tag_name} eq 'frameset') {
5063                redo B;            !!!insert-element ($token->{tag_name}, $token->{attributes});
5064              } elsif ($token->{tag_name} eq 'noframes') {            !!!next-token;
5065                $in_body->($insert_to_current);            redo B;
5066                redo B;          } elsif ($token->{tag_name} eq 'frame') {
5067              } else {            !!!insert-element ($token->{tag_name}, $token->{attributes});
5068                #            pop @{$self->{open_elements}};
5069              }            !!!next-token;
5070            } elsif ($token->{type} eq 'end tag') {            redo B;
5071              if ($token->{tag_name} eq 'frameset') {          } elsif ($token->{tag_name} eq 'noframes') {
5072                if ($open_elements->[-1]->[1] eq 'html' and            $in_body->($insert_to_current);
5073                    @$open_elements == 1) {            redo B;
5074                  !!!parse-error;          } else {
5075                  ## Ignore the token            !!!parse-error (type => 'in frameset:'.$token->{tag_name});
5076                  !!!next-token;            ## Ignore the token
5077                } else {            !!!next-token;
5078                  pop @$open_elements;            redo B;
5079                  !!!next-token;          }
5080                }        } elsif ($token->{type} eq 'end tag') {
5081                          if ($token->{tag_name} eq 'frameset') {
5082                ## if not inner_html and            if ($self->{open_elements}->[-1]->[1] eq 'html' and
5083                if ($open_elements->[-1]->[1] ne 'frameset') {                @{$self->{open_elements}} == 1) {
5084                  $insertion_mode = 'after frameset';              !!!parse-error (type => 'unmatched end tag:'.$token->{tag_name});
5085                }              ## Ignore the token
5086                redo B;              !!!next-token;
             } else {  
               #  
             }  
5087            } else {            } else {
5088              #              pop @{$self->{open_elements}};
5089                !!!next-token;
5090            }            }
5091              
5092            !!!parse-error;            if (not defined $self->{inner_html_node} and
5093                  $self->{open_elements}->[-1]->[1] ne 'frameset') {
5094                $self->{insertion_mode} = 'after frameset';
5095              }
5096              redo B;
5097            } else {
5098              !!!parse-error (type => 'in frameset:/'.$token->{tag_name});
5099            ## Ignore the token            ## Ignore the token
5100            !!!next-token;            !!!next-token;
5101            redo B;            redo B;
5102          } elsif ($insertion_mode eq 'after frameset') {          }
5103            if ($token->{type} eq 'character') {        } else {
5104            die "$0: $token->{type}: Unknown token type";
5105          }
5106        } elsif ($self->{insertion_mode} eq 'after frameset') {
5107          if ($token->{type} eq 'character') {
5108              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {              if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5109                $open_elements->[-1]->[0]->manakai_append_text ($token->{data});                $self->{open_elements}->[-1]->[0]->manakai_append_text ($1);
5110    
5111                unless (length $token->{data}) {                unless (length $token->{data}) {
5112                  !!!next-token;                  !!!next-token;
# Line 4593  sub _construct_tree ($) { Line 5114  sub _construct_tree ($) {
5114                }                }
5115              }              }
5116    
5117              #              if ($token->{data} =~ s/^[^\x09\x0A\x0B\x0C\x20]+//) {
5118            } elsif ($token->{type} eq 'comment') {                !!!parse-error (type => 'after frameset:#character');
5119              my $comment = $self->{document}->create_comment ($token->{data});  
5120              $open_elements->[-1]->[0]->append_child ($comment);                ## Ignore the token.
5121              !!!next-token;                if (length $token->{data}) {
5122              redo B;                  ## reprocess the rest of characters
5123            } elsif ($token->{type} eq 'start tag') {                } else {
5124              if ($token->{tag_name} eq 'noframes') {                  !!!next-token;
5125                $in_body->($insert_to_current);                }
               redo B;  
             } else {  
               #  
             }  
           } elsif ($token->{type} eq 'end tag') {  
             if ($token->{tag_name} eq 'html') {  
               $phase = 'trailing end';  
               !!!next-token;  
5126                redo B;                redo B;
             } else {  
               #  
5127              }              }
5128            } else {  
5129              #          die qq[$0: Character "$token->{data}"];
5130            }        } elsif ($token->{type} eq 'start tag') {
5131                      if ($token->{tag_name} eq 'noframes') {
5132            !!!parse-error;            $in_body->($insert_to_current);
5133              redo B;
5134            } else {
5135              !!!parse-error (type => 'after frameset:'.$token->{tag_name});
5136            ## Ignore the token            ## Ignore the token
5137            !!!next-token;            !!!next-token;
5138            redo B;            redo B;
5139            }
5140            ## ISSUE: An issue in spec there        } elsif ($token->{type} eq 'end tag') {
5141            if ($token->{tag_name} eq 'html') {
5142              $previous_insertion_mode = $self->{insertion_mode};
5143              $self->{insertion_mode} = 'trailing end';
5144              !!!next-token;
5145              redo B;
5146          } else {          } else {
5147            die "$0: $insertion_mode: Unknown insertion mode";            !!!parse-error (type => 'after frameset:/'.$token->{tag_name});
5148              ## Ignore the token
5149              !!!next-token;
5150              redo B;
5151          }          }
5152          } else {
5153            die "$0: $token->{type}: Unknown token type";
5154        }        }
5155      } elsif ($phase eq 'trailing end') {  
5156          ## ISSUE: An issue in spec here
5157        } elsif ($self->{insertion_mode} eq 'trailing end') {
5158        ## states in the main stage is preserved yet # MUST        ## states in the main stage is preserved yet # MUST
5159                
5160        if ($token->{type} eq 'DOCTYPE') {        if ($token->{type} eq 'character') {
         !!!parse-error;  
         ## Ignore the token  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'comment') {  
         my $comment = $self->{document}->create_comment ($token->{data});  
         $self->{document}->append_child ($comment);  
         !!!next-token;  
         redo B;  
       } elsif ($token->{type} eq 'character') {  
5161          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {          if ($token->{data} =~ s/^([\x09\x0A\x0B\x0C\x20]+)//) {
5162            my $data = $1;            my $data = $1;
5163            ## As if in the main phase.            ## As if in the main phase.
5164            ## NOTE: The insertion mode in the main phase            ## NOTE: The insertion mode in the main phase
5165            ## just before the phase has been changed to the trailing            ## just before the phase has been changed to the trailing
5166            ## end phase is either "after body" or "after frameset".            ## end phase is either "after body" or "after frameset".
5167            $reconstruct_active_formatting_elements->($insert_to_current)            $reconstruct_active_formatting_elements->($insert_to_current);
             if $phase eq 'main';  
5168                        
5169            $open_elements->[-1]->[0]->manakai_append_text ($data);            $self->{open_elements}->[-1]->[0]->manakai_append_text ($data);
5170                        
5171            unless (length $token->{data}) {            unless (length $token->{data}) {
5172              !!!next-token;              !!!next-token;
# Line 4659  sub _construct_tree ($) { Line 5174  sub _construct_tree ($) {
5174            }            }
5175          }          }
5176    
5177          !!!parse-error;          !!!parse-error (type => 'after html:#character');
5178          $phase = 'main';          $self->{insertion_mode} = $previous_insertion_mode;
5179            ## reprocess
5180            redo B;
5181          } elsif ($token->{type} eq 'start tag') {
5182            !!!parse-error (type => 'after html:'.$token->{tag_name});
5183            $self->{insertion_mode} = $previous_insertion_mode;
5184          ## reprocess          ## reprocess
5185          redo B;          redo B;
5186        } elsif ($token->{type} eq 'start tag' or        } elsif ($token->{type} eq 'end tag') {
5187                 $token->{type} eq 'end tag') {          !!!parse-error (type => 'after html:/'.$token->{tag_name});
5188          !!!parse-error;          $self->{insertion_mode} = $previous_insertion_mode;
         $phase = 'main';  
5189          ## reprocess          ## reprocess
5190          redo B;          redo B;
       } elsif ($token->{type} eq 'end-of-file') {  
         ## Stop parsing  
         last B;  
5191        } else {        } else {
5192          die "$0: $token->{type}: Unknown token";          die "$0: $token->{type}: Unknown token";
5193        }        }
5194        } else {
5195          die "$0: $self->{insertion_mode}: Unknown insertion mode";
5196      }      }
5197    } # B    } # B
5198    
5199    ## Stop parsing # MUST    ## Stop parsing # MUST
5200        
5201    ## TODO: script stuffs    ## TODO: script stuffs
5202  } # _construct_tree  } # _tree_construct_main
5203    
5204    sub set_inner_html ($$$) {
5205      my $class = shift;
5206      my $node = shift;
5207      my $s = \$_[0];
5208      my $onerror = $_[1];
5209    
5210      my $nt = $node->node_type;
5211      if ($nt == 9) {
5212        # MUST
5213        
5214        ## Step 1 # MUST
5215        ## TODO: If the document has an active parser, ...
5216        ## ISSUE: There is an issue in the spec.
5217        
5218        ## Step 2 # MUST
5219        my @cn = @{$node->child_nodes};
5220        for (@cn) {
5221          $node->remove_child ($_);
5222        }
5223    
5224        ## Step 3, 4, 5 # MUST
5225        $class->parse_string ($$s => $node, $onerror);
5226      } elsif ($nt == 1) {
5227        ## TODO: If non-html element
5228    
5229        ## NOTE: Most of this code is copied from |parse_string|
5230    
5231        ## Step 1 # MUST
5232        my $this_doc = $node->owner_document;
5233        my $doc = $this_doc->implementation->create_document;
5234        $doc->manakai_is_html (1);
5235        my $p = $class->new;
5236        $p->{document} = $doc;
5237    
5238        ## Step 9 # MUST
5239        my $i = 0;
5240        my $line = 1;
5241        my $column = 0;
5242        $p->{set_next_input_character} = sub {
5243          my $self = shift;
5244    
5245          pop @{$self->{prev_input_character}};
5246          unshift @{$self->{prev_input_character}}, $self->{next_input_character};
5247    
5248          $self->{next_input_character} = -1 and return if $i >= length $$s;
5249          $self->{next_input_character} = ord substr $$s, $i++, 1;
5250          $column++;
5251    
5252          if ($self->{next_input_character} == 0x000A) { # LF
5253            $line++;
5254            $column = 0;
5255          } elsif ($self->{next_input_character} == 0x000D) { # CR
5256            $i++ if substr ($$s, $i, 1) eq "\x0A";
5257            $self->{next_input_character} = 0x000A; # LF # MUST
5258            $line++;
5259            $column = 0;
5260          } elsif ($self->{next_input_character} > 0x10FFFF) {
5261            $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5262          } elsif ($self->{next_input_character} == 0x0000) { # NULL
5263            !!!parse-error (type => 'NULL');
5264            $self->{next_input_character} = 0xFFFD; # REPLACEMENT CHARACTER # MUST
5265          }
5266        };
5267        $p->{prev_input_character} = [-1, -1, -1];
5268        $p->{next_input_character} = -1;
5269        
5270        my $ponerror = $onerror || sub {
5271          my (%opt) = @_;
5272          warn "Parse error ($opt{type}) at line $opt{line} column $opt{column}\n";
5273        };
5274        $p->{parse_error} = sub {
5275          $ponerror->(@_, line => $line, column => $column);
5276        };
5277        
5278        $p->_initialize_tokenizer;
5279        $p->_initialize_tree_constructor;
5280    
5281        ## Step 2
5282        my $node_ln = $node->local_name;
5283        $p->{content_model_flag} = {
5284          title => 'RCDATA',
5285          textarea => 'RCDATA',
5286          style => 'CDATA',
5287          script => 'CDATA',
5288          xmp => 'CDATA',
5289          iframe => 'CDATA',
5290          noembed => 'CDATA',
5291          noframes => 'CDATA',
5292          noscript => 'CDATA',
5293          plaintext => 'PLAINTEXT',
5294        }->{$node_ln} || 'PCDATA';
5295           ## ISSUE: What is "the name of the element"? local name?
5296    
5297        $p->{inner_html_node} = [$node, $node_ln];
5298    
5299        ## Step 4
5300        my $root = $doc->create_element_ns
5301          ('http://www.w3.org/1999/xhtml', [undef, 'html']);
5302    
5303        ## Step 5 # MUST
5304        $doc->append_child ($root);
5305    
5306        ## Step 6 # MUST
5307        push @{$p->{open_elements}}, [$root, 'html'];
5308    
5309        undef $p->{head_element};
5310    
5311        ## Step 7 # MUST
5312        $p->_reset_insertion_mode;
5313    
5314        ## Step 8 # MUST
5315        my $anode = $node;
5316        AN: while (defined $anode) {
5317          if ($anode->node_type == 1) {
5318            my $nsuri = $anode->namespace_uri;
5319            if (defined $nsuri and $nsuri eq 'http://www.w3.org/1999/xhtml') {
5320              if ($anode->local_name eq 'form') { ## TODO: case?
5321                $p->{form_element} = $anode;
5322                last AN;
5323              }
5324            }
5325          }
5326          $anode = $anode->parent_node;
5327        } # AN
5328        
5329        ## Step 3 # MUST
5330        ## Step 10 # MUST
5331        {
5332          my $self = $p;
5333          !!!next-token;
5334        }
5335        $p->_tree_construction_main;
5336    
5337        ## Step 11 # MUST
5338        my @cn = @{$node->child_nodes};
5339        for (@cn) {
5340          $node->remove_child ($_);
5341        }
5342        ## ISSUE: mutation events? read-only?
5343    
5344        ## Step 12 # MUST
5345        @cn = @{$root->child_nodes};
5346        for (@cn) {
5347          $this_doc->adopt_node ($_);
5348          $node->append_child ($_);
5349        }
5350        ## ISSUE: mutation events?
5351    
5352        $p->_terminate_tree_constructor;
5353      } else {
5354        die "$0: |set_inner_html| is not defined for node of type $nt";
5355      }
5356    } # set_inner_html
5357    
5358    } # tree construction stage
5359    
5360  sub get_inner_html ($$$) {  sub get_inner_html ($$$) {
5361    my ($class, $node, $on_error) = @_;    my (undef, $node, $on_error) = @_;
5362    
5363    ## Step 1    ## Step 1
5364    my $s = '';    my $s = '';
# Line 4718  sub get_inner_html ($$$) { Line 5392  sub get_inner_html ($$$) {
5392            
5393      my $nt = $child->node_type;      my $nt = $child->node_type;
5394      if ($nt == 1) { # Element      if ($nt == 1) { # Element
5395        my $tag_name = lc $child->tag_name; ## ISSUE: Definition of "lowercase"        my $tag_name = $child->tag_name; ## TODO: manakai_tag_name
5396        $s .= '<' . $tag_name;        $s .= '<' . $tag_name;
5397          ## NOTE: Non-HTML case:
5398        ## ISSUE: Non-html elements        ## <http://permalink.gmane.org/gmane.org.w3c.whatwg.discuss/11191>
5399    
5400        my @attrs = @{$child->attributes}; # sort order MUST be stable        my @attrs = @{$child->attributes}; # sort order MUST be stable
5401        for my $attr (@attrs) { # order is implementation dependent        for my $attr (@attrs) { # order is implementation dependent
5402          my $attr_name = lc $attr->name; ## ISSUE: Definition of "lowercase"          my $attr_name = $attr->name; ## TODO: manakai_name
5403          $s .= ' ' . $attr_name . '="';          $s .= ' ' . $attr_name . '="';
5404          my $attr_value = $attr->value;          my $attr_value = $attr->value;
5405          ## escape          ## escape
# Line 4744  sub get_inner_html ($$$) { Line 5418  sub get_inner_html ($$$) {
5418          spacer => 1, wbr => 1,          spacer => 1, wbr => 1,
5419        }->{$tag_name};        }->{$tag_name};
5420    
5421          $s .= "\x0A" if $tag_name eq 'pre' or $tag_name eq 'textarea';
5422    
5423        if (not $in_cdata and {        if (not $in_cdata and {
5424          style => 1, script => 1, xmp => 1, iframe => 1,          style => 1, script => 1, xmp => 1, iframe => 1,
5425          noembed => 1, noframes => 1, noscript => 1,          noembed => 1, noframes => 1, noscript => 1,
5426            plaintext => 1,
5427        }->{$tag_name}) {        }->{$tag_name}) {
5428          unshift @node, 'cdata-out';          unshift @node, 'cdata-out';
5429          $in_cdata = 1;          $in_cdata = 1;

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.36

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24