/[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.169 by wakaba, Sat Sep 13 11:31:09 2008 UTC revision 1.173 by wakaba, Sun Sep 14 03:59:08 2008 UTC
# Line 618  sub parse_byte_stream ($$$$;$$) { Line 618  sub parse_byte_stream ($$$$;$$) {
618  sub parse_char_string ($$$;$$) {  sub parse_char_string ($$$;$$) {
619    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;    #my ($self, $s, $doc, $onerror, $get_wrapper) = @_;
620    my $self = shift;    my $self = shift;
   require utf8;  
621    my $s = ref $_[0] ? $_[0] : \($_[0]);    my $s = ref $_[0] ? $_[0] : \($_[0]);
622    open my $input, '<' . (utf8::is_utf8 ($$s) ? ':utf8' : ''), $s;    require Whatpm::Charset::DecodeHandle;
623      my $input = Whatpm::Charset::DecodeHandle::CharString->new ($s);
624    if ($_[3]) {    if ($_[3]) {
625      $input = $_[3]->($input);      $input = $_[3]->($input);
626    }    }
# Line 669  sub parse_char_stream ($$$;$) { Line 669  sub parse_char_stream ($$$;$) {
669        $self->{column} = 0;        $self->{column} = 0;
670      } elsif ($self->{next_char} == 0x000D) { # CR      } elsif ($self->{next_char} == 0x000D) { # CR
671        !!!cp ('j2');        !!!cp ('j2');
672    ## TODO: support for abort/streaming
673        my $next = $input->getc;        my $next = $input->getc;
674        if (defined $next and $next ne "\x0A") {        if (defined $next and $next ne "\x0A") {
675          $self->{next_next_char} = $next;          $self->{next_next_char} = $next;
# Line 688  sub parse_char_stream ($$$;$) { Line 689  sub parse_char_stream ($$$;$) {
689               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or               (0x007F <= $self->{next_char} and $self->{next_char} <= 0x009F) or
690               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or               (0xD800 <= $self->{next_char} and $self->{next_char} <= 0xDFFF) or
691               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or               (0xFDD0 <= $self->{next_char} and $self->{next_char} <= 0xFDDF) or
692    ## ISSUE: U+FDE0-U+FDEF are not excluded
693               {               {
694                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,                0xFFFE => 1, 0xFFFF => 1, 0x1FFFE => 1, 0x1FFFF => 1,
695                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,                0x2FFFE => 1, 0x2FFFF => 1, 0x3FFFE => 1, 0x3FFFF => 1,
# Line 712  sub parse_char_stream ($$$;$) { Line 714  sub parse_char_stream ($$$;$) {
714    $self->{prev_char} = [-1, -1, -1];    $self->{prev_char} = [-1, -1, -1];
715    $self->{next_char} = -1;    $self->{next_char} = -1;
716    
717      $self->{read_until} = sub {
718        #my ($scalar, $specials_range, $offset) = @_;
719        my $specials_range = $_[1];
720        return 0 if defined $self->{next_next_char};
721        my $count = $input->manakai_read_until
722           ($_[0],
723            qr/(?![$specials_range\x{FDD0}-\x{FDDF}\x{FFFE}\x{FFFF}\x{1FFFE}\x{1FFFF}\x{2FFFE}\x{2FFFF}\x{3FFFE}\x{3FFFF}\x{4FFFE}\x{4FFFF}\x{5FFFE}\x{5FFFF}\x{6FFFE}\x{6FFFF}\x{7FFFE}\x{7FFFF}\x{8FFFE}\x{8FFFF}\x{9FFFE}\x{9FFFF}\x{AFFFE}\x{AFFFF}\x{BFFFE}\x{BFFFF}\x{CFFFE}\x{CFFFF}\x{DFFFE}\x{DFFFF}\x{EFFFE}\x{EFFFF}\x{FFFFE}\x{FFFFF}])[\x20-\x7E\xA0-\x{D7FF}\x{E000}-\x{10FFFD}]/,
724            $_[2]);
725        if ($count) {
726          $self->{column} += $count;
727          $self->{column_prev} += $count;
728          $self->{prev_char} = [-1, -1, -1];
729          $self->{next_char} = -1;
730        }
731        return $count;
732      }; # $self->{read_until}
733    
734    my $onerror = $_[2] || sub {    my $onerror = $_[2] || sub {
735      my (%opt) = @_;      my (%opt) = @_;
736      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};      my $line = $opt{token} ? $opt{token}->{line} : $opt{line};
# Line 1008  sub _get_next_token ($) { Line 1027  sub _get_next_token ($) {
1027                     data => chr $self->{next_char},                     data => chr $self->{next_char},
1028                     line => $self->{line}, column => $self->{column},                     line => $self->{line}, column => $self->{column},
1029                    };                    };
1030          $self->{read_until}->($token->{data}, q[-!<>&], length $token->{data});
1031    
1032        ## Stay in the data state        ## Stay in the data state
1033        !!!next-input-character;        !!!next-input-character;
1034    
# Line 1722  sub _get_next_token ($) { Line 1743  sub _get_next_token ($) {
1743        } else {        } else {
1744          !!!cp (100);          !!!cp (100);
1745          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1746            $self->{read_until}->($self->{current_attribute}->{value},
1747                                  q["&],
1748                                  length $self->{current_attribute}->{value});
1749    
1750          ## Stay in the state          ## Stay in the state
1751          !!!next-input-character;          !!!next-input-character;
1752          redo A;          redo A;
# Line 1769  sub _get_next_token ($) { Line 1794  sub _get_next_token ($) {
1794        } else {        } else {
1795          !!!cp (106);          !!!cp (106);
1796          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1797            $self->{read_until}->($self->{current_attribute}->{value},
1798                                  q['&],
1799                                  length $self->{current_attribute}->{value});
1800    
1801          ## Stay in the state          ## Stay in the state
1802          !!!next-input-character;          !!!next-input-character;
1803          redo A;          redo A;
# Line 1851  sub _get_next_token ($) { Line 1880  sub _get_next_token ($) {
1880            !!!cp (116);            !!!cp (116);
1881          }          }
1882          $self->{current_attribute}->{value} .= chr ($self->{next_char});          $self->{current_attribute}->{value} .= chr ($self->{next_char});
1883            $self->{read_until}->($self->{current_attribute}->{value},
1884                                  q["'=& >],
1885                                  length $self->{current_attribute}->{value});
1886    
1887          ## Stay in the state          ## Stay in the state
1888          !!!next-input-character;          !!!next-input-character;
1889          redo A;          redo A;
# Line 1995  sub _get_next_token ($) { Line 2028  sub _get_next_token ($) {
2028        } else {        } else {
2029          !!!cp (126);          !!!cp (126);
2030          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2031            $self->{read_until}->($self->{current_token}->{data},
2032                                  q[>],
2033                                  length $self->{current_token}->{data});
2034    
2035          ## Stay in the state.          ## Stay in the state.
2036          !!!next-input-character;          !!!next-input-character;
2037          redo A;          redo A;
# Line 2229  sub _get_next_token ($) { Line 2266  sub _get_next_token ($) {
2266        } else {        } else {
2267          !!!cp (147);          !!!cp (147);
2268          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment          $self->{current_token}->{data} .= chr ($self->{next_char}); # comment
2269            $self->{read_until}->($self->{current_token}->{data},
2270                                  q[-],
2271                                  length $self->{current_token}->{data});
2272    
2273          ## Stay in the state          ## Stay in the state
2274          !!!next-input-character;          !!!next-input-character;
2275          redo A;          redo A;
# Line 2594  sub _get_next_token ($) { Line 2635  sub _get_next_token ($) {
2635          !!!cp (190);          !!!cp (190);
2636          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2637              .= chr $self->{next_char};              .= chr $self->{next_char};
2638            $self->{read_until}->($self->{current_token}->{public_identifier},
2639                                  q[">],
2640                                  length $self->{current_token}->{public_identifier});
2641    
2642          ## Stay in the state          ## Stay in the state
2643          !!!next-input-character;          !!!next-input-character;
2644          redo A;          redo A;
# Line 2630  sub _get_next_token ($) { Line 2675  sub _get_next_token ($) {
2675          !!!cp (194);          !!!cp (194);
2676          $self->{current_token}->{public_identifier} # DOCTYPE          $self->{current_token}->{public_identifier} # DOCTYPE
2677              .= chr $self->{next_char};              .= chr $self->{next_char};
2678            $self->{read_until}->($self->{current_token}->{public_identifier},
2679                                  q['>],
2680                                  length $self->{current_token}->{public_identifier});
2681    
2682          ## Stay in the state          ## Stay in the state
2683          !!!next-input-character;          !!!next-input-character;
2684          redo A;          redo A;
# Line 2766  sub _get_next_token ($) { Line 2815  sub _get_next_token ($) {
2815          !!!cp (210);          !!!cp (210);
2816          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2817              .= chr $self->{next_char};              .= chr $self->{next_char};
2818            $self->{read_until}->($self->{current_token}->{system_identifier},
2819                                  q[">],
2820                                  length $self->{current_token}->{system_identifier});
2821    
2822          ## Stay in the state          ## Stay in the state
2823          !!!next-input-character;          !!!next-input-character;
2824          redo A;          redo A;
# Line 2802  sub _get_next_token ($) { Line 2855  sub _get_next_token ($) {
2855          !!!cp (214);          !!!cp (214);
2856          $self->{current_token}->{system_identifier} # DOCTYPE          $self->{current_token}->{system_identifier} # DOCTYPE
2857              .= chr $self->{next_char};              .= chr $self->{next_char};
2858            $self->{read_until}->($self->{current_token}->{system_identifier},
2859                                  q['>],
2860                                  length $self->{current_token}->{system_identifier});
2861    
2862          ## Stay in the state          ## Stay in the state
2863          !!!next-input-character;          !!!next-input-character;
2864          redo A;          redo A;
# Line 2862  sub _get_next_token ($) { Line 2919  sub _get_next_token ($) {
2919          redo A;          redo A;
2920        } else {        } else {
2921          !!!cp (221);          !!!cp (221);
2922            my $s = '';
2923            $self->{read_until}->($s, q[>], 0);
2924    
2925          ## Stay in the state          ## Stay in the state
2926          !!!next-input-character;          !!!next-input-character;
2927          redo A;          redo A;
# Line 2890  sub _get_next_token ($) { Line 2950  sub _get_next_token ($) {
2950        } else {        } else {
2951          !!!cp (221.4);          !!!cp (221.4);
2952          $self->{current_token}->{data} .= chr $self->{next_char};          $self->{current_token}->{data} .= chr $self->{next_char};
2953            $self->{read_until}->($self->{current_token}->{data},
2954                                  q<]>,
2955                                  length $self->{current_token}->{data});
2956    
2957          ## Stay in the state.          ## Stay in the state.
2958          !!!next-input-character;          !!!next-input-character;
2959          redo A;          redo A;
# Line 2946  sub _get_next_token ($) { Line 3010  sub _get_next_token ($) {
3010          ## Return nothing.          ## Return nothing.
3011          #          #
3012        } elsif ($self->{next_char} == 0x0023) { # #        } elsif ($self->{next_char} == 0x0023) { # #
3013            !!!cp (999);
3014          $self->{state} = ENTITY_HASH_STATE;          $self->{state} = ENTITY_HASH_STATE;
3015          $self->{state_keyword} = '#';          $self->{state_keyword} = '#';
3016          !!!next-input-character;          !!!next-input-character;
# Line 2954  sub _get_next_token ($) { Line 3019  sub _get_next_token ($) {
3019                  $self->{next_char} <= 0x005A) or # A..Z                  $self->{next_char} <= 0x005A) or # A..Z
3020                 (0x0061 <= $self->{next_char} and                 (0x0061 <= $self->{next_char} and
3021                  $self->{next_char} <= 0x007A)) { # a..z                  $self->{next_char} <= 0x007A)) { # a..z
3022            !!!cp (998);
3023          require Whatpm::_NamedEntityList;          require Whatpm::_NamedEntityList;
3024          $self->{state} = ENTITY_NAME_STATE;          $self->{state} = ENTITY_NAME_STATE;
3025          $self->{state_keyword} = chr $self->{next_char};          $self->{state_keyword} = chr $self->{next_char};
# Line 2975  sub _get_next_token ($) { Line 3041  sub _get_next_token ($) {
3041        ## process of the tokenizer.        ## process of the tokenizer.
3042    
3043        if ($self->{prev_state} == DATA_STATE) {        if ($self->{prev_state} == DATA_STATE) {
3044            !!!cp (997);
3045          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
3046          ## Reconsume.          ## Reconsume.
3047          !!!emit ({type => CHARACTER_TOKEN, data => '&',          !!!emit ({type => CHARACTER_TOKEN, data => '&',
# Line 2983  sub _get_next_token ($) { Line 3050  sub _get_next_token ($) {
3050                   });                   });
3051          redo A;          redo A;
3052        } else {        } else {
3053            !!!cp (996);
3054          $self->{current_attribute}->{value} .= '&';          $self->{current_attribute}->{value} .= '&';
3055          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
3056          ## Reconsume.          ## Reconsume.
# Line 2991  sub _get_next_token ($) { Line 3059  sub _get_next_token ($) {
3059      } elsif ($self->{state} == ENTITY_HASH_STATE) {      } elsif ($self->{state} == ENTITY_HASH_STATE) {
3060        if ($self->{next_char} == 0x0078 or # x        if ($self->{next_char} == 0x0078 or # x
3061            $self->{next_char} == 0x0058) { # X            $self->{next_char} == 0x0058) { # X
3062            !!!cp (995);
3063          $self->{state} = HEXREF_X_STATE;          $self->{state} = HEXREF_X_STATE;
3064          $self->{state_keyword} .= chr $self->{next_char};          $self->{state_keyword} .= chr $self->{next_char};
3065          !!!next-input-character;          !!!next-input-character;
3066          redo A;          redo A;
3067        } elsif (0x0030 <= $self->{next_char} and        } elsif (0x0030 <= $self->{next_char} and
3068                 $self->{next_char} <= 0x0039) { # 0..9                 $self->{next_char} <= 0x0039) { # 0..9
3069            !!!cp (994);
3070          $self->{state} = NCR_NUM_STATE;          $self->{state} = NCR_NUM_STATE;
3071          $self->{state_keyword} = $self->{next_char} - 0x0030;          $self->{state_keyword} = $self->{next_char} - 0x0030;
3072          !!!next-input-character;          !!!next-input-character;
3073          redo A;          redo A;
3074        } else {        } else {
         !!!cp (1019);  
3075          !!!parse-error (type => 'bare nero',          !!!parse-error (type => 'bare nero',
3076                          line => $self->{line_prev},                          line => $self->{line_prev},
3077                          column => $self->{column_prev} - 1);                          column => $self->{column_prev} - 1);
# Line 3012  sub _get_next_token ($) { Line 3081  sub _get_next_token ($) {
3081          ## value in the later processing.          ## value in the later processing.
3082    
3083          if ($self->{prev_state} == DATA_STATE) {          if ($self->{prev_state} == DATA_STATE) {
3084              !!!cp (1019);
3085            $self->{state} = $self->{prev_state};            $self->{state} = $self->{prev_state};
3086            ## Reconsume.            ## Reconsume.
3087            !!!emit ({type => CHARACTER_TOKEN,            !!!emit ({type => CHARACTER_TOKEN,
# Line 3021  sub _get_next_token ($) { Line 3091  sub _get_next_token ($) {
3091                     });                     });
3092            redo A;            redo A;
3093          } else {          } else {
3094              !!!cp (993);
3095            $self->{current_attribute}->{value} .= '&#';            $self->{current_attribute}->{value} .= '&#';
3096            $self->{state} = $self->{prev_state};            $self->{state} = $self->{prev_state};
3097            ## Reconsume.            ## Reconsume.
# Line 3077  sub _get_next_token ($) { Line 3148  sub _get_next_token ($) {
3148        }        }
3149    
3150        if ($self->{prev_state} == DATA_STATE) {        if ($self->{prev_state} == DATA_STATE) {
3151            !!!cp (992);
3152          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
3153          ## Reconsume.          ## Reconsume.
3154          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
# Line 3084  sub _get_next_token ($) { Line 3156  sub _get_next_token ($) {
3156                   });                   });
3157          redo A;          redo A;
3158        } else {        } else {
3159            !!!cp (991);
3160          $self->{current_attribute}->{value} .= chr $code;          $self->{current_attribute}->{value} .= chr $code;
3161          $self->{current_attribute}->{has_reference} = 1;          $self->{current_attribute}->{has_reference} = 1;
3162          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
# Line 3095  sub _get_next_token ($) { Line 3168  sub _get_next_token ($) {
3168            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or            (0x0041 <= $self->{next_char} and $self->{next_char} <= 0x0046) or
3169            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {            (0x0061 <= $self->{next_char} and $self->{next_char} <= 0x0066)) {
3170          # 0..9, A..F, a..f          # 0..9, A..F, a..f
3171            !!!cp (990);
3172          $self->{state} = HEXREF_HEX_STATE;          $self->{state} = HEXREF_HEX_STATE;
3173          $self->{state_keyword} = 0;          $self->{state_keyword} = 0;
3174          ## Reconsume.          ## Reconsume.
3175          redo A;          redo A;
3176        } else {        } else {
         !!!cp (1005);  
3177          !!!parse-error (type => 'bare hcro',          !!!parse-error (type => 'bare hcro',
3178                          line => $self->{line_prev},                          line => $self->{line_prev},
3179                          column => $self->{column_prev} - 2);                          column => $self->{column_prev} - 2);
# Line 3110  sub _get_next_token ($) { Line 3183  sub _get_next_token ($) {
3183          ## element or the attribute value in the later processing.          ## element or the attribute value in the later processing.
3184    
3185          if ($self->{prev_state} == DATA_STATE) {          if ($self->{prev_state} == DATA_STATE) {
3186              !!!cp (1005);
3187            $self->{state} = $self->{prev_state};            $self->{state} = $self->{prev_state};
3188            ## Reconsume.            ## Reconsume.
3189            !!!emit ({type => CHARACTER_TOKEN,            !!!emit ({type => CHARACTER_TOKEN,
# Line 3119  sub _get_next_token ($) { Line 3193  sub _get_next_token ($) {
3193                     });                     });
3194            redo A;            redo A;
3195          } else {          } else {
3196              !!!cp (989);
3197            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};            $self->{current_attribute}->{value} .= '&' . $self->{state_keyword};
3198            $self->{state} = $self->{prev_state};            $self->{state} = $self->{prev_state};
3199            ## Reconsume.            ## Reconsume.
# Line 3189  sub _get_next_token ($) { Line 3264  sub _get_next_token ($) {
3264        }        }
3265    
3266        if ($self->{prev_state} == DATA_STATE) {        if ($self->{prev_state} == DATA_STATE) {
3267            !!!cp (988);
3268          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
3269          ## Reconsume.          ## Reconsume.
3270          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,          !!!emit ({type => CHARACTER_TOKEN, data => chr $code,
# Line 3196  sub _get_next_token ($) { Line 3272  sub _get_next_token ($) {
3272                   });                   });
3273          redo A;          redo A;
3274        } else {        } else {
3275            !!!cp (987);
3276          $self->{current_attribute}->{value} .= chr $code;          $self->{current_attribute}->{value} .= chr $code;
3277          $self->{current_attribute}->{has_reference} = 1;          $self->{current_attribute}->{has_reference} = 1;
3278          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
# Line 3279  sub _get_next_token ($) { Line 3356  sub _get_next_token ($) {
3356        ## appropriate attribute value state anyway.        ## appropriate attribute value state anyway.
3357    
3358        if ($self->{prev_state} == DATA_STATE) {        if ($self->{prev_state} == DATA_STATE) {
3359            !!!cp (986);
3360          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
3361          ## Reconsume.          ## Reconsume.
3362          !!!emit ({type => CHARACTER_TOKEN,          !!!emit ({type => CHARACTER_TOKEN,
# Line 3288  sub _get_next_token ($) { Line 3366  sub _get_next_token ($) {
3366                   });                   });
3367          redo A;          redo A;
3368        } else {        } else {
3369            !!!cp (985);
3370          $self->{current_attribute}->{value} .= $data;          $self->{current_attribute}->{value} .= $data;
3371          $self->{current_attribute}->{has_reference} = 1 if $has_ref;          $self->{current_attribute}->{has_reference} = 1 if $has_ref;
3372          $self->{state} = $self->{prev_state};          $self->{state} = $self->{prev_state};
# Line 7758  sub set_inner_html ($$$;$) { Line 7837  sub set_inner_html ($$$;$) {
7837      };      };
7838      $p->{prev_char} = [-1, -1, -1];      $p->{prev_char} = [-1, -1, -1];
7839      $p->{next_char} = -1;      $p->{next_char} = -1;
7840        
7841        $p->{read_until} = sub {
7842          ## TODO: ...
7843          return 0;
7844        }; # $p->{read_until};
7845    
7846      my $ponerror = $onerror || sub {      my $ponerror = $onerror || sub {
7847        my (%opt) = @_;        my (%opt) = @_;
7848        my $line = $opt{line};        my $line = $opt{line};
Legend:
Removed from v.1.169  
changed lines
  Added in v.1.173
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24