/[suikacvs]/messaging/manakai/lib/Message/DOM/XMLParser.dis
Suika

Contents of /messaging/manakai/lib/Message/DOM/XMLParser.dis

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.24 - (hide annotations) (download)
Wed Feb 15 13:36:21 2006 UTC (20 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.23: +455 -26 lines
++ manakai/lib/Message/DOM/ChangeLog	15 Feb 2006 13:28:44 -0000
2006-02-15  Wakaba  <wakaba@suika.fam.cx>

	* XMLParser.dis: Issues |xp:error-internal-predefined-entity| error
	if a predefined entity declaration references an external entity.
	Issues |xp:error-malformed-predefined-entity| error if
	a predefined entity declaration defines different thing than
	one as in XML specification.
	Issies |xp:warning-entity-declaration-ignored| warning if
	more than one entity declarations for an entity is found.
	(WFErrDef): Now all well-formedness errors are marked
	as |SEVERITY_FATAL_ERROR|.

	* XDoctype.dis (DocumentXDoctype.createDocumentTypeDefinition): Creates
	predefined entity declarations.
	(DocumentXDoctype.createNotation): New method.
	(DocumentTypeDefinition.notations): New attribute.
	(DocumentTypeDefinition.getNotationNode): New method.
	(DocumentTypeDefinition.setNotationNode): New method.
	(newNotationForTest): New code fragment.

	* Tree.dis (ManakaiDOMXML:ManakaiDOMNotations): Removed.
	(c:ManakaiDOMNotationMap): New class.
	(c:ManakaiDOMNotationMapArray): New class.
	(Document.allDeclarationsProcessed): New attribute.

	* DOMXML.dis (DocumentType.notations): Implemented.
	(Notation): Revised.
	(Notation.ownerDocumentTypeDefinition): New attribute.

1 wakaba 1.1 Module:
2     @QName: MDOM|XMLParser
3     @Namespace:
4     http://suika.fam.cx/~wakaba/archive/2004/dom/xml-parser#
5    
6     @FullName:
7     @@lang:en
8     @@@: XML Parser
9    
10     @DISCore:author: DISCore|Wakaba
11     @License: license|Perl+MPL
12     @Date:
13 wakaba 1.24 $Date: 2006/02/13 17:03:22 $
14 wakaba 1.1
15     @DefaultFor: ManakaiDOM|ManakaiDOMLatest
16    
17     @Require:
18     @@Module:
19     @@@QName: MDOM|DOMLS
20     @@@WithFor: ManakaiDOM|ManakaiDOMLatest
21 wakaba 1.6 @@Module:
22     @@@QName: MDOM|XDoctype
23     @@@WithFor: ManakaiDOM|ManakaiDOMLatest
24 wakaba 1.1
25     Namespace:
26 wakaba 1.8 @c:
27     http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core#
28 wakaba 1.11 @cfg:
29     http://suika.fam.cx/www/2006/dom-config/
30 wakaba 1.6 @d:
31     http://suika.fam.cx/~wakaba/archive/2004/dom/xdt#
32 wakaba 1.1 @dis:
33     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis--
34 wakaba 1.5 @dtest:
35     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/DIS#Test/
36 wakaba 1.1 @dx:
37     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException#
38     @ecore:
39     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/Core/
40     @f:
41     http://suika.fam.cx/~wakaba/archive/2004/dom/feature#
42 wakaba 1.11 @fe:
43     http://suika.fam.cx/www/2006/feature/
44     @gls:
45     http://suika.fam.cx/~wakaba/archive/2004/dom/gls#
46 wakaba 1.1 @idl:
47     http://suika.fam.cx/~wakaba/archive/2004/dis/IDL#
48     @infoset:
49     http://www.w3.org/2001/04/infoset#
50     @lang:
51     http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#
52     @license:
53     http://suika.fam.cx/~wakaba/archive/2004/8/18/license#
54     @LSEV:
55     http://www.w3.org/2002/DOMLS
56     @ManakaiDOM:
57     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#
58     @ManakaiDOMLS:
59     http://suika.fam.cx/~wakaba/archive/2004/mdom-ls#
60     @MDOM:
61     http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM.
62     @MDOMX:
63     http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception#
64 wakaba 1.11 @mn:
65     http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/ManakaiNode#
66 wakaba 1.1 @rdf:
67     http://www.w3.org/1999/02/22-rdf-syntax-ns#
68     @rdfs:
69     http://www.w3.org/2000/01/rdf-schema#
70     @t:
71     http://suika.fam.cx/~wakaba/archive/2004/dom/tree#
72 wakaba 1.5 @test:
73     http://suika.fam.cx/~wakaba/archive/2004/dis/Test#
74 wakaba 1.8 @x:
75     http://suika.fam.cx/~wakaba/archive/2004/dom/xml#
76 wakaba 1.1 @xml:
77     http://www.w3.org/XML/1998/namespace
78 wakaba 1.9 @xml-dtd:
79     http://www.w3.org/TR/REC-xml
80 wakaba 1.1 @xmlns:
81     http://www.w3.org/2000/xmlns/
82     @xp:
83     http://suika.fam.cx/~wakaba/archive/2004/dom/xml-parser#
84    
85     ## -- Features
86    
87     ElementTypeBinding:
88     @Name: FeatureDef
89     @ElementType:
90     dis:ResourceDef
91     @ShadowContent:
92     @@rdf:type: f|Feature
93     @@For: =ManakaiDOM|all
94    
95     ElementTypeBinding:
96     @Name: FeatureVerDef
97     @ElementType:
98     dis:ResourceDef
99     @ShadowContent:
100     @@rdf:type: f|Feature
101    
102     ElementTypeBinding:
103     @Name: featureQName
104     @ElementType:
105     f:name
106     @ShadowContent:
107     @@ContentType: DISCore|QName
108    
109     ResourceDef:
110     @QName: DOMString
111     @AliasFor: DOMMain|DOMString
112     @For: ManakaiDOM|DOM
113    
114     ResourceDef:
115     @QName: Node
116     @AliasFor: t|Node
117     @For: ManakaiDOM|DOM
118    
119     ResourceDef:
120     @QName: Element
121     @AliasFor: t|Element
122     @For: ManakaiDOM|DOM
123    
124     ResourceDef:
125     @QName: Document
126     @AliasFor: t|Document
127     @For: ManakaiDOM|DOM
128    
129 wakaba 1.6 ResourceDef:
130     @QName: DocumentXDoctype
131     @AliasFor: d|DocumentXDoctype
132     @For: ManakaiDOM|DOM
133    
134 wakaba 1.8 ResourceDef:
135     @QName: DTDef
136     @AliasFor: d|DocumentTypeDefinition
137     @For: ManakaiDOM|DOM
138    
139     ResourceDef:
140     @QName: ETDef
141     @AliasFor: d|ElementTypeDefinition
142     @For: ManakaiDOM|DOM
143    
144     ResourceDef:
145     @QName: ATDef
146     @AliasFor: d|AttributeDefinition
147     @For: ManakaiDOM|DOM
148    
149 wakaba 1.1 ElementTypeBinding:
150     @Name: ClsDef
151     @ElementType:
152     dis:ResourceDef
153     @ShadowContent:
154     @@rdf:type:
155     @@@@: dis|MultipleResource
156     @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass
157     @@resourceFor:
158     @@@@: ManakaiDOM|ForClass
159     @@@ForCheck: ManakaiDOM|ManakaiDOM !=ManakaiDOM|ManakaiDOM
160     @@For: ManakaiDOM|DOM3
161     @@For: =ManakaiDOM|ManakaiDOM
162    
163     @@rdf:type:
164     @@@@: DISLang|Class
165     @@@ForCheck: ManakaiDOM|ForClass
166    
167     ElementTypeBinding:
168     @Name: ClsQName
169     @ElementType:
170     dis:QName
171     @ShadowContent:
172     @@ForCheck: ManakaiDOM|ForClass
173    
174     ElementTypeBinding:
175     @Name: ClsISA
176     @ElementType:
177     dis:ISA
178     @ShadowContent:
179     @@ForCheck: ManakaiDOM|ForClass
180    
181     ElementTypeBinding:
182     @Name: nullCase
183     @ElementType:
184     dis:ResourceDef
185     @ShadowContent:
186     @@rdf:type: ManakaiDOM|InCase
187     @@Value:
188     @@@is-null:1
189    
190     ResourceDef:
191     @QName: LSParser
192     @AliasFor: DOMLS|LSParser
193     @For: ManakaiDOM|DOM3
194    
195     ClsDef:
196     @ClsQName: ManakaiXMLParser
197    
198     @Implement: DOMLS|LSParser
199    
200     @f:implements:
201     @@@: DOMLS|LSFeature30
202     @@For: ManakaiDOM|DOM3
203    
204 wakaba 1.11 @DISLang:role: gls|ParserRole
205 wakaba 1.1
206 wakaba 1.3 @enDesc:
207     Note that the <Class::ManakaiXMLParser> reports any XML errors
208     (syntax errors and / or well-formedness constraint errors)
209     via the <IF::DOMCore:error-handler> registered to
210     the <A::DOMLS:LSParser.domConfig> object. Each error has
211     its <A::DOMCore:DOMError.severity>, either <C::DOMCore:SEVERITY_ERROR>
212     or <C::DOMCore:SEVERITY_FATAL_ERROR>. However, their semantics
213     are slight different from the ones of <QUOTE::error> and
214     <QUOTE::fatal error> in XML; in this implemenetation,
215     <C::DOMCore:SEVERITY_ERROR> implies that the parsing process
216     can effectively be continued to detect more errors while
217     <C::DOMCore:SEVERITY_FATAL_ERROR> implies that the error
218     is serious so that the result document tree and any errors
219     might be far from the ones obtained when the error would not
220     be found.
221    
222 wakaba 1.1 @Attr:
223     @@Name: domConfig
224     @@enDesc:
225     The configuration of the parser.
226    
227     @@Get:
228     @@@Type: DOMCore|DOMConfiguration
229     @@@enDesc: The DOM configuration object.
230     @@@PerlDef:
231     __CODE{DOMCore|getConfigObject::
232     $target => $self,
233     $targetHash => $self,
234     $targetType => {<IFName::LSParser>},
235     $result => $r,
236     }__;
237    
238     @Method:
239     @@ManakaiDOM:isForInternal:1
240     @@ForCheck: ManakaiDOM|ForClass
241     @@Operator: DISPerl|NewMethod
242     @@enDesc:
243     Creates a new instance of the object.
244     @@Param:
245     @@@Name: impl
246 wakaba 1.11 @@@Type: gls|GLSImplementation
247 wakaba 1.1 @@@enDesc:
248     The implementation from which the parser is created.
249     @@Param:
250     @@@Name: features
251     @@@Type: DOMString
252     @@@dis:actualType: f|FeaturesString
253     @@@enDesc:
254     The set of features requested for the parser.
255     @@Return:
256     @@@Type: DOMMain|DOMObject
257     @@@dis:actualType: LSParser
258     @@@enDesc:
259     The newly created parser.
260     @@@PerlDef:
261     $r = bless {
262     <H::DOMCore:implementation> => $impl,
263     }, $self;
264    
265     @Method:
266     @@Name: parseString
267     @@enImplNote:
268     Non-standard - to be removed
269    
270     @@Param:
271     @@@Name: sourceText
272     @@@Type: DOMString
273     @@Return:
274     @@@Type: Document
275     @@@PerlDef:
276    
277     $self->{char} = [];
278     $self->{token} = [];
279 wakaba 1.6 $self->{entity} = [{
280     reptxt => \$sourceText,
281     line => 1,
282     column => 1,
283     pos => 0,
284     }];
285 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
286 wakaba 1.6 $self->{entity_char} = [];
287     $self->{entity_token} = [];
288 wakaba 1.3 $self->{xml_version} = '1.0';
289     $self->{standalone} = false;
290 wakaba 1.19 $self->{has_xref} = false;
291 wakaba 1.11 $self->{general_entity} = {
292     lt => {is_predefined => true},
293     gt => {is_predefined => true},
294     amp => {is_predefined => true},
295     quot => {is_predefined => true},
296     apos => {is_predefined => true},
297     };
298 wakaba 1.6 $self->{param_entity} = {};
299 wakaba 1.9 $self->{attr} = {};
300     # $self->{attr}->{$element_type_name}->{$attr_name} = $attr_def
301 wakaba 1.17
302 wakaba 1.3 ## Well-formedness constraint Entity Declared takes effect?
303 wakaba 1.1
304     __DEEP{
305 wakaba 1.11 $r = $self->{<H::c|implementation>}-><M::DOMImpl.createDocument>;
306     $self->{doc} = $r;
307 wakaba 1.21 $self->{doc_cfg} = $r-><AG::Document.domConfig>;
308 wakaba 1.11 CORE::delete $self->{docx};
309     CORE::delete $self->{dtdef};
310 wakaba 1.17 CORE::delete $self->{dtdecl};
311 wakaba 1.21
312     $r-><AS::Document.strictErrorChecking> (false);
313     ## NOTE: Any checks such as |Name| validity done by
314     ## methods on DOM nodes are disabled. It might result
315     ## in creating an ill-formed DOM tree when parser
316     ## errors are traped by |error-handler|.
317     $self->{doc_cfg}-><M::c|DOMConfiguration.setParameter>
318     (<Q::cfg|entity-reference-read-only> => false);
319     ## NOTE: Turn this configuration parameter off is required
320     ## because entity reference subtree is created by
321     ## the parser rather than |createEntityReference|'s
322     ## cloning. Parser's |cfg:entity-reference-read-only|
323     ## configuration parameter controls whether generated
324     ## subtree is then marked as read-only or not.
325     $self->{doc_cfg}-><M::c|DOMConfiguration.setParameter>
326     (<Q::cfg|clone-entity-reference-subtree> => true);
327     ## NOTE: Turn this configuration parameter on makes
328     ## entity reference subtrees in attribute default values
329     ## cloned as is into default attribute node subtrees.
330 wakaba 1.11
331     ## Document entity -> |Document| node
332     $self->_parse_DocumentEntity;
333    
334     ## Replacement tree for general |Entity| nodes
335 wakaba 1.20 my @ent = values %{$self->{general_entity}};
336     for my $ent (@ent) {
337     if (exists $ent->{has_replacement_text}) {
338 wakaba 1.11 my $ent_name = $ent->{name};
339     $self->{entity} = [<Code::getCopyOfEntityState::
340     $entity_type = 'general_entity',
341     $entity_name = $ent_name>];
342 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
343 wakaba 1.11 $self->{token} = [];
344     $self->{char} = [];
345 wakaba 1.23 local $ent->{is_opened} = true;
346 wakaba 1.11 ## TODO: External entity support
347     $self->_parse_InternalGeneralParsedEntity ($ent->{node});
348     $ent->{node}-><AS::x|Entity.hasReplacementTree> (true);
349 wakaba 1.21 ## ISSUE: Should errors detected by this phase result
350     ## in |DOMLS:PARSE_ERR| exception thrown?
351 wakaba 1.20 }
352 wakaba 1.11 ## TODO: Read-only if configuration (for all entities)
353     }
354    
355 wakaba 1.21 ## Turns flags to their default value
356     $self->{doc_cfg}-><M::c|DOMConfiguration.setParameter>
357     (<Q::cfg|entity-reference-read-only> => null);
358     $self->{doc_cfg}-><M::c|DOMConfiguration.setParameter>
359     (<Q::cfg|clone-entity-reference-subtree> => null);
360 wakaba 1.11 $r-><AS::Document.strictErrorChecking> (true);
361 wakaba 1.1 }__;
362    
363     @Method:
364     @@Name: shiftChar
365     @@ManakaiDOM:isForInternal:1
366     @@ForCheck: ManakaiDOM|ForClass
367     @@enDesc:
368     Returns the next character.
369     @@Return:
370     @@@Type: idl|long||ManakaiDOM|all
371     @@@enDesc:
372     The code position number of the next character, if any,
373 wakaba 1.6 or <CODE::-1>.
374 wakaba 1.1 @@@PerlDef:
375     if (@{$self->{char}}) {
376     $r = shift @{$self->{char}};
377     } else {
378 wakaba 1.7 no warnings 'substr';
379     ## substr outside length warnings at the end of the string
380 wakaba 1.6 GETCHAR: {
381     my $char = substr (${$self->{entity}->[-1]->{reptxt}},
382     $self->{entity}->[-1]->{pos}, 1);
383    
384 wakaba 1.7 if (defined $char and length $char) {
385 wakaba 1.13 $self->{entity}->[-1]->{pos}++;
386 wakaba 1.6 $r = ord $char;
387     if ($r == 0x000A) {
388     $self->{entity}->[-1]->{line}++;
389     $self->{entity}->[-1]->{column} = 1;
390     } elsif ($r == 0x000D) {
391     my $next_char = substr (${$self->{entity}->[-1]->{reptxt}},
392     $self->{entity}->[-1]->{pos}, 1);
393     if ($next_char eq "\x0A") {
394     $self->{entity}->[-1]->{pos}++;
395 wakaba 1.13 $self->{entity}->[-1]->{line}++;
396 wakaba 1.6 $self->{entity}->[-1]->{column} = 1;
397     } elsif ($next_char eq "\x85") {
398     if ($self->{xml_version} eq '1.1') {
399 wakaba 1.16 if ($self->{entity}->[-1]->{no_xml11_eol}) {
400     my $location = {
401     utf32_offset => $self->{entity}->[-1]->{pos} - 1,
402     line_number => $self->{entity}->[-1]->{line},
403     column_number => $self->{entity}->[-1]->{column},
404     };
405     my $continue = __DOMCore:ERROR{
406     xp|fatal-xml11-end-of-line-in-xml-declaration::
407     DOMCore|location => {$location},
408     xp|character-number => {$r},
409     }__;
410     unless ($continue) {
411     __EXCEPTION{DOMLS|PARSE_ERR}__;
412     }
413     } # no_xml11_eol
414 wakaba 1.6 $self->{entity}->[-1]->{pos}++;
415 wakaba 1.13 $self->{entity}->[-1]->{line}++;
416 wakaba 1.6 $self->{entity}->[-1]->{column} = 1;
417     } else {
418 wakaba 1.16 ## |no_xml11_eol| will be tested later.
419 wakaba 1.13 $self->{entity}->[-1]->{column}++;
420     ## Line number will be increased by next |shiftChar| call.
421 wakaba 1.6 }
422 wakaba 1.3 } else {
423 wakaba 1.13 $self->{entity}->[-1]->{line}++;
424 wakaba 1.6 $self->{entity}->[-1]->{column} = 1;
425     }
426     $r = 0x000A;
427     } elsif (
428     not ((0x0020 <= $r and $r <= 0x007E) or
429     (0x00A0 <= $r and $r <= 0xD7FF) or
430     (0xE000 <= $r and $r <= 0xFFFD) or
431     (0x10000 <= $r and $r <= 0x10FFFF)) and
432     $r != 0x0009 and $r != 0x0085 and
433     not ($self->{xml_version} eq '1.0' and
434     (0x007F <= $r and $r <= 0x009F))
435     ) {
436     my $location = {
437 wakaba 1.13 utf32_offset => $self->{entity}->[-1]->{pos} - 1,
438 wakaba 1.6 line_number => $self->{entity}->[-1]->{line},
439     column_number => $self->{entity}->[-1]->{column},
440     };
441     my $continue = __DOMCore:ERROR{xp|wf-legal-literal-character::
442     DOMCore|location => {$location},
443     xp|character-number => {$r},
444     }__;
445     unless ($continue) {
446     __EXCEPTION{DOMLS|PARSE_ERR}__;
447 wakaba 1.3 }
448 wakaba 1.6 $self->{entity}->[-1]->{column}++;
449     } elsif ($r == 0x0085 or $r == 0x2028) {
450 wakaba 1.16 if ($self->{entity}->[-1]->{no_xml11_eol}) {
451     my $location = {
452     utf32_offset => $self->{entity}->[-1]->{pos} - 1,
453     line_number => $self->{entity}->[-1]->{line},
454     column_number => $self->{entity}->[-1]->{column},
455     };
456     my $continue = __DOMCore:ERROR{
457     xp|fatal-xml11-end-of-line-in-xml-declaration::
458     DOMCore|location => {$location},
459     xp|character-number => {$r},
460     }__;
461     unless ($continue) {
462     __EXCEPTION{DOMLS|PARSE_ERR}__;
463     }
464     } # no_xml11_eol
465 wakaba 1.6 $r = 0x000A if $self->{xml_version} eq '1.1';
466 wakaba 1.13 ## Even in XML 1.0 it increases the line number.
467 wakaba 1.6 $self->{entity}->[-1]->{line}++;
468     $self->{entity}->[-1]->{column} = 1;
469 wakaba 1.3 } else {
470 wakaba 1.6 $self->{entity}->[-1]->{column}++;
471 wakaba 1.3 }
472     } else {
473 wakaba 1.6 $r = -1;
474 wakaba 1.3 }
475 wakaba 1.6 } # GETCHAR
476 wakaba 1.1 }
477    
478     @Method:
479     @@ManakaiDOM:isForInternal: 1
480     @@Operator: ManakaiDOM|MUErrorHandler
481     @@enDesc:
482     When a <IF::ecore|ErrorInterface||ManakaiDOM|Perl> is <Perl::report>ed,
483     then this method is invoked.
484    
485     The method calls the <cfg::DOMCore|error-handler> if the error is of
486     <IF::DOMCore|DOMError>. Otherwise, the error is re-thrown so that
487     corresponding <Perl::catch> clause, if any, can catch the error.
488     @@Param:
489     @@@Name: err
490     @@@Type: ecore|ErrorInterface||ManakaiDOM|Perl
491     @@@enDesc:
492     The reported error object.
493     @@Return:
494     @@@Type: DISPerl|Any
495     @@@enDesc:
496     If the <P::err> is a <IF::DOMCore|DOMError>, then the return value
497     of the error handler.
498    
499     {NOTE:: If the error is thrown, the method never returns.
500     }
501     @@@nullCase:
502     @@@@enDesc:
503     No error handler.
504     @@@PerlDef:
505     if ($err->isa (<IFName::DOMCore|DOMError||ManakaiDOM|ManakaiDOM>)) {
506     __DEEP{
507     A: {
508     my $cfg = $self-><AG::LSParser.domConfig>;
509     my $h = $cfg-><M::DOMCore|DOMConfiguration.getParameter>
510     ('error-handler');
511     $r = $h-><M::DOMCore|DOMErrorHandler.handleError> ($err);
512     } # A
513     }__;
514     } else {
515     $err-><M::ecore|ErrorInterface||ManakaiDOM|Perl.throw>;
516     }
517    
518     @DISPerl:dpgDef:
519    
520     /*
521     XML Document Entity
522    
523     document := prolog element *Misc
524     - *Char RestrictedChar *Char ;; [1]
525     */
526 wakaba 1.11 rule DocumentEntity : standalone {
527 wakaba 1.1 /*
528     prolog := XMLDecl? *Misc [doctypedecl *Misc] ;; [22]
529     */
530 wakaba 1.16 ?lexmode DocumentStart;
531 wakaba 1.11
532     my $doc;
533     lang:Perl {
534     $doc = $self->{doc};
535     }
536 wakaba 1.1
537 wakaba 1.3 ~? (XDO) {
538 wakaba 1.16 ?lexmode XMLDeclarationOrPI;
539     lang:Perl {
540     $self->{entity}->[-1]->{no_xml11_eol} = true;
541     }
542     ~ (S) { // XML declaration
543     &_XMLDeclaration_ ($doc => $doc);
544     ~ (PIC2) {
545     ?lexmode DocumentProlog;
546     } else {
547     ?lexmode DocumentProlog;
548     }
549     } (NameChar) { // Processing instruction whose target begins with |xml|
550     my $target_token;
551     lang:Perl ($v => $token.value) {
552     $target_token = $token;
553     $target_token->{value} = 'xml'.$target_token->{value};
554     $self->{entity}->[-1]->{no_xml11_eol} = false;
555     }
556     ?lexmode PINmtoken;
557     ~? (Nmtoken) {
558     lang:Perl ($v => $token.value) {
559     $target_token->{value} .= $v;
560     }
561     ?lexmode PIName;
562     }
563     lang:Perl {
564     $target_token->{type} = 'Name';
565     $target_token->{location_d} += 3; # 'xml'
566     unshift @{$self->{token}}, $token;
567     $token = $target_token;
568     }
569     &_ProcessingInstruction_ ($doc => $doc, $parent => $doc);
570     ~ (PIC) {
571     ?lexmode DocumentProlog;
572     } else {
573     ?lexmode DocumentProlog;
574     }
575 wakaba 1.3 } else {
576 wakaba 1.16 lang:Perl {
577     $self->{entity}->[-1]->{no_xml11_eol} = false;
578     }
579 wakaba 1.3 }
580     } else {
581     ?lexmode 'DocumentProlog';
582     }
583 wakaba 1.1
584     // *Misc
585 wakaba 1.2 ~* (CDO) {
586 wakaba 1.1 &_CommentDeclaration_ ($doc => $doc, $parent => $doc);
587    
588     ~ (MDC) {
589     ?lexmode DocumentProlog;
590     } else {
591     ?lexmode DocumentProlog;
592     }
593     } (PIO) {
594     &_ProcessingInstruction_ ($doc => $doc, $parent => $doc);
595    
596     ~ (PIC) {
597     ?lexmode 'DocumentProlog';
598     } else {
599     ?lexmode DocumentProlog;
600     }
601     } (S) {
602     //
603     }
604    
605     // doctypedecl
606     ~? (MDO) {
607     &_DocumentTypeDeclaration_ ($doc => $doc);
608    
609 wakaba 1.3 ~ (MDC) {
610     ?lexmode DocumentMisc;
611     } else {
612     ?lexmode DocumentMisc;
613     }
614     } else {
615     ?lexmode DocumentMisc;
616 wakaba 1.1 }
617    
618     // *Misc
619 wakaba 1.2 ~* (CDO) {
620 wakaba 1.1 &_CommentDeclaration_ ($doc => $doc, $parent => $doc);
621    
622     ~ (MDC) {
623     ?lexmode DocumentMisc;
624     } else {
625     ?lexmode DocumentMisc;
626     }
627     } (PIO) {
628     &_ProcessingInstruction_ ($doc => $doc, $parent => $doc);
629    
630     ~ (PIC) {
631     ?lexmode 'DocumentMisc';
632     } else {
633     ?lexmode DocumentMisc;
634     }
635     } (S) {
636     //
637     }
638    
639     // Document element
640     ~ (STAGO) {
641     &Element_ ($doc => $doc, $parent => $doc)
642     : unshift-current-token;
643     ~ (TAGC) {
644     ?lexmode DocumentEnd;
645     } else {
646     ?lexmode DocumentEnd;
647     }
648     } else {
649     ?lexmode 'DocumentEnd';
650     }
651    
652     // *Misc
653 wakaba 1.2 ~* (CDO) {
654 wakaba 1.1 &_CommentDeclaration_ ($doc => $doc, $parent => $doc);
655    
656     ~ (MDC) {
657     ?lexmode DocumentEnd;
658     } else {
659     ?lexmode DocumentEnd;
660     }
661     } (PIO) {
662     &_ProcessingInstruction_ ($doc => $doc, $parent => $doc);
663     ~ (PIC) {
664     ?lexmode 'DocumentEnd';
665     } else {
666     ?lexmode DocumentEnd;
667     }
668     } (S) {
669     //
670     }
671    
672     ~ (#EOF) { }
673     } // DocumentEntity
674 wakaba 1.11
675     /*
676     Internal General Parsed Entity
677    
678     An internal general parsed entity is well-formed if its
679     replacement text matches the production labeled |content|.
680     */
681     rule InternalGeneralParsedEntity ($ent) : standalone {
682     ?lexmode ElementContent;
683    
684     my $ns;
685     lang:Perl {
686     $ns = {
687     xml => <Q::xml:>,
688     xmlns => <Q::xmlns:>,
689     };
690     }
691    
692     &content ($parent => $ent, $ns => $ns);
693    
694     ~ (#EOF) { }
695     } // InternalGeneralParsedEntity
696    
697 wakaba 1.1 /*
698     XML Declaration
699    
700     XMLDecl := '<?xml' VersionInfo
701     [EncodingDecl]
702     [SDDecl]
703     [S] '?>' ;; [23]
704    
705     NOTE: XML declaration is optional in XML 1.0
706     while it is required in XML 1.1.
707     */
708 wakaba 1.16 rule _XMLDeclaration_ {
709     // ~ (XDO) { }
710 wakaba 1.3 ?lexmode XMLDeclaration;
711 wakaba 1.16 //lang:Perl {
712     // $self->{entity}->[-1]->{no_xml11_eol} = true;
713     //}
714     //~ (S) { }
715 wakaba 1.3
716     ~ (Name == 'version') {
717     ~? (S) { }
718     ~ (VI) { }
719     ~? (S) { }
720 wakaba 1.1
721 wakaba 1.3 my $ver;
722     my $bad_token;
723    
724     ~ (LIT) {
725     ?lexmode AttributeValueLiteral;
726    
727     ~ (STRING) {
728     lang:Perl ($version => $token.value) {
729     $ver = $version;
730     $bad_token = $token;
731     }
732     }
733    
734     ~ (LIT) {
735     ?lexmode XMLDeclaration;
736     }
737     } (LITA) {
738     ?lexmode AttributeValueLiteralA;
739    
740     ~ (STRING) {
741     lang:Perl ($version => $token.value) {
742     $ver = $version;
743     $bad_token = $token;
744     }
745     }
746    
747     ~ (LITA) {
748     ?lexmode XMLDeclaration;
749     }
750     }
751    
752     lang:Perl : has-error {
753     unless ($ver eq '1.0' or $ver eq '1.1') {
754     my $location;
755     __CODE{xp|get-location-from-token::
756     $token => {$bad_token},
757     $result => {$location},
758     }__;
759     my $continue = __DOMCore:ERROR{xp|wf-unsupported-xml-version::
760     DOMCore|location => {$location},
761 wakaba 1.16 xp|parent => {$self->{doc}},
762 wakaba 1.3 infoset|version => {$ver},
763     xp|error-token => {$bad_token},
764     }__;
765     unless ($continue) {
766     __EXCEPTION{DOMLS|PARSE_ERR}__;
767     }
768     }
769 wakaba 1.16 $self->{doc}-><AS::Document.xmlVersion> ($ver);
770 wakaba 1.3 $self->{xml_version} = $ver;
771     }
772    
773     ~? (S) { }
774 wakaba 1.1 }
775    
776 wakaba 1.3 ~? (Name == 'encoding') {
777     ~? (S) { }
778     ~ (VI) { }
779     ~? (S) { }
780    
781     my $ver;
782     my $bad_token;
783    
784     ~ (LIT) {
785     ?lexmode AttributeValueLiteral;
786    
787     ~ (STRING) {
788     lang:Perl ($version => $token.value) {
789     $ver = $version;
790     $bad_token = $token;
791     }
792     }
793    
794     ~ (LIT) {
795     ?lexmode XMLDeclaration;
796     }
797     } (LITA) {
798     ?lexmode AttributeValueLiteralA;
799    
800     ~ (STRING) {
801     lang:Perl ($version => $token.value) {
802     $ver = $version;
803     $bad_token = $token;
804     }
805     }
806    
807     ~ (LITA) {
808     ?lexmode XMLDeclaration;
809     }
810     }
811    
812     lang:Perl : has-error {
813     unless ($ver =~ /\A[A-Za-z][A-Za-z0-9._-]*\z/) {
814     my $location;
815     __CODE{xp|get-location-from-token::
816     $token => {$bad_token},
817     $result => {$location},
818     }__;
819     my $continue = __DOMCore:ERROR{xp|wf-malformed-enc-name::
820     DOMCore|location => {$location},
821 wakaba 1.16 xp|parent => {$self->{doc}},
822 wakaba 1.3 xp|name => {$ver},
823     xp|error-token => {$bad_token},
824     }__;
825     unless ($continue) {
826     __EXCEPTION{DOMLS|PARSE_ERR}__;
827     }
828     }
829 wakaba 1.16 $self->{doc}-><AS::Document.xmlEncoding> ($ver);
830 wakaba 1.3 }
831    
832     ~? (S) { }
833 wakaba 1.1 }
834 wakaba 1.3
835     ~? (Name == 'standalone') {
836     ~? (S) { }
837     ~ (VI) { }
838     ~? (S) { }
839    
840     my $ver;
841     my $bad_token;
842    
843     ~ (LIT) {
844     ?lexmode AttributeValueLiteral;
845    
846     ~ (STRING) {
847     lang:Perl ($version => $token.value) {
848     $ver = $version;
849     $bad_token = $token;
850     }
851     }
852    
853     ~ (LIT) {
854     ?lexmode XMLDeclaration;
855     }
856     } (LITA) {
857     ?lexmode AttributeValueLiteralA;
858    
859     ~ (STRING) {
860     lang:Perl ($version => $token.value) {
861     $ver = $version;
862     $bad_token = $token;
863     }
864     }
865 wakaba 1.1
866 wakaba 1.3 ~ (LITA) {
867     ?lexmode XMLDeclaration;
868     }
869     }
870    
871     lang:Perl : has-error {
872     unless ($ver eq 'yes' or $ver eq 'no') {
873     my $location;
874     __CODE{xp|get-location-from-token::
875     $token => {$bad_token},
876     $result => {$location},
877     }__;
878     my $continue = __DOMCore:ERROR{xp|wf-malformed-xml-standalone::
879     DOMCore|location => {$location},
880 wakaba 1.16 xp|parent => {$self->{doc}},
881 wakaba 1.3 xp|name => {$ver},
882     xp|error-token => {$bad_token},
883     }__;
884     unless ($continue) {
885     __EXCEPTION{DOMLS|PARSE_ERR}__;
886     }
887     }
888 wakaba 1.13 if ($ver eq 'yes') {
889 wakaba 1.16 $self->{doc}-><AS::Document.xmlStandalone> (true);
890 wakaba 1.13 $self->{standalone} = true;
891     }
892 wakaba 1.3 }
893    
894     ~? (S) { }
895     }
896    
897 wakaba 1.16 ~ (PIC1) {
898     lang:Perl {
899     $self->{entity}->[-1]->{no_xml11_eol} = false;
900     }
901     } else {
902     lang:Perl {
903     $self->{entity}->[-1]->{no_xml11_eol} = false;
904     }
905     }
906    
907     // ~ (PIC2) { }
908 wakaba 1.3 } // _XMLDeclaration_
909 wakaba 1.1
910     /*
911     Comment Declaration
912    
913     Comment := '<!--' *(Char - '-' / '-' (Char - '-'))
914     '-->' ;; [15]
915 wakaba 1.4 */
916 wakaba 1.1 rule _CommentDeclaration_ ($doc, $parent) {
917     ?lexmode 'CommentDeclaration';
918    
919     ~? (STRING) {
920     lang:Perl ($data => $token.value) {
921     my $com = $doc-><M::Document.createComment> ($data);
922     $parent-><M::Node.appendChild> ($com);
923     }
924     } else {
925     lang:Perl {
926     my $com = $doc-><M::Document.createComment> ('');
927     $parent-><M::Node.appendChild> ($com);
928     }
929     }
930    
931     ~ (COM) {
932     ?lexmode MarkupDeclaration;
933     } else {
934     ?lexmode MarkupDeclaration;
935     }
936    
937     // ~ (MDC) { }
938 wakaba 1.4 } // _CommentDeclaration
939 wakaba 1.15
940     rule _CommentDeclarationDTD {
941     ?lexmode CommentDeclaration;
942 wakaba 1.4
943     ~? (STRING) {
944     //
945     }
946    
947     ~ (COM) {
948     ?lexmode MarkupDeclaration;
949     } else {
950     ?lexmode MarkupDeclaration;
951     }
952    
953     ~ (MDC) {
954     ?lexmode DTD;
955     } else {
956     ?lexmode DTD;
957     }
958     } // _CommentDeclarationDTD
959    
960 wakaba 1.1 /*
961     Processing Instruction
962    
963     PI := '<?' PITarget [S *Char - *Char '?>' *Char]
964     '?>' ;; [16]
965     */
966     rule _ProcessingInstruction_ ($doc, $parent) {
967     ?lexmode 'PIName';
968    
969     my $pi;
970    
971     ~ (Name) {
972 wakaba 1.3 lang:Perl ($name => $token.value) : has-error {
973 wakaba 1.1 if (lc $name eq 'xml') {
974 wakaba 1.3 my $location;
975     __CODE{xp|get-location-from-token::
976     $token => {$token},
977     $result => {$location},
978     }__;
979     my $continue = __DOMCore:ERROR{xp|wf-pi-target-is-xml::
980     xp|name => {$name},
981     DOMCore|location => {$location},
982     xp|parent => {$parent},
983     }__;
984     unless ($continue) {
985     __EXCEPTION{DOMLS|PARSE_ERR::
986     }__;
987     }
988 wakaba 1.1 }
989     ## TODO: Namespace well-formedness
990     $pi = $doc-><M::Document.createProcessingInstruction>
991     ($name);
992     }
993 wakaba 1.14 } else {
994     lang:Perl {
995     $pi = $doc-><M::Document.createProcessingInstruction> ('#INVALID');
996     }
997 wakaba 1.1 }
998    
999 wakaba 1.14 ~? (S) {
1000 wakaba 1.1 ?lexmode 'PIData';
1001    
1002     my $tdata;
1003    
1004     ~? (DATA) {
1005     lang:Perl ($data => $token.value) {
1006     $tdata = $data;
1007     }
1008     } else {
1009     lang:Perl {
1010     $tdata = '';
1011     }
1012     }
1013    
1014     lang:Perl {
1015     $pi-><AS::Node.nodeValue> ($tdata);
1016     }
1017     }
1018    
1019     lang:Perl {
1020     $parent-><M::Node.appendChild> ($pi);
1021     }
1022    
1023     // ~ (PIC) { }
1024     } // _ProcessingInstruction_
1025 wakaba 1.4
1026 wakaba 1.6 /*
1027     Processing instruction in DTD
1028     */
1029     rule _ProcessingInstructionDTD ($doc, $doctype) {
1030 wakaba 1.4 ?lexmode 'PIName';
1031 wakaba 1.6
1032     my $pi;
1033 wakaba 1.4
1034     ~ (Name) {
1035 wakaba 1.6 lang:Perl ($name => $token.value) : has-error {
1036     if (lc $name eq 'xml') {
1037     my $location;
1038     __CODE{xp|get-location-from-token::
1039     $token => {$token},
1040     $result => {$location},
1041     }__;
1042     my $continue = __DOMCore:ERROR{xp|wf-pi-target-is-xml::
1043     xp|name => {$name},
1044     DOMCore|location => {$location},
1045     xp|parent => {$doctype},
1046     }__;
1047     unless ($continue) {
1048     __EXCEPTION{DOMLS|PARSE_ERR::
1049     }__;
1050     }
1051     }
1052     ## TODO: Namespace well-formedness
1053     $pi = $doc-><M::Document.createProcessingInstruction>
1054     ($name);
1055     }
1056 wakaba 1.14 } else {
1057     lang:Perl {
1058     $pi = $doc-><M::Document.createProcessingInstruction> ('#INVALID');
1059     }
1060 wakaba 1.4 }
1061    
1062 wakaba 1.14 ~? (S) {
1063 wakaba 1.4 ?lexmode 'PIData';
1064    
1065 wakaba 1.6 my $tdata;
1066    
1067 wakaba 1.4 ~? (DATA) {
1068 wakaba 1.6 lang:Perl ($data => $token.value) {
1069     $tdata = $data;
1070     }
1071     } else {
1072     lang:Perl {
1073     $tdata = '';
1074     }
1075     }
1076    
1077     lang:Perl {
1078     $pi-><AS::Node.nodeValue> ($tdata);
1079 wakaba 1.4 }
1080     }
1081    
1082 wakaba 1.6 lang:Perl {
1083     $doctype-><M::Node.appendChild> ($pi);
1084     }
1085    
1086 wakaba 1.4 ~ (PIC) {
1087     ?lexmode DTD;
1088     } else {
1089     ?lexmode DTD;
1090     }
1091     } // _ProcessingInstructionDTD
1092 wakaba 1.1
1093     /*
1094     Element content parsing mode
1095    
1096     element := EmptyElemTag /
1097     STag content ETag ;; [39]
1098     content := (CharData / element / Reference / CDSect /
1099     PI / Comment) ;; [43]
1100     */
1101 wakaba 1.6 rule Element_ ($doc, $parent, $ns) : standalone {
1102 wakaba 1.1 ?lexmode 'ElementContent';
1103    
1104     my $node; // Current "parent" node
1105     my $nodes; // Node stack (w/o $current_node)
1106     my $type; // Current "parent" element type QName
1107     my $types; // Element type stack (w/o $current_type)
1108 wakaba 1.6 //my $ns; // Current in-scope namespace bindings
1109 wakaba 1.1 my $nses; // Namespace binding stack (w/o $current_ns)
1110    
1111     lang:Perl {
1112     $node = $parent;
1113     $nodes = [];
1114     $type = '';
1115     $types = [];
1116 wakaba 1.6 $ns ||= {
1117 wakaba 1.1 xml => <Q::xml:>,
1118     xmlns => <Q::xmlns:>,
1119     };
1120     $nses = [];
1121     }
1122    
1123     ~* : name => CONTENT
1124     (CharData) {
1125     // Character data
1126     lang:Perl ($data => $token.value) {
1127     $node-><M::Node.appendChild>
1128     ($doc-><M::Document.createTextNode> ($data));
1129     }
1130     } (STAGO) {
1131     // Start tag or empty element tag
1132    
1133     ?lexmode 'StartTag';
1134    
1135     ~ (Name) {
1136     my $attrs;
1137     lang:Perl ($name => $token.value) {
1138     push @{$types}, $type;
1139     $type = $name;
1140     $attrs = {};
1141     }
1142    
1143     ~? (S) {
1144     &AttributeSpecificationList
1145     ($doc => $doc, $attrs => $attrs);
1146     }
1147    
1148     my $el;
1149 wakaba 1.9
1150     /*
1151     Note that this implementation does not perform
1152     attribute value tokenization (but does white space
1153     normalization common to attribute types) and
1154     construct the tree as is. DOM Level 3 Core spec
1155     is unclear on this point. With tokenization,
1156     entity references cannot be preserved.
1157    
1158     The manakai Node.nodeValue and Attr.value attributes
1159     do tokenization according to attribute types.
1160     */
1161    
1162     /*
1163     ISSUE: Should |xml:id| attribute be typed?
1164     */
1165 wakaba 1.1
1166     lang:Perl {
1167     push @{$nses}, $ns;
1168     $ns = {%$ns};
1169    
1170     my %gattr;
1171     my %lattr;
1172     for my $atqname (keys %$attrs) {
1173     my ($pfx, $lname) = split /:/, $atqname;
1174 wakaba 1.9 $attrs->{$atqname}->{def} = $self->{attr}->{$type}->{$atqname};
1175 wakaba 1.1 if (defined $lname) { ## Global attribute
1176     ## TODO: Namespace well-formedness (lname is NCName)
1177     if ($pfx eq 'xmlns') {
1178     my $nsuri = $attrs->{$atqname}->{value};
1179     if ($lname eq 'xml' and
1180     $nsuri ne <Q::xml:>) {
1181     ## TODO: error
1182     } elsif ($lname eq 'xmlns') {
1183     ## TODO: error
1184     }
1185     if ($nsuri eq '') {
1186     ## TODO: error in XML 1.0
1187     } elsif ($nsuri eq <Q::xml:> and
1188     $lname ne 'xml') {
1189     ## TODO: error
1190     } elsif ($nsuri eq <Q::xmlns:>) {
1191     ## TODO: error
1192     }
1193     $ns->{$lname} = $attrs->{$atqname}->{value};
1194 wakaba 1.9 if ($attrs->{$atqname}->{def}) {
1195     my $dt = $attrs->{$atqname}->{def}-><AG::ATDef.declaredType>;
1196     if ({
1197     <C::ATDef.ID_ATTR> => true,
1198     <C::ATDef.IDREF_ATTR> => true,
1199     <C::ATDef.IDREFS_ATTR> => true,
1200     <C::ATDef.ENTITY_ATTR> => true,
1201     <C::ATDef.ENTITIES_ATTR> => true,
1202     <C::ATDef.NMTOKEN_ATTR> => true,
1203     <C::ATDef.NMTOKENS_ATTR> => true,
1204     <C::ATDef.NOTATION_ATTR> => true,
1205     <C::ATDef.ENUMERATION_ATTR> => true,
1206     }->{$dt}) {
1207     ## Tokenization (XML 1 3.3.3)
1208     for ($ns->{$lname}) {
1209     s/^\x20+//;
1210     s/\x20+\z//;
1211     s/\x20+/ /g;
1212     }
1213     }
1214     }
1215 wakaba 1.1 delete $ns->{$lname} unless length $ns->{$lname};
1216     } elsif ($pfx eq '') {
1217     ## TODO: pfx is not NCName error
1218     } else {
1219     if ($gattr{$pfx}->{$lname}) {
1220     ## TODO: Namespace well-formedness error
1221     }
1222     }
1223     $gattr{$pfx}->{$lname} = $attrs->{$atqname};
1224     } else { ## Local attribute
1225     if ($pfx eq 'xmlns') {
1226     $ns->{''} = $attrs->{xmlns}->{value};
1227 wakaba 1.9 if ($attrs->{$atqname}->{def}) {
1228     my $dt = $attrs->{$atqname}->{def}-><AG::ATDef.declaredType>;
1229     if ({
1230     <C::ATDef.ID_ATTR> => true,
1231     <C::ATDef.IDREF_ATTR> => true,
1232     <C::ATDef.IDREFS_ATTR> => true,
1233     <C::ATDef.ENTITY_ATTR> => true,
1234     <C::ATDef.ENTITIES_ATTR> => true,
1235     <C::ATDef.NMTOKEN_ATTR> => true,
1236     <C::ATDef.NMTOKENS_ATTR> => true,
1237     <C::ATDef.NOTATION_ATTR> => true,
1238     <C::ATDef.ENUMERATION_ATTR> => true,
1239     }->{$dt}) {
1240     ## Tokenization (XML 1 3.3.3)
1241     for ($ns->{''}) {
1242     s/^\x20+//;
1243     s/\x20+\z//;
1244     s/\x20+/ /g;
1245     }
1246     }
1247     }
1248 wakaba 1.1 delete $ns->{''} unless length $ns->{''};
1249     } else {
1250     $lattr{$pfx} = $attrs->{$atqname};
1251     }
1252     }
1253     }
1254    
1255     my ($pfx, $lname) = split /:/, $type;
1256     my $nsuri;
1257     ## TODO: lname is NCName?
1258     if (defined $lname) { ## Prefixed namespace
1259     if ($pfx eq '') {
1260     ## TODO: pfx is not NCName error
1261     }
1262     if (defined $ns->{$pfx}) {
1263     $nsuri = $ns->{$pfx};
1264     } else {
1265     ## TODO: namespace ill-formed
1266     }
1267     } else { ## Default namespace
1268     $nsuri = $ns->{''};
1269     }
1270    
1271     $el = $doc-><M::Document.createElementNS>
1272     ($nsuri, $type);
1273    
1274     if ($attrs->{xmlns}) {
1275     my $attr = $doc-><M::Document.createAttributeNS>
1276     (<Q::xmlns:>, 'xmlns');
1277     for (@{$attrs->{xmlns}->{nodes}}) {
1278     $attr-><M::Node.appendChild> ($_);
1279     }
1280 wakaba 1.9 if ($attrs->{xmlns}->{def}) {
1281     __CODE{t|setAttrType::
1282     $attr => $attr,
1283     $type => {$attrs->{xmlns}->{def}-><AG::ATDef.declaredType>},
1284     }__;
1285     }
1286 wakaba 1.1 $el-><M::Element.setAttributeNodeNS> ($attr);
1287     }
1288    
1289     for my $lname (keys %lattr) {
1290     my $attr = $doc-><M::Document.createAttributeNS>
1291     (null, $lname);
1292     for (@{$lattr{$lname}->{nodes}}) {
1293     $attr-><M::Node.appendChild> ($_);
1294     }
1295 wakaba 1.9 if ($attrs->{$lname}->{def}) {
1296     __CODE{t|setAttrType::
1297     $attr => $attr,
1298     $type => {$attrs->{$lname}->{def}-><AG::ATDef.declaredType>},
1299     }__;
1300     }
1301 wakaba 1.1 $el-><M::Element.setAttributeNodeNS> ($attr);
1302     }
1303    
1304     for my $pfx (keys %gattr) {
1305     for my $lname (keys %{$gattr{$pfx}}) {
1306     my $attr = $doc-><M::Document.createAttributeNS>
1307     ($ns->{$pfx}, $pfx.':'.$lname);
1308     for (@{$gattr{$pfx}->{$lname}->{nodes}}) {
1309     $attr-><M::Node.appendChild> ($_);
1310     }
1311 wakaba 1.9 if ($attrs->{$pfx}->{$lname}->{def}) {
1312     __CODE{t|setAttrType::
1313     $attr => $attr,
1314     $type => {$attrs->{$pfx}->{$lname}
1315     ->{def}-><AG::ATDef.declaredType>},
1316     }__;
1317     }
1318 wakaba 1.1 $el-><M::Element.setAttributeNodeNS> ($attr);
1319     }
1320     }
1321    
1322     $node-><M::Node.appendChild> ($el);
1323     }
1324    
1325     ~ (TAGC) {
1326     lang:Perl {
1327     push @{$nodes}, $node;
1328     $node = $el;
1329     }
1330     ?lexmode ElementContent;
1331 wakaba 1.6 } (NESTC) {
1332     my $is_docel;
1333 wakaba 1.1 lang:Perl {
1334     $ns = pop @{$nses};
1335     $type = pop @{$types};
1336 wakaba 1.6 $is_docel = (@{$types} == 0);
1337     }
1338    
1339     if-true ($is_docel) {
1340     return;
1341     }
1342    
1343     ~ (TAGC) {
1344     ?lexmode ElementContent;
1345     } else {
1346     ?lexmode ElementContent;
1347 wakaba 1.1 }
1348     } else {
1349     ?lexmode ElementContent;
1350     }
1351     } else {
1352     ?lexmode ElementContent;
1353     }
1354    
1355     } (ETAGO) {
1356     // End tag
1357    
1358     ?lexmode 'EndTag';
1359    
1360     my $is_docel;
1361    
1362     ~ (Name) {
1363 wakaba 1.3 lang:Perl ($name => $token.value) : has-error {
1364 wakaba 1.1 if ($name eq $type) {
1365     $type = pop @{$types};
1366     if ($type eq '') {
1367     $is_docel = true;
1368     }
1369     $node = pop @{$nodes};
1370     $ns = pop @{$nses};
1371     } else {
1372 wakaba 1.3 my $location;
1373     __CODE{xp|get-location-from-token::
1374     $token => $token,
1375     $result => $location,
1376     }__;
1377     my $continue = __DOMCore:ERROR{xp|wf-element-type-match::
1378     DOMCore:location => {$location},
1379     xp|token => {$token},
1380     xp|expected-element-type => {$type},
1381     xp|actual-element-type => {$name},
1382     xp|node => {$node},
1383     }__;
1384     unless ($continue) {
1385     __EXCEPTION{DOMLS|PARSE_ERR}__;
1386     }
1387 wakaba 1.1 }
1388     }
1389     }
1390    
1391     ~? (S) { }
1392    
1393     if-true ($is_docel) {
1394 wakaba 1.3 lang:Perl : has-error {
1395 wakaba 1.1 if (@{$types}) {
1396 wakaba 1.3 my $location;
1397     __CODE{xp|get-location-from-token::
1398     $token => $token,
1399     $result => $location,
1400     }__;
1401     for my $type (reverse @{$types}) {
1402     my $continue = __DOMCore:ERROR{xp|wf-no-end-tag::
1403     DOMCore:location => {$location},
1404     xp|token => {$token},
1405     xp|expected-element-type => {$type},
1406     xp|node => {$node},
1407     }__;
1408     unless ($continue) {
1409     __EXCEPTION{DOMLS|PARSE_ERR}__;
1410     }
1411     $node = shift @{$nodes};
1412     }
1413 wakaba 1.1 }
1414     }
1415     return;
1416     }
1417    
1418     ~ (TAGC) {
1419     ?lexmode ElementContent;
1420     } else {
1421     ?lexmode 'ElementContent';
1422     }
1423    
1424     } (HCRO) {
1425     &_HexadecimalCharacterReference_
1426     ($doc => $doc, $parent => $node);
1427    
1428     ~ (REFC) {
1429     ?lexmode 'ElementContent';
1430     } else {
1431     ?lexmode ElementContent;
1432     }
1433     } (CRO) {
1434     &_NumericCharacterReference_
1435     ($doc => $doc, $parent => $node);
1436    
1437     ~ (REFC) {
1438     ?lexmode 'ElementContent';
1439     } else {
1440     ?lexmode ElementContent;
1441     }
1442     } (ERO) {
1443 wakaba 1.6 &_GeneralEntityReferenceEC
1444     ($doc => $doc, $parent => $node, $ns => $ns);
1445 wakaba 1.1 } (CDO) {
1446     &_CommentDeclaration_ ($doc => $doc, $parent => $node);
1447    
1448     ~ (MDC) {
1449     ?lexmode ElementContent;
1450     } else {
1451     ?lexmode ElementContent;
1452     }
1453     } (CDSO) {
1454     &_CDATASection_ ($doc => $doc, $parent => $node);
1455    
1456     ~ (MSE) {
1457     ?lexmode 'ElementContent';
1458     } else {
1459     ?lexmode ElementContent;
1460     }
1461     } (PIO) {
1462     &_ProcessingInstruction_ ($doc => $doc, $parent => $node);
1463    
1464     ~ (PIC) {
1465     ?lexmode 'ElementContent';
1466     } else {
1467     ?lexmode ElementContent;
1468     }
1469     }
1470 wakaba 1.3
1471     ~ (#NONE) { }
1472 wakaba 1.1 } // Element_
1473 wakaba 1.11
1474     /*
1475     content := [CharData]
1476     *((element / Reference / CDSect / PI / Comment) [CharData])
1477     */
1478     rule content ($parent, $ns) {
1479     // ?lexmode ElementContent;
1480    
1481     my $doc;
1482     lang:Perl {
1483     $doc = $self->{doc};
1484     }
1485    
1486     ~* (CharData) {
1487     lang:Perl ($data => $token.value) {
1488     $parent-><M::Node.appendChild>
1489     ($self->{doc}-><M::Document.createTextNode> ($data));
1490     }
1491     } (STAGO) {
1492     &Element_ ($doc => $doc, $parent => $parent, $ns => $ns)
1493     : unshift-current-token;
1494     ~ (TAGC) {
1495     ?lexmode ElementContent;
1496     } else {
1497     ?lexmode ElementContent;
1498     }
1499     } (HCRO) {
1500     &_HexadecimalCharacterReference_
1501     ($doc => $doc, $parent => $parent);
1502    
1503     ~ (REFC) {
1504     ?lexmode 'ElementContent';
1505     } else {
1506     ?lexmode ElementContent;
1507     }
1508     } (CRO) {
1509     &_NumericCharacterReference_
1510     ($doc => $doc, $parent => $parent);
1511    
1512     ~ (REFC) {
1513     ?lexmode 'ElementContent';
1514     } else {
1515     ?lexmode ElementContent;
1516     }
1517     } (ERO) {
1518     &_GeneralEntityReferenceEC
1519     ($doc => $doc, $parent => $parent, $ns => $ns);
1520     } (CDO) {
1521     &_CommentDeclaration_ ($doc => $doc, $parent => $parent);
1522    
1523     ~ (MDC) {
1524     ?lexmode ElementContent;
1525     } else {
1526     ?lexmode ElementContent;
1527     }
1528     } (CDSO) {
1529     &_CDATASection_ ($doc => $doc, $parent => $parent);
1530    
1531     ~ (MSE) {
1532     ?lexmode 'ElementContent';
1533     } else {
1534     ?lexmode ElementContent;
1535     }
1536     } (PIO) {
1537     &_ProcessingInstruction_ ($doc => $doc, $parent => $parent);
1538    
1539     ~ (PIC) {
1540     ?lexmode 'ElementContent';
1541     } else {
1542     ?lexmode ElementContent;
1543     }
1544     }
1545     } // content
1546 wakaba 1.1
1547     rule AttributeSpecificationList ($doc, $attrs)
1548     : standalone
1549     {
1550     ?lexmode 'StartTag';
1551    
1552     my $i;
1553     lang:Perl {
1554     $i = 0;
1555     }
1556    
1557     ~* (Name) {
1558     my $atqname;
1559     lang:Perl ($name => $token.value) {
1560     $atqname = $name;
1561     }
1562    
1563     my $vals;
1564 wakaba 1.18 lang:Perl : has-error {
1565 wakaba 1.1 if ($attrs->{$atqname}) {
1566 wakaba 1.3 my $location;
1567     __CODE{xp|get-location-from-token::
1568     $token => $token,
1569     $result => $location,
1570     }__;
1571     my $continue = __DOMCore:ERROR{xp|wf-unique-att-spec::
1572     DOMCore:location => {$location},
1573     xp|token => {$token},
1574     xp|name => {$atqname},
1575     }__;
1576     unless ($continue) {
1577     __EXCEPTION{DOMLS|PARSE_ERR}__;
1578     }
1579 wakaba 1.1 }
1580    
1581     $vals = $attrs->{$atqname} = {
1582     nodes => [],
1583     value => '',
1584     index => $i++,
1585     };
1586     }
1587 wakaba 1.3
1588     ~? (S) { }
1589     ~ (VI) { }
1590     ~? (S) { }
1591 wakaba 1.1
1592     ~ (LIT) {
1593     &_AttributeValueSpecification_
1594     ($doc => $doc, $vals => $vals);
1595    
1596     ~ (LIT) {
1597     ?lexmode StartTag;
1598     } else {
1599     ?lexmode StartTag;
1600     }
1601     } (LITA) {
1602     &_AttributeValueSpecificationA_
1603     ($doc => $doc, $vals => $vals);
1604    
1605     ~ (LITA) {
1606     ?lexmode StartTag;
1607     } else {
1608     ?lexmode StartTag;
1609     }
1610     }
1611     } (S) : separator : terminator? { }
1612     } // AttributeSpecificationList
1613    
1614     rule _AttributeValueSpecification_ ($doc, $vals) {
1615     // ~ (LIT) { }
1616     ?lexmode 'AttributeValueLiteral';
1617    
1618     ~* (STRING) {
1619     lang:Perl ($value => $token.value) {
1620     $value =~ s/[\x09\x0A\x0D]/ /g;
1621     my $text = $doc-><M::Document.createTextNode> ($value);
1622     push @{$vals->{nodes}}, $text;
1623     $vals->{value} .= $value;
1624     }
1625     } (HCRO) {
1626     &_HexadecimalCharacterReferenceV_
1627     ($doc => $doc, $vals => $vals);
1628    
1629     ~ (REFC) {
1630     ?lexmode AttributeValueLiteral;
1631     } else {
1632     ?lexmode AttributeValueLiteral;
1633     }
1634     } (CRO) {
1635     &_NumericCharacterReferenceV_
1636     ($doc => $doc, $vals => $vals);
1637    
1638     ~ (REFC) {
1639     ?lexmode AttributeValueLiteral;
1640     } else {
1641     ?lexmode AttributeValueLiteral;
1642     }
1643     } (ERO) {
1644     // TODO: Attribute value normalization
1645     &_GeneralEntityReferenceV_
1646     ($doc => $doc, $vals => $vals);
1647    
1648     ~ (REFC) {
1649     ?lexmode AttributeValueLiteral;
1650     } else {
1651     ?lexmode AttributeValueLiteral;
1652     }
1653     }
1654    
1655     // ~ (LIT) { } (LITA) { }
1656     } // _AttributeValueSpecification_
1657    
1658     rule _AttributeValueSpecificationA_ ($doc, $vals) {
1659     // ~ (LITA) { }
1660     ?lexmode 'AttributeValueLiteralA';
1661    
1662     ~* (STRING) {
1663     lang:Perl ($value => $token.value) {
1664     $value =~ s/[\x09\x0A\x0D]/ /g;
1665     my $text = $doc-><M::Document.createTextNode> ($value);
1666     push @{$vals->{nodes}}, $text;
1667     $vals->{value} .= $value;
1668     }
1669     } (HCRO) {
1670     &_HexadecimalCharacterReferenceV_
1671     ($doc => $doc, $vals => $vals);
1672    
1673     ~ (REFC) {
1674     ?lexmode AttributeValueLiteralA;
1675     } else {
1676     ?lexmode AttributeValueLiteralA;
1677     }
1678     } (CRO) {
1679     &_NumericCharacterReferenceV_
1680     ($doc => $doc, $vals => $vals);
1681    
1682     ~ (REFC) {
1683     ?lexmode AttributeValueLiteralA;
1684     } else {
1685     ?lexmode AttributeValueLiteralA;
1686     }
1687     } (ERO) {
1688     // TODO: Attribute value normalization
1689     &_GeneralEntityReferenceV_
1690     ($doc => $doc, $vals => $vals);
1691    
1692     ~ (REFC) {
1693     ?lexmode AttributeValueLiteralA;
1694     } else {
1695     ?lexmode AttributeValueLiteralA;
1696     }
1697     }
1698    
1699     // ~ (LITA) { }
1700     } // _AttributeValueSpecificationA_
1701    
1702     /*
1703 wakaba 1.11 Parsing replacement text of an entity referenced in
1704     an attribute value specification.
1705     */
1706     rule AttributeValueLiteralE_ ($parent, $vals)
1707     : recursive
1708     {
1709     // ?lexmode AttributeValueLiteralE;
1710    
1711     ~* (STRING) {
1712     lang:Perl ($value => $token.value) {
1713     $value =~ s/[\x09\x0A\x0D]/ /g;
1714     my $text = $self->{doc}-><M::Document.createTextNode> ($value);
1715     $parent-><M::Node.appendChild> ($text);
1716     $vals->{value} .= $value;
1717     }
1718     } (HCRO) {
1719     &_HexadecimalCharacterReferenceAE_
1720     ($parent => $parent, $vals => $vals);
1721    
1722     ~ (REFC) {
1723     ?lexmode AttributeValueLiteralE;
1724     } else {
1725     ?lexmode AttributeValueLiteralE;
1726     }
1727     } (CRO) {
1728     &_NumericCharacterReferenceAE_
1729     ($parent => $parent, $vals => $vals);
1730    
1731     ~ (REFC) {
1732     ?lexmode AttributeValueLiteralE;
1733     } else {
1734     ?lexmode AttributeValueLiteralE;
1735     }
1736     } (ERO) {
1737     &_GeneralEntityReferenceAE_ ($parent => $parent, $vals => $vals);
1738    
1739     ~ (REFC) {
1740     ?lexmode AttributeValueLiteralE;
1741     } else {
1742     ?lexmode AttributeValueLiteralE;
1743     }
1744 wakaba 1.18 } (#INVALID == '<') {
1745     lang:Perl : has-error {
1746     my $location;
1747     __CODE{xp|get-location-from-token::
1748     $token => $token,
1749     $result => $location,
1750     }__;
1751     my $continue = __DOMCore:ERROR{xp|wf-no-lt-in-attribute-values::
1752     c|location => {$location},
1753     xp|token => {$token},
1754     }__;
1755     unless ($continue) {
1756     __EXCEPTION{DOMLS|PARSE_ERR}__;
1757     }
1758    
1759     my $text = $self->{doc}-><M::Document.createTextNode> ('<');
1760     $parent-><M::Node.appendChild> ($text);
1761     $vals->{value} .= '<';
1762     }
1763 wakaba 1.11 }
1764    
1765     // ~ (#EOF) { }
1766     } // AttributeValueLiteralE_
1767    
1768     /*
1769 wakaba 1.1 CDATA Section Content Parsing Mode
1770     */
1771     rule _CDATASection_ ($doc, $parent) {
1772     ?lexmode 'CDATASectionContent';
1773    
1774     my $cdata;
1775    
1776 wakaba 1.2 ~? (CData) {
1777 wakaba 1.1 lang:Perl ($data => $token.value) {
1778     $cdata = $data;
1779     }
1780     } else {
1781     lang:Perl {
1782     $cdata = '';
1783     }
1784     }
1785    
1786     lang:Perl {
1787     my $cdsect = $doc-><M::Document.createCDATASection>
1788     ($cdata);
1789     $parent-><M::Node.appendChild> ($cdsect);
1790     }
1791    
1792     // ~ (MSE) { }
1793     } // _CDATASection_
1794    
1795     rule _NumericCharacterReference_ ($doc, $parent) {
1796     ?lexmode 'NumericCharacterReference';
1797    
1798     ~ (NUMBER) {
1799 wakaba 1.3 lang:Perl ($num => $token.value) : has-error {
1800     $num += 0;
1801     unless (
1802     ($self->{xml_version} eq '1.0' and
1803     ((0x0020 <= $num and $num <= 0xD7FF) or
1804     (0xE000 <= $num and $num <= 0xFFFD) or
1805     (0x10000 <= $num and $num <= 0x10FFFF) or
1806     $num == 0x9 or $num == 0xA or $num == 0xD)) or
1807     ($self->{xml_version} eq '1.1' and
1808     ((0x0001 <= $num and $num <= 0xD7FF) or
1809     (0xE000 <= $num and $num <= 0xFFFD) or
1810     (0x10000 <= $num and $num <= 0x10FFFF)))
1811     ) {
1812     my $location;
1813     __CODE{xp|get-location-from-token::
1814     $token => $token,
1815     $result => $location,
1816     }__;
1817     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
1818     DOMCore:location => {$location},
1819     xp|token => {$token},
1820     xp|character-number => {$num},
1821     xp|parent => {$parent},
1822     }__;
1823     unless ($continue) {
1824     __EXCEPTION{DOMLS|PARSE_ERR}__;
1825     }
1826     }
1827     my $ncr = $doc-><M::Document.createTextNode> (chr $num);
1828 wakaba 1.1 $parent-><M::Node.appendChild> ($ncr);
1829     }
1830     }
1831    
1832     // ~ (REFC) { }
1833     } // _NumericCharacterReference_
1834    
1835     rule _NumericCharacterReferenceV_ ($doc, $vals) {
1836     ?lexmode 'NumericCharacterReference';
1837    
1838     ~ (NUMBER) {
1839 wakaba 1.3 lang:Perl ($num => $token.value) : has-error {
1840     $num += 0;
1841     unless (
1842     ($self->{xml_version} eq '1.0' and
1843     ((0x0020 <= $num and $num <= 0xD7FF) or
1844     (0xE000 <= $num and $num <= 0xFFFD) or
1845     (0x10000 <= $num and $num <= 0x10FFFF) or
1846     $num == 0x9 or $num == 0xA or $num == 0xD)) or
1847     ($self->{xml_version} eq '1.1' and
1848     ((0x0001 <= $num and $num <= 0xD7FF) or
1849     (0xE000 <= $num and $num <= 0xFFFD) or
1850     (0x10000 <= $num and $num <= 0x10FFFF)))
1851     ) {
1852     my $location;
1853     __CODE{xp|get-location-from-token::
1854     $token => $token,
1855     $result => $location,
1856     }__;
1857     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
1858     DOMCore:location => {$location},
1859     xp|token => {$token},
1860     xp|character-number => {$num},
1861     }__;
1862     unless ($continue) {
1863     __EXCEPTION{DOMLS|PARSE_ERR}__;
1864     }
1865     }
1866 wakaba 1.1 my $ncr = $doc-><M::Document.createTextNode>
1867 wakaba 1.9 (my $char = chr $num);
1868 wakaba 1.1 push @{$vals->{nodes}}, $ncr;
1869     $vals->{value} .= $char;
1870     }
1871     }
1872    
1873     // ~ (REFC) { }
1874     } // _NumericCharacterReferenceV_
1875    
1876 wakaba 1.11 /*
1877     Numeric character reference in the replacement text
1878     of the entity referenced in an attribute value specification
1879     */
1880     rule _NumericCharacterReferenceAE_ ($parent, $vals)
1881     {
1882     ?lexmode NumericCharacterReference;
1883    
1884     ~ (NUMBER) {
1885     lang:Perl ($num => $token.value) : has-error {
1886     $num += 0;
1887     unless (
1888     ($self->{xml_version} eq '1.0' and
1889     ((0x0020 <= $num and $num <= 0xD7FF) or
1890     (0xE000 <= $num and $num <= 0xFFFD) or
1891     (0x10000 <= $num and $num <= 0x10FFFF) or
1892     $num == 0x9 or $num == 0xA or $num == 0xD)) or
1893     ($self->{xml_version} eq '1.1' and
1894     ((0x0001 <= $num and $num <= 0xD7FF) or
1895     (0xE000 <= $num and $num <= 0xFFFD) or
1896     (0x10000 <= $num and $num <= 0x10FFFF)))
1897     ) {
1898     my $location;
1899     __CODE{xp|get-location-from-token::
1900     $token => $token,
1901     $result => $location,
1902     }__;
1903     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
1904     DOMCore:location => {$location},
1905     xp|token => {$token},
1906     xp|character-number => {$num},
1907     }__;
1908     unless ($continue) {
1909     __EXCEPTION{DOMLS|PARSE_ERR}__;
1910     }
1911     }
1912     my $ncr = $self->{doc}-><M::Document.createTextNode>
1913     (my $char = chr $num);
1914     $parent-><M::Node.appendChild> ($ncr);
1915     $vals->{value} .= $char;
1916     }
1917     }
1918    
1919     // ~ (REFC) { }
1920     } // _NumericCharacterReferenceAE_
1921    
1922     rule _NumericCharacterReferenceEV_ ($vals)
1923     {
1924     ?lexmode 'NumericCharacterReference';
1925    
1926     ~ (NUMBER) {
1927     lang:Perl ($num => $token.value) : has-error {
1928     $num += 0;
1929     unless (
1930     ($self->{xml_version} eq '1.0' and
1931     ((0x0020 <= $num and $num <= 0xD7FF) or
1932     (0xE000 <= $num and $num <= 0xFFFD) or
1933     (0x10000 <= $num and $num <= 0x10FFFF) or
1934     $num == 0x9 or $num == 0xA or $num == 0xD)) or
1935     ($self->{xml_version} eq '1.1' and
1936     ((0x0001 <= $num and $num <= 0xD7FF) or
1937     (0xE000 <= $num and $num <= 0xFFFD) or
1938     (0x10000 <= $num and $num <= 0x10FFFF)))
1939     ) {
1940     my $location;
1941     __CODE{xp|get-location-from-token::
1942     $token => $token,
1943     $result => $location,
1944     }__;
1945     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
1946     DOMCore:location => {$location},
1947     xp|token => {$token},
1948     xp|character-number => {$num},
1949     }__;
1950     unless ($continue) {
1951     __EXCEPTION{DOMLS|PARSE_ERR}__;
1952     }
1953     }
1954     push @{$vals}, chr $num;
1955     }
1956     }
1957    
1958     // ~ (REFC) { }
1959     } // _NumericCharacterReferenceEV_
1960    
1961 wakaba 1.1 rule _HexadecimalCharacterReference_ ($doc, $parent) {
1962     ?lexmode 'HexadecimalCharacterReference';
1963    
1964     ~ (Hex) {
1965 wakaba 1.9 lang:Perl ($v => $token.value) : has-error {
1966     my $num = hex $v;
1967 wakaba 1.3 unless (
1968     ($self->{xml_version} eq '1.0' and
1969     ((0x0020 <= $num and $num <= 0xD7FF) or
1970     (0xE000 <= $num and $num <= 0xFFFD) or
1971     (0x10000 <= $num and $num <= 0x10FFFF) or
1972     $num == 0x9 or $num == 0xA or $num == 0xD)) or
1973     ($self->{xml_version} eq '1.1' and
1974     ((0x0001 <= $num and $num <= 0xD7FF) or
1975     (0xE000 <= $num and $num <= 0xFFFD) or
1976     (0x10000 <= $num and $num <= 0x10FFFF)))
1977     ) {
1978     my $location;
1979     __CODE{xp|get-location-from-token::
1980     $token => $token,
1981     $result => $location,
1982     }__;
1983     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
1984     DOMCore:location => {$location},
1985     xp|token => {$token},
1986     xp|character-number => {$num},
1987     xp|parent => {$parent},
1988     }__;
1989     unless ($continue) {
1990     __EXCEPTION{DOMLS|PARSE_ERR}__;
1991     }
1992     }
1993 wakaba 1.1 my $ncr = $doc-><M::Document.createTextNode>
1994 wakaba 1.9 (chr $num);
1995 wakaba 1.1 $parent-><M::Node.appendChild> ($ncr);
1996     }
1997     }
1998    
1999     // ~ (REFC) { }
2000     } // _HexadecimalCharacterReference_
2001    
2002 wakaba 1.3 rule _HexadecimalCharacterReferenceV_ ($doc, $vals) {
2003 wakaba 1.1 ?lexmode 'HexadecimalCharacterReference';
2004    
2005     ~ (Hex) {
2006 wakaba 1.9 lang:Perl ($v => $token.value) : has-error {
2007     my $num = hex $v;
2008 wakaba 1.3 unless (
2009     ($self->{xml_version} eq '1.0' and
2010     ((0x0020 <= $num and $num <= 0xD7FF) or
2011     (0xE000 <= $num and $num <= 0xFFFD) or
2012     (0x10000 <= $num and $num <= 0x10FFFF) or
2013     $num == 0x9 or $num == 0xA or $num == 0xD)) or
2014     ($self->{xml_version} eq '1.1' and
2015     ((0x0001 <= $num and $num <= 0xD7FF) or
2016     (0xE000 <= $num and $num <= 0xFFFD) or
2017     (0x10000 <= $num and $num <= 0x10FFFF)))
2018     ) {
2019     my $location;
2020     __CODE{xp|get-location-from-token::
2021     $token => $token,
2022     $result => $location,
2023     }__;
2024     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
2025     DOMCore:location => {$location},
2026     xp|token => {$token},
2027     xp|character-number => {$num},
2028     }__;
2029     unless ($continue) {
2030     __EXCEPTION{DOMLS|PARSE_ERR}__;
2031     }
2032     }
2033 wakaba 1.1 my $ncr = $doc-><M::Document.createTextNode>
2034 wakaba 1.9 (my $char = chr $num);
2035 wakaba 1.1 push @{$vals->{nodes}}, $ncr;
2036     $vals->{value} .= $char;
2037     }
2038     }
2039    
2040     // ~ (REFC) { }
2041 wakaba 1.11 } // _HexadecimalCharacterReferenceV_
2042    
2043     /*
2044     Hexadecimal character reference in the replacement text
2045     of the entity referenced in an attribute value literal
2046     */
2047     rule _HexadecimalCharacterReferenceAE_ ($parent, $vals)
2048     {
2049     ?lexmode HexadecimalCharacterReference;
2050    
2051     ~ (Hex) {
2052     lang:Perl ($v => $token.value) : has-error {
2053     my $num = hex $v;
2054     unless (
2055     ($self->{xml_version} eq '1.0' and
2056     ((0x0020 <= $num and $num <= 0xD7FF) or
2057     (0xE000 <= $num and $num <= 0xFFFD) or
2058     (0x10000 <= $num and $num <= 0x10FFFF) or
2059     $num == 0x9 or $num == 0xA or $num == 0xD)) or
2060     ($self->{xml_version} eq '1.1' and
2061     ((0x0001 <= $num and $num <= 0xD7FF) or
2062     (0xE000 <= $num and $num <= 0xFFFD) or
2063     (0x10000 <= $num and $num <= 0x10FFFF)))
2064     ) {
2065     my $location;
2066     __CODE{xp|get-location-from-token::
2067     $token => $token,
2068     $result => $location,
2069     }__;
2070     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
2071     DOMCore:location => {$location},
2072     xp|token => {$token},
2073     xp|character-number => {$num},
2074     }__;
2075     unless ($continue) {
2076     __EXCEPTION{DOMLS|PARSE_ERR}__;
2077     }
2078     }
2079     my $ncr = $self->{doc}-><M::Document.createTextNode>
2080     (my $char = chr $num);
2081     $parent-><M::Node.appendChild> ($ncr);
2082     $vals->{value} .= $char;
2083     }
2084     }
2085    
2086     // ~ (REFC) { }
2087     } // _HexadecimalCharacterReferenceAE_
2088    
2089     rule _HexadecimalCharacterReferenceEV_ ($vals) {
2090     ?lexmode HexadecimalCharacterReference;
2091    
2092     ~ (Hex) {
2093     lang:Perl ($v => $token.value) : has-error {
2094     my $num = hex $v;
2095     unless (
2096     ($self->{xml_version} eq '1.0' and
2097     ((0x0020 <= $num and $num <= 0xD7FF) or
2098     (0xE000 <= $num and $num <= 0xFFFD) or
2099     (0x10000 <= $num and $num <= 0x10FFFF) or
2100     $num == 0x9 or $num == 0xA or $num == 0xD)) or
2101     ($self->{xml_version} eq '1.1' and
2102     ((0x0001 <= $num and $num <= 0xD7FF) or
2103     (0xE000 <= $num and $num <= 0xFFFD) or
2104     (0x10000 <= $num and $num <= 0x10FFFF)))
2105     ) {
2106     my $location;
2107     __CODE{xp|get-location-from-token::
2108     $token => $token,
2109     $result => $location,
2110     }__;
2111     my $continue = __DOMCore:ERROR{xp|wf-legal-character::
2112     DOMCore:location => {$location},
2113     xp|token => {$token},
2114     xp|character-number => {$num},
2115     }__;
2116     unless ($continue) {
2117     __EXCEPTION{DOMLS|PARSE_ERR}__;
2118     }
2119     }
2120     push @{$vals}, chr $num;
2121     }
2122     }
2123    
2124     // ~ (REFC) { }
2125     } // _HexadecimalCharacterReferenceEV_
2126    
2127     /*
2128     General entity reference in element's content
2129     */
2130     rule _GeneralEntityReferenceEC ($doc, $parent, $ns)
2131     : recursive
2132     {
2133     ?lexmode 'EntityReference';
2134    
2135     ~ (Name == 'lt') {
2136     lang:Perl {
2137     $parent-><M::Node.appendChild>
2138     ($self->{doc}-><M::Document.createTextNode> ('<'));
2139     }
2140     } (Name == 'gt') {
2141     lang:Perl {
2142     $parent-><M::Node.appendChild>
2143     ($self->{doc}-><M::Document.createTextNode> ('>'));
2144     }
2145     } (Name == 'amp') {
2146     lang:Perl {
2147     $parent-><M::Node.appendChild>
2148     ($self->{doc}-><M::Document.createTextNode> ('&'));
2149     }
2150     } (Name == 'quot') {
2151     lang:Perl {
2152     $parent-><M::Node.appendChild>
2153     ($self->{doc}-><M::Document.createTextNode> ('"'));
2154     }
2155     } (Name == 'apos') {
2156     lang:Perl {
2157     $parent-><M::Node.appendChild>
2158     ($self->{doc}-><M::Document.createTextNode> ("'"));
2159     }
2160     } (Name) {
2161     my $er;
2162 wakaba 1.19 lang:Perl ($name => $token.value) : has-error {
2163 wakaba 1.11 ## TODO: Namespace well-formedness
2164     $er = $doc-><M::Document.createEntityReference>
2165     ($name);
2166 wakaba 1.20 $er-><AS::Node.textContent> ('');
2167     ## NOTE: When document entity (and entities referenced directly
2168     ## or indirectly from it) is parsed, no general entity
2169     ## node have its replacement tree. During general
2170     ## entity node collection construction, however,
2171     ## some entity node has replacement tree.
2172 wakaba 1.11 $parent-><M::Node.appendChild> ($er);
2173 wakaba 1.19
2174     my $ent = $self->{general_entity}->{$name};
2175     if (not $ent) { # no entity declaration
2176     if ($self->{standalone} or not $self->{has_xref}) { # WFC error
2177     my $location;
2178     __CODE{xp|get-location-from-token::
2179     $token => {$token},
2180     $result => {$location},
2181     }__;
2182     my $continue = __DOMCore:ERROR{xp|wf-entity-declared::
2183     xp|error-token => {$token},
2184     c|location => {$location},
2185     xp|name => {$name},
2186     }__;
2187     unless ($continue) {
2188     __EXCEPTION{DOMLS|PARSE_ERR}__;
2189     }
2190     } # Otherwise VC error
2191 wakaba 1.23 push @{$self->{entity}}, <Code::getEmptyEntityState::
2192     $name = $name>;
2193 wakaba 1.20 $er-><AS::x|EntityReference.isExpanded> (false);
2194 wakaba 1.19
2195     } else { # there IS entity declaration
2196     if (($self->{standalone} or not $self->{has_xref}) and
2197     $ent->{is_externally_declared} and
2198     not $self->{entity}->[-1]->{is_externally_declared}) {
2199     my $location;
2200     __CODE{xp|get-location-from-token::
2201     $token => {$token},
2202     $result => {$location},
2203     }__;
2204     my $continue = __DOMCore:ERROR{xp|wf-entity-declared::
2205     xp|error-token => {$token},
2206     c|location => {$location},
2207     xp|name => {$name},
2208     }__;
2209     unless ($continue) {
2210     __EXCEPTION{DOMLS|PARSE_ERR}__;
2211     }
2212     }
2213     $er-><AS::x|EntityReference.isExpanded>
2214     ($ent->{has_replacement_text});
2215     push @{$self->{entity}}, <Code::getCopyOfEntityState::
2216 wakaba 1.11 $entity_type = 'general_entity',
2217     $entity_name = $name>;
2218 wakaba 1.23
2219     if (defined $ent->{notation}) {
2220     my $location;
2221     __CODE{xp|get-location-from-token::
2222     $token => {$token},
2223     $result => {$location},
2224     }__;
2225     my $continue = __c|ERROR{xp|wf-parsed-entity::
2226     xp|error-token => {$token},
2227     c|location => {$location},
2228     xp|name => {$name},
2229     }__;
2230     unless ($continue) {
2231     __EXCEPTION{DOMLS|PARSE_ERR::
2232     }__;
2233     }
2234     } # if unparsed entity
2235    
2236     if ($ent->{is_opened}) {
2237     my $location;
2238     __CODE{xp|get-location-from-token::
2239     $token => {$token},
2240     $result => {$location},
2241     }__;
2242     my $continue = __c|ERROR{xp|wf-no-recursion::
2243     xp|error-token => {$token},
2244     c|location => {$location},
2245     xp|name => {$name},
2246     }__;
2247     unless ($continue) {
2248     __EXCEPTION{DOMLS|PARSE_ERR::
2249     }__;
2250     }
2251     $self->{entity}->[-1]->{reptxt} = \'';
2252     $er-><AS::x|EntityReference.isExpanded> (false);
2253     } # recursive
2254     $ent->{is_opened} = true;
2255     } # entity declared
2256 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
2257 wakaba 1.11 push @{$self->{entity_token}}, $self->{token};
2258     $self->{token} = [];
2259     push @{$self->{entity_char}}, $self->{char};
2260     $self->{char} = [];
2261     }
2262    
2263     ?lexmode ElementContent;
2264     &content ($doc => $doc, $parent => $er, $ns => $ns);
2265     ~ (#EOF) { }
2266     lang:Perl {
2267 wakaba 1.23 $self->{general_entity}->{$self->{entity}->[-1]->{name}}
2268     ->{is_opened} = false
2269     if $self->{general_entity}->{$self->{entity}->[-1]->{name}};
2270 wakaba 1.11 $self->{token} = pop @{$self->{entity_token}};
2271     $self->{char} = pop @{$self->{entity_char}};
2272     pop @{$self->{entity}};
2273 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
2274 wakaba 1.11 }
2275    
2276     // TODO: Set read-only flag
2277    
2278     ?lexmode EntityReference;
2279     ?requires-next-token;
2280     }
2281    
2282     ~ (REFC) {
2283     ?lexmode ElementContent;
2284     } else {
2285     ?lexmode ElementContent;
2286     }
2287     } // _GeneralEntityReferenceEC
2288    
2289     /*
2290     General entity reference in an attribute value literal
2291     */
2292     rule _GeneralEntityReferenceV_ ($vals) {
2293     ?lexmode EntityReference;
2294    
2295     ~ (Name == 'lt') {
2296     lang:Perl {
2297     push @{$vals->{nodes}}, $self->{doc}-><M::Document.createTextNode>
2298     ('<');
2299     $vals->{value} .= '<';
2300     }
2301     } (Name == 'gt') {
2302     lang:Perl {
2303     push @{$vals->{nodes}}, $self->{doc}-><M::Document.createTextNode>
2304     ('>');
2305     $vals->{value} .= '>';
2306     }
2307     } (Name == 'amp') {
2308     lang:Perl {
2309     push @{$vals->{nodes}}, $self->{doc}-><M::Document.createTextNode>
2310     ('&');
2311     $vals->{value} .= '&';
2312     }
2313     } (Name == 'quot') {
2314     lang:Perl {
2315     push @{$vals->{nodes}}, $self->{doc}-><M::Document.createTextNode>
2316     ('"');
2317     $vals->{value} .= '"';
2318     }
2319     } (Name == 'apos') {
2320     lang:Perl {
2321     push @{$vals->{nodes}}, $self->{doc}-><M::Document.createTextNode>
2322     ("'");
2323     $vals->{value} .= "'";
2324     }
2325     } (Name) {
2326     my $er;
2327 wakaba 1.18 lang:Perl ($name => $token.value) : has-error {
2328 wakaba 1.11 ## TODO: Namespace well-formedness
2329 wakaba 1.18
2330 wakaba 1.11 $er = $self->{doc}-><M::Document.createEntityReference> ($name);
2331 wakaba 1.20 $er-><AS::Node.textContent> ('');
2332     ## NOTE: When document entity (and entities referenced directly
2333     ## or indirectly from it) is parsed, no general entity
2334     ## node have its replacement tree. During general
2335     ## entity node collection construction, however,
2336     ## some entity node has replacement tree.
2337 wakaba 1.19 my $ent = $self->{general_entity}->{$name};
2338 wakaba 1.20 if (not $ent) { # no entity declaration
2339     if ($self->{standalone} or not $self->{has_xref}) { # WFC error
2340     my $location;
2341     __CODE{xp|get-location-from-token::
2342     $token => {$token},
2343     $result => {$location},
2344     }__;
2345     my $continue = __DOMCore:ERROR{xp|wf-entity-declared::
2346     xp|error-token => {$token},
2347     c|location => {$location},
2348     xp|name => {$name},
2349     }__;
2350     unless ($continue) {
2351     __EXCEPTION{DOMLS|PARSE_ERR}__;
2352     }
2353     } # Otherwise VC error
2354 wakaba 1.23 push @{$self->{entity}}, <Code::getEmptyEntityState::
2355     $name = $name>;
2356 wakaba 1.20 $er-><AS::x|EntityReference.isExpanded> (false);
2357    
2358     } else { # there IS entity declaration
2359     if (($self->{standalone} or not $self->{has_xref}) and
2360     $ent->{is_externally_declared} and
2361     not $self->{entity}->[-1]->{is_externally_declared}) {
2362     my $location;
2363     __CODE{xp|get-location-from-token::
2364     $token => {$token},
2365     $result => {$location},
2366     }__;
2367     my $continue = __DOMCore:ERROR{xp|wf-entity-declared::
2368     xp|error-token => {$token},
2369     c|location => {$location},
2370     xp|name => {$name},
2371     }__;
2372     unless ($continue) {
2373     __EXCEPTION{DOMLS|PARSE_ERR}__;
2374     }
2375     }
2376    
2377     if ($ent->{is_external_entity}) {
2378     my $location;
2379     __CODE{xp|get-location-from-token::
2380     $token => {$token},
2381     $result => {$location},
2382     }__;
2383     my $continue = __c|ERROR{xp|wf-no-external-entity-references::
2384     xp|error-token => {$token},
2385     c|location => {$location},
2386     xp|name => {$name},
2387     }__;
2388     unless ($continue) {
2389     __EXCEPTION{DOMLS|PARSE_ERR::
2390     }__;
2391     }
2392 wakaba 1.23 ## NOTE: |xp:wf-parsed-entity| is not checked
2393 wakaba 1.20 } # if external entity
2394    
2395     $er-><AS::x|EntityReference.isExpanded>
2396 wakaba 1.19 ($ent->{has_replacement_text});
2397 wakaba 1.20 push @{$self->{entity}}, <Code::getCopyOfEntityState::
2398 wakaba 1.11 $entity_type = 'general_entity',
2399     $entity_name = $name>;
2400 wakaba 1.23
2401     if ($ent->{is_opened}) {
2402     my $location;
2403     __CODE{xp|get-location-from-token::
2404     $token => {$token},
2405     $result => {$location},
2406     }__;
2407     my $continue = __c|ERROR{xp|wf-no-recursion::
2408     xp|error-token => {$token},
2409     c|location => {$location},
2410     xp|name => {$name},
2411     }__;
2412     unless ($continue) {
2413     __EXCEPTION{DOMLS|PARSE_ERR::
2414     }__;
2415     }
2416     $self->{entity}->[-1]->{reptxt} = \'';
2417     $er-><AS::x|EntityReference.isExpanded> (false);
2418     } # recursive
2419     $ent->{is_opened} = true;
2420 wakaba 1.20 }
2421     push @{$vals->{nodes}}, $er;
2422 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
2423 wakaba 1.11 push @{$self->{entity_token}}, $self->{token};
2424     $self->{token} = [];
2425     push @{$self->{entity_char}}, $self->{char};
2426     $self->{char} = [];
2427     }
2428    
2429     ?lexmode AttributeValueLiteralE;
2430     &AttributeValueLiteralE_ ($parent => $er, $vals => $vals);
2431     ~ (#EOF) { }
2432     lang:Perl {
2433 wakaba 1.23 $self->{general_entity}->{$self->{entity}->[-1]->{name}}
2434     ->{is_opened} = false
2435     if $self->{general_entity}->{$self->{entity}->[-1]->{name}};
2436 wakaba 1.11 $self->{token} = pop @{$self->{entity_token}};
2437     $self->{char} = pop @{$self->{entity_char}};
2438     pop @{$self->{entity}};
2439 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
2440 wakaba 1.11 }
2441    
2442     // TODO: Set read-only flag
2443    
2444     ?lexmode EntityReference;
2445     ?requires-next-token;
2446     }
2447    
2448     // ~ (REFC) { }
2449     } // _GeneralEntityReferenceV_
2450 wakaba 1.1
2451 wakaba 1.6 /*
2452 wakaba 1.11 General entity reference in the replacement text
2453     of the entity referenced in an attribute value literal
2454 wakaba 1.6 */
2455 wakaba 1.11 rule _GeneralEntityReferenceAE_ ($parent, $vals)
2456 wakaba 1.6 {
2457 wakaba 1.11 ?lexmode EntityReference;
2458 wakaba 1.1
2459 wakaba 1.11 ~ (Name == 'lt') {
2460     lang:Perl {
2461     $parent-><M::Node.appendChild>
2462     ($self->{doc}-><M::Document.createTextNode> ('<'));
2463     $vals->{value} .= '<';
2464     }
2465     } (Name == 'gt') {
2466     lang:Perl {
2467     $parent-><M::Node.appendChild>
2468     ($self->{doc}-><M::Document.createTextNode> ('>'));
2469     $vals->{value} .= '>';
2470     }
2471     } (Name == 'amp') {
2472     lang:Perl {
2473     $parent-><M::Node.appendChild>
2474     ($self->{doc}-><M::Document.createTextNode> ('&'));
2475     $vals->{value} .= '&';
2476     }
2477     } (Name == 'quot') {
2478     lang:Perl {
2479     $parent-><M::Node.appendChild>
2480     ($self->{doc}-><M::Document.createTextNode> ('"'));
2481     $vals->{value} .= '"';
2482     }
2483     } (Name == 'apos') {
2484     lang:Perl {
2485     $parent-><M::Node.appendChild>
2486     ($self->{doc}-><M::Document.createTextNode> ("'"));
2487     $vals->{value} .= "'";
2488     }
2489     } (Name) {
2490 wakaba 1.6 my $er;
2491 wakaba 1.1 lang:Perl ($name => $token.value) {
2492     ## TODO: Namespace well-formedness
2493 wakaba 1.18
2494 wakaba 1.11 $er = $self->{doc}-><M::Document.createEntityReference> ($name);
2495 wakaba 1.20 $er-><AS::Node.textContent> ('');
2496     ## NOTE: When document entity (and entities referenced directly
2497     ## or indirectly from it) is parsed, no general entity
2498     ## node have its replacement tree. During general
2499     ## entity node collection construction, however,
2500     ## some entity node has replacement tree.
2501 wakaba 1.19 my $ent = $self->{general_entity}->{$name};
2502 wakaba 1.22 if (not $ent) { # no entity declaration
2503     if ($self->{standalone} or not $self->{has_xref}) { # WFC error
2504     my $location;
2505     __CODE{xp|get-location-from-token::
2506     $token => {$token},
2507     $result => {$location},
2508     }__;
2509     my $continue = __DOMCore:ERROR{xp|wf-entity-declared::
2510     xp|error-token => {$token},
2511     c|location => {$location},
2512     xp|name => {$name},
2513     }__;
2514     unless ($continue) {
2515     __EXCEPTION{DOMLS|PARSE_ERR}__;
2516     }
2517     } # Otherwise VC error
2518 wakaba 1.23 push @{$self->{entity}}, <Code::getEmptyEntityState::
2519     $name = $name>;
2520 wakaba 1.22 $er-><AS::x|EntityReference.isExpanded> (false);
2521    
2522     } else { # there IS entity declaration
2523     if (($self->{standalone} or not $self->{has_xref}) and
2524     $ent->{is_externally_declared} and
2525     not $self->{entity}->[-1]->{is_externally_declared}) {
2526     my $location;
2527     __CODE{xp|get-location-from-token::
2528     $token => {$token},
2529     $result => {$location},
2530     }__;
2531     my $continue = __DOMCore:ERROR{xp|wf-entity-declared::
2532     xp|error-token => {$token},
2533     c|location => {$location},
2534     xp|name => {$name},
2535     }__;
2536     unless ($continue) {
2537     __EXCEPTION{DOMLS|PARSE_ERR}__;
2538     }
2539     }
2540    
2541     if ($ent->{is_external_entity}) {
2542     my $location;
2543     __CODE{xp|get-location-from-token::
2544     $token => {$token},
2545     $result => {$location},
2546     }__;
2547     my $continue = __c|ERROR{xp|wf-no-external-entity-references::
2548     xp|error-token => {$token},
2549     c|location => {$location},
2550     xp|name => {$name},
2551     }__;
2552     unless ($continue) {
2553     __EXCEPTION{DOMLS|PARSE_ERR::
2554     }__;
2555     }
2556 wakaba 1.23 ## NOTE: |xp:wf-parsed-entity| is not checked
2557 wakaba 1.22 } # if external entity
2558    
2559     $er-><AS::x|EntityReference.isExpanded>
2560 wakaba 1.19 ($ent->{has_replacement_text});
2561 wakaba 1.22 push @{$self->{entity}}, <Code::getCopyOfEntityState::
2562 wakaba 1.6 $entity_type = 'general_entity',
2563     $entity_name = $name>;
2564 wakaba 1.23
2565     if ($ent->{is_opened}) {
2566     my $location;
2567     __CODE{xp|get-location-from-token::
2568     $token => {$token},
2569     $result => {$location},
2570     }__;
2571     my $continue = __c|ERROR{xp|wf-no-recursion::
2572     xp|error-token => {$token},
2573     c|location => {$location},
2574     xp|name => {$name},
2575     }__;
2576     unless ($continue) {
2577     __EXCEPTION{DOMLS|PARSE_ERR::
2578     }__;
2579     }
2580     $self->{entity}->[-1]->{reptxt} = \'';
2581     $er-><AS::x|EntityReference.isExpanded> (false);
2582     } # recursive
2583     $ent->{is_opened} = true;
2584 wakaba 1.22 }
2585     $parent-><M::Node.appendChild> ($er);
2586 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
2587 wakaba 1.6 push @{$self->{entity_token}}, $self->{token};
2588     $self->{token} = [];
2589     push @{$self->{entity_char}}, $self->{char};
2590     $self->{char} = [];
2591     }
2592    
2593 wakaba 1.11 ?lexmode AttributeValueLiteralE;
2594     &AttributeValueLiteralE_ ($parent => $er, $vals => $vals);
2595 wakaba 1.6 ~ (#EOF) { }
2596     lang:Perl {
2597 wakaba 1.23 $self->{general_entity}->{$self->{entity}->[-1]->{name}}
2598     ->{is_opened} = false
2599     if $self->{general_entity}->{$self->{entity}->[-1]->{name}};
2600 wakaba 1.6 $self->{token} = pop @{$self->{entity_token}};
2601     $self->{char} = pop @{$self->{entity_char}};
2602     pop @{$self->{entity}};
2603 wakaba 1.14 $self->{location} = $self->{entity}->[-1];
2604 wakaba 1.6 }
2605    
2606 wakaba 1.11 // TODO: Set read-only flag
2607    
2608 wakaba 1.6 ?lexmode EntityReference;
2609     ?requires-next-token;
2610 wakaba 1.1 }
2611    
2612     // ~ (REFC) { }
2613 wakaba 1.11 } // _GeneralEntityReferenceAE_
2614 wakaba 1.6
2615     /*
2616 wakaba 1.24 General Entity Reference in Literal Entity Value in Entity Declaration
2617 wakaba 1.6 */
2618 wakaba 1.11 rule _GeneralEntityReferenceEV_ ($vals) {
2619 wakaba 1.6 ?lexmode 'EntityReference';
2620    
2621     ~ (Name) {
2622     lang:Perl ($name => $token.value) {
2623     ## TODO: Namespace well-formedness
2624     push @$vals, $name;
2625     }
2626 wakaba 1.24 /*
2627     WFCs such as Entity Declared are not checked
2628     <http://www.w3.org/TR/xml11/#bypass>
2629    
2630     Note that violation to the Parsed Entity WFC is an error
2631     rather than fatal error here.
2632     */
2633 wakaba 1.6 }
2634 wakaba 1.11
2635     // No expansion
2636 wakaba 1.6
2637     // ~ (REFC) { }
2638     } // _GeneralEntityReferenceEV_
2639 wakaba 1.1
2640     /*
2641 wakaba 1.4 Document Type Declaration
2642 wakaba 1.1 */
2643 wakaba 1.4 rule _DocumentTypeDeclaration_ ($doc) {
2644     ?lexmode MarkupDeclaration;
2645    
2646     ~ (Name == 'DOCTYPE') { }
2647    
2648     ~ (S) { }
2649    
2650     // Document type name
2651 wakaba 1.6 my $name;
2652 wakaba 1.4 ~ (Name) {
2653 wakaba 1.6 lang:Perl ($v => $token.value) {
2654     $name = $v;
2655     }
2656     }
2657 wakaba 1.17
2658     my $node;
2659     my $decl;
2660 wakaba 1.6 lang:Perl {
2661 wakaba 1.11 $self->{docx} = $self->{doc}
2662     -><M::Node.getFeature> (<Q::fe:XDoctype>, '3.0');
2663     $node = $self->{docx}-><M::DocumentXDoctype.createDocumentTypeDefinition>
2664     ($name);
2665 wakaba 1.17 $decl = $self->{dtdecl} = $node-><M::Node.getFeature>
2666     (<Q::fe:XDoctypeDeclaration>, '3.0');
2667 wakaba 1.4 }
2668    
2669     ~? (S) {
2670     ~? (Name == 'PUBLIC') {
2671     ~ (S) { }
2672    
2673 wakaba 1.17 &PubidLiteral ($decl => $decl);
2674 wakaba 1.4
2675     ~ (S) { }
2676    
2677 wakaba 1.17 &SystemLiteral ($decl => $decl);
2678 wakaba 1.4
2679     ~? (S) { }
2680 wakaba 1.19
2681     lang:Perl {
2682     $self->{has_xref} = true;
2683     }
2684 wakaba 1.4 } (Name == 'SYSTEM') {
2685     ~ (S) { }
2686    
2687 wakaba 1.17 &SystemLiteral ($decl => $decl);
2688 wakaba 1.4
2689     ~? (S) { }
2690 wakaba 1.19
2691     lang:Perl {
2692     $self->{has_xref} = true;
2693     }
2694 wakaba 1.4 }
2695     }
2696 wakaba 1.17
2697 wakaba 1.11 lang:Perl {
2698     $self->{dtdef} = $node;
2699 wakaba 1.21 $self->{doc}-><M::Node.appendChild> ($node);
2700     $self->{doc_cfg}-><M::c|DOMConfiguration.setParameter>
2701     ('schema-type' => <Q::xml-dtd:>);
2702     ## ISSUE: Should default schema language information be
2703     ## preserved by some other flag?
2704 wakaba 1.11 }
2705    
2706 wakaba 1.4 ~? (DSO) {
2707 wakaba 1.6 &InternalSubset ($doc => $doc, $doctype => $node);
2708 wakaba 1.4
2709     ~ (DSC) {
2710     ?lexmode MarkupDeclaration;
2711     } else {
2712     ?lexmode MarkupDeclaration;
2713     }
2714    
2715     ~? (S) { }
2716     }
2717    
2718     // ~ (MDC) { }
2719     } // _DocumentTypeDeclaration_
2720    
2721 wakaba 1.17 /*
2722     Public Identifier Literal
2723     */
2724     rule PubidLiteral ($decl) {
2725     my $pubid;
2726     my $pubid_token;
2727 wakaba 1.4 ~ (LIT) {
2728     ?lexmode SystemLiteral;
2729    
2730     ~? (STRING) {
2731 wakaba 1.17 lang:Perl ($v => $token.value) {
2732     $pubid = $v;
2733     $pubid_token = $token;
2734     }
2735 wakaba 1.4 }
2736    
2737     ~ (LIT) {
2738     ?lexmode MarkupDeclaration;
2739     } else {
2740     ?lexmode MarkupDeclaration;
2741     }
2742     } (LITA) {
2743     ?lexmode SystemLiteralA;
2744    
2745     ~? (STRING) {
2746 wakaba 1.17 lang:Perl ($v => $token.value) {
2747     $pubid = $v;
2748     $pubid_token = $token;
2749     }
2750 wakaba 1.4 }
2751    
2752     ~ (LITA) {
2753     ?lexmode MarkupDeclaration;
2754     } else {
2755     ?lexmode MarkupDeclaration;
2756     }
2757     }
2758 wakaba 1.17
2759     if-true ($pubid_token) {
2760     lang:Perl : has-error {
2761     if ($pubid =~ m{[^\x20\x0D\x0Aa-zA-Z0-9'()+,./:=?;!*#\@\$_%-]}s) {
2762     my $location;
2763     __CODE{xp|get-location-from-token::
2764     $token => {$pubid_token},
2765     $result => {$location},
2766     }__;
2767     ## Should this be other (new) error type?
2768     my $continue = __DOMCore:ERROR{xp|wf-syntax-error::
2769     xp|error-token => {$token},
2770     c|location => {$location},
2771     }__;
2772     unless ($continue) {
2773     __EXCEPTION{DOMLS|PARSE_ERR::
2774     }__;
2775     }
2776     }
2777    
2778     ## NOTE: U+0009 is syntactically illegal.
2779 wakaba 1.23 $pubid =~ s/[\x09\x0A\x0D\x20]+/\x20/gs;
2780 wakaba 1.17 $pubid =~ s/\A\x20//s;
2781     $pubid =~ s/\x20\z//s;
2782     ## NOTE: Bare attribute name is written.
2783     $decl->public_id ($pubid);
2784     }
2785     }
2786 wakaba 1.4 } // PubidLiteral
2787    
2788 wakaba 1.17 /*
2789     System Identifier Literal
2790     */
2791     rule SystemLiteral ($decl) {
2792 wakaba 1.4 ~ (LIT) {
2793     ?lexmode SystemLiteral;
2794 wakaba 1.17 &_SystemLiteral ($decl => $decl);
2795 wakaba 1.4 } (LITA) {
2796     ?lexmode SystemLiteralA;
2797 wakaba 1.17 &_SystemLiteral ($decl => $decl);
2798 wakaba 1.4 }
2799     } // SystemLiteral
2800    
2801 wakaba 1.17 /*
2802     System Identifier Literal Content
2803     */
2804     rule _SystemLiteral ($decl) {
2805     // LIT or LITA
2806    
2807 wakaba 1.4 ~? (STRING) {
2808 wakaba 1.17 lang:Perl ($v => $token.value) {
2809     ## NOTE: Bare attribute name is written.
2810     $decl->system_id ($v);
2811     }
2812 wakaba 1.4 }
2813    
2814     ~ (LIT) {
2815     ?lexmode MarkupDeclaration;
2816     } (LITA) {
2817     ?lexmode MarkupDeclaration;
2818     } else {
2819     ?lexmode MarkupDeclaration;
2820     }
2821     } // _SystemLiteral
2822    
2823     /*
2824     DTD Internal Subset
2825    
2826     intSubset := *(markupdecl / DeclSep) ;; [28b]
2827     */
2828 wakaba 1.6 rule InternalSubset ($doc, $doctype) {
2829 wakaba 1.4 ?lexmode DTD;
2830    
2831     ~* (MDO) {
2832     ?lexmode MarkupDeclaration;
2833    
2834     ~ (Name == 'ELEMENT') {
2835     &_ElementDeclaration ($doc => $doc);
2836     } (Name == 'ATTLIST') {
2837 wakaba 1.8 &_AttlistDeclaration ($doc => $doc, $doctype => $doctype);
2838 wakaba 1.4 } (Name == 'ENTITY') {
2839     &_EntityDeclaration ($doc => $doc);
2840     } (Name == 'NOTATION') {
2841     &_NotationDeclaration ($doc => $doc);
2842     }
2843     } (S) {
2844     //
2845     } (CDO) {
2846     &_CommentDeclarationDTD ($doc => $doc);
2847     } (PIO) {
2848 wakaba 1.6 &_ProcessingInstructionDTD ($doc => $doc, $doctype => $doctype);
2849 wakaba 1.4 } (PERO) {
2850     ?lexmode EntityReference;
2851    
2852 wakaba 1.19 lang:Perl {
2853     $self->{has_xref} = true;
2854     }
2855    
2856 wakaba 1.4 ~ (Name) {
2857    
2858     }
2859    
2860     ~ (REFC) {
2861     ?lexmode DTD;
2862     } else {
2863     ?lexmode DTD;
2864     }
2865     }
2866     } // InternalSubset
2867    
2868     rule _ElementDeclaration ($doc) {
2869     // ~ (MDO) { }
2870     // ?lexmode MarkupDeclaration
2871     // ~ (Name == 'Element') { }
2872    
2873     ~ (S) { }
2874    
2875     ~ (Name) {
2876    
2877     }
2878    
2879     ?lexmode ElementDeclaration;
2880    
2881     ~ (S) { }
2882    
2883     // contentspec
2884     ~ (MGO) {
2885     &_ContentModel ($doc => $doc);
2886     } (Name == 'EMPTY') {
2887    
2888     } (Name == 'ANY') {
2889    
2890     }
2891    
2892     ~? (S) { }
2893    
2894     ~ (MDC) {
2895     ?lexmode DTD;
2896     } else {
2897     ?lexmode DTD;
2898     }
2899     } // _ElementDeclaration
2900    
2901     rule _ContentModel ($doc) {
2902     // ~ (MGO) { }
2903    
2904     ~? (S) { }
2905    
2906     ~ (Name) {
2907     // Element content model
2908     &_ModelGroup ($doc => $doc)
2909     : unshift-current-token;
2910    
2911     ~? (OPT) {
2912    
2913     } (REP) {
2914    
2915     } (PLUS) {
2916    
2917     }
2918    
2919     } (MDO) {
2920     &_ModelGroup ($doc => $doc)
2921     : unshift-current-token;
2922    
2923     ~? (OPT) {
2924    
2925     } (REP) {
2926    
2927     } (PLUS) {
2928    
2929     }
2930    
2931     } (PCDATA) {
2932     // Mixed content declaration
2933     ~? (S) { }
2934    
2935     ~* (OR) {
2936     ~? (S) { }
2937    
2938     ~ (Name) {
2939    
2940     }
2941    
2942     ~? (S) { }
2943     }
2944    
2945     ~ (MGC) { }
2946    
2947     ~? (REP) {
2948    
2949     } else {
2950     // TODO: error if |Name|
2951     }
2952    
2953    
2954     }
2955     } // _ContentModel
2956    
2957     rule _ModelGroup ($doc)
2958     : standalone
2959     : recursive
2960     {
2961     // ~ (MGO) { }
2962     // ~? (S) { }
2963    
2964     &ContentParticle ($doc => $doc);
2965    
2966     ~? (S) { }
2967    
2968     ~? (OR) {
2969     ~? (S) { }
2970    
2971     &ContentParticle ($doc => $doc);
2972    
2973     ~? (S) { }
2974    
2975     ~* (OR) {
2976     ~? (S) { }
2977    
2978     &ContentParticle ($doc => $doc);
2979    
2980     ~? (S) { }
2981     }
2982    
2983     } (SEQ) {
2984     ~? (S) { }
2985    
2986     &ContentParticle ($doc => $doc);
2987    
2988     ~? (S) { }
2989    
2990     ~* (SEQ) {
2991     ~? (S) { }
2992    
2993     &ContentParticle ($doc => $doc);
2994    
2995     ~? (S) { }
2996     }
2997    
2998     }
2999    
3000     ~ (MGC) { }
3001     } // _ModelGroup
3002    
3003     rule ContentParticle ($doc) {
3004     ~ (Name) {
3005    
3006     } (MGO) {
3007     ~? (S) { }
3008    
3009     &_ModelGroup ($doc => $doc);
3010     }
3011    
3012     ~? (OPT) {
3013    
3014     } (REP) {
3015    
3016     } (PLUS) {
3017    
3018     }
3019     } // ContentParticle
3020    
3021 wakaba 1.8 /*
3022     Attribute list declaration
3023     */
3024     rule _AttlistDeclaration ($doc, $doctype) {
3025 wakaba 1.4 // ~ (MDO) { }
3026     // ~ (Name == 'ATTLIST') { }
3027    
3028     ?lexmode AttlistDeclaration;
3029    
3030     ~ (S) { }
3031    
3032 wakaba 1.8 my $name;
3033 wakaba 1.4 ~ (Name) {
3034 wakaba 1.8 lang:Perl ($v => $token.value) {
3035     $name = $v;
3036     }
3037     } else {
3038     lang:Perl { $name = '#ILLEGAL' }
3039     }
3040 wakaba 1.4
3041 wakaba 1.8 my $docxd;
3042     my $et;
3043     lang:Perl {
3044     $et = $doctype-><M::DTDef.getElementTypeDefinitionNode> ($name);
3045     unless ($et) {
3046 wakaba 1.11 $docxd = $doc-><M::Node.getFeature> (<Q::fe:XDoctype>, '3.0');
3047 wakaba 1.8 $et = $docxd-><M::DocumentXDoctype.createElementTypeDefinition>
3048     ($name);
3049     $doctype-><M::DTDef.setElementTypeDefinitionNode> ($et)
3050     unless $name eq '#ILLEGAL';
3051     }
3052 wakaba 1.4 }
3053    
3054     ~? (S) { }
3055    
3056     ~* (Name) {
3057 wakaba 1.8 my $at;
3058     lang:Perl ($v => $token.value) {
3059     $docxd ||= $doc-><M::Node.getFeature>
3060 wakaba 1.11 (<Q::fe:XDoctype>, '3.0');
3061 wakaba 1.8 $at = $docxd-><M::DocumentXDoctype.createAttributeDefinition> ($v);
3062 wakaba 1.9 unless (exists $et-><AG::ETDef.attributeDefinitions>->{$v}) {
3063     $et-><M::ETDef.setAttributeDefinitionNode> ($at);
3064     $self->{attr}->{$name}->{$v} = $at;
3065     }
3066 wakaba 1.8 }
3067 wakaba 1.4
3068     ~ (S) { }
3069    
3070     // AttType
3071     ~ (Name == 'NOTATION') {
3072     ~ (S) { }
3073    
3074 wakaba 1.8 my $kwd;
3075     lang:Perl {
3076     $at-><AS::ATDef.declaredType> (<C::ATDef.NOTATION_ATTR>);
3077     $kwd = $at-><AG::ATDef.allowedTokens>;
3078     }
3079    
3080 wakaba 1.4 ~ (EGO) {
3081     ~? (S) { }
3082    
3083 wakaba 1.8 ~+ (Name) {
3084     lang:Perl ($v => $token.value) {
3085     push @$kwd, $v;
3086     }
3087 wakaba 1.4
3088     ~? (S) { }
3089     } (OR) : separator {
3090     ~? (S) { }
3091     }
3092    
3093     ~ (EGC) { }
3094     }
3095 wakaba 1.8
3096 wakaba 1.4 } (Name) {
3097 wakaba 1.8 my $type;
3098     lang:Perl ($v => $token.value) : has-error {
3099     my $map = {
3100     CDATA => <C::ATDef.CDATA_ATTR>,
3101     ID => <C::ATDef.ID_ATTR>,
3102     IDREF => <C::ATDef.IDREF_ATTR>,
3103     IDREFS => <C::ATDef.IDREFS_ATTR>,
3104     ENTITY => <C::ATDef.ENTITY_ATTR>,
3105     ENTITIES => <C::ATDef.ENTITIES_ATTR>,
3106     NMTOKEN => <C::ATDef.NMTOKEN_ATTR>,
3107     NMTOKENS => <C::ATDef.NMTOKENS_ATTR>,
3108     };
3109     if ($map->{$v}) {
3110     $at-><AS::ATDef.declaredType> ($map->{$v});
3111     } else {
3112     ## TODO: Exception
3113     }
3114     }
3115 wakaba 1.4
3116     } (EGO) {
3117     ?lexmode Enumeration;
3118    
3119     ~? (S) { }
3120    
3121 wakaba 1.8 my $kwd;
3122     lang:Perl {
3123     $at-><AS::ATDef.declaredType> (<C::ATDef.ENUMERATION_ATTR>);
3124     $kwd = $at-><AG::ATDef.allowedTokens>;
3125     }
3126    
3127     ~+ (Nmtoken) {
3128     lang:Perl ($v => $token.value) {
3129     push @$kwd, $v;
3130     }
3131 wakaba 1.4
3132     ~? (S) { }
3133     } (OR) : separator {
3134     ~? (S) { }
3135     }
3136    
3137     ~ (EGC) {
3138     ?lexmode AttlistDeclaration;
3139     } else {
3140     ?lexmode AttlistDeclaration;
3141     }
3142    
3143     }
3144    
3145     ~ (S) { }
3146    
3147     // DefaultDecl
3148     ~ (RNI) {
3149     ~ (Name == 'REQUIRED') {
3150 wakaba 1.8 lang:Perl {
3151     $at-><AS::ATDef.defaultType> (<C::ATDef.REQUIRED_DEFAULT>);
3152     }
3153 wakaba 1.4 } (Name == 'IMPLIED') {
3154 wakaba 1.8 lang:Perl {
3155     $at-><AS::ATDef.defaultType> (<C::ATDef.IMPLIED_DEFAULT>);
3156     }
3157 wakaba 1.4 } (Name == 'FIXED') {
3158     ~ (S) { }
3159 wakaba 1.8
3160     lang:Perl {
3161     $at-><AS::ATDef.defaultType> (<C::ATDef.FIXED_DEFAULT>);
3162     }
3163 wakaba 1.4
3164     ~ (LIT) {
3165     my $vals;
3166     lang:Perl {
3167 wakaba 1.8 $vals = {nodes => [], value => ''};
3168 wakaba 1.4 }
3169    
3170     &_AttributeValueSpecification_ ($doc => $doc, $vals => $vals);
3171    
3172 wakaba 1.8 lang:Perl {
3173     for (@{$vals->{nodes}}) {
3174     $at-><M::Node.appendChild> ($_);
3175     }
3176     }
3177    
3178 wakaba 1.4 ~ (LIT) {
3179     ?lexmode AttlistDeclaration;
3180     } else {
3181     ?lexmode AttlistDeclaration;
3182     }
3183     } (LITA) {
3184     my $vals;
3185     lang:Perl {
3186 wakaba 1.8 $vals = {nodes => [], value => ''};
3187 wakaba 1.4 }
3188    
3189     &_AttributeValueSpecificationA_ ($doc => $doc, $vals => $vals);
3190    
3191 wakaba 1.8 lang:Perl {
3192     for (@{$vals->{nodes}}) {
3193     $at-><M::Node.appendChild> ($_);
3194     }
3195     }
3196    
3197     ~ (LITA) {
3198 wakaba 1.4 ?lexmode AttlistDeclaration;
3199     } else {
3200     ?lexmode AttlistDeclaration;
3201     }
3202     }
3203     }
3204    
3205     } (LIT) {
3206     my $vals;
3207     lang:Perl {
3208 wakaba 1.8 $at-><AS::ATDef.defaultType> (<C::ATDef.EXPLICIT_DEFAULT>);
3209     $vals = {nodes => [], value => ''};
3210 wakaba 1.4 }
3211    
3212     &_AttributeValueSpecification_ ($doc => $doc, $vals => $vals);
3213    
3214 wakaba 1.8 lang:Perl {
3215     for (@{$vals->{nodes}}) {
3216     $at-><M::Node.appendChild> ($_);
3217     }
3218     }
3219    
3220 wakaba 1.4 ~ (LIT) {
3221     ?lexmode AttlistDeclaration;
3222     } else {
3223     ?lexmode AttlistDeclaration;
3224     }
3225     } (LITA) {
3226     my $vals;
3227     lang:Perl {
3228 wakaba 1.8 $at-><AS::ATDef.defaultType> (<C::ATDef.EXPLICIT_DEFAULT>);
3229     $vals = {nodes => [], value => ''};
3230 wakaba 1.4 }
3231    
3232     &_AttributeValueSpecificationA_ ($doc => $doc, $vals => $vals);
3233    
3234 wakaba 1.8 lang:Perl {
3235     for (@{$vals->{nodes}}) {
3236     $at-><M::Node.appendChild> ($_);
3237     }
3238     }
3239    
3240 wakaba 1.4 ~ (LITA) {
3241     ?lexmode AttlistDeclaration;
3242     } else {
3243     ?lexmode AttlistDeclaration;
3244     }
3245     }
3246    
3247     } (S) : separator : terminator? {
3248     //
3249     }
3250    
3251     ~ (MDC) {
3252     ?lexmode DTD;
3253     } else {
3254     ?lexmode DTD;
3255     }
3256     } // _AttlistDeclaration
3257    
3258 wakaba 1.11 /*
3259     Entity declaration
3260     */
3261 wakaba 1.4 rule _EntityDeclaration ($doc) {
3262     // ~ (MDO) { }
3263     // ~ (Name == ENTITY) { }
3264    
3265     ~ (S) { }
3266    
3267 wakaba 1.23 my $is_param_entity;
3268 wakaba 1.6 my $decl;
3269 wakaba 1.18 lang:Perl { $decl = { name => '#ILLEGAL', reptxt => \'' }; }
3270 wakaba 1.6
3271 wakaba 1.4 ~? (PERO) {
3272     ~ (S) { }
3273 wakaba 1.6 lang:Perl {
3274 wakaba 1.23 $is_param_entity = $decl->{is_param_entity} = true;
3275 wakaba 1.6 }
3276 wakaba 1.4 }
3277    
3278 wakaba 1.19 /*
3279     TODO: Set |$decl->{is_externally_declared}| flag
3280     and |Entity.isExternallyDeclared| attribute
3281     for entity declarations in external subset or
3282     in parameter entity.
3283     */
3284    
3285 wakaba 1.4 ~ (Name) {
3286 wakaba 1.6 lang:Perl ($v => $token.value) {
3287     $decl->{name} = $v;
3288     }
3289 wakaba 1.4 }
3290    
3291 wakaba 1.18 my $node;
3292 wakaba 1.11 lang:Perl {
3293 wakaba 1.18 $node =
3294 wakaba 1.11 $decl->{node} = $self->{docx}-><M::DocumentXDoctype.createGeneralEntity>
3295     ($decl->{name});
3296     ## TODO: Parameter entity...
3297     }
3298    
3299 wakaba 1.4 ~ (S) { }
3300    
3301     ~ (LIT) {
3302 wakaba 1.6 &_EntityValue ($doc => $doc, $decl => $decl);
3303 wakaba 1.4 } (LITA) {
3304 wakaba 1.6 &_EntityValueA ($doc => $doc, $decl => $decl);
3305 wakaba 1.4 } (Name == 'PUBLIC') {
3306     ~ (S) { }
3307    
3308 wakaba 1.18 &PubidLiteral ($decl => $node);
3309 wakaba 1.4
3310     ~ (S) { }
3311    
3312 wakaba 1.18 &SystemLiteral ($decl => $node);
3313    
3314     lang:Perl {
3315     $decl->{is_external_entity} = true;
3316     }
3317 wakaba 1.4 } (Name == 'SYSTEM') {
3318     ~ (S) { }
3319    
3320 wakaba 1.18 &SystemLiteral ($decl => $node);
3321    
3322     lang:Perl {
3323     $decl->{is_external_entity} = true;
3324     }
3325 wakaba 1.4 }
3326    
3327     ~? (S) {
3328     ~? (Name == 'NDATA') {
3329 wakaba 1.23 if-true ($is_param_entity) {
3330     lang:Perl : has-error {
3331     my $location;
3332     __CODE{xp|get-location-from-token::
3333     $token => {$token},
3334     $result => {$location},
3335     }__;
3336     my $continue = __DOMCore:ERROR{xp|wf-syntax-error::
3337     xp|error-token => {$token},
3338     c|location => {$location},
3339     }__;
3340     unless ($continue) {
3341     __EXCEPTION{DOMLS|PARSE_ERR::
3342     }__;
3343     }
3344     }
3345     }
3346 wakaba 1.4
3347     ~ (S) { }
3348    
3349     ~ (Name) {
3350 wakaba 1.6 lang:Perl ($v => $token.value) {
3351     $decl->{notation} = $v;
3352 wakaba 1.11 $decl->{node}-><AG::x|Entity.notationName> ($v);
3353 wakaba 1.6 }
3354 wakaba 1.4 }
3355    
3356     ~? (S) { }
3357     }
3358     }
3359    
3360 wakaba 1.24 lang:Perl : has-error {
3361 wakaba 1.6 if ($self->{$decl->{is_param_entity} ? 'param_entity' : 'general_entity'}
3362     ->{$decl->{name}}) {
3363 wakaba 1.24 ## Predefined entity
3364     if (not $decl->{is_param_entity} and
3365     {lt => true, gt => true, amp => true,
3366     quot => true, apos => true}->{$decl->{name}}) {
3367     if ($decl->{is_external_entity}) {
3368     my $location;
3369     __CODE{xp|get-location-from-token::
3370     $token => {$token},
3371     $result => {$location},
3372     }__;
3373     my $continue = __c|ERROR{xp|error-internal-predefined-entity::
3374     xp|error-token => {$token},
3375     c|location => {$location},
3376     xp|name => {$decl->{name}},
3377     }__;
3378     unless ($continue) {
3379     __EXCEPTION{DOMLS|PARSE_ERR::
3380     }__;
3381     }
3382     } elsif (
3383     not ({gt => true, apos => true, quot => true}->{$decl->{name}} and
3384     ${$decl->{reptxt}} eq {
3385     gt => '>', apos => "'", quot => '"',
3386     }->{$decl->{name}}) and
3387     not (${$decl->{reptxt}} =~ /\A&#0*@{[{
3388     lt => '60', gt => '62', amp => '38',
3389     apos => '39', quot => '34',
3390     }->{$decl->{name}}]};\z/) and
3391     not (${$decl->{reptxt}} =~ /\A&#x0*(?:(?i)@{[{
3392     lt => '3C', gt => '3E', amp => '26',
3393     apos => '27', quot => '22',
3394     }->{$decl->{name}}]});\z/)
3395     ) {
3396     ## NOTE: See "SuikaWiki - Predefined Entities"
3397     ## "http://suika.fam.cx/gate/2005/sw/%E5%AE%9A%E7%BE%A9%E6%B8%88%E5%AE%9F%E4%BD%93".
3398     my $location;
3399     __CODE{xp|get-location-from-token::
3400     $token => {$token},
3401     $result => {$location},
3402     }__;
3403     my $continue = __c|ERROR{xp|error-malformed-predefined-entity::
3404     xp|error-token => {$token},
3405     c|location => {$location},
3406     xp|name => {$decl->{name}},
3407     xp|replacement-text => {${$decl->{reptxt}}},
3408     }__;
3409     unless ($continue) {
3410     __EXCEPTION{DOMLS|PARSE_ERR::
3411     }__;
3412     }
3413     }
3414     ## TODO:
3415     } else { ## Dupulicating declaration
3416     my $location;
3417     __CODE{xp|get-location-from-token::
3418     $token => {$token},
3419     $result => {$location},
3420     }__;
3421     my $continue = __c|ERROR{xp|warning-entity-declaration-ignored::
3422     xp|error-token => {$token},
3423     c|location => {$location},
3424     xp|name => {$decl->{name}},
3425     }__;
3426     unless ($continue) {
3427     __EXCEPTION{DOMLS|PARSE_ERR::
3428     }__;
3429     }
3430     }
3431 wakaba 1.6 } else {
3432     $self->{$decl->{is_param_entity} ? 'param_entity' : 'general_entity'}
3433     ->{$decl->{name}} = $decl;
3434 wakaba 1.11 $self->{dtdef}-><M::DTDef.setGeneralEntityNode> ($decl->{node})
3435     unless $decl->{is_param_entity};
3436 wakaba 1.6 }
3437     }
3438    
3439 wakaba 1.4 ~ (MDC) {
3440     ?lexmode DTD;
3441     } else {
3442     ?lexmode DTD;
3443     }
3444     } // _EntityDeclaration
3445    
3446     rule _NotationDeclaration ($doc) {
3447     // ~ (MDO) { }
3448     // ~ (Name == NOTATION) { }
3449    
3450     ~ (S) { }
3451    
3452     ~ (Name) {
3453    
3454     }
3455    
3456     ~ (S) { }
3457    
3458 wakaba 1.17 my $decl;
3459     lang:Perl {
3460     $decl = $self->{docx}-><M::DocumentXDoctype.createGeneralEntity>
3461     ($decl->{name});
3462     ## Temporary: to avoid error.
3463     }
3464    
3465 wakaba 1.4 ~ (Name == 'PUBLIC') {
3466     ~ (S) { }
3467    
3468 wakaba 1.17 &PubidLiteral ($decl => $decl);
3469 wakaba 1.4
3470     ~? (S) {
3471     ~? (LIT) {
3472     ?lexmode SystemLiteral;
3473 wakaba 1.17 &_SystemLiteral ($decl => $decl);
3474 wakaba 1.4
3475     ~? (S) { }
3476     } (LITA) {
3477     ?lexmode SystemLiteralA;
3478 wakaba 1.17 &_SystemLiteral ($decl => $decl);
3479 wakaba 1.4
3480     ~? (S) { }
3481     }
3482     }
3483     } (Name == 'SYSTEM') {
3484     ~ (S) { }
3485    
3486 wakaba 1.17 &SystemLiteral ($decl => $decl);
3487 wakaba 1.4
3488     ~? (S) { }
3489     }
3490    
3491     ~ (MDC) {
3492     ?lexmode DTD;
3493     } else {
3494     ?lexmode DTD;
3495     }
3496     } // _NotationDeclaration
3497    
3498 wakaba 1.11 rule _EntityValue ($decl) {
3499 wakaba 1.4 ?lexmode EntityValue;
3500    
3501     my $vals;
3502 wakaba 1.6 my $reptxt;
3503 wakaba 1.4 lang:Perl {
3504     $vals = [];
3505 wakaba 1.6 $reptxt = '';
3506 wakaba 1.4 }
3507    
3508     ~* (STRING) {
3509 wakaba 1.6 lang:Perl ($v => $token.value) {
3510     $reptxt .= $v;
3511     }
3512 wakaba 1.4 } (PERO) {
3513     ?lexmode EntityDeclaration;
3514 wakaba 1.19
3515     lang:Perl {
3516     $self->{has_xref} = true;
3517     }
3518 wakaba 1.6
3519     // TODO: Expand or wferror if internal subset
3520 wakaba 1.4
3521     ~ (Name) {
3522    
3523     }
3524    
3525     ~ (REFC) {
3526     ?lexmode EntityValue;
3527     } else {
3528     ?lexmode EntityValue;
3529     }
3530     } (HCRO) {
3531 wakaba 1.11 &_HexadecimalCharacterReferenceEV_ ($vals => $vals);
3532 wakaba 1.4
3533 wakaba 1.6 lang:Perl {
3534 wakaba 1.11 $reptxt .= $vals->[-1];
3535 wakaba 1.6 }
3536    
3537 wakaba 1.4 ~ (REFC) {
3538     ?lexmode EntityValue;
3539     } else {
3540     ?lexmode EntityValue;
3541     }
3542     } (CRO) {
3543 wakaba 1.11 &_NumericCharacterReferenceEV_ ($vals => $vals);
3544 wakaba 1.6
3545     lang:Perl {
3546 wakaba 1.11 $reptxt .= $vals->[-1];
3547 wakaba 1.6 }
3548 wakaba 1.4
3549     ~ (REFC) {
3550     ?lexmode EntityValue;
3551     } else {
3552     ?lexmode EntityValue;
3553     }
3554     } (ERO) {
3555 wakaba 1.11 &_GeneralEntityReferenceEV_ ($vals => $vals);
3556 wakaba 1.4
3557 wakaba 1.6 lang:Perl {
3558 wakaba 1.11 $reptxt .= '&' . $vals->[-1] . ';';
3559 wakaba 1.6 }
3560    
3561 wakaba 1.4 ~ (REFC) {
3562     ?lexmode EntityValue;
3563     } else {
3564     ?lexmode EntityValue;
3565     }
3566     }
3567    
3568     ~ (LIT) {
3569     ?lexmode MarkupDeclaration;
3570     } (LITA) {
3571     ?lexmode MarkupDeclaration;
3572     } else {
3573     ?lexmode MarkupDeclaration;
3574     }
3575 wakaba 1.6
3576     lang:Perl {
3577     $decl->{reptxt} = \$reptxt;
3578 wakaba 1.19 $decl->{has_replacement_text} = true;
3579 wakaba 1.6 }
3580 wakaba 1.4 } // _EntityValue
3581    
3582 wakaba 1.11 rule _EntityValueA ($decl) {
3583 wakaba 1.4 ?lexmode EntityValueA;
3584    
3585     my $vals;
3586 wakaba 1.6 my $reptxt;
3587 wakaba 1.4 lang:Perl {
3588     $vals = [];
3589 wakaba 1.6 $reptxt = '';
3590 wakaba 1.4 }
3591    
3592     ~* (STRING) {
3593 wakaba 1.6 lang:Perl ($v => $token.value) {
3594     $reptxt .= $v;
3595     }
3596 wakaba 1.4 } (PERO) {
3597     ?lexmode EntityDeclaration;
3598    
3599 wakaba 1.19 lang:Perl {
3600     $self->{has_xref} = true;
3601     }
3602    
3603 wakaba 1.6 // TODO: implement this
3604 wakaba 1.4 ~ (Name) {
3605    
3606     }
3607    
3608     ~ (REFC) {
3609     ?lexmode EntityValueA;
3610     } else {
3611     ?lexmode EntityValueA;
3612     }
3613     } (HCRO) {
3614 wakaba 1.11 &_HexadecimalCharacterReferenceEV_ ($vals => $vals);
3615 wakaba 1.4
3616 wakaba 1.6 lang:Perl {
3617 wakaba 1.11 $reptxt .= $vals->[-1];
3618 wakaba 1.6 }
3619    
3620    
3621 wakaba 1.4 ~ (REFC) {
3622     ?lexmode EntityValueA;
3623     } else {
3624     ?lexmode EntityValueA;
3625     }
3626     } (CRO) {
3627 wakaba 1.11 &_NumericCharacterReferenceEV_ ($vals => $vals);
3628 wakaba 1.4
3629 wakaba 1.6 lang:Perl {
3630 wakaba 1.11 $reptxt .= $vals->[-1];
3631 wakaba 1.6 }
3632    
3633 wakaba 1.4 ~ (REFC) {
3634     ?lexmode EntityValueA;
3635     } else {
3636     ?lexmode EntityValueA;
3637     }
3638     } (ERO) {
3639 wakaba 1.11 &_GeneralEntityReferenceEV_ ($vals => $vals);
3640 wakaba 1.4
3641 wakaba 1.6 lang:Perl {
3642 wakaba 1.11 $reptxt .= '&' . $vals->[-1] . ';';
3643 wakaba 1.6 }
3644    
3645 wakaba 1.4 ~ (REFC) {
3646     ?lexmode EntityValueA;
3647     } else {
3648     ?lexmode EntityValueA;
3649     }
3650     }
3651    
3652     ~ (LITA) {
3653     ?lexmode MarkupDeclaration;
3654     } else {
3655     ?lexmode MarkupDeclaration;
3656     }
3657 wakaba 1.6
3658     lang:Perl {
3659     $decl->{reptxt} = \$reptxt;
3660 wakaba 1.19 $decl->{has_replacement_text} = true;
3661 wakaba 1.6 }
3662 wakaba 1.4 } // _EntityValueA
3663    
3664    
3665     /*
3666     XML Name
3667     */
3668     lexmode NameChar {
3669     $NameStartChar10 := [
3670     '_' ':'
3671     // Letter
3672     // BaseChar
3673     U+0041..U+005A U+0061..U+007A U+00C0..U+00D6
3674     U+00D8..U+00F6 U+00F8..U+00FF U+0100..U+0131
3675     U+0134..U+013E U+0141..U+0148 U+014A..U+017E
3676     U+0180..U+01C3 U+01CD..U+01F0 U+01F4..U+01F5
3677     U+01FA..U+0217 U+0250..U+02A8 U+02BB..U+02C1
3678     U+0386 U+0388..U+038A U+038C U+038E..U+03A1
3679     U+03A3..U+03CE U+03D0..U+03D6 U+03DA U+03DC
3680     U+03DE U+03E0 U+03E2..U+03F3 U+0401..U+040C
3681     U+040E..U+044F U+0451..U+045C U+045E..U+0481
3682     U+0490..U+04C4 U+04C7..U+04C8 U+04CB..U+04CC
3683     U+04D0..U+04EB U+04EE..U+04F5 U+04F8..U+04F9
3684     U+0531..U+0556 U+0559 U+0561..U+0586
3685     U+05D0..U+05EA U+05F0..U+05F2 U+0621..U+063A
3686     U+0641..U+064A U+0671..U+06B7 U+06BA..U+06BE
3687     U+06C0..U+06CE U+06D0..U+06D3 U+06D5
3688     U+06E5..U+06E6 U+0905..U+0939 U+093D
3689     U+0958..U+0961 U+0985..U+098C U+098F..U+0990
3690     U+0993..U+09A8 U+09AA..U+09B0 U+09B2
3691     U+09B6..U+09B9 U+09DC..U+09DD U+09DF..U+09E1
3692     U+09F0..U+09F1 U+0A05..U+0A0A U+0A0F..U+0A10
3693     U+0A13..U+0A28 U+0A2A..U+0A30 U+0A32..U+0A33
3694     U+0A35..U+0A36 U+0A38..U+0A39 U+0A59..U+0A5C
3695     U+0A5E U+0A72..U+0A74 U+0A85..U+0A8B U+0A8D
3696     U+0A8F..U+0A91 U+0A93..U+0AA8 U+0AAA..U+0AB0
3697     U+0AB2..U+0AB3 U+0AB5..U+0AB9 U+0ABD U+0AE0
3698     U+0B05..U+0B0C U+0B0F..U+0B10 U+0B13..U+0B28
3699     U+0B2A..U+0B30 U+0B32..U+0B33 U+0B36..U+0B39
3700     U+0B3D U+0B5C..U+0B5D U+0B5F..U+0B61
3701     U+0B85..U+0B8A U+0B8E..U+0B90 U+0B92..U+0B95
3702     U+0B99..U+0B9A U+0B9C U+0B9E..U+0B9F
3703     U+0BA3..U+0BA4 U+0BA8..U+0BAA U+0BAE..U+0BB5
3704     U+0BB7..U+0BB9 U+0C05..U+0C0C U+0C0E..U+0C10
3705     U+0C12..U+0C28 U+0C2A..U+0C33 U+0C35..U+0C39
3706     U+0C60..U+0C61 U+0C85..U+0C8C U+0C8E..U+0C90
3707     U+0C92..U+0CA8 U+0CAA..U+0CB3 U+0CB5..U+0CB9
3708     U+0CDE U+0CE0..U+0CE1 U+0D05..U+0D0C
3709     U+0D0E..U+0D10 U+0D12..U+0D28 U+0D2A..U+0D39
3710     U+0D60..U+0D61 U+0E01..U+0E2E U+0E30
3711     U+0E32..U+0E33 U+0E40..U+0E45 U+0E81..U+0E82
3712     U+0E84 U+0E87..U+0E88 U+0E8A U+0E8D
3713     U+0E94..U+0E97 U+0E99..U+0E9F U+0EA1..U+0EA3
3714     U+0EA5 U+0EA7 U+0EAA..U+0EAB U+0EAD..U+0EAE
3715     U+0EB0 U+0EB2..U+0EB3 U+0EBD U+0EC0..U+0EC4
3716     U+0F40..U+0F47 U+0F49..U+0F69 U+10A0..U+10C5
3717     U+10D0..U+10F6 U+1100 U+1102..U+1103
3718     U+1105..U+1107 U+1109 U+110B..U+110C
3719     U+110E..U+1112 U+113C U+113E U+1140 U+114C
3720     U+114E U+1150 U+1154..U+1155 U+1159
3721     U+115F..U+1161 U+1163 U+1165 U+1167 U+1169
3722     U+116D..U+116E U+1172..U+1173 U+1175 U+119E
3723     U+11A8 U+11AB U+11AE..U+11AF U+11B7..U+11B8
3724     U+11BA U+11BC..U+11C2 U+11EB U+11F0 U+11F9
3725     U+1E00..U+1E9B U+1EA0..U+1EF9 U+1F00..U+1F15
3726     U+1F18..U+1F1D U+1F20..U+1F45 U+1F48..U+1F4D
3727     U+1F50..U+1F57 U+1F59 U+1F5B U+1F5D
3728     U+1F5F..U+1F7D U+1F80..U+1FB4 U+1FB6..U+1FBC
3729     U+1FBE U+1FC2..U+1FC4 U+1FC6..U+1FCC
3730     U+1FD0..U+1FD3 U+1FD6..U+1FDB U+1FE0..U+1FEC
3731     U+1FF2..U+1FF4 U+1FF6..U+1FFC U+2126
3732     U+212A..U+212B U+212E U+2180..U+2182
3733     U+3041..U+3094 U+30A1..U+30FA U+3105..U+312C
3734     U+AC00..U+D7A3
3735     // Ideographic
3736     U+4E00..U+9FA5 U+3007 U+3021..U+3029
3737     ];
3738     $NameChar10 := [
3739     '.' '-' '_' ':'
3740     // Letter
3741     // BaseChar
3742     U+0041..U+005A U+0061..U+007A U+00C0..U+00D6
3743     U+00D8..U+00F6 U+00F8..U+00FF U+0100..U+0131
3744     U+0134..U+013E U+0141..U+0148 U+014A..U+017E
3745     U+0180..U+01C3 U+01CD..U+01F0 U+01F4..U+01F5
3746     U+01FA..U+0217 U+0250..U+02A8 U+02BB..U+02C1
3747     U+0386 U+0388..U+038A U+038C U+038E..U+03A1
3748     U+03A3..U+03CE U+03D0..U+03D6 U+03DA U+03DC
3749     U+03DE U+03E0 U+03E2..U+03F3 U+0401..U+040C
3750     U+040E..U+044F U+0451..U+045C U+045E..U+0481
3751     U+0490..U+04C4 U+04C7..U+04C8 U+04CB..U+04CC
3752     U+04D0..U+04EB U+04EE..U+04F5 U+04F8..U+04F9
3753     U+0531..U+0556 U+0559 U+0561..U+0586
3754     U+05D0..U+05EA U+05F0..U+05F2 U+0621..U+063A
3755     U+0641..U+064A U+0671..U+06B7 U+06BA..U+06BE
3756     U+06C0..U+06CE U+06D0..U+06D3 U+06D5
3757     U+06E5..U+06E6 U+0905..U+0939 U+093D
3758     U+0958..U+0961 U+0985..U+098C U+098F..U+0990
3759     U+0993..U+09A8 U+09AA..U+09B0 U+09B2
3760     U+09B6..U+09B9 U+09DC..U+09DD U+09DF..U+09E1
3761     U+09F0..U+09F1 U+0A05..U+0A0A U+0A0F..U+0A10
3762     U+0A13..U+0A28 U+0A2A..U+0A30 U+0A32..U+0A33
3763     U+0A35..U+0A36 U+0A38..U+0A39 U+0A59..U+0A5C
3764     U+0A5E U+0A72..U+0A74 U+0A85..U+0A8B U+0A8D
3765     U+0A8F..U+0A91 U+0A93..U+0AA8 U+0AAA..U+0AB0
3766     U+0AB2..U+0AB3 U+0AB5..U+0AB9 U+0ABD U+0AE0
3767     U+0B05..U+0B0C U+0B0F..U+0B10 U+0B13..U+0B28
3768     U+0B2A..U+0B30 U+0B32..U+0B33 U+0B36..U+0B39
3769     U+0B3D U+0B5C..U+0B5D U+0B5F..U+0B61
3770     U+0B85..U+0B8A U+0B8E..U+0B90 U+0B92..U+0B95
3771     U+0B99..U+0B9A U+0B9C U+0B9E..U+0B9F
3772     U+0BA3..U+0BA4 U+0BA8..U+0BAA U+0BAE..U+0BB5
3773     U+0BB7..U+0BB9 U+0C05..U+0C0C U+0C0E..U+0C10
3774     U+0C12..U+0C28 U+0C2A..U+0C33 U+0C35..U+0C39
3775     U+0C60..U+0C61 U+0C85..U+0C8C U+0C8E..U+0C90
3776     U+0C92..U+0CA8 U+0CAA..U+0CB3 U+0CB5..U+0CB9
3777     U+0CDE U+0CE0..U+0CE1 U+0D05..U+0D0C
3778     U+0D0E..U+0D10 U+0D12..U+0D28 U+0D2A..U+0D39
3779     U+0D60..U+0D61 U+0E01..U+0E2E U+0E30
3780     U+0E32..U+0E33 U+0E40..U+0E45 U+0E81..U+0E82
3781     U+0E84 U+0E87..U+0E88 U+0E8A U+0E8D
3782     U+0E94..U+0E97 U+0E99..U+0E9F U+0EA1..U+0EA3
3783     U+0EA5 U+0EA7 U+0EAA..U+0EAB U+0EAD..U+0EAE
3784     U+0EB0 U+0EB2..U+0EB3 U+0EBD U+0EC0..U+0EC4
3785     U+0F40..U+0F47 U+0F49..U+0F69 U+10A0..U+10C5
3786     U+10D0..U+10F6 U+1100 U+1102..U+1103
3787     U+1105..U+1107 U+1109 U+110B..U+110C
3788     U+110E..U+1112 U+113C U+113E U+1140 U+114C
3789     U+114E U+1150 U+1154..U+1155 U+1159
3790     U+115F..U+1161 U+1163 U+1165 U+1167 U+1169
3791     U+116D..U+116E U+1172..U+1173 U+1175 U+119E
3792     U+11A8 U+11AB U+11AE..U+11AF U+11B7..U+11B8
3793     U+11BA U+11BC..U+11C2 U+11EB U+11F0 U+11F9
3794     U+1E00..U+1E9B U+1EA0..U+1EF9 U+1F00..U+1F15
3795     U+1F18..U+1F1D U+1F20..U+1F45 U+1F48..U+1F4D
3796     U+1F50..U+1F57 U+1F59 U+1F5B U+1F5D
3797     U+1F5F..U+1F7D U+1F80..U+1FB4 U+1FB6..U+1FBC
3798     U+1FBE U+1FC2..U+1FC4 U+1FC6..U+1FCC
3799     U+1FD0..U+1FD3 U+1FD6..U+1FDB U+1FE0..U+1FEC
3800     U+1FF2..U+1FF4 U+1FF6..U+1FFC U+2126
3801     U+212A..U+212B U+212E U+2180..U+2182
3802     U+3041..U+3094 U+30A1..U+30FA U+3105..U+312C
3803     U+AC00..U+D7A3
3804     // Ideographic
3805     U+4E00..U+9FA5 U+3007 U+3021..U+3029
3806     // Digit
3807     U+0030..U+0039 U+0660..U+0669 U+06F0..U+06F9
3808     U+0966..U+096F U+09E6..U+09EF U+0A66..U+0A6F
3809     U+0AE6..U+0AEF U+0B66..U+0B6F U+0BE7..U+0BEF
3810     U+0C66..U+0C6F U+0CE6..U+0CEF U+0D66..U+0D6F
3811     U+0E50..U+0E59 U+0ED0..U+0ED9 U+0F20..U+0F29
3812     // CombiningChar
3813     U+0300..U+0345 U+0360..U+0361 U+0483..U+0486
3814     U+0591..U+05A1 U+05A3..U+05B9 U+05BB..U+05BD
3815     U+05BF U+05C1..U+05C2 U+05C4 U+064B..U+0652
3816     U+0670 U+06D6..U+06DC U+06DD..U+06DF
3817     U+06E0..U+06E4 U+06E7..U+06E8 U+06EA..U+06ED
3818     U+0901..U+0903 U+093C U+093E..U+094C U+094D
3819     U+0951..U+0954 U+0962..U+0963 U+0981..U+0983
3820     U+09BC U+09BE U+09BF U+09C0..U+09C4
3821     U+09C7..U+09C8 U+09CB..U+09CD U+09D7
3822     U+09E2..U+09E3 U+0A02 U+0A3C U+0A3E U+0A3F
3823     U+0A40..U+0A42 U+0A47..U+0A48 U+0A4B..U+0A4D
3824     U+0A70..U+0A71 U+0A81..U+0A83 U+0ABC
3825     U+0ABE..U+0AC5 U+0AC7..U+0AC9 U+0ACB..U+0ACD
3826     U+0B01..U+0B03 U+0B3C U+0B3E..U+0B43
3827     U+0B47..U+0B48 U+0B4B..U+0B4D U+0B56..U+0B57
3828     U+0B82..U+0B83 U+0BBE..U+0BC2 U+0BC6..U+0BC8
3829     U+0BCA..U+0BCD U+0BD7 U+0C01..U+0C03
3830     U+0C3E..U+0C44 U+0C46..U+0C48 U+0C4A..U+0C4D
3831     U+0C55..U+0C56 U+0C82..U+0C83 U+0CBE..U+0CC4
3832     U+0CC6..U+0CC8 U+0CCA..U+0CCD U+0CD5..U+0CD6
3833     U+0D02..U+0D03 U+0D3E..U+0D43 U+0D46..U+0D48
3834     U+0D4A..U+0D4D U+0D57 U+0E31 U+0E34..U+0E3A
3835     U+0E47..U+0E4E U+0EB1 U+0EB4..U+0EB9
3836     U+0EBB..U+0EBC U+0EC8..U+0ECD U+0F18..U+0F19
3837     U+0F35 U+0F37 U+0F39 U+0F3E U+0F3F
3838     U+0F71..U+0F84 U+0F86..U+0F8B U+0F90..U+0F95
3839     U+0F97 U+0F99..U+0FAD U+0FB1..U+0FB7 U+0FB9
3840     U+20D0..U+20DC U+20E1 U+302A..U+302F U+3099
3841     U+309A
3842     // Extender
3843     U+00B7 U+02D0 U+02D1 U+0387 U+0640 U+0E46
3844     U+0EC6 U+3005 U+3031..U+3035 U+309D..U+309E
3845     U+30FC..U+30FE
3846     ];
3847 wakaba 1.1
3848     $NameStartChar11 := [
3849     ':' '_'
3850     'A' 'B' 'C' 'D' 'E' 'F' 'G' 'H' 'I' 'J' 'K' 'L' 'M'
3851     'N' 'O' 'P' 'Q' 'R' 'S' 'T' 'U' 'V' 'W' 'X' 'Y' 'Z'
3852     'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i' 'j' 'k' 'l' 'm'
3853     'n' 'o' 'p' 'q' 'r' 's' 't' 'u' 'v' 'w' 'x' 'y' 'z'
3854     U+00C0..U+00D6 U+00D8..U+00F6 U+00F8..U+02FF
3855     U+0370..U+037D U+037F..U+1FFF U+200C..U+200D
3856     U+2070..U+218F U+2C00..U+2FEF U+3001..U+D7FF
3857     U+F900..U+FDCF U+FDF0..U+FFFD U+10000..U+EFFFF
3858     ];
3859     $NameChar11 := [
3860     '-' '.' '0' '1' '2' '3' '4' '5' '6' '7' '8' '9'
3861     U+00B7 U+0300..U+036F U+203F..U+2040
3862     // NameStartChar
3863     ':' '_'
3864     'A' 'B' 'C' 'D' 'E' 'F' 'G' 'H' 'I' 'J' 'K' 'L' 'M'
3865     'N' 'O' 'P' 'Q' 'R' 'S' 'T' 'U' 'V' 'W' 'X' 'Y' 'Z'
3866     'a' 'b' 'c' 'd' 'e' 'f' 'g' 'h' 'i' 'j' 'k' 'l' 'm'
3867     'n' 'o' 'p' 'q' 'r' 's' 't' 'u' 'v' 'w' 'x' 'y' 'z'
3868     U+00C0..U+00D6 U+00D8..U+00F6 U+00F8..U+02FF
3869     U+0370..U+037D U+037F..U+1FFF U+200C..U+200D
3870     U+2070..U+218F U+2C00..U+2FEF U+3001..U+D7FF
3871     U+F900..U+FDCF U+FDF0..U+FFFD U+10000..U+EFFFF
3872     ];
3873 wakaba 1.4 } // NameChar
3874    
3875     lexmode Name
3876     : extends => 'NameChar'
3877     {
3878 wakaba 1.1 Name : value := $NameStartChar11 $NameChar11*;
3879     } // Name
3880 wakaba 1.4
3881     lexmode Nmtoken
3882     : extends => 'NameChar'
3883     {
3884     Nmtoken : value := $NameChar11*;
3885     } // Nmtoken
3886 wakaba 1.1
3887     /*
3888 wakaba 1.14 S
3889 wakaba 1.1 */
3890     lexmode S {
3891 wakaba 1.14 $s := [U+0009 U+000A U+000D U+0020];
3892     S := $s+;
3893 wakaba 1.1 } // S
3894    
3895     /*
3896     Document end scanning mode
3897     */
3898     lexmode DocumentEnd
3899     : standalone
3900     : extends => 'S'
3901     {
3902     /*
3903     Processing instruction
3904     */
3905     PIO := ['<'] ['?'];
3906    
3907     /*
3908     Comment declaration
3909     */
3910     CDO := ['<'] ['!'] ['-'] ['-'];
3911     } // DocumentEnd
3912    
3913     /*
3914     Document misc scanning mode
3915    
3916     This mode scans |Misc| constructions as well
3917     as document element's start tag.
3918     */
3919     lexmode DocumentMisc
3920     : standalone
3921     : extends => 'DocumentEnd'
3922     {
3923     /*
3924     Document element start tag
3925     */
3926     STAGO := ['<'];
3927     } // DocumentMisc
3928    
3929     /*
3930     Document prolog scanning mode
3931     */
3932     lexmode DocumentProlog
3933     : standalone
3934     : extends => 'DocumentMisc'
3935     {
3936     /*
3937     |DOCTYPE| declaration
3938     */
3939     MDO := ['<'] ['!'];
3940     } // DocumentProlog
3941 wakaba 1.16
3942 wakaba 1.1 /*
3943 wakaba 1.16 Document Start Scanning Mode
3944 wakaba 1.1 */
3945     lexmode DocumentStart
3946     : standalone
3947     : extends => 'DocumentProlog'
3948     {
3949     /*
3950     XML declaration
3951     */
3952 wakaba 1.16 XDO := ['<'] ['?'] ['x'] ['m'] ['l'];
3953 wakaba 1.1 } // DocumentStart
3954    
3955     /*
3956     Comment declaration scanning mode
3957     */
3958     lexmode CommentDeclaration
3959     : standalone
3960     {
3961     /*
3962     Comment close
3963     */
3964     COM := ['-'] ['-'];
3965    
3966     /*
3967     Comment data
3968     */
3969 wakaba 1.15 ?default-token STRING : value;
3970 wakaba 1.1 } // CommentDeclaration
3971    
3972     /*
3973     Processing instruction name and |S| scanning mode
3974     */
3975     lexmode PIName
3976     : standalone
3977     : extends => 'Name'
3978     : extends => 'S'
3979     {
3980     /*
3981     Processing instruction close
3982     */
3983     PIC := ['?'] ['>'];
3984     } // PIName
3985    
3986     /*
3987 wakaba 1.16 Processing instruction name and |S| scanning mode
3988     */
3989     lexmode PINmtoken
3990     : standalone
3991     : extends => 'Nmtoken'
3992     : extends => 'S'
3993     {
3994     /*
3995     Processing instruction close
3996     */
3997     PIC := ['?'] ['>'];
3998     } // PINmtoken
3999    
4000     /*
4001 wakaba 1.1 Processing instruction data scanning mode
4002     */
4003     lexmode PIData
4004     : standalone
4005     {
4006     /*
4007     Processing instruction close
4008     */
4009     PIC := ['?'] ['>'];
4010    
4011     /*
4012     Processing instruction target data
4013     */
4014 wakaba 1.2 ?default-token DATA : value;
4015 wakaba 1.1 } // PIData
4016    
4017     /*
4018     Content of element scanning mode
4019     */
4020     lexmode ElementContent
4021     : standalone
4022     {
4023     /*
4024     Start tag open
4025     */
4026     STAGO := ['<'];
4027    
4028     /*
4029     End tag open
4030     */
4031     ETAGO := ['<'] ['/'];
4032    
4033     /*
4034     Hexadecimal character reference open
4035     */
4036     HCRO := ['&'] ['#'] ['x'];
4037    
4038     /*
4039     Numeric character reference open
4040     */
4041     CRO := ['&'] ['#'];
4042    
4043     /*
4044     General entity reference open
4045     */
4046     ERO := ['&'];
4047    
4048     /*
4049     Comment declaration open
4050     */
4051     CDO := ['<'] ['!'] ['-'] ['-'];
4052    
4053     /*
4054     CDATA section open
4055     */
4056     CDSO := ['<'] ['!'] ['[']
4057     ['C'] ['D'] ['A'] ['T'] ['A'] ['['];
4058    
4059     /*
4060     Processing instruction open
4061     */
4062     PIO := ['<'] ['?'];
4063 wakaba 1.2
4064     /*
4065     Markup section end
4066     */
4067     MSE := [']'] [']'] ['>'];
4068    
4069     /*
4070     Character data
4071     */
4072     /*
4073     Character data and/or |MSE|
4074     */
4075     ?default-token CharData : value;
4076 wakaba 1.1 } // ElementContent
4077    
4078     /*
4079     CDATA section content scanning mode
4080     */
4081     lexmode CDATASectionContent
4082     : standalone
4083     {
4084     /*
4085     Markup section end
4086     */
4087     MSE := [']'] [']'] ['>'];
4088    
4089     /*
4090     Character data
4091 wakaba 1.2 */
4092     ?default-token CData : value;
4093 wakaba 1.1 } // CDATASectionContent
4094    
4095     lexmode EntityReference
4096     : standalone
4097     : extends => 'Name'
4098     {
4099     /*
4100     Reference close
4101     */
4102     REFC := [';'];
4103     } // EntityReference
4104    
4105     lexmode NumericCharacterReference
4106     : standalone
4107     {
4108     /*
4109     Decimal number
4110     */
4111     $digit := ['0' '1' '2' '3' '4' '5' '6' '7' '8' '9'];
4112     NUMBER : value := $digit+;
4113    
4114     /*
4115     Reference close
4116     */
4117     REFC := [';'];
4118     } // NumericCharacterReference
4119    
4120     lexmode HexadecimalCharacterReference
4121     : standalone
4122     {
4123     /*
4124     Hexadecimal number
4125     */
4126     $hexdigit := ['0' '1' '2' '3' '4' '5' '6' '7' '8' '9'
4127     'A' 'B' 'C' 'D' 'E' 'F'
4128     'a' 'b' 'c' 'd' 'e' 'f'];
4129     Hex : value := $hexdigit+;
4130    
4131     /*
4132     Reference close
4133     */
4134     REFC := [';'];
4135     } // HexadecimalCharacterReference
4136    
4137 wakaba 1.16 /*
4138     The XML Declaration and Text Declaration Scanning Mode
4139     */
4140 wakaba 1.3 lexmode XMLDeclaration
4141     : standalone
4142     : extends => 'Name'
4143     : extends => 'S'
4144     {
4145    
4146     /*
4147     Value indicator
4148     */
4149     VI := ['='];
4150    
4151     /*
4152     Literal open
4153     */
4154     LIT := ['"'];
4155     LITA := [U+0027];
4156    
4157     /*
4158     Processing instruction close
4159 wakaba 1.16
4160     The |PIC|, i.e. |?>|, is split into two tokens |PIC1| and |PIC2|
4161     in this scanning mode to set |no_xml11_eol| flag in the
4162     |_XMLDeclaration_| |rule|.
4163 wakaba 1.3 */
4164 wakaba 1.16 PIC1 := ['?'];
4165     PIC2 := ['>'];
4166 wakaba 1.3 } // XMLDeclaration
4167 wakaba 1.16
4168     /*
4169     The XML Declaration or Processing Instruction Scanning Mode
4170    
4171     '<?xml' S ...
4172     (DocumentStart) (XMLDeclarationOrPI) (XMLDeclaration)
4173     '<?xml' '1' S ...
4174     (DocumentStart) (XMLDeclarationOrPI) (PINmtoken)(PIName) (PITarget)
4175     '<?xml' '-' 'stylesheet' S ...
4176     (DocumentStart) (XMLDeclarationOrPI) (PINmtoken) (PIName) (PITarget)
4177     */
4178     lexmode XMLDeclarationOrPI
4179     : standalone
4180     : extends => 'NameChar'
4181     : extends => 'S'
4182     {
4183     NameChar : value := $NameChar11;
4184     } // XMLDeclarationOrPI
4185 wakaba 1.3
4186 wakaba 1.1 lexmode StartTag
4187     : standalone
4188     : extends => 'Name'
4189     : extends => 'S'
4190     {
4191    
4192     /*
4193     Value indicator
4194     */
4195     VI := ['='];
4196    
4197     /*
4198     Literal open
4199     */
4200     LIT := ['"'];
4201     LITA := [U+0027];
4202    
4203     /*
4204     Tag close
4205     */
4206     TAGC := ['>'];
4207    
4208     /*
4209 wakaba 1.6 Null end-tag enabled start-tag close
4210 wakaba 1.1 */
4211 wakaba 1.6 NESTC := ['/'];
4212 wakaba 1.1 } // StartTag
4213    
4214     lexmode EndTag
4215     : standalone
4216     : extends => 'Name'
4217     : extends => 'S'
4218     {
4219     /*
4220     Tag close
4221     */
4222     TAGC := ['>'];
4223     } // EndTag
4224    
4225     lexmode AttributeValueLiteral_ {
4226     ERO := ['&'];
4227     CRO := ['&'] ['#'];
4228     HCRO := ['&'] ['#'] ['x'];
4229     } // AttributeValueLiteral_
4230    
4231     lexmode AttributeValueLiteral
4232     : standalone
4233     : extends => 'AttributeValueLiteral_'
4234     {
4235     LIT := ['"'];
4236 wakaba 1.3 STRING : value := [^'"' '&' '<']+;
4237 wakaba 1.1 } // AttributeValueLiteral
4238    
4239     lexmode AttributeValueLiteralA
4240     : standalone
4241     : extends => 'AttributeValueLiteral_'
4242     {
4243 wakaba 1.4 LITA := [U+0027];
4244 wakaba 1.3 STRING : value := [^U+0027 '&' '<']+;
4245 wakaba 1.1 } // AttributeValueLiteralA
4246 wakaba 1.11
4247     lexmode AttributeValueLiteralE
4248     : standalone
4249     : extends => 'AttributeValueLiteral_'
4250     {
4251     STRING : value := [^'&' '<']+;
4252     } // AttributeValueLiteralE
4253 wakaba 1.4
4254     lexmode EntityValue_ {
4255     PERO := ['%'];
4256     ERO := ['&'];
4257     CRO := ['&'] ['#'];
4258     HCRO := ['&'] ['#'] ['x'];
4259     } // EntityValue_
4260    
4261     lexmode EntityValue
4262     : standalone
4263     : extends => 'EntityValue_'
4264     {
4265     LIT := ['"'];
4266     STRING : value := [^'"' '&' '%']+;
4267     } // EntityValue
4268