Module: @QName: Markup|SuikaWiki @enFN: SuikaWiki/0.9 and SuikaWiki/0.10 Document Markup Language DOM @enDesc: {TODO:: } - SuikaWiki/0.9 Structure::: , , , (deprecated), (deprecated), (deprecated), (deprecated) - SuikaWikiImage/0.9 Structure::: (deprecated) - SuikaWiki/0.9 Block-level::: , , , , , , , , , , , , , - SuikaWiki/0.10 Block-level::: , - SuikaWiki/0.9 Table::: , , , - SuikaWiki/0.9 Hyperlink::: , , , - SuikaWiki/0.9 Phrase::: , , , , , , , , , , , , (deprecated), , , , , , - SuikaWiki/0.10 Phrase:: , , , , , , , , @Namespace: http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup/SuikaWiki/ @DISCore:author: DISCore|Wakaba @License: license|Perl+MPL @Date: $Date: 2006/12/30 08:27:50 $ @Require: @@Module: @@@QName: Markup|common @@Module: @@@QName: MDOM|TreeCore @@Module: @@@QName: Markup|Atom Namespace: @aa: http://pc5.2ch.net/test/read.cgi/hp/1096723178/aavocab# @c: http://suika.fam.cx/~wakaba/archive/2004/8/18/dom-core# @cfg: http://suika.fam.cx/www/2006/dom-config/ @dis: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang#dis-- @doc: http://suika.fam.cx/~wakaba/archive/2005/7/tutorial# @d: http://suika.fam.cx/~wakaba/archive/2004/dom/xdt# @DOMMain: http://suika.fam.cx/~wakaba/archive/2004/dom/main# @dx: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/DOMException# @ecore: http://suika.fam.cx/~wakaba/archive/2005/manakai/Util/Error/Core/ @f: http://suika.fam.cx/~wakaba/archive/2004/dom/feature# @fe: http://suika.fam.cx/www/2006/feature/ @gls: http://suika.fam.cx/~wakaba/archive/2004/dom/gls# @html: http://www.w3.org/1999/xhtml @idl: http://suika.fam.cx/~wakaba/archive/2004/dis/IDL# @kwd: http://suika.fam.cx/~wakaba/archive/2005/rfc2119/ @lang: http://suika.fam.cx/~wakaba/archive/2004/8/18/lang# @license: http://suika.fam.cx/~wakaba/archive/2004/8/18/license# @ManakaiDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom# @mat: http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup/Atom/ @Markup: http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup# @mat: http://suika.fam.cx/~wakaba/archive/2005/manakai/Markup/Atom/ @MDOM: http://suika.fam.cx/~wakaba/archive/2004/8/18/manakai-dom#ManakaiDOM. @MDOMX: http://suika.fam.cx/~wakaba/archive/2004/8/4/manakai-dom-exception# @dlp: http://suika.fam.cx/~wakaba/archive/2004/dis/Perl# @html3: urn:x-suika-fam-cx:markup:ietf:html:3:draft:00: @html5: http://www.w3.org/1999/xhtml @rel: http://www.iana.org/assignments/relation/ @s: http://suika.fam.cx/~wakaba/archive/2004/dis/Markup# @sw09: urn:x-suika-fam-cx:markup:suikawiki:0:9: @sw010: urn:x-suika-fam-cx:markup:suikawiki:0:10: @tc: http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/TreeCore/ @td: http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/Document/ @te: http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/Element/ @test: http://suika.fam.cx/~wakaba/archive/2004/dis/Test# @tx: http://suika.fam.cx/~wakaba/archive/2005/manakai/DOM/XML/ @urigen: http://suika.fam.cx/~wakaba/archive/2005/manakai/URI/Generic/ @xhtml2: http://www.w3.org/2002/06/xhtml2/ @xml: http://www.w3.org/XML/1998/namespace @xmlns: http://www.w3.org/2000/xmlns/ ElementTypeBinding: @Name: CODE @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: dlp|BlockCode @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: Method @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|Method @@ForCheck: !=ManakaiDOM|ManakaiDOM ElementTypeBinding: @Name: Param @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|MethodParameter ElementTypeBinding: @Name: Return @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|MethodReturn ElementTypeBinding: @Name: Attr @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|Attribute ElementTypeBinding: @Name: Get @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|AttributeGet ElementTypeBinding: @Name: Set @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: DISLang|AttributeSet ElementTypeBinding: @Name: nullCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM|InCase @@Value: @@@is-null:1 ElementTypeBinding: @Name: PerlDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang|Perl @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: PerlCDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang|Perl ElementTypeBinding: @Name: enImplNote @ElementType: dis:ImplNote @ShadowContent: @@lang:en ElementTypeBinding: @Name: enFN @ElementType: dis:FullName @ShadowContent: @@lang:en ElementTypeBinding: @Name: PTests @ElementType: dis:ResourceDef @ShadowContent: @@ForCheck: ManakaiDOM|ForClass @@DISCore:resourceType: test|ParserTestSet ElementTypeBinding: @Name: PTest @ElementType: dis:ResourceDef @ShadowContent: @@ForCheck: ManakaiDOM|ForClass @@DISCore:resourceType: test|ParserTest ElementTypeBinding: @Name: DEnt @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: test|RootEntity ElementTypeBinding: @Name: IFClsETDef @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: @@@@: dis|MultipleResource @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass !s|ForML @@resourceFor: ManakaiDOM|ForIF @@resourceFor: ManakaiDOM|ForClass @@resourceFor: s|ForML @@DISCore:resourceType: @@@@: DISLang|Interface @@@ForCheck: ManakaiDOM|ForIF @@DISCore:resourceType: @@@@: DISLang|Class @@@ForCheck: ManakaiDOM|ForClass @@Implement: @@@@: ||+||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass @@s:elementType: @@@@: ||+||s|ForML @@@ContentType: DISCore|TFPQNames @@@DISCore:stopISARecursive:1 @@DISCore:resourceType: @@@@: s|ElementType @@@ForCheck: s|ForML @@f:implements: AtomFeature10 ElementTypeBinding: @Name: IFClsDef @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: @@@@: dis|MultipleResource @@@ForCheck: !ManakaiDOM|ForIF !ManakaiDOM|ForClass !s|ForML @@resourceFor: ManakaiDOM|ForIF @@resourceFor: ManakaiDOM|ForClass @@DISCore:resourceType: @@@@: DISLang|Interface @@@ForCheck: ManakaiDOM|ForIF @@DISCore:resourceType: @@@@: DISLang|Class @@@ForCheck: ManakaiDOM|ForClass @@Implement: @@@@: ||+||ManakaiDOM|ForIF @@@ContentType: DISCore|TFPQNames @@@ForCheck: ManakaiDOM|ForClass @@f:implements: AtomFeature10 ElementTypeBinding: @Name: IFQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForIF ElementTypeBinding: @Name: ClsQName @ElementType: dis:QName @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: ETRQName @ElementType: dis:QName @ShadowContent: @@ForCheck: s|ForML ElementTypeBinding: @Name: ETQName @ElementType: dis:AppName @ShadowContent: @@ForCheck: s|ForML @@ContentType: DISCore|QName ElementTypeBinding: @Name: IFISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForIF ElementTypeBinding: @Name: ClsISA @ElementType: dis:ISA @ShadowContent: @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: disDef @ElementType: dis:Def @ShadowContent: @@ContentType: lang:dis @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: Code @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: dlp|InlineCode @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: Test @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: test|StandaloneTest @@ForCheck: ManakaiDOM|ForClass ElementTypeBinding: @Name: TestC @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: test|StandaloneTest ResourceDef: @QName: Document @AliasFor: td|Document ResourceDef: @QName: Element @AliasFor: te|Element ResourceDef: @QName: Attr @AliasFor: te|Attr ResourceDef: @QName: DOMString @AliasFor: DOMMain|DOMString ResourceDef: @QName: DOMURI @AliasFor: ManakaiDOM|ManakaiDOMURI ResourceDef: @QName: DOMTimeStamp @AliasFor: DOMMain|DOMTimeStamp ResourceDef: @QName: boolean @AliasFor: idl|boolean||ManakaiDOM|all ResourceDef: @QName: Node @AliasFor: tc|Node ResourceDef: @QName: NodeList @AliasFor: tc|NodeList ResourceDef: @QName: StaticNodeList @AliasFor: tc|StaticNodeList ElementTypeBinding: @Name: enDesc @ElementType: dis:Description @ShadowContent: @@lang:en ElementTypeBinding: @Name: TrueCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM:InCase @@Value: @@@@: 1 @@@ContentType: DISCore|Boolean @@Type: idl|boolean||ManakaiDOM|all ElementTypeBinding: @Name: FalseCase @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: ManakaiDOM:InCase @@Value: @@@@: 0 @@@ContentType: DISCore|Boolean @@Type: idl|boolean||ManakaiDOM|all ## -- Features ElementTypeBinding: @Name: FeatureDef @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: f|Feature @@For: =ManakaiDOM|all ElementTypeBinding: @Name: FeatureVerDef @ElementType: dis:ResourceDef @ShadowContent: @@DISCore:resourceType: f|Feature ElementTypeBinding: @Name: featureQName @ElementType: f:name @ShadowContent: @@ContentType: DISCore|QName FeatureDef: @featureQName: fe|SuikaWikiDML @QName: SWDMLFeature @FeatureVerDef: @@QName: SWDMLFeature010 @@Version: 0.10 @@f:instanceOf: SWDMLFeature @@f:requires: tx|XMLFeature30 @@enDesc: The SuikaWiki Document Markup Language DOM, version 0.10. ## -- Implementation ## TODO: ## -- Elements IFClsDef: @IFQName: SWDMLElement @ClsQName: ManakaiSWDMLElement @IFISA: Element @ClsISA: te|ManakaiDOMElement @s:elementType: AnySW09Element||ManakaiDOM|all @s:elementType: AnySW010Element||ManakaiDOM|all ##SWDMLElement ResourceDef: @QName: AnySW09Element @DISCore:resourceType: s|AnyElementInNS @AppName: @@@: sw09|* @@ContentType: DISCore|QName @ForCheck: =ManakaiDOM|all ResourceDef: @QName: AnySW010Element @DISCore:resourceType: s|AnyElementInNS @AppName: @@@: sw010|* @@ContentType: DISCore|QName @ForCheck: =ManakaiDOM|all IFClsETDef: @IFQName: SWDMLDocumentElement @ETQName: sw09|document @ClsQName: ManakaiSWDMLDocumentElement @IFISA: SWDMLElement @ClsISA: ManakaiSWDMLElement @Attr: @@Name: headElement @@enDesc: The child element of the node. @@Type: SWDMLElement @@Get: @@@enDesc: It child element> of the node. @@@nullCase: @@@@enDesc: If the algorithm returns . @@@NodeReadOnlyError: @@@PerlDef: __CODE{mat|returnChildElement:: $node => $self, $namespaceURI => {}, $localName => 'head', $r => $r, }__; @Attr: @@Name: bodyElement @@enDesc: The child element of the node. @@Type: SWDMLElement @@Get: @@@enDesc: It child element> of the node. @@@nullCase: @@@@enDesc: If the algorithm returns . @@@NodeReadOnlyError: @@@PerlDef: __CODE{mat|returnChildElement:: $node => $self, $namespaceURI => {}, $localName => 'body', $r => $r, }__; @Attr: @@Name: markupLanguageName @@enDesc: The markup language name. It attribute> of the node. It default value be . @@Type: DOMString @@Get: @@@nullCase: @@@@enDesc: If the algorithm returns . @@@PerlDef: __CODE{mat|getReflectAttrStringValue:: $node => $self, $namespaceURI => {}, $localName => 'Name', $r => $r, $defaultValue => 'SuikaWiki', }__; @@Set: @@@nullCase: @@@@enDesc: Removes the attribute. @@@NodeReadOnlyError: @@@PerlDef: __CODE{mat|setReflectAttrStringValue:: $node => $self, $namespaceURI => {}, $localName => 'Name', $given => $given, }__; @Attr: @@Name: markupLanguageVersion @@enDesc: The markup language version. It attribute> of the node. It default value be . @@Type: DOMString @@Get: @@@nullCase: @@@@enDesc: If the algorithm returns . @@@PerlDef: __CODE{mat|getReflectAttrStringValue:: $node => $self, $namespaceURI => {}, $localName => 'Version', $r => $r, $defaultValue => '0.9', }__; @@Set: @@@nullCase: @@@@enDesc: Removes the attribute. @@@NodeReadOnlyError: @@@PerlDef: __CODE{mat|setReflectAttrStringValue:: $node => $self, $namespaceURI => {}, $localName => 'Version', $given => $given, }__; ##SWDMLDocumentElement ElementTypeBinding: @Name: NodeReadOnlyError @ElementType: dx:raises @ShadowContent: @@@: MDOMX|NOMOD_THIS @@Description: @@@lang:en @@@@: If the node or a descendant of it, which is to be modified, is read-only. ## -- Parser IFClsDef: @IFQName: SWDMLParser @ClsQName: ManakaiSWDMLParser @Implement: ecore|MUErrorTarget||ManakaiDOM|Perl @DISLang:role: gls|ParserRole @f:implements: SWDMLFeature010 @f:provides: @@@: SWDMLFeature010 @@f:through: c|ManakaiDOMImplementation @enDesc: A object parses a SuikaWiki/0.9, SuikaWikiImage/0.9, or SuikaWiki/0.10 textual document and returns it as an object. @Attr: @@Name: domConfig @@enDesc: The configuration of the parser. @@Get: @@@Type: c|DOMConfiguration @@@enDesc: The DOM configuration object. @@@PerlDef: __CODE{c|getConfigObject:: $target => $self, $targetHash => $self, $targetType => {}, $result => $r, }__; @Method: @@ManakaiDOM:isForInternal:1 @@ForCheck: ManakaiDOM|ForClass @@Operator: DISPerl|NewMethod @@enDesc: Creates a new instance of the object. @@Param: @@@Name: impl @@@Type: gls|GLSImplementation @@@enDesc: The implementation from which the parser is created. @@Param: @@@Name: features @@@Type: DOMString @@@dis:actualType: f|FeaturesString @@@enDesc: The set of features requested for the parser. @@Return: @@@Type: DOMMain|DOMObject @@@enDesc: The newly created parser. @@@PerlDef: $r = bless { => $impl->get_feature ('XML' => '3.0'), }, $self; @Method: @@Name: parseString @@enDesc: Parses a string as SWDML textual document and converts it into DOM tree. @@Param: @@@Name: sourceText @@@Type: DOMString @@@enDesc: The text to parse. @@Return: @@@Type: DISPerl|HASH @@@enDesc: An object representation of . @@@PerlDef: $self->{scanner} = $self->can ('_scan_Body'); $self->{char} = [0x000A]; $self->{token} = []; $self->{source} = $sourceText; pos ($self->{source}) = 0; $self->{location} = {}; $self->{doc} = $self->{} ->create_document (, 'document'); $self->{doc}->strict_error_checking (false); $self->{docel} = $self->{doc}->document_element; $self->{docel}->set_attribute_ns (, 'xmlns', ); $self->{docel}->set_attribute_ns (, 'xmlns:h2', ); $self->{docel}->markup_language_name ('SuikaWiki'); $self->{docel}->markup_language_version ('0.10'); $self->{docel}->append_child ($self->{doc}->create_element_ns (, 'h2:head')); $self->{docel}->append_child ($self->{doc}->create_element_ns (, 'h2:body')); __DEEP{ $self->_parse_Document; }__; $r = $self->{doc}; @Method: @@Name: shiftChar @@ManakaiDOM:isForInternal:1 @@ForCheck: ManakaiDOM|ForClass @@enDesc: Returns the next character. @@Return: @@@Type: idl|long||ManakaiDOM|all @@@enDesc: The code position number of the next character, if any, or . @@@PerlDef: if (@{$self->{char}}) { $r = shift @{$self->{char}}; } else { my $char = substr ($self->{source}, pos ($self->{source}), 1); pos ($self->{source})++; if (length $char) { $r = ord $char; if ($r == 0x000D) { my $char2 = substr ($self->{source}, pos ($self->{source}), 1); if (length $char2) { if (ord $char2 == 0x000A) { pos ($self->{source})++; } push @{$self->{char}}, 0x000A; } } elsif ($r == 0x000A) { $r = 0x000D; push @{$self->{char}}, 0x000A; } } else { ## ISSUE: The last |RE| $r = -1; } } @Method: @@ManakaiDOM:isForInternal: 1 @@Operator: ManakaiDOM|MUErrorHandler @@enDesc: When a is ed, then this method is invoked. The method calls the if the error is of . Otherwise, the error is re-thrown so that corresponding clause, if any, can catch the error. @@Param: @@@Name: err @@@Type: ecore|ErrorInterface||ManakaiDOM|Perl @@@enDesc: The reported error object. @@Return: @@@Type: DISPerl|Any @@@enDesc: If the is a , then the return value of the error handler. {NOTE:: If the error is thrown, the method never returns. } @@@nullCase: @@@@enDesc: No error handler. @@@PerlDef: if ($err->isa ()) { __DEEP{ A: { my $cfg = $self->; my $h = $cfg-> ('error-handler'); $r = $h-> ($err); } # A }__; } else { $err->; } @DISPerl:dpgDef: lexmode WSP { $wsp := [U+0009 U+0020]; /* U+000D and U+000A characters in source stream are replaced to record separators by |shiftChar|. */ $rs := [U+000A]; $re := [U+000D]; $nonRSRE := [^U+000D U+000A]; } lexmode Body : extends => 'WSP' : initial : standalone { $digit := [U+0030..U+0039]; $ltagchar := [U+0041..U+005A U+0061..U+007A U+0030..U+0039 '-' '_']; $classchar := [^'(' ')' U+005C U+000D U+000A]; magicVersionS : value := $rs ['#'] ['?'] ['S'] ['u'] ['i'] ['k'] ['a'] ['W'] ['i'] ['k'] ['i'] ['/'] ['0'] ['.'] ['9'] $wsp* -> MagicParameter; magicVersionI : value := $rs ['#'] ['?'] ['S'] ['u'] ['i'] ['k'] ['a'] ['W'] ['i'] ['k'] ['i'] ['I'] ['m'] ['a'] ['g'] ['e'] ['/'] ['0'] ['.'] ['9'] $wsp* -> MagicParameter; otherRS : ignore := $rs; headingStart : value := $rs ['*']+ $wsp*; listStart : value := $rs ['-' '=']+ $wsp*; dlistStart : value := $rs [':'] [^':' U+000D U+000A]* [':'] $wsp*; quote : value := $rs ['>']+ $wsp*; eol := $re; anchorNumberDef : value := ['['] $digit+ [']']; anchorNumberRef : value := ['>'] ['>'] $digit+; externalRefStart := ['<'] -> ExternalRefBody; startTag : value := ['['] [U+0041..U+005A]+ ['[']; startTagClass : value := ['['] [U+0041..U+005A]+ ['('] $classchar* [')'] ['[']; startTagClassLang : value := ['['] [U+0041..U+005A]+ ['('] $classchar* [')'] ['@'] $ltagchar* ['[']; startTagLang : value := ['['] [U+0041..U+005A]+ ['@'] $ltagchar* ['[']; termStartTag := ['['] ['[']; midTag : value := [']'] $wsp* ['[']; midTagLang : value := [']'] $wsp* ['@'] $ltagchar* ['[']; endTag := [']'] [']']; endTagAnchorNumberRef : value := [']'] ['>'] ['>'] $digit+ [']']; endTagExternalRefStart := [']'] ['<'] -> EndTagExternalRefBody; preStartTag : value := $rs ['['] ['P'] ['R'] ['E'] ['['] $wsp* $re; preStartTagClass : value := $rs ['['] ['P'] ['R'] ['E'] ['('] $classchar* [')'] ['['] $wsp* $re; insStartTag : value := $rs ['['] ['I'] ['N'] ['S'] ['['] $wsp* $re; insStartTagClass : value := $rs ['['] ['I'] ['N'] ['S'] ['('] $classchar* [')'] ['['] $wsp* $re; delStartTag : value := $rs ['['] ['D'] ['E'] ['L'] ['['] $wsp* $re; delStartTagClass : value := $rs ['['] ['D'] ['E'] ['L'] ['('] $classchar* [')'] ['['] $wsp* $re; preEndTag : value := $rs [']'] ['P'] ['R'] ['E'] [']'] $wsp* $re; insEndTag : value := $rs [']'] ['I'] ['N'] ['S'] [']'] $wsp* $re; delEndTag : value := $rs [']'] ['D'] ['E'] ['L'] [']'] $wsp* $re; formStart : value := ['['] ['['] ['#'] [U+0061..U+007A '-']+ -> FormBody; emphasis2 := [U+0027] [U+0027]; emphasis3 := [U+0027] [U+0027] [U+0027]; entityRef : value := ['_'] ['_'] ['&'] ['&'] [^'&' U+000D U+000A]+ ['&'] ['&'] ['_'] ['_']; obsPreStart : value := $rs $wsp; noteStart : value := $rs [';'] [';'] $wsp*; edStart : value := $rs ['@'] ['@'] $wsp*; tableLine : value := $rs [','] $nonRSRE* $re; imageStart : value := $rs ['_'] ['_'] ['I'] ['M'] ['A'] ['G'] ['E'] ['_'] ['_'] $re; ?default-token text : value; } lexmode MagicParameter : extends => 'WSP' : standalone { name : value := [U+0041..U+005A U+0061..U+007A U+0030..U+0039 '-']+; vi := ['=']; lit := ['"'] -> MagicParameterValue; s : ignore := $wsp+; eol := $re -> Body; } lexmode MagicParameterValue : standalone : extends => WSP { quotedPair : value := [U+005C] $nonRSRE; ?default-token text : value; lit := ['"'] -> MagicParameter; } lexmode ExternalRefBody : standalone { lit := ['"'] -> ExternalRefQuotedStringBody; externalRefEnd := ['>'] -> Body; ?default-token text : value; } lexmode EndTagExternalRefBody : standalone { lit := ['"'] -> EndTagExternalRefQuotedStringBody; endTagExternalRefEnd := ['>'] [']'] -> Body; ?default-token text : value; } lexmode ExternalRefQuotedStringBody : standalone : extends => WSP { lit := ['"'] -> ExternalRefBody; quotedPair : value := [U+005C] $nonRSRE; ?default-token text : value; } lexmode EndTagExternalRefQuotedStringBody : standalone : extends => WSP { lit := ['"'] -> EndTagExternalRefBody; quotedPair : value := [U+005C] $nonRSRE; ?default-token text : value; } lexmode FormBody : standalone { lita := [U+0027] -> FormQuotedStringBody; formEnd := [']'] [']'] -> Body; ?default-token text : value; } lexmode FormQuotedStringBody : standalone : extends => WSP { lita := [U+0027] -> FormBody; quotedPair : value := [U+005C] $nonRSRE; ?default-token text : value; } rule Document : standalone { ~? (magicVersionS) { lang:Perl { $self->{docel} ->set_attribute_ns (, 'sw9:Name' => 'SuikaWiki'); $self->{docel}->set_attribute_ns (, 'sw9:Version' => '0.9'); } &MagicParam; } (magicVersionI) { lang:Perl { $self->{docel} ->set_attribute_ns (, 'sw9:Name' => 'SuikaWikiImage'); $self->{docel}->set_attribute_ns (, 'sw9:Version' => '0.9'); } &MagicParam; } my $parent; lang:Perl { $parent->{block} = [$self->{doc}->document_element->body_element]; $parent->{quote} = [$parent->{block}->[-1]]; $parent->{section}->[1] = $parent->{block}->[-1]; $parent->{edit} = []; } &Body ($parent => $parent); } // Document rule Body ($parent) : standalone { /* $parent block i For block-level elements. section i For i-th-level sections. Null if no (i-1)-th level section. list i For i-th-level list items. Null if no i-th-level list. text i For texts or inline-level elements Null if no container for inlines. quote i Contains i-th-level quotation's |bodytext| element. edit i Contains |parent| state restored when i-th-level editing element is closed. tr For |tr| elements. */ my $state; /* heading Next |eol| closes the heading. pre In |pre| element. section Otherwise. */ lang:Perl { $state = 'section'; } ~* (text) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } (startTag) { my $element_type; my $class_names; my $lang_tag; lang:Perl ($v => $token.value) { $v =~ /([A-Z]+)/; $element_type = $1; $class_names = ''; } &_StartTag ($element_type => $element_type, $class_names => $class_names, $lang_tag => $lang_tag, $parent => $parent); } (startTagClass) { my $element_type; my $class_names; my $lang_tag; lang:Perl ($v => $token.value) { $v =~ /([A-Z]+)\(([^()]+)/; $element_type = $1; $class_names = $2; } &_StartTag ($element_type => $element_type, $class_names => $class_names, $lang_tag => $lang_tag, $parent => $parent); } (startTagClassLang) { my $element_type; my $class_names; my $lang_tag; lang:Perl ($v => $token.value) { $v =~ /([A-Z]+)\(([^()]+)\@([^\[\]]*)/; $element_type = $1; $class_names = $2; $lang_tag = $2; } &_StartTag ($element_type => $element_type, $class_names => $class_names, $lang_tag => $lang_tag, $parent => $parent); } (startTagLang) { my $element_type; my $class_names; my $lang_tag; lang:Perl ($v => $token.value) { $v =~ /([A-Z]+)\@([^\[\]]*)/; $element_type = $1; $class_names = ''; $lang_tag = $2; } &_StartTag ($element_type => $element_type, $class_names => $class_names, $lang_tag => $lang_tag, $parent => $parent); } (termStartTag) { lang:Perl { CORE::delete $parent->{tr}; __CODE{setTextParent}__; my $a_el = $self->{doc}->create_element_ns (, 'anchor'); $parent->{text}->[-1]->append_child ($a_el); push @{$parent->{text}}, $a_el; } } (midTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if (defined $parent->{text}->[0]) { my $xuri = $parent->{text}->[-1]->manakai_expanded_uri; if ($xuri eq or $xuri eq ) { push @{$parent->{text}}, $parent->{text}->[-1]->parent_node ->append_child ($self->{doc}->create_element_ns (, 'h2:rt')); } elsif ($xuri eq ) { push @{$parent->{text}}, $parent->{text}->[-1]->parent_node ->append_child ($self->{doc}->create_element_ns (, 'nsuri')); } else { __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } else { __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } } (midTagLang) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if (defined $parent->{text}->[0]) { my $xuri = $parent->{text}->[-1]->manakai_expanded_uri; $v =~ /\@([A-Za-z0-9-]*)/; my $lang = $1; if ($xuri eq or $xuri eq ) { push @{$parent->{text}}, $parent->{text}->[-1]->parent_node ->append_child ($self->{doc}->create_element_ns (, 'h2:rt')); $parent->{text}->[-1] ->set_attribute_ns (, 'xml:lang', $lang); } elsif ($xuri eq ) { push @{$parent->{text}}, $parent->{text}->[-1]->parent_node ->append_child ($self->{doc}->create_element_ns (, 'nsuri')); $parent->{text}->[-1] ->set_attribute_ns (, 'xml:lang', $lang); } else { __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } else { __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } } (endTag) { lang:Perl { my $iref; my $xref; __CODE{endTag:: $tagString => ']]'}__; } } (endTagAnchorNumberRef) { lang:Perl ($v => $token.value) { $v =~ />>([0-9]+)/; my $iref = $1; my $xref; __CODE{endTag:: $tagString => $v}__; } } (endTagExternalRefStart) { my $xref; lang:Perl { $xref = ''; } ~* (text) { lang:Perl ($v => $token.value) { $xref .= $v; } } (quotedPair) { lang:Perl ($v => $token.value) { $xref .= $v; } } (lit) { lang:Perl { $xref .= '"'; } } ~ (endTagExternalRefEnd) { } lang:Perl { my $iref; __CODE{endTag:: $tagString => {']<'.$xref.'>]'}}__; } } (eol) { ~? (eol) { lang:Perl { CORE::delete $parent->{tr}; if ($state eq 'pre') { $parent->{text}->[-1]->manakai_append_text ("\x0A\x0A"); } elsif ($state eq 'obspre') { $#{$parent->{block}}--; $parent->{text} = []; $state = 'section'; } else { $parent->{block} = [$parent->{section}->[-1]]; $parent->{quote} = [$parent->{block}->[-1]]; $parent->{list} = []; $parent->{text} = []; $state = 'section'; } } } else { lang:Perl { CORE::delete $parent->{tr}; if ($state eq 'heading') { $parent->{text} = []; $state = 'section'; } elsif ($state eq 'pre') { $parent->{text}->[-1]->manakai_append_text ("\x0A"); } elsif (defined $parent->{text}->[0]) { $parent->{text}->[-1]->manakai_append_text ("\x0A"); } } } } (anchorNumberDef) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; my $a_el = $self->{doc}->create_element_ns (, 'anchor-end'); $a_el->set_attribute_ns (, 'sw9:anchor', 0+substr ($v, 1, length ($v) - 2)); $a_el->text_content ($v); $parent->{text}->[-1]->append_child ($a_el); } } (anchorNumberRef) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; my $a_el = $self->{doc} ->create_element_ns (, 'anchor-internal'); $a_el->set_attribute_ns (, 'sw9:anchor', 0+substr ($v, 2)); $a_el->text_content ($v); $parent->{text}->[-1]->append_child ($a_el); } } (externalRefStart) { my $xref; ~ (text) { lang:Perl ($v => $token.value) { $xref .= $v; } } (quotedPair) { lang:Perl ($v => $token.value) { $xref .= $v; } } (lit) { lang:Perl { $xref .= '"'; } } ~ (externalRefEnd) { } lang:Perl { CORE::delete $parent->{tr}; __CODE{setTextParent}__; my $a_el = $self->{doc} ->create_element_ns (, 'anchor-external'); my $data = $xref; my $scheme; if ($data =~ s/^([A-Z]+)://) { $scheme = $1; } else { $scheme = 'URI'; } $a_el->set_attribute_ns (, 'sw9:resScheme', $scheme); $a_el->set_attribute_ns (, 'sw9:resParameter', $data); $a_el->text_content ($xref); $parent->{text}->[-1]->append_child ($a_el); } } (listStart) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr $v, 1); } else { $v =~ /([-=]+)/; my $level = length ($1) - 1; my $type = substr ($1, -1) eq '-' ? 'ul' : 'ol'; if (defined $parent->{list}->[$level]) { unless ($parent->{list}->[$level]->local_name eq $type) { $parent->{list}->[$level] = $parent->{list}->[$level]->parent_node ->append_child ($self->{doc}->create_element_ns (, 'h2:'.$type)); } } elsif (defined $parent->{list}->[0]) { my $parent_list = $parent->{list}->[-1]; my $parent_lc = $parent_list->last_child; if (defined $parent_lc and $parent_lc->node_type eq ) { $parent->{list}->[$level] = $parent_lc->append_child ($self->{doc}->create_element_ns (, 'h2:'.$type)); } else { $parent->{list}->[$level] = $parent_list->append_child ($self->{doc}->create_element_ns (, 'h2:li')) ->append_child ($self->{doc}->create_element_ns (, 'h2:'.$type)); } } else { $parent->{list}->[$level] = $parent->{block}->[-1]->append_child ($self->{doc}->create_element_ns (, 'h2:'.$type)); } push @{$parent->{block}}, $parent->{list}->[$level]->append_child ($self->{doc}->create_element_ns (, 'h2:li')); $parent->{text} = [$parent->{block}->[-1]]; $state = 'section'; } } } (dlistStart) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1)); } else { $v =~ /:([^:]*)/; my $dt_src = $1; my $dr_el = $self->{doc}->create_element_ns (, 'dr'); my $dt_el = $self->{doc}->create_element_ns (, 'h2:dt'); my $dd_el = $self->{doc}->create_element_ns (, 'h2:dd'); $dr_el->append_child ($dt_el); $dr_el->append_child ($dd_el); if ($parent->{block}->[-1]->manakai_expanded_uri eq ) { $parent->{block}->[-1]->parent_node->parent_node ->append_child ($dr_el); } else { my $dl_el = $self->{doc}->create_element_ns (, 'h2:dl'); $dl_el->append_child ($dr_el); $parent->{block}->[-1]->append_child ($dl_el); } push @{$parent->{block}}, $dd_el; $parent->{text} = [$dd_el]; $parent->{list} = []; $parent->{edit} = []; $state = 'section'; my $original_pos = pos $self->{source}; { local $self->{token} = []; local $self->{char} = []; local $self->{source} = $dt_src; pos ($self->{source}) = 0; local $self->{location} = {}; local $self->{scanner} = $self->can ('_scan_Body'); $self->_parse_Body ({ block => [$dt_el], quote => [$dt_el], section => [null, $dt_el], text => [$dt_el], }); } pos ($self->{source}) = $original_pos; } } } (emphasis2) { lang:Perl { CORE::delete $parent->{tr}; if (defined $parent->{text}->[1] and $parent->{text}->[-1]->manakai_expanded_uri eq ) { $#{$parent->{text}}--; } else { __CODE{setTextParent}__; my $em_el = $self->{doc}->create_element_ns (, 'h2:em'); $parent->{text}->[-1]->append_child ($em_el); push @{$parent->{text}}, $em_el; } } } (emphasis3) { lang:Perl { CORE::delete $parent->{tr}; if (defined $parent->{text}->[1] and $parent->{text}->[-1]->manakai_expanded_uri eq ) { $#{$parent->{text}}--; } else { __CODE{setTextParent}__; my $em_el = $self->{doc}->create_element_ns (, 'h2:strong'); $parent->{text}->[-1]->append_child ($em_el); push @{$parent->{text}}, $em_el; } } } (quote) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1)); } else { $v =~ /(>+)/; my $level = length $1; if (defined $parent->{quote}->[$level]) { if (defined $parent->{quote}->[$level + 1]) { $#{$parent->{quote}} = $level; } } else { L: for my $i (1..$level) { next L if defined $parent->{quote}->[$i]; $parent->{quote}->[$i] = $parent->{quote}->[$i - 1] ->append_child ($self->{doc}->create_element_ns (, 'h2:blockquote')) ->append_child ($self->{doc}->create_element_ns (, 'h3:bodytext')); } # L } push @{$parent->{block}}, $parent->{quote}->[$level]; $parent->{text} = []; $parent->{list} = []; $state = 'section'; } } } (headingStart) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1)); } else { $v =~ /(\*+)/; my $level = length $1; if (defined $parent->{section}->[$level]) { if (defined $parent->{section}->[$level + 1]) { $#{$parent->{section}} = $level; } } else { L: for my $i (2..$level) { next L if defined $parent->{section}->[$i]; $parent->{section}->[$i] = $self->{doc}->create_element_ns (, 'h2:section'); $parent->{section}->[$i - 1] ->append_child ($parent->{section}->[$i]); } # L } $parent->{section}->[$level + 1] = $self->{doc}->create_element_ns (, 'h2:section'); $parent->{section}->[$level] ->append_child ($parent->{section}->[$level + 1]); $parent->{block} = [$parent->{section}->[$level + 1]]; $parent->{quote} = [$parent->{block}->[-1]]; $parent->{text} = [$self->{doc}->create_element_ns (, 'h2:h')]; $parent->{block}->[-1]->append_child ($parent->{text}->[-1]); $parent->{list} = []; $state = 'heading'; } } } (noteStart) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $ed_el = $self->{doc}->create_element_ns (, 'sw10:comment-p'); $parent->{block}->[-1]->append_child ($ed_el); push @{$parent->{block}}, $ed_el; $parent->{list} = []; $parent->{quote} = [$ed_el]; $parent->{text} = [$ed_el]; $state = 'section'; } } } (edStart) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $ed_el = $self->{doc}->create_element_ns (, 'sw10:ed'); $parent->{block}->[-1]->append_child ($ed_el); push @{$parent->{block}}, $ed_el; $parent->{list} = []; $parent->{quote} = [$ed_el]; $parent->{text} = [$ed_el]; $state = 'section'; } } } (preStartTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $pre_el = $self->{doc}->create_element_ns (, 'h2:pre'); $pre_el->set_attribute_ns (, 'xml:space', 'preserve'); $parent->{block}->[-1]->append_child ($pre_el); push @{$parent->{block}}, $pre_el; $parent->{text} = [$pre_el]; $state = 'pre'; } } } (preStartTagClass) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $pre_el = $self->{doc}->create_element_ns (, 'h2:pre'); $pre_el->set_attribute_ns (, 'xml:space', 'preserve'); $v =~ /\(([^()]*)/; $pre_el->set_attribute_ns (null, class => $1); $parent->{block}->[-1]->append_child ($pre_el); push @{$parent->{block}}, $pre_el; $parent->{text} = [$pre_el]; $state = 'pre'; } } } (obsPreStart) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; unless ($state eq 'pre' or $state eq 'obspre') { my $pre_el = $self->{doc}->create_element_ns (, 'h2:pre'); $pre_el->set_attribute_ns (, 'xml:space', 'preserve'); $parent->{block}->[-1]->append_child ($pre_el); push @{$parent->{block}}, $pre_el; $parent->{text} = [$pre_el]; $state = 'obspre'; } $parent->{text}->[-1]->manakai_append_text (substr ($v, 1)); } } (preEndTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $#{$parent->{block}}--; $parent->{text} = []; $parent->{list} = []; $parent->{quote} = [$parent->{block}->[-1]]; $state = 'section'; } else { __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } } } (insStartTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $ins_el = $self->{doc}->create_element_ns (, 'insert'); $parent->{block}->[-1]->append_child ($ins_el); push @{$parent->{edit}}, { section => $parent->{section}, block => $parent->{block}, text => $parent->{text}, list => $parent->{list}, quote => $parent->{quote}, type => 'insert', }; $parent->{section} = [null, $ins_el]; $parent->{block} = [$ins_el]; $parent->{text} = []; $parent->{list} = []; $parent->{quote} = [$parent->{block}->[-1]]; } } } (insStartTagClass) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $ins_el = $self->{doc}->create_element_ns (, 'insert'); $parent->{block}->[-1]->append_child ($ins_el); $v =~ /\(([^()]*)/; $ins_el->set_attribute_ns (null, class => $1); push @{$parent->{edit}}, { section => $parent->{section}, block => $parent->{block}, list => $parent->{list}, quote => $parent->{quote}, type => 'insert', }; $parent->{section} = [null, $ins_el]; $parent->{block} = [$ins_el]; $parent->{text} = []; $parent->{list} = []; $parent->{quote} = [$parent->{block}->[-1]]; } } } (insEndTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { if (defined $parent->{edit}->[0] and $parent->{edit}->[-1]->{type} eq 'insert') { my $rp = pop @{$parent->{edit}}; $parent->{$_} = $rp->{$_} for qw/section block list quote/; $parent->{text} = []; } else { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } } } } (delStartTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $ins_el = $self->{doc}->create_element_ns (, 'delete'); $parent->{block}->[-1]->append_child ($ins_el); push @{$parent->{edit}}, { section => $parent->{section}, block => $parent->{block}, list => $parent->{list}, quote => $parent->{quote}, type => 'delete', }; $parent->{section} = [null, $ins_el]; $parent->{block} = [$ins_el]; $parent->{text} = []; $parent->{list} = []; $parent->{quote} = [$parent->{block}->[-1]]; } } } (delStartTagClass) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { my $ins_el = $self->{doc}->create_element_ns (, 'delete'); $parent->{block}->[-1]->append_child ($ins_el); $v =~ /\(([^()]*)/; $ins_el->set_attribute_ns (null, class => $1); push @{$parent->{edit}}, { section => $parent->{section}, block => $parent->{block}, list => $parent->{list}, quote => $parent->{quote}, type => 'delete', }; $parent->{section} = [null, $ins_el]; $parent->{block} = [$ins_el]; $parent->{text} = []; $parent->{list} = []; $parent->{quote} = [$parent->{block}->[-1]]; } } } (delEndTag) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } else { if (defined $parent->{edit}->[0] and $parent->{edit}->[-1]->{type} eq 'delete') { my $rp = pop @{$parent->{edit}}; $parent->{$_} = $rp->{$_} for qw/section block list quote/; $parent->{text} = []; } else { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1, length ($v) - 2) . "\x0A"); } } } } (tableLine) { lang:Perl ($v => $token.value) { if ($state eq 'pre' or $state eq 'obspre') { $parent->{text}->[-1]->manakai_append_text (substr ($v, 1)); } else { my $tbody_el; if (defined $parent->{tr}) { $tbody_el = $parent->{tr}; } else { my $tbl_el = $self->{doc}->create_element_ns (, 'h2:table'); my $tbody_el = $self->{doc}->create_element_ns (, 'h2:tbody'); $tbl_el->append_child ($tbody_el); $parent->{block}->[-1]->append_child ($tbl_el); $parent->{tr} = $tbody_el; } my $tr_el = $self->{doc}->create_element_ns (, 'h2:tr'); $parent->{tr}->append_child ($tr_el); my $src = substr ($v, 1, length ($v) - 2); my $prev_cell; C: while ($src =~ /\G,\s*/gc) { $src =~ /\G([^,"][^,]*|"(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"\s*)/gc; my $cell = defined $1 ? $1 : ''; if ($cell =~ s/^"//) { $cell =~ s/"\s*$//g; $cell =~ s/\\(.)/$1/gs; } else { $cell =~ s/\s+$//g; if ($cell eq '==') { if (ref $prev_cell) { my $colspan = $prev_cell->get_attribute_ns (null, 'colspan'); $colspan = defined $colspan ? $colspan + 1 : 1; $prev_cell->set_attribute_ns (null, colspan => $colspan); next C; } } } $prev_cell = $self->{doc}->create_element_ns (, 'h2:td'); $tr_el->append_child ($prev_cell); my $original_pos = pos $self->{source}; { local $self->{token} = []; local $self->{char} = []; local $self->{source} = $cell; pos ($self->{source}) = 0; local $self->{location} = {}; local $self->{scanner} = $self->can ('_scan_Body'); $self->_parse_Body ({ block => [$prev_cell], quote => [$prev_cell], section => [null, $prev_cell], text => [$prev_cell], }); } pos ($self->{source}) = $original_pos; } $parent->{text} = []; $state = 'section'; } } } (formStart) { my $form_el; my $param; my $ref; lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; $form_el = $self->{doc}->create_element_ns (, 'form'); $v =~ /#([a-z-]+)/; $form_el->set_attribute_ns (null, ref => $ref = $1); $param = ''; } ~* (text) { lang:Perl ($v => $token.value) { $param .= $v; } } (quotedPair) { lang:Perl ($v => $token.value) { $param .= $v; } } (lita) { lang:Perl ($v => $token.value) { $param .= "'"; } } ~ (formEnd) { } lang:Perl { if ($param =~ s/^\(([^()]*)\)//) { $form_el->set_attribute_ns (null, id => $1); } if ($ref eq 'form' and $param =~ m{\A : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## input (?> : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## template (?> : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' )? )? ## option \z}x) { my ($in, $te, $op) = ($1, defined $2 ? $2 : '', defined $3 ? $3 : ''); s/\\(.)/$1/g for $in, $te, $op; $form_el->set_attribute_ns (null, input => $1); $form_el->set_attribute_ns (null, template => defined $2 ? $2 : ''); $form_el->set_attribute_ns (null, option => defined $3 ? $3 : ''); } else { $param =~ s/^://; $form_el->set_attribute_ns (null, parameter => $param); } if (defined $parent->{text}->[0]) { $parent->{text}->[-1]->append_child ($form_el); } else { $parent->{block}->[-1]->append_child ($form_el); } } } (magicVersionS) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text (substr ($v, 1)); } ?lexmode Body; } (magicVersionI) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } ?lexmode Body; } (entityRef) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; my $ref_el = $self->{doc}->create_element_ns (, 'replace'); $ref_el->set_attribute_ns (null, 'by', substr ($v, 4, length ($v) - 8)); if (defined $parent->{text}->[0]) { $parent->{text}->[-1]->append_child ($ref_el); } else { $parent->{block}->[-1]->append_child ($ref_el); } } } (imageStart) { lang:Perl { my $img_el = $self->{doc}->create_element_ns (, 'image'); my $value = ''; while (my $token = shift @{$self->{token}}) { $value .= $token->{value} if defined $token->{value}; } $value =~ tr/\x0D//d; $img_el->manakai_append_text ($value); $value = ''; while ((my $char = $self->_shift_char) >= 0) { if ($char == 0x000D) { $img_el->manakai_append_text ($value); $value = ''; } else { $value .= ord $char; } } $img_el->manakai_append_text ($value); $self->{doc}->document_element->append_child ($img_el); } } (name) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } (vi) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ('='); } } (lit) { lang:Perl ($v => $token.value) { CORE::delete $parent->{tr}; __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($v); } } } // Body rule MagicParam { ~* (name) { my $param_el; my $value; lang:Perl ($v => $token.value) { $param_el = $self->{doc}->create_element_ns (, 'parameter'); $param_el->set_attribute_ns (null, 'name', $v); $value = ''; } ~ (vi) { } ~ (lit) { } ~* (text) { lang:Perl ($v => $token.value) { $value .= $v; } } (quotedPair) { lang:Perl ($v => $token.value) { $value .= substr ($v, 1); } } ~ (lit) { } lang:Perl { for (split /,/, $value) { $param_el->append_child ($self->{doc}->create_element_ns (, 'value')) ->manakai_append_text ($_); } $self->{docel}->head_element->append_child ($param_el); } } ~ (eol) { } } // MagicParam rule _StartTag ($parent, $element_type, $class_names, $lang_tag) { lang:Perl { __CODE{setTextParent}__; my @class_names = split /\s+/, $class_names; my $et = { ABBR => [, 'abbr'], CODE => [, 'code'], DEL => [, 'del'], DFN => [, 'dfn'], INS => [, 'ins'], KBD => [, 'kbd'], Q => [, 'q'], RUBY => [, 'ruby'], RUBYB=> [, 'rubyb'], SAMP => [, 'samp'], SUB => [, 'sub'], SUP => [, 'sup'], VAR => [, 'var'], WEAK => [, 'weak'], AA => [, 'aa'], CITE => [, 'cite'], CSECTION => [, 'csection'], KEY => [, 'key'], QN => [, 'qn'], SPAN => [, 'span'], SRC => [, 'src'], }->{$element_type}; unless (defined $et) { $et = [, 'code']; push @class_names, $element_type; } my $el = $self->{doc}->create_element_ns ($et->[0], $et->[1]); $parent->{text}->[-1]->append_child ($el); $el->set_attribute_ns (null, 'class' => join ' ', @class_names) if @class_names; $el->set_attribute_ns (, 'xml:lang', $lang_tag) if defined $lang_tag; if ($element_type eq 'RUBY' or $element_type eq 'RUBYB' or $element_type eq 'RUBYB') { $el = $el->append_child ($self->{doc}->create_element_ns (, 'rb')); } elsif ($element_type eq 'QN') { $el = $el->append_child ($self->{doc}->create_element_ns (, 'qname')); } push @{$parent->{text}}, $el; } } // _StartTag token-error default : default { // } @CODE: @@QName: setTextParent @@PerlDef: unless (defined $parent->{text}->[0]) { $parent->{text} = [$parent->{block}->[-1] ->append_child ($self->{doc}->create_element_ns (, 'h2:p'))]; } @CODE: @@QName: endTag @@PerlDef: if (defined $parent->{text}->[1]) { if (defined $iref) { $parent->{text}->[-1]->set_attribute_ns (, 'sw9:anchor', 0+$iref); } if (defined $xref) { if ($xref =~ s/^([A-Z]+)://) { $parent->{text}->[-1]->set_attribute_ns (, 'sw9:resScheme', $1); $parent->{text}->[-1]->set_attribute_ns (, 'sw9:resParameter', $xref); } else { $parent->{text}->[-1]->set_attribute_ns (, 'sw9:resScheme', 'URI'); $parent->{text}->[-1]->set_attribute_ns (, 'sw9:resParameter', $xref); } } $#{$parent->{text}}--; } else { __CODE{setTextParent}__; $parent->{text}->[-1]->manakai_append_text ($tagString); } @PTests: @@PTest: @@@QName: p.empty.test @@@DEnt: @@@@test:value: \ @@@test:domTree: document { element { namespace-uri: 'urn:x-suika-fam-cx:markup:suikawiki:0:9:'; local-name: 'document'; markup-language-name: 'SuikaWiki'; markup-language-version: '0.10'; element { namespace-uri: 'http://www.w3.org/2002/06/xhtml2/'; local-name: 'head'; has-child-nodes: false; } element { namespace-uri: 'http://www.w3.org/2002/06/xhtml2/'; local-name: 'body'; has-child-nodes: false; } } } @@PTest: @@@QName: p.magic.sw09.test @@@DEnt: @@@@test:value: #?SuikaWiki/0.9 @@@test:domTree: document { element { namespace-uri: 'urn:x-suika-fam-cx:markup:suikawiki:0:9:'; local-name: 'document'; markup-language-name: 'SuikaWiki'; markup-language-version: '0.9'; element { namespace-uri: 'http://www.w3.org/2002/06/xhtml2/'; local-name: 'head'; has-child-nodes: false; } element { namespace-uri: 'http://www.w3.org/2002/06/xhtml2/'; local-name: 'body'; has-child-nodes: false; } } } @@PTest: @@@QName: p.magic.swimg09.test @@@DEnt: @@@@test:value: #?SuikaWikiImage/0.9 @@@test:domTree: document { element { namespace-uri: 'urn:x-suika-fam-cx:markup:suikawiki:0:9:'; local-name: 'document'; markup-language-name: 'SuikaWikiImage'; markup-language-version: '0.9'; element { namespace-uri: 'http://www.w3.org/2002/06/xhtml2/'; local-name: 'head'; has-child-nodes: false; } element { namespace-uri: 'http://www.w3.org/2002/06/xhtml2/'; local-name: 'body'; has-child-nodes: false; } } } @@PerlDef: my $impl = $Message::DOM::ImplementationRegistry->get_dom_implementation ({ 'Core' => '3.0', 'XML' => '3.0', }); for my $test_data (@$TestData) { my $parser = ->new ($impl); $test->start_new_test ($test_data->{uri}); my $doc_ent = $test_data->{entity}->{$test_data->{root_uri}}; my $not_ok; ## -- DOM Configuration Parameters my $pcfg = $parser->dom_config; for (keys %{$test_data->{dom_config}}) { $pcfg->set_parameter ($_ => $test_data->{dom_config}->{$_}); } # $pcfg->set_parameter ('error-handler' => sub ($$) { # my (undef, $err) = @_; # my $err_type = $err->type; # if ($test_data->{dom_error}->{$err_type}) { # $test->assert_error_equals # (actual_value => $err, # expected_hash => shift @{$test_data->{dom_error} # ->{$err_type}}); # } else { # Uncatched error # warn $err; # unless ($err->severity == ) { # $test->failure_comment ('Unexpected error |'.$err->type.'|'); # $not_ok = true; # } # } # return true; # continue as far as possible # }); ## -- Test and Result my $doc; try { $doc = $parser->parse_string ($doc_ent->{}); $test->assert_dom_tree_equals (actual_value => $doc, expected_hash => $test_data->{dom_tree}); for (values %{$test_data->{dom_error}||{}}) { if (@$_) { $test->failure_comment (@$_.' |DOMError|s of type |'. $_->[0]->{type}->{value}.'| are not reported'); $not_ok = true; } } $not_ok ? $test->not_ok : $test->ok; undef $doc; } catch Message::Util::IF::DTException with { require Message::DOM::SimpleLS; my $ls = Message::DOM::SimpleLS::ManakaiDOMSimpleXMLSerializer->new; print STDERR $ls->write_to_string ($doc); } otherwise { my $err = shift; warn $err; $test->not_ok; }; } ##SWDMLParser