/[pub]/suikawiki/script/misc/plugins/SuikaWiki09.wp2
Suika

Contents of /suikawiki/script/misc/plugins/SuikaWiki09.wp2

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.21 - (hide annotations) (download)
Mon Jul 4 12:27:23 2005 UTC (19 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.20: +128 -19 lines 
Support for new @lang rule and SPAN element type for SuikaWiki/0.10 incorporated
1 wakaba 1.1 #?SuikaWikiConfig/2.0
2    
3     Plugin:
4     @Name: SuikaWiki09
5     @Description:
6 wakaba 1.16 @@@: SuikaWiki/0.9 and SuikaWiki/0.10 document formats
7 wakaba 1.1 @@lang:en
8 wakaba 1.8 @License: %%Perl%%
9 wakaba 1.1 @Author:
10     @@Name:
11     @@@@: Wakaba
12     @@@lang:ja
13     @@@script:Latn
14     @@Mail[list]: w@suika.fam.cx
15 wakaba 1.7 @Date.RCS:
16 wakaba 1.21 $Date: 2005/04/23 11:44:04 $
17 wakaba 1.1 @RequiredPlugin[list]:
18 wakaba 1.4 Edit
19     WikiFormCore
20 wakaba 1.2 WikiLinking
21 wakaba 1.4 WikiStruct
22 wakaba 1.1 @Use:
23     use Message::Markup::XML::QName qw/NS_xml_URI/;
24     my $Reg_Form_Content_M = qr{
25     \ \#form
26     \ (?:
27     \ \( (\w+) \) ## id
28     \ )?
29     \ : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## input
30 wakaba 1.9 \ (?> : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## template
31     \ (?> : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' )? )? ## option
32 wakaba 1.1 }x;
33     my $Reg_Embed_Content_M = qr{
34     \ \#([a-z-]+)
35     \ (?>
36     \ \( (\w+) \) ## id
37     \ )?
38     \ (?>
39     \ : ( \w+ (?> : \w+ )* ) ## parameter
40     \ )?
41     }x;
42     my $Reg_URI_Opaque = qr{
43     \ (?>[^<>"]*)
44     \ (?>
45     \ (?>
46     \ [^<>"]+
47     \ | "(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"
48     \ )*
49     \ )
50     }x;
51 wakaba 1.9
52     my ($WIKIRESOURCE, $WIKISTRUCT, $WIKIFORMCORE, $WIKILINKING);
53 wakaba 1.1
54 wakaba 1.2 PluginConst:
55 wakaba 1.19 @NS_AA:
56     http://pc5.2ch.net/test/read.cgi/hp/1096723178/aavocab#
57 wakaba 1.2 @NS_SW09:
58     urn:x-suika-fam-cx:markup:suikawiki:0:9:
59 wakaba 1.16 @NS_SW010:
60     urn:x-suika-fam-cx:markup:suikawiki:0:10:
61 wakaba 1.2 @NS_HTML3:
62     urn:x-suika-fam-cx:markup:ietf:html:3:draft:00:
63     @NS_XHTML1:
64     http://www.w3.org/1999/xhtml
65     @NS_XHTML2:
66 wakaba 1.21 http://www.w3.org/2002/06/xhtml2/
67     @NS_XML:
68     http://www.w3.org/XML/1998/namespace
69 wakaba 1.9 @WIKIFORMCORE:
70     {($WIKIFORMCORE ||= SuikaWiki::Plugin->module_package ('WikiFormCore'))}
71     @WIKILINKING:
72     {($WIKILINKING ||= SuikaWiki::Plugin->module_package ('WikiLinking'))}
73 wakaba 1.5 @WIKIRESOURCE:
74     {($WIKIRESOURCE ||= SuikaWiki::Plugin->module_package ('WikiResource'))}
75 wakaba 1.9 @WIKISTRUCT:
76     {($WIKISTRUCT ||= SuikaWiki::Plugin->module_package ('WikiStruct'))}
77    
78    
79 wakaba 1.2
80 wakaba 1.1 Format:
81     @ModuleName:
82     SuikaWiki::V0
83     @Description:
84     @@@: Dummy base format for SuikaWiki/0.*
85     @@lang:en
86     @Inherit[list]:
87     Text::Plain
88    
89     Format:
90     @Name: SuikaWiki
91 wakaba 1.16 @Version: 0.10
92     @Type:
93     @@@: text/x-suikawiki
94     @@version: 0.10
95     @ModuleName:
96     SuikaWiki::V0_10
97     @Inherit[list]:
98     SuikaWiki::V0_9
99     @Description:
100     @@@: SuikaWiki/0.10 document format (SuikaWiki/0.9 with minor additions)
101     @@lang: en
102    
103     Format:
104     @Name: SuikaWiki
105 wakaba 1.1 @Version: 0.9
106     @Type:
107     @@@: text/x-suikawiki
108     @@version: 0.9
109     @ModuleName:
110     SuikaWiki::V0_9
111     @Inherit[list]:
112     SuikaWiki::V0
113     @Description:
114     @@@: SuikaWiki/0.9 document format (Standard document format for SuikaWiki 2)
115     @@lang:en
116 wakaba 1.2
117     @Use:
118     use Message::Markup::XML::QName qw/NS_xml_URI/;
119 wakaba 1.4 use Message::Util::Error;
120 wakaba 1.1
121     @Converter:
122     @@Type: text/html
123     @@IsFragment: 1
124     @@Description:
125     @@@@: Converting SuikaWiki/0.9 to Hypertext Markup Language fragment
126     @@@lang:en
127     @@Main:
128 wakaba 1.4 $opt->{o}->{wiki} ||= $self->{wiki};
129    
130 wakaba 1.2 ## Text format -> XML format
131 wakaba 1.4 my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => $opt,
132     wiki => $self->{wiki});
133    
134     ## SuikaWiki/0.9 -> XHTML 1
135 wakaba 1.6 __FUNCPACK__->sw09_to_xhtml1 (source => $xml, parent => $opt->{-parent},
136     o => $opt->{o}, page => $opt->{page});
137    
138     if ($opt->{-with_annotation_input}) {
139     SuikaWiki::Plugin->module_package ('WikiFormCore')
140     ->make_content_form_in_html
141     ($opt->{-parent},
142     $WIKIRESOURCE->get
143     (name => 'SuikaWiki/0.9:form:footannotate:input',
144     o => $opt->{o}, wiki => $opt->{o}->{wiki}),
145     option => $WIKIRESOURCE->get
146     (name => 'SuikaWiki/0.9:form:footannotate:option',
147     o => $opt->{o}, wiki => $opt->{o}->{wiki}),
148     o => $opt->{o},
149     wiki => $opt->{o}->{wiki},
150     output => {
151     page => $opt->{page},
152     });
153     }
154    
155    
156     @Converter:
157     @@Type:
158     @@@@: application/x-suikawiki+xml
159     @@@version: 0.9
160     @@Description:
161     @@@@: Converting SuikaWiki/0.9 text format to XML format
162     @@@lang: en
163     @@Main:
164     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => $opt,
165     wiki => $self->{wiki});
166     ## TODO: Make a clone
167     $opt->{-parent}->append_node ($xml);
168    
169     @NextIndex:
170     @@Name: anchor
171     @@Main:
172     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => \%opt,
173     wiki => $self->{wiki});
174     (__FUNCPACK__->get_last_anchor_index ($xml)) + 1;
175    
176     @WikiForm:
177     @@Main:
178     ## Text format -> XML format
179     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => \%opt,
180     wiki => $self->{wiki});
181     local $opt{o}->{var}->{sw09__anchor_index};
182     local $opt{o}->{var}->{sw09__document_tree} = $xml;
183    
184     my $form;
185     if ($opt{o}->{form}->{output}->{id}) {
186     $form = __FUNCPACK__->get_element_by_id
187     ($xml, $opt{o}->{form}->{output}->{id});
188     undef $form unless ref $form and
189     $form->namespace_uri eq $NS_SW09 and
190     $form->local_name eq 'form';
191     } else {
192     $form = __FUNCPACK__->get_nth_element
193     ($xml, $NS_SW09 => 'form',
194     $opt{o}->{form}->{output}->{index});
195     }
196    
197     my $ref;
198     if (ref $form) {
199     $ref = $form->get_attribute_value ('ref', default => 'form');
200     } else {
201     $ref = '#footannotate';
202     }
203    
204    
205     ## WikiForm Option
206     if ($ref eq 'form') {
207     $opt{option} ||= $form->get_attribute_value ('option');
208     } elsif ($ref eq 'comment') {
209     $opt{option} ||= $WIKIRESOURCE->get
210     (name => 'SuikaWiki/0.9:form:comment:option',
211     o => $opt{o}, wiki => $opt{o}->{wiki});
212     } elsif ($ref eq '#footannotate') {
213     $opt{option} ||= $WIKIRESOURCE->get
214     (name => 'SuikaWiki/0.9:form:footannotate:option',
215     o => $opt{o}, wiki => $opt{o}->{wiki});
216     } else {
217     ## TODO:
218     }
219 wakaba 1.11 $WIKIFORMCORE->set_option ($opt{option} => $opt{o}) if $opt{option};
220    
221     my @missing;
222     for (keys %{$opt{o}->{form}->{require}->{id}}) {
223     unless (length $opt{o}->{wiki}->{input}->parameter
224     ($WIKIFORMCORE->control_id ($opt{o}, local_id => $_,
225     local_id_prefix => 'wikiform__')
226     ->{local_id})) {
227     push @missing, $_;
228     }
229     }
230     if (@missing) {
231     return [{
232     type => 'required_param_missing',
233     missing_id => \@missing,
234     }];
235     }
236 wakaba 1.6
237     ## Replace Output Template
238     my $result;
239     if ($ref eq 'form') {
240     $opt{template} ||= $form->get_attribute_value
241     ('template', default => '');
242     } elsif ($ref eq 'comment') {
243     $opt{template} ||= $WIKIRESOURCE->get
244     (name => 'SuikaWiki/0.9:form:comment:template',
245     o => $opt{o}, wiki => $opt{o}->{wiki});
246     } elsif ($ref eq '#footannotate') {
247     $opt{template} ||= $WIKIRESOURCE->get
248     (name => 'SuikaWiki/0.9:form:footannotate:template',
249     o => $opt{o}, wiki => $opt{o}->{wiki});
250     }
251     try {
252     $result = SuikaWiki::Plugin->text_formatter ('form_template')
253     ->replace ($opt{template}, param => $opt{o});
254     } catch Message::Util::Formatter::error with {
255     my $err = shift;
256     SuikaWiki::Plugin->module_package ('Error')
257     ->reporting_formatting_template_error
258     ($err, $err->{option}->{param}->{wiki});
259     ##TODO:
260     throw SuikaWiki::View::Implementation::error -type => 'ERROR_REPORTED';
261     };
262    
263     ## Insert
264     if (length $result) {
265     if ($ref eq '#footannotate') {
266     my $parent;
267     for (@{$xml->child_nodes}) {
268     if ($_->node_type eq '#element' and
269     $_->local_name eq 'document') {
270     for (@{$_->child_nodes}) {
271     if ($_->node_type eq '#element' and
272     $_->local_name eq 'body') {
273     $parent = $_;
274     last;
275     }
276     }
277     }
278     }
279 wakaba 1.9 CORE::die "Buggy implementation: no body element".$xml
280     unless ref $parent;
281 wakaba 1.6
282     $parent->append_new_node (type => '#element',
283     namespace_uri => $NS_SW09,
284     local_name => 'text')
285     ->append_text ($result);
286     } else {
287     my $parent = $form->parent_node;
288     CORE::die "Byggy implementation: No parent of form" unless ref $parent;
289     my $children = $parent->child_nodes;
290    
291     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
292     $parent->append_new_node (type => '#element',
293     namespace_uri => $NS_SW09,
294     local_name => 'text')
295     ->append_text ($result);
296     my $node = pop @{$children};
297     my $form_str = overload::StrVal ($form);
298     my $i = 0;
299     for (@{$children}) {
300     last if overload::StrVal ($_) eq $form_str;
301     $i++;
302     }
303     if ($opt{o}->{form}->{output}->{reverse}) {
304     splice @{$children}, $i + 1, 0, $node;
305     } else {
306     splice @{$children}, $i, 0, $node;
307     }
308     }
309     } else {
310     ## TODO:
311     }
312    
313     ## XML format -> Text format
314     my $text = __FUNCPACK__->xml_to_text ($xml, {%opt});
315    
316     my %fragment = (fragment => $opt{o}->{form}->{output}->{id}
317     || 'wikiform-'.$opt{o}->{form}->{output}->{index});
318     if (not $opt{o}->{form}->{output}->{reverse} and
319     $opt{o}->{var}->{sw09__anchor_index}) {
320     %fragment = (anchor_no => $opt{o}->{var}->{sw09__anchor_index});
321     }
322    
323     my $action = [
324     {
325     type => 'write',
326     content => $text,
327     update_lastmodified => time,
328     },
329     {
330 wakaba 1.11 type => 'ok',
331 wakaba 1.6 %fragment,
332     },
333     ];
334    
335     @HeadSummary:
336     @@Main:
337     my $xml = __FUNCPACK__->get_xml_tree (text => $source, opt => \%opt,
338     wiki => $self->{wiki});
339     return $xml->inner_text;
340    
341     FormattingRule:
342     @Category[list]:form-template
343     @Name: index
344     @Description:
345     @@@: Next anchor index number
346     @@lang:en
347     @After:
348     if ($o->{var}->{sw09__anchor_index}) {
349     ++$o->{var}->{sw09__anchor_index};
350     } else {
351     $o->{var}->{sw09__anchor_index}
352     = 1 + __FUNCPACK__->get_last_anchor_index
353     ($o->{var}->{sw09__document_tree});
354     }
355     $p->{-result} .= $o->{var}->{sw09__anchor_index};
356    
357     Function:
358     @Name: get_last_anchor_index
359     @Main:
360     my (undef, $xml) = @_;
361     my $anchor = 0;
362     my $get_anchor_no;
363     $get_anchor_no = sub {
364     my $node = shift;
365     for my $child (@{$node->child_nodes}) {
366 wakaba 1.9 my $nt = $child->node_type;
367     if ($nt eq '#element') {
368 wakaba 1.6 if ($child->namespace_uri => $NS_SW09 and
369     $child->local_name eq 'anchor-end') {
370     my $a = $child->get_attribute_value ('anchor', default => 0,
371     namespace_uri => $NS_SW09);
372     $anchor = 0+$a if $anchor < 0+$a;
373     } else {
374     $get_anchor_no->($child);
375     }
376 wakaba 1.9 } elsif ($nt eq '#document' or $nt eq '#fragment') {
377 wakaba 1.6 $get_anchor_no->($child);
378     }
379     }
380     };
381     $get_anchor_no->($xml);
382     $anchor;
383    
384    
385     Function:
386     @Name: get_xml_tree
387     @Main:
388     my (undef, %opt) = @_;
389     if ($opt{opt}->{page}) {
390 wakaba 1.17
391 wakaba 1.8 ## TODO:
392 wakaba 1.6 unless ($__FUNCPACK__::DBLoaded) {
393     $opt{wiki}->{db}->_set_prop_db (sw09__xml_tree => {-db_open => sub {
394     require SuikaWiki::DB::Hash;
395     new SuikaWiki::DB::Hash;
396     }});
397     $__FUNCPACK__::DBLoaded++;
398     }
399    
400 wakaba 1.19 my $xml = new Message::Markup::XML::Node type => '#fragment';
401 wakaba 1.6 __FUNCPACK__->text_to_xml (${$opt{text}}, {%{$opt{opt}}, -parent => $xml});
402    
403     $opt{wiki}->{db}->set (sw09__xml_tree => $opt{opt}->{page} => $xml);
404     $xml;
405     } else {
406     my $xml = new Message::Markup::XML::Node type => '#fragment';
407     __FUNCPACK__->text_to_xml (${$opt{text}}, {%{$opt{opt}}, -parent => $xml});
408     $xml;
409     }
410    
411     Function:
412     @Name: sw09_to_xhtml1
413 wakaba 1.16 @Description:
414     @@lang:en
415     @@@: Transform a SuikaWiki/0.9 or SuikaWiki/0.10 XML tree to an XHTML tree.
416 wakaba 1.6 @Main:
417     my (undef, %opt) = @_;
418    
419 wakaba 1.2 my ($apply_template, $apply_template_children);
420     $apply_template_children = sub {
421 wakaba 1.9 for (@{$_[0]->child_nodes}) {
422     $apply_template->($_ => $_[1]) unless $_->node_type eq '#attribute';
423 wakaba 1.2 }
424     };
425     $apply_template = sub {
426     my ($source, $result) = @_;
427     my $ln = $source->local_name;
428     if ($source->node_type eq '#text') {
429     $result->append_text ($source->inner_text);
430 wakaba 1.16 } elsif ({qw/code 1 samp 1 var 1 dfn 1 kbd 1 sub 1 sup 1
431 wakaba 1.21 cite 1 span 1/ ## SuikaWiki/0.10
432 wakaba 1.16 }->{$ln}) {
433 wakaba 1.2 my $node = $result->append_new_node
434     (type => '#element',
435     namespace_uri => $NS_XHTML1,
436     local_name => $ln);
437     my $class = $source->get_attribute_value ('class', default => '');
438     $node->set_attribute (class => $class) if $class;
439 wakaba 1.21 my $lang = $source->get_attribute_value
440     ('lang', namespace_uri => NS_xml_URI);
441     if (defined $lang) {
442     $node->set_attribute (lang => $lang);
443     $node->set_attribute ('xml:lang' => $lang,
444     namespace_uri => NS_xml_URI,
445     namespace_prefix => 'xml');
446     }
447 wakaba 1.2 $apply_template_children->($source => $node);
448 wakaba 1.4 } elsif ({qw/ins 1 del 1 insert 1 delete 1/}->{$ln}) {
449 wakaba 1.2 my $node = $result->append_new_node
450     (type => '#element',
451     namespace_uri => $NS_XHTML1,
452 wakaba 1.4 local_name => {qw/ins ins insert ins
453     delete del del del/}->{$ln});
454 wakaba 1.2 my $class = $source->get_attribute_value ('class', default => '');
455     $node->set_attribute (class => $class) if $class;
456 wakaba 1.21 my $lang = $source->get_attribute_value
457     ('lang', namespace_uri => NS_xml_URI);
458     if (defined $lang) {
459     $node->set_attribute (lang => $lang);
460     $node->set_attribute ('xml:lang' => $lang,
461     namespace_uri => NS_xml_URI,
462     namespace_prefix => 'xml');
463     }
464 wakaba 1.2 ## TODO: cite
465     $apply_template_children->($source => $node);
466     } elsif ({qw/table 1 tbody 1 tr 1 td 1 blockquote 1 ul 1 ol 1
467     li 1 pre 1 dl 1 dt 1 dd 1 em 1 strong 1/}->{$ln}) {
468     my $node = $result->append_new_node
469     (type => '#element',
470     namespace_uri => $NS_XHTML1,
471     local_name => $ln);
472     if ($ln eq 'td') {
473     my $colspan = $source->get_attribute_value ('colspan', default => 0);
474     $node->set_attribute (colspan => $colspan) if $colspan;
475     } elsif ($ln eq 'pre') {
476     $node->set_attribute (space => 'preserve',
477     namespace_uri => NS_xml_URI);
478 wakaba 1.10 my $class = $source->get_attribute_value ('class', default => '');
479     $node->set_attribute (class => $class) if length $class;
480 wakaba 1.2 }
481 wakaba 1.6 $apply_template_children->($source => $node);
482     } elsif ($ln eq 'anchor') {
483     local $opt{o}->{var}->{sw09__anchor_content} = sub {
484     $apply_template_children->($source => shift);
485     };
486     SuikaWiki::Plugin->module_package ('WikiLinking')
487     ->to_wikipage_in_html ({
488 wakaba 1.9 label => $WIKIRESOURCE->get_text
489 wakaba 1.6 (name =>
490     'Link:SuikaWiki/0.9:toWikiPage:SourceLabel',
491     param => $opt{o},
492     wiki => $opt{o}->{wiki}),
493     } => {
494     base => $opt{o}->{wiki}->{var}->{page},
495 wakaba 1.14 page_name => $opt{o}->{wiki}->name ($source->inner_text)
496     ->absolute (wiki => $opt{o}->{wiki},
497     nearest => 'content',
498     base => $opt{o}->{wiki}
499     ->{var}->{page}),
500 wakaba 1.6 page_anchor_no => $source->get_attribute_value
501     ('anchor',
502     namespace_uri => $NS_SW09),
503     }, {
504     o => $opt{o},
505     parent => $result,
506     });
507     } elsif ($ln eq 'p') {
508     $apply_template_children->($source => $result->append_new_node
509 wakaba 1.2 (type => '#element',
510     namespace_uri => $NS_XHTML1,
511 wakaba 1.6 local_name => 'p'));
512     } elsif ($ln eq 'h') {
513     my $node;
514     if ($opt{o}->{var}->{ws__section_depth} > 6) {
515     $node = $result->append_new_node
516 wakaba 1.2 (type => '#element',
517     namespace_uri => $NS_XHTML1,
518 wakaba 1.6 local_name => 'div');
519     $node->set_attribute (class => 'heading h'.$opt{o}->{var}
520     ->{ws__section_depth});
521     } else {
522     $node = $result->append_new_node
523 wakaba 1.2 (type => '#element',
524     namespace_uri => $NS_XHTML1,
525 wakaba 1.6 local_name => 'h'.$opt{o}->{var}
526     ->{ws__section_depth});
527 wakaba 1.2 }
528     $apply_template_children->($source => $node);
529 wakaba 1.9 $WIKISTRUCT->set_section_id ($result, undef, $opt{o}->{wiki},
530 wakaba 1.6 title => $source->inner_text);
531     } elsif ($ln eq 'ruby' or $ln eq 'rubyb') {
532     my @child;
533     for (@{$source->child_nodes}) {
534     if ({qw/rb 1 rt 1/}->{$_->local_name}) {
535     push @child, $_;
536     }
537     }
538     for ($result->append_new_node (type => '#element',
539     namespace_uri => $NS_XHTML1,
540     local_name => 'ruby')) {
541     if ($ln eq 'rubyb') {
542     my $class = join ' ',
543     'descriptive',
544     split /\s+/, $source->get_attribute_value
545     ('class', default => '');
546     $_->set_attribute (class => $class) if $class;
547     } else {
548     my $class = $source->get_attribute_value ('class', default => '');
549     $_->set_attribute (class => $class) if $class;
550     }
551 wakaba 1.21 my $lang = $source->get_attribute_value
552     ('lang', namespace_uri => NS_xml_URI);
553     if (defined $lang) {
554     $_->set_attribute (lang => $lang);
555     $_->set_attribute ('xml:lang' => $lang,
556     namespace_uri => NS_xml_URI,
557     namespace_prefix => 'xml');
558     }
559 wakaba 1.6 $apply_template_children->($child[0]
560     => $_->append_new_node (type => '#element',
561     namespace_uri => $NS_XHTML1,
562     local_name => 'rb'));
563     $_->append_new_node (type => '#element',
564     namespace_uri => $NS_XHTML1,
565     local_name => 'rp')
566     ->append_text ('(');
567     if ($child[1]) {
568     $apply_template_children->($child[1]
569     => $_->append_new_node (type => '#element',
570     namespace_uri => $NS_XHTML1,
571     local_name => 'rt'));
572     } else {
573     $_->append_new_node (type => '#element',
574     namespace_uri => $NS_XHTML1,
575     local_name => 'rt');
576     }
577     if ($child[2]) {
578     $_->append_new_node (type => '#element',
579     namespace_uri => $NS_XHTML1,
580     local_name => 'rp')
581     ->append_text ('/');
582     $apply_template_children->($child[2]
583     => $_->append_new_node (type => '#element',
584     namespace_uri => $NS_XHTML1,
585     local_name => 'rt'));
586 wakaba 1.5 }
587 wakaba 1.6 $_->append_new_node (type => '#element',
588     namespace_uri => $NS_XHTML1,
589     local_name => 'rp')
590     ->append_text (')');
591 wakaba 1.5 }
592 wakaba 1.6 } elsif ($ln eq 'abbr') {
593     my (@b);
594     for (@{$source->child_nodes}) {
595     push @b, $_ if {qw/rb 1 rt 1/}->{$_->local_name};
596 wakaba 1.5 }
597 wakaba 1.6 my $node = $result->append_new_node
598     (type => '#element',
599     namespace_uri => $NS_XHTML1,
600     local_name => 'abbr');
601     $node->set_attribute (title => $b[1]->inner_text) if $b[1];
602 wakaba 1.21 my $lang = $source->get_attribute_value
603     ('lang', namespace_uri => NS_xml_URI);
604     if (defined $lang) {
605     $node->set_attribute (lang => $lang);
606     $node->set_attribute ('xml:lang' => $lang,
607     namespace_uri => NS_xml_URI,
608     namespace_prefix => 'xml');
609     }
610 wakaba 1.6 $apply_template_children->($b[0] => $node);
611 wakaba 1.19 } elsif ($ln eq 'qn') {
612     my (@b);
613     for (@{$source->child_nodes}) {
614     push @b, $_ if {qw/qname 1 nsuri 1/}->{$_->local_name};
615     }
616     my $node = $result->append_new_node
617     (type => '#element',
618     namespace_uri => $NS_XHTML1,
619     local_name => 'code');
620     $node->set_attribute (class => 'qname');
621 wakaba 1.21 my $lang = $source->get_attribute_value
622     ('lang', namespace_uri => NS_xml_URI);
623     if (defined $lang) {
624     $node->set_attribute (lang => $lang);
625     $node->set_attribute ('xml:lang' => $lang,
626     namespace_uri => NS_xml_URI,
627     namespace_prefix => 'xml');
628     }
629 wakaba 1.19 $node->set_attribute (title => '{<'.$b[1]->inner_text.'>}') if $b[1];
630     $apply_template_children->($b[0] => $node);
631 wakaba 1.6 } elsif ($ln eq 'q') {
632     my $node = $result->append_new_node
633     (type => '#element',
634     namespace_uri => $NS_XHTML1,
635     local_name => 'q');
636     ## TODO: cite
637 wakaba 1.21 my $lang = $source->get_attribute_value
638     ('lang', namespace_uri => NS_xml_URI);
639     if (defined $lang) {
640     $node->set_attribute (lang => $lang);
641     $node->set_attribute ('xml:lang' => $lang,
642     namespace_uri => NS_xml_URI,
643     namespace_prefix => 'xml');
644     }
645 wakaba 1.6 $apply_template_children->($source => $node);
646 wakaba 1.16 } elsif ($ln eq 'weak' or
647     $ln eq 'aa' ## SuikaWiki/0.10
648     ) {
649 wakaba 1.6 my $node = $result->append_new_node
650     (type => '#element',
651     namespace_uri => $NS_XHTML1,
652     local_name => 'span');
653 wakaba 1.16 my @class = split /\s+/,
654     $source->get_attribute_value ('class', default => '');
655     $node->set_attribute (class => join ' ', $ln, @class);
656 wakaba 1.21 my $lang = $source->get_attribute_value
657     ('lang', namespace_uri => NS_xml_URI);
658     if (defined $lang) {
659     $node->set_attribute (lang => $lang);
660     $node->set_attribute ('xml:lang' => $lang,
661     namespace_uri => NS_xml_URI,
662     namespace_prefix => 'xml');
663     }
664 wakaba 1.16 $apply_template_children->($source => $node);
665 wakaba 1.21 } elsif ($ln eq 'src') { ## SuikaWiki/0.10
666 wakaba 1.16 my $node = $result->append_new_node
667     (type => '#element',
668     namespace_uri => $NS_XHTML1,
669     local_name => 'cite');
670     my @class = split /\s+/,
671     $source->get_attribute_value ('class', default => '');
672     $node->set_attribute (class => join ' ', $ln, @class);
673 wakaba 1.21 my $lang = $source->get_attribute_value
674     ('lang', namespace_uri => NS_xml_URI);
675     if (defined $lang) {
676     $node->set_attribute (lang => $lang);
677     $node->set_attribute ('xml:lang' => $lang,
678     namespace_uri => NS_xml_URI,
679     namespace_prefix => 'xml');
680     }
681 wakaba 1.16 $node->append_text ("[");
682     $apply_template_children->($source => $node);
683     $node->append_text ("]");
684 wakaba 1.21 } elsif ($ln eq 'csection') { ## SuikaWiki/0.10
685     my $node = $result->append_new_node
686     (type => '#element',
687     namespace_uri => $NS_XHTML1,
688     local_name => 'cite');
689     my @class = split /\s+/,
690     $source->get_attribute_value ('class', default => '');
691     $node->set_attribute (class => join ' ', $ln, @class);
692     $apply_template_children->($source => $node);
693 wakaba 1.16 } elsif ($ln eq 'key') { ## SuikaWiki/0.10
694     my $node = $result->append_new_node
695     (type => '#element',
696     namespace_uri => $NS_XHTML1,
697     local_name => 'kbd');
698     my @class = split /\s+/,
699     $source->get_attribute_value ('class', default => '');
700     $node->set_attribute (class => join ' ', $ln, @class);
701 wakaba 1.21 my $lang = $source->get_attribute_value
702     ('lang', namespace_uri => NS_xml_URI);
703     if (defined $lang) {
704     $node->set_attribute (lang => $lang);
705     $node->set_attribute ('xml:lang' => $lang,
706     namespace_uri => NS_xml_URI,
707     namespace_prefix => 'xml');
708     }
709 wakaba 1.6 $apply_template_children->($source => $node);
710     } elsif ({qw/section 1 bodytext 1/}->{$ln}) {
711     my $node = $result->append_new_node
712     (type => '#element',
713     namespace_uri => $NS_XHTML1,
714     local_name => 'div');
715     $node->set_attribute (class => $ln);
716     local $opt{o}->{var}->{ws__section_depth}
717     = $opt{o}->{var}->{ws__section_depth} + 1;
718     $apply_template_children->($source => $node);
719     } elsif ($ln eq 'anchor-end') {
720     my $node = $result->append_new_node
721     (type => '#element',
722     namespace_uri => $NS_XHTML1,
723     local_name => 'a');
724     $node->set_attribute (id => 'anchor-'.$source->get_attribute_value
725     ('anchor', default => '0',
726     namespace_uri => $NS_SW09));
727 wakaba 1.8 $node->set_attribute (name => 'anchor-'.$source->get_attribute_value
728     ('anchor', default => '0',
729     namespace_uri => $NS_SW09))
730     if $opt{o}->{wiki}->{var}->{client}->{downgrade}->{html_no_id};
731 wakaba 1.12 $node->set_attribute (class => 'anchor');
732 wakaba 1.6 $node->append_text ($source->inner_text);
733     } elsif ($ln eq 'anchor-internal') {
734     my $node = $result->append_new_node
735     (type => '#element',
736     namespace_uri => $NS_XHTML1,
737     local_name => 'a');
738     $node->set_attribute (href => '#anchor-'.$source->get_attribute_value
739     ('anchor',
740     namespace_uri => $NS_SW09, default => '0'));
741     $node->set_attribute (class => 'wiki-anchor');
742     $node->append_text ($source->inner_text);
743     } elsif ($ln eq 'anchor-external') {
744     local $opt{o}->{var}->{sw09__anchor_content} = sub {
745     $apply_template_children->($source => shift);
746     };
747 wakaba 1.9 $WIKILINKING
748 wakaba 1.6 ->to_resource_in_html (
749     {
750 wakaba 1.9 label => $WIKIRESOURCE
751 wakaba 1.6 ->get_text (name =>
752     'Link:SuikaWiki/0.9:toResource:SourceLabel',
753     param => $opt{o},
754     wiki => $opt{o}->{wiki}),
755     }, {
756     resource_scheme =>
757     $source->get_attribute_value ('resScheme',
758     namespace_uri => $NS_SW09,
759     default => 'URI'),
760     resource_parameter =>
761     $source->get_attribute_value ('resParameter',
762     namespace_uri => $NS_SW09,
763     default => ''),
764     }, {
765     o => $opt{o},
766     parent => $result,
767     });
768     } elsif ($ln eq 'form') {
769     my $ref = $source->get_attribute_value ('ref', default => 'form');
770     if ($ref eq 'form') {
771 wakaba 1.9 $WIKIFORMCORE->make_content_form_in_html
772 wakaba 1.6 ($result,
773     $source->get_attribute_value
774     ('input', default => ''),
775     option => $source->get_attribute_value
776     ('option'),
777     name => $source->get_attribute_value ('id'),
778     o => $opt{o},
779     wiki => $opt{o}->{wiki},
780     output => {
781     page => $opt{page},
782     });
783     } elsif ($ref eq 'comment') {
784 wakaba 1.9 $WIKIFORMCORE->make_content_form_in_html
785 wakaba 1.6 ($result,
786     $WIKIRESOURCE->get
787     (name => 'SuikaWiki/0.9:form:comment:input',
788     o => $opt{o}, wiki => $opt{o}->{wiki}),
789     option => $WIKIRESOURCE->get
790     (name => 'SuikaWiki/0.9:form:comment:option',
791     o => $opt{o}, wiki => $opt{o}->{wiki}),
792     name => $source->get_attribute_value ('id'),
793     o => $opt{o},
794     wiki => $opt{o}->{wiki},
795     output => {
796     page => $opt{page},
797     });
798 wakaba 1.5 } else {
799 wakaba 1.14 ## TODO: Warning
800     $WIKIFORMCORE->make_content_form_in_html
801     ($result,
802     '',
803     option => '',
804     o => $opt{o},
805     wiki => $opt{o}->{wiki},
806     output => {
807     page => $opt{page},
808     });
809 wakaba 1.6 }
810     } elsif ($ln eq 'dr') {
811     $apply_template_children->($source => $result);
812     } elsif ($ln eq 'document') {
813     my $body;
814     for (@{$source->child_nodes}) {
815     $body = $_ and last if $_->local_name eq 'body';
816 wakaba 1.5 }
817 wakaba 1.6 my $body_block = $result->append_new_node
818     (type => '#element',
819     namespace_uri => $NS_XHTML1,
820     local_name => 'div');
821     $body_block->set_attribute (class => 'block SuikaWiki-0-9');
822     $apply_template_children->($body => $body_block);
823     } else {
824     my $node = $result->append_new_node
825     (type => '#element',
826     namespace_uri => $NS_XHTML1,
827     local_name => 'span');
828     $node->set_attribute (class => 'warn');
829     for ($node->append_new_node
830     (type => '#element',
831     namespace_uri => $NS_XHTML1,
832     local_name => 'ins')
833     ->append_new_node
834     (type => '#element',
835     namespace_uri => $NS_XHTML1,
836     local_name => 'code')) {
837     $_->set_attribute (class => 'XML element');
838     $_->append_text ("<".$source->namespace_uri.">:$ln");
839 wakaba 1.4 }
840 wakaba 1.6 $apply_template_children->($source => $node);
841 wakaba 1.4 }
842     };
843 wakaba 1.6
844     $apply_template_children->($opt{source} => $opt{parent});
845 wakaba 1.4
846    
847     Function:
848     @Name: xml_to_text
849     @Main:
850     my (undef, $src, $opt) = @_;
851    
852    
853     my %is_block = (
854     qw/p 1 blockquote 1 pre 1 ul 1 ol 1 dl 1 section 1 h 1
855     bodytext 1 document 1 head 1 body 1 table 1 text 1 form 1
856     insert 1 delete 1/
857     );
858    
859     my %x2t;
860     %x2t = (
861     anchor => sub {
862     my $source = shift;
863     my $result = '[['
864     . $x2t{'#inline'}->($source, no_newline => 1)
865     . ']';
866     my $anchor = $source->get_attribute_value
867     ('anchor',
868     namespace_uri => $NS_SW09,
869     default => '');
870     if (length $anchor) {
871     $result .= '>>'.(0+$anchor);
872     } else {
873     $anchor = $source->get_attribute_value
874     ('resScheme',
875     namespace_uri => $NS_SW09);
876     if ($anchor) {
877     my $param = $source->get_attribute_value
878     ('resParameter',
879     namespace_uri => $NS_SW09);
880     if ($anchor eq 'URI' and $param =~ /^[0-9A-Za-z_+.%-]+:/) {
881     $result .= '<' . $param . '>';
882     } else {
883     $result .= '<' . $anchor . ':' . $param . '>';
884     }
885     }
886     }
887     $result . ']';
888     },
889     li => sub {
890     my $source = shift;
891     my $result = ({qw/ul - ol =/}->{$opt->{o}->{var}->{sw09__list_type}}
892     x $opt->{o}->{var}->{sw09__list_depth})
893     . ' ' . $x2t{'#flow'}->($source);
894     $result;
895     },
896     dt => sub {
897     ':' . $x2t{'#inline'}->(return, no_newline => 1) . ':';
898     },
899     h => sub {
900     ("*" x ($opt->{o}->{var}->{ws__section_depth} - 1))
901     . " "
902     . $x2t{'#inline'}->(shift, no_newline => 1);
903     },
904     'anchor-end' => sub {
905     return shift->inner_text;
906     },
907     'anchor-internal' => sub {
908     return shift->inner_text;
909     },
910     'anchor-external' => sub {
911     return '<'.shift->inner_text.'>';
912     },
913     form => sub {
914     my $source = shift;
915     my $ref = $source->get_attribute_value ('ref', default => 'form');
916     my $result = '[[#'.$ref;
917     my $name = $source->get_attribute_value ('id');
918     $name =~ s/([()\\])/\\$1/g;
919     $result .= '(' . $name . ')' if $name;
920     ## General WikiForm
921     if ($ref eq 'form') {
922     $result .= ":'";
923     my $input = $source->get_attribute_value ('input', default => '');
924     $input =~ s/(['\\])/\\$1/g;
925     $result .= $input . "':'";
926     my $template = $source->get_attribute_value ('template', default => '');
927     $template =~ s/(['\\])/\\$1/g;
928     $result .= $template . "'";
929     my $option = $source->get_attribute_value ('option');
930     if ($option) {
931     $option =~ s/(['\\])/\\$1/g;
932     $result .= ":'" . $option . "'";
933     }
934     ## Specific WikiForm
935     } else {
936     my $param = $source->get_attribute_value ('parameter');
937     if ($param) {
938     $result .= ':' . $param;
939     }
940     }
941     $result .= ']]';
942     },
943     pre => sub {
944     my $source = shift;
945     my $result = '[PRE';
946     my $class = $source->get_attribute_value ('class');
947     if ($class) {
948     $class =~ s/([\\()])/\\$1/g;
949     $result .= '(' . $class . ')';
950     }
951     $result .= "[\x0A"
952     . $x2t{'#inline'}->($source);
953     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
954     $result .= "]PRE]\x0A";
955     },
956     insert => sub {
957     my $source = shift;
958     my $result = '[INS';
959     my $class = $source->get_attribute_value ('class');
960     if ($class) {
961     $class =~ s/([\\()])/\\$1/g;
962     $result .= '(' . $class . ')';
963     }
964     local $opt->{o}->{var}->{sw09__list_depth} = 0;
965     $result .= "[\x0A"
966     . $x2t{'#block'}->($source);
967     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
968     $result .= "]INS]\x0A";
969     },
970     delete => sub {
971     my $source = shift;
972     my $result = '[DEL';
973     my $class = $source->get_attribute_value ('class');
974     if ($class) {
975     $class =~ s/([\\()])/\\$1/g;
976     $result .= '(' . $class . ')';
977     }
978     local $opt->{o}->{var}->{sw09__list_depth} = 0;
979     $result .= "[\x0A"
980     . $x2t{'#block'}->($source);
981     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
982     $result .= "]DEL]\x0A";
983     },
984     document => sub {
985     my $source = shift;
986 wakaba 1.16 my $result = '';
987 wakaba 1.21 $result = '#?'
988     . $source->get_attribute_value
989     ('Name', namespace_uri => $NS_SW09,
990     default => 'SuikaWiki')
991     . '/'
992     . $source->get_attribute_value
993     ('Version', namespace_uri => $NS_SW09,
994     default => '0.9');
995 wakaba 1.4 for (@{$source->child_nodes}) {
996     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_)
997     if $_->node_type eq '#element';
998 wakaba 1.21 if ($_->local_name eq 'head') {
999     $result = '' if $result eq "#?SuikaWiki/0.9\x0A";
1000     }
1001 wakaba 1.4 }
1002     $result;
1003     },
1004     head => sub {
1005     my $source = shift;
1006 wakaba 1.6 my $result = '';
1007 wakaba 1.19 ## ISSUE: '#?SuikaWiki/0.9 ' required...
1008 wakaba 1.4 for (@{$source->child_nodes}) {
1009     if ($_->node_type eq '#element' and
1010     $_->local_name eq 'parameter') {
1011     $result .= ' '.$x2t{parameter}->($_);
1012     }
1013     }
1014     $result . "\x0A";
1015     },
1016     parameter => sub {
1017     my $source = shift;
1018     my $result = $source->get_attribute_value ('name', default => '')
1019     . '="';
1020     my @v;
1021     for (@{$source->child_nodes}) {
1022     push @v, $x2t{value}->($_) if $_->node_type eq '#element' and
1023     $_->local_name eq 'value';
1024     }
1025     $result .= join ',', @v;
1026     $result . '"';
1027     },
1028     value => sub {
1029     my $value = $x2t{'#inline'}->(shift, no_newline => 1);
1030     $value =~ s/(["\\])/\\$1/g;
1031     $value =~ tr/\x0A\x0D/ /;
1032     $value;
1033     },
1034     section => sub {
1035     local $opt->{o}->{var}->{ws__section_depth}
1036     = $opt->{o}->{var}->{ws__section_depth} + 1;
1037     $x2t{'#block'}->(shift);
1038     },
1039     body => sub {
1040     local $opt->{o}->{var}->{ws__section_depth} = 1;
1041     $x2t{'#block'}->(shift);
1042     },
1043     text => sub {
1044     my ($source, %opt) = @_;
1045     my $result .= '';
1046     for (@{$source->child_nodes}) {
1047     if ($_->node_type eq '#text') {
1048     $result .= $_->inner_text;
1049     } elsif ($_->node_type eq '#element') {
1050     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_);
1051     }
1052     }
1053     $result;
1054     },
1055     dr => sub {
1056     my $result = $x2t{'#list'}->(shift);
1057     if ($result) {
1058     $result . "\x0A";
1059     } else {
1060     "::\x0A";
1061     }
1062     },
1063     dt => sub {
1064     ':' . $x2t{'#inline'}->(shift, no_newline => 1) . ':';
1065     },
1066     dd => sub {
1067     $x2t{'#inline'}->(shift);
1068     },
1069     tr => sub {
1070     my $result = $x2t{'#list'}->(shift);
1071     if ($result) {
1072     substr ($result, 1) . "\x0A";
1073     } else {
1074     "',\x0A";
1075     }
1076     },
1077     td => sub {
1078     my $source = shift;
1079     my $result = $x2t{'#inline'}->($source, no_newline => 1);
1080     if ($result =~ /[,"\\]/ or $result =~ /==/) {
1081     $result =~ s/(["\\])/\\$1/g;
1082     $result = '"' . $result . '"';
1083     }
1084     my $colspan = $source->get_attribute_value ('colspan', default => 1);
1085     $result .= ("\t,==" x ($colspan - 1)) if $colspan > 1;
1086     "\t," . $result;
1087     },
1088     em => sub {
1089     "''" . $x2t{'#inline'}->($_, no_newline => 1) . "''";
1090     },
1091     strong => => sub {
1092     "'''" . $x2t{'#inline'}->($_, no_newline => 1) . "'''";
1093     },
1094     rb => sub {
1095     $x2t{'#inline'}->(shift, no_newline => 1);
1096     },
1097 wakaba 1.19 qname => sub {
1098     $x2t{'#inline'}->(shift, no_newline => 1);
1099     },
1100 wakaba 1.4 rt => sub {
1101 wakaba 1.21 my $lang = $_[0]->get_attribute_value
1102     ('lang', namespace_uri => NS_xml_URI,
1103     default => '');
1104     $lang = '@' . $lang if length $lang;
1105     '] '.$lang.'[' . $x2t{'#inline'}->(shift, no_newline => 1);
1106 wakaba 1.4 },
1107 wakaba 1.19 nsuri => sub {
1108 wakaba 1.21 my $lang = $_[0]->get_attribute_value
1109     ('lang', namespace_uri => NS_xml_URI,
1110     default => '');
1111     $lang = '@' . $lang if length $lang;
1112     '] '.$lang.'[' . $x2t{'#inline'}->(shift, no_newline => 1);
1113 wakaba 1.19 },
1114 wakaba 1.4 replace => sub {
1115     '__&&' . shift->get_attribute_value ('by', default => '') . '&&__';
1116     },
1117     bodytext => sub {
1118     my ($source, %opt) = @_;
1119     local $opt->{o}->{var}->{sw09__bq_depth}
1120     = $opt->{o}->{var}->{sw09__bq_depth} + 1;
1121     my @result;
1122     for (@{$source->child_nodes}) {
1123     if ($_->node_type eq '#element') {
1124     my $ln = $_->local_name;
1125     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1126     $ln];
1127     }
1128     }
1129     my $result = '';
1130     my $prev = '';
1131     for (@result) {
1132     my $s = $_->[0];
1133     if ($_->[1] eq 'p') {
1134     $result .= "\x0A" if length $result and
1135     substr ($result, -1) ne "\x0A";
1136     $result .= ('>' x $opt->{o}->{var}->{sw09__bq_depth}) . ' ';
1137     } elsif ($_->[1] eq 'form' or $_->[1] eq 'replace') {
1138     $result .= "\x0A" if length $result and
1139     substr ($result, -1) ne "\x0A";
1140     $result .= ('>' x $opt->{o}->{var}->{sw09__bq_depth})."\x0A";
1141     } elsif ($_->[1] eq 'blockquote' or $_->[1] eq 'text') {
1142     $result .= "\x0A" if length $result and
1143     substr ($result, -1) ne "\x0A";
1144     } else {
1145     unless ($prev eq 'text') {
1146     $result .= "\x0A" if length $result and
1147     substr ($result, -1) ne "\x0A";
1148     }
1149     $result .= ('>' x $opt->{o}->{var}->{sw09__bq_depth})."\x0A";
1150     }
1151     $result .= $s;
1152     $prev = $_->[1];
1153     }
1154     $result;
1155     },
1156 wakaba 1.6 ## Note: This element will be interpreted as a paragraph
1157     ## unless format is SuikaWikiImage/0.9.
1158     image => sub {
1159     my ($source, %opt) = @_;
1160     return "\x0A__IMAGE__\x0A" . $source->inner_text . "\x0A";
1161     },
1162 wakaba 1.4 '#block' => sub {
1163     my ($source, %opt) = @_;
1164     my @result;
1165     for (@{$source->child_nodes}) {
1166     if ($_->node_type eq '#element') {
1167     my $ln = $_->local_name;
1168     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1169     $ln];
1170     }
1171     }
1172     my $result = '';
1173     my $prev = '';
1174     for (@result) {
1175     my $s = $_->[0];
1176     if ($_->[1] eq 'form') {
1177     $result .= "\x0A" if length $result and
1178     substr ($result, -1) ne "\x0A";
1179     $result .= "\x0A";
1180     } elsif ($_->[1] eq 'replace') {
1181     $result .= "\x0A" if length $result and
1182     substr ($result, -1) ne "\x0A";
1183     } elsif ($_->[1] eq 'text') {
1184     $result .= "\x0A" if length $result and
1185     substr ($result, -1) ne "\x0A";
1186     $result .= "\x0A" if $prev eq 'p';
1187     } else {
1188     if ($prev ne 'text' and $prev ne 'replace') {
1189     $result .= "\x0A" if length $result and
1190     substr ($result, -1) ne "\x0A";
1191     $result .= "\x0A";
1192     }
1193     }
1194     $result .= $s;
1195     $prev = $_->[1];
1196     }
1197     $result;
1198     },
1199     '#flow' => sub {
1200     my ($source, %opt) = @_;
1201     my @result;
1202     for (@{$source->child_nodes}) {
1203     if ($_->node_type eq '#element') {
1204     my $ln = $_->local_name;
1205     if ($is_block{$ln}) {
1206     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1207     $ln];
1208     } else {
1209     if (@result and ($result[$#result]->[1] eq '#inline')) {
1210     $result[$#result]->[0]
1211     .= ($x2t{$ln} or $x2t{'#undef'})->($_);
1212     } else {
1213     push @result, [($x2t{$ln} or $x2t{'#undef'})->($_),
1214     '#inline'];
1215     }
1216     }
1217     } elsif ($_->node_type eq '#text') {
1218     if (@result and ($result[$#result]->[1] eq '#inline')) {
1219     $result[$#result]->[0] .= $_->inner_text;
1220     } else {
1221     push @result, [$_->inner_text, '#inline'];
1222     }
1223     }
1224     }
1225     my $result = '';
1226     my $prev = '';
1227     for (@result) {
1228     my $s = $_->[0];
1229     if ($_->[1] eq '#inline') {
1230     if ($prev ne 'text' and $prev ne 'form' and $prev ne 'replace') {
1231     $result .= "\x0A" if length $result and
1232     substr ($result, -1) ne "\x0A";
1233     }
1234     $s =~ s/\x0D\x0A/\x0A/g;
1235     $s =~ s/\x0D/\x0A/g;
1236     $s =~ s/\x0A\x0A+/\x0A/g;
1237     $s =~ s/\x0A/\x20/g if $opt{no_newline};
1238     } elsif ($_->[1] eq 'form' or $_->[1] eq 'replace') {
1239     if ($prev ne '#inline') {
1240     $result .= "\x0A" if length $result and
1241     substr ($result, -1) ne "\x0A";
1242     }
1243     } elsif ($_->[1] eq 'text') {
1244     $result .= "\x0A" if length $result and
1245     substr ($result, -1) ne "\x0A";
1246     } else {
1247     unless ($prev eq 'text') {
1248     $result .= "\x0A" if length $result and
1249     substr ($result, -1) ne "\x0A";
1250     }
1251     }
1252     $result .= $s;
1253     $prev = $_->[1];
1254     }
1255     $result;
1256     },
1257     '#inline' => sub {
1258     my ($source, %opt) = @_;
1259     my $result .= '';
1260     for (@{$source->child_nodes}) {
1261     if ($_->node_type eq '#text') {
1262     $result .= $_->inner_text;
1263     } elsif ($_->node_type eq '#element') {
1264     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_);
1265     }
1266     }
1267     $result =~ s/\x0D\x0A/\x0A/g;
1268     $result =~ s/\x0D/\x0A/g;
1269     $result =~ s/\x0A\x0A+/\x0A/g;
1270     $result =~ s/\x0A/\x20/g if $opt{no_newline};
1271     $result;
1272     },
1273     '#list' => sub {
1274     my ($source, %opt) = @_;
1275     my $result .= '';
1276     for (@{$source->child_nodes}) {
1277     if ($_->node_type eq '#element') {
1278     $result .= ($x2t{$_->local_name} or $x2t{'#undef'})->($_);
1279     }
1280     }
1281     $result;
1282     },
1283     '#undef' => sub {
1284     my $source = shift;
1285     ## TODO:
1286     "<".$source->namespace_uri.">:".$source->local_name
1287     . $x2t{'#inline'}->($source);
1288     },
1289     );
1290     for (qw/blockquote dl tbody table/) {
1291     $x2t{$_} = sub { $x2t{'#list'}->(shift) };
1292     }
1293     for (qw/p dd/) {
1294     $x2t{$_} = sub { $x2t{'#flow'}->(shift) };
1295     }
1296     for my $type (qw/ul ol/) {
1297     $x2t{$type} = sub {
1298     my $source = shift;
1299     local $opt->{o}->{var}->{sw09__list_type} = $type;
1300     local $opt->{o}->{var}->{sw09__list_depth}
1301     = $opt->{o}->{var}->{sw09__list_depth} + 1;
1302     my @result;
1303     for (@{$source->child_nodes}) {
1304     push @result, $x2t{$_->local_name}->($_)
1305     if $_->node_type eq '#element';
1306     }
1307     my $result = '';
1308     for (@result) {
1309     $result .= "\x0A" unless substr ($result, -1) eq "\x0A";
1310     $result .= $_;
1311     }
1312     substr ($result, 1);
1313     };
1314     }
1315     for my $type (qw/code samp var dfn kbd sub sup weak q ruby rubyb
1316 wakaba 1.21 abbr ins del aa src cite key qn csection span/) {
1317 wakaba 1.4 $x2t{$type} = sub {
1318     my $source = shift;
1319     my $result = '['.uc $type;
1320     my $class = $source->get_attribute_value ('class', default => '');
1321     if ($class) {
1322     $class =~ s/([()\\])/\\$1/g;
1323     $result .= '(' . $class . ')';
1324     }
1325 wakaba 1.21 my $lang = $source->get_attribute_value
1326     ('lang', namespace_uri => NS_xml_URI);
1327     if (defined $lang) {
1328     $result .= '@' . $lang;
1329     }
1330 wakaba 1.4 $result .= '['
1331     . $x2t{'#inline'}->($source, no_newline => 1)
1332     . ']';
1333     my $anchor = $source->get_attribute_value
1334     ('anchor',
1335     namespace_uri => $NS_SW09,
1336     default => '');
1337     if (length $anchor) {
1338     $result .= '>>'.(0+$anchor);
1339     } else {
1340     $anchor = $source->get_attribute_value
1341     ('resScheme',
1342     namespace_uri => $NS_SW09);
1343     if ($anchor) {
1344     my $param = $source->get_attribute_value
1345     ('resParameter',
1346     namespace_uri => $NS_SW09);
1347     if ($anchor eq 'URI' and $param =~ /^[0-9A-Za-z_+.%-]+:/) {
1348     $result .= '<' . $param . '>';
1349     } else {
1350     $result .= '<' . $anchor . ':' . $param . '>';
1351     }
1352     }
1353     }
1354     $result .= ']';
1355     $result;
1356     };
1357     }
1358    
1359     $x2t{'#list'}->($src);
1360    
1361     Function:
1362     @Name: get_nth_element
1363     @Main:
1364     my (undef, $node, $ns => $ln, $n) = @_;
1365     return $n if $n < 1;
1366     if ($node->node_type eq '#element' and
1367     $node->namespace_uri eq $ns and
1368     $node->local_name eq $ln) {
1369     return $node unless --$n;
1370     }
1371     for (@{$node->child_nodes}) {
1372     if ($_->node_type eq '#element') {
1373     if ($_->namespace_uri eq $ns and
1374     $_->local_name eq $ln) {
1375     return $_ unless --$n;
1376     } else {
1377     $n = __FUNCPACK__->get_nth_element ($_, $ns => $ln, $n);
1378     return $n if ref $n;
1379     }
1380     } elsif ($_->node_type eq '#fragment' or $_->node_type eq '#document') {
1381     $n = __FUNCPACK__->get_nth_element ($_, $ns => $ln, $n);
1382     return $n if ref $n;
1383     }
1384     }
1385     return $n;
1386    
1387     Function:
1388     @Name: get_element_by_id
1389     @Main:
1390     my (undef, $node, $id) = @_;
1391     return $node if $node->node_type eq '#element'
1392     and $node->get_attribute_value ('id', default_value => '')
1393     eq $id;
1394     for (@{$node->child_nodes}) {
1395     if ({'#element'=>1, '#fragment'=>1, '#document'=>1}->{$_->node_type}) {
1396     my $r = __FUNCPACK__->get_element_by_id ($_, $id);
1397     return $r if $r;
1398     }
1399     }
1400 wakaba 1.1
1401     Function:
1402     @Name: text_to_xml
1403     @Description:
1404     @@@:
1405     Converting SuikaWiki/0.9 text format to XML representation
1406     @@lang: en
1407     @Main:
1408     my (undef, $source, $opt) = @_;
1409     $source =~ s/\x0D\x0A/\x0A/g;
1410     $source =~ tr/\x0D/\x0A/;
1411     $source .= "\x0A";
1412     my $root = $opt->{-parent}
1413     ->append_new_node (type => '#element',
1414     namespace_uri => $NS_SW09,
1415     local_name => 'document');
1416     my $head = $root->append_new_node (type => '#element',
1417     namespace_uri => $NS_XHTML2,
1418     local_name => 'head');
1419 wakaba 1.6 $root->append_text ("\x0A");
1420     my $body = $root->append_new_node (type => '#element',
1421     namespace_uri => $NS_XHTML2,
1422     local_name => 'body');
1423     $root->append_text ("\x0A");
1424    
1425     if ($source =~ s#^\#\?(SuikaWiki(?:Image)?)/0\.9\b((?>.*))\s*##) {
1426     my $type = $1;
1427     my $param = $2;
1428     $root->set_attribute (Name => $type, namespace_uri => $NS_SW09);
1429     $root->set_attribute (Version => '0.9', namespace_uri => $NS_SW09);
1430 wakaba 1.1 while ($param =~ /\G\s+([a-z-]+)="((?>[^"\\]*)(?>(?>[^"\\]+|\\.)*))"/g) {
1431     my ($name, $value) = ($1, $2);
1432     $value =~ s/\\(.)/$1/g;
1433     for ($head->append_new_node (type => '#element',
1434     namespace_uri => $NS_SW09,
1435 wakaba 1.4 local_name => 'parameter')) {
1436 wakaba 1.1 $_->set_attribute (name => $name);
1437     for my $value (split /,/, $value) {
1438     $_->append_new_node (type => '#element',
1439     namespace_uri => $NS_SW09,
1440     local_name => 'value')
1441     ->append_text ($value);
1442     }
1443     }
1444     $head->append_text ("\x0A");
1445     }
1446 wakaba 1.6
1447     if ($type eq 'SuikaWikiImage') {
1448     $source =~ s/\x0A__IMAGE__\x0A(.*)$//s;
1449     if (my $image = $1) {
1450     $image =~ s/^\s+//;
1451     $image =~ s/\s+$//;
1452     $root->append_new_node
1453     (type => '#element',
1454     namespace_uri => $NS_SW09,
1455     local_name => 'image')
1456     ->append_text ($image);
1457     $root->append_text ("\x0A");
1458     }
1459     }
1460 wakaba 1.1 } else {
1461 wakaba 1.16 #$root->set_attribute (Name => 'SuikaWiki', namespace_uri => $NS_SW09);
1462     #$root->set_attribute (Version => '0.9', namespace_uri => $NS_SW09);
1463 wakaba 1.1 }
1464    
1465 wakaba 1.4 __FUNCPACK__->block_text_to_xml (\$source => $body, opt => $opt);
1466 wakaba 1.1
1467     Function:
1468     @Name:block_text_to_xml
1469     @Description:
1470     @@@:
1471     SuikaWiki/0.9 text format to XML representation convertion - block
1472     level elements
1473     @@lang:en
1474     @Main:
1475     my (undef, $source, $current, %opt) = @_;
1476 wakaba 1.4 my %depth = %{$opt{depth} || {}};
1477 wakaba 1.1 my $back_to_section = sub {
1478     my $cur_type = $current->local_name;
1479     while (not (
1480     $cur_type eq 'section'
1481     or $cur_type eq 'body'
1482     or $cur_type eq 'bodytext'
1483 wakaba 1.4 or $cur_type eq 'insert'
1484     or $cur_type eq 'delete'
1485 wakaba 1.1 )
1486     ) {
1487     $current = $current->parent_node;
1488     $cur_type = $current->local_name;
1489     }
1490     delete $depth{list};
1491     };
1492     my $back_to_real_section = sub {
1493     my $cur_type = $current->local_name;
1494     while (not (
1495     $cur_type eq 'section'
1496     or $cur_type eq 'body'
1497 wakaba 1.4 or $cur_type eq 'insert'
1498     or $cur_type eq 'delete'
1499 wakaba 1.1 )
1500     ) {
1501     $current = $current->parent_node;
1502     $cur_type = $current->local_name;
1503     }
1504     delete $depth{bq};
1505     delete $depth{list};
1506     };
1507     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
1508     my $line = $1;
1509     if ($line eq '') {
1510     $back_to_real_section->();
1511     } elsif ($line =~ s/^([-=]+)\s*//) {
1512     my $list_type = substr ($1, -1) eq '-' ? 'ul' : 'ol';
1513     my $depth = length $1;
1514     my $parent_type = $current->parent_node->local_name;
1515     ## Parent node is list element
1516     if ($parent_type eq 'ul' or $parent_type eq 'ol') {
1517     if ($depth{list} == $depth) {
1518     if ($parent_type eq $list_type) {
1519     $current = $current->parent_node;
1520     } else {
1521     $current = $current->parent_node
1522     ->parent_node
1523     ->append_new_node
1524     (type => '#element',
1525     namespace_uri => $NS_XHTML2,
1526     local_name => $list_type);
1527     }
1528     } elsif ($depth < $depth{list}) {
1529     for ($depth+1..$depth{list}) {
1530     $current = $current->parent_node->parent_node;
1531     }
1532     $current = $current->parent_node;
1533     if ($current->local_name ne $list_type) {
1534     $current = $current->parent_node
1535     ->append_new_node
1536     (type => '#element',
1537     namespace_uri => $NS_XHTML2,
1538     local_name => $list_type);
1539     }
1540     $depth{list} = $depth;
1541     } else { # $depth{list} < $depth
1542     $current = $current->append_new_node
1543     (type => '#element',
1544     namespace_uri => $NS_XHTML2,
1545     local_name => $list_type);
1546     $depth{list}++;
1547     }
1548     ## Parent node is non-list element
1549     } else {
1550     $current = $current->append_new_node (type => '#element',
1551     namespace_uri => $NS_XHTML2,
1552     local_name => $list_type);
1553     $depth{list} = 1;
1554     }
1555     $current->append_text ("\x0A".(" " x $depth{list}));
1556     $current = $current->append_new_node (type => '#element',
1557     namespace_uri => $NS_XHTML2,
1558     local_name => 'li');
1559 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1560 wakaba 1.1 } elsif ($line =~ s/^(\*+)\s*//) {
1561     my $depth = length $1;
1562     $back_to_real_section->();
1563     if ($depth <= $depth{section}) {
1564     for ($depth..$depth{section}) {
1565     $back_to_real_section->();
1566     $current = $current->parent_node;
1567     }
1568     $depth{section} = $depth;
1569     } else { # $depth{section} < $depth
1570     for ($depth{section}+2..$depth) {
1571     $current = $current->append_new_node
1572     (type => '#element',
1573     namespace_uri => $NS_XHTML2,
1574     local_name => 'section');
1575     }
1576     $depth{section} = $depth;
1577     }
1578     $current = $current->append_new_node
1579     (type => '#element',
1580     namespace_uri => $NS_XHTML2,
1581     local_name => 'section');
1582     __FUNCPACK__->inline_text_to_xml (\$line =>
1583     $current->append_new_node (type => '#element',
1584     namespace_uri => $NS_XHTML2,
1585 wakaba 1.4 local_name => 'h'), %opt,
1586 wakaba 1.1 );
1587     } elsif ($line =~ s/^(?!>>[0-9])(>+)\s*//) {
1588     my $depth = length $1;
1589     if ($depth <= $depth{bq}) {
1590     for ($depth+1..$depth{bq}) {
1591     $back_to_section->();
1592     $current = $current->parent_node->parent_node;
1593     }
1594     $back_to_section->();
1595     $current->append_text ("\x0A");
1596     $depth{bq} = $depth;
1597     } else { # $depth{bq} < $depth
1598     $back_to_section->();
1599     for ($depth{bq}+1..$depth) {
1600     $current = $current->append_new_node
1601     (type => '#element',
1602     namespace_uri => $NS_XHTML2,
1603     local_name => 'blockquote')
1604     ->append_new_node
1605     (type => '#element',
1606     namespace_uri => $NS_HTML3,
1607     local_name => 'bodytext');
1608     $current->append_text ("\x0A");
1609     }
1610     $depth{bq} = $depth;
1611     }
1612     if (length $line) {
1613     $current = $current->append_new_node
1614     (type => '#element',
1615     namespace_uri => $NS_XHTML2,
1616     local_name => 'p');
1617 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1618 wakaba 1.1 }
1619     } elsif ($line =~ s/^(?>:\s*)([^:]+?)\s*:\s*//) {
1620     my $parent_type = $current->local_name;
1621     if ($parent_type eq 'dd') {
1622     $current = $current->parent_node->parent_node;
1623     $current->append_text ("\x0A");
1624     } else { #if ($parent_type ne 'dl') {
1625     $current = $current->append_new_node (type => '#element',
1626     namespace_uri => $NS_XHTML2,
1627     local_name => 'dl');
1628     }
1629     $current = $current->append_new_node
1630     (type => '#element',
1631     namespace_uri => $NS_SW09,
1632     local_name => 'dr');
1633     __FUNCPACK__->inline_text_to_xml (\"$1" =>
1634     $current->append_new_node (type => '#element',
1635     namespace_uri => $NS_XHTML2,
1636 wakaba 1.4 local_name => 'dt'), %opt,
1637 wakaba 1.1 );
1638     $current->append_text ("\x0A");
1639     $current = $current->append_new_node (type => '#element',
1640     namespace_uri => $NS_XHTML2,
1641     local_name => 'dd');
1642 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1643 wakaba 1.9 } elsif ($line =~ /^\[(INS|DEL)(?>(\([^()\\]*\))?)\[\s*$/) {
1644 wakaba 1.1 $current->append_text ("\x0A");
1645 wakaba 1.4 my $mod = $current->append_new_node
1646     (type => '#element',
1647     namespace_uri => $NS_SW09,
1648     local_name => {qw/INS insert DEL delete/}->{$1});
1649 wakaba 1.1 $mod->set_attribute (class => $2) if $2;
1650 wakaba 1.4 __FUNCPACK__->block_text_to_xml ($source => $mod, %opt,
1651     'return_by_'.$1 => 1,
1652     depth => \%depth);
1653 wakaba 1.1 } elsif ($line =~ /^\](INS|DEL)\]\s*$/) {
1654     if ($opt{'return_by_'.$1}) {
1655     return;
1656     } else {
1657     ## TODO: warn
1658     }
1659 wakaba 1.10 } elsif ($line =~ /^\[PRE(?>(?>\(((?>[^()\\]*)(?>(?>[^()\\]+|\\.)*))\))?)\[\s*$/) {
1660 wakaba 1.1 $current->append_text ("\x0A");
1661     my $pre = $current->append_new_node (type => '#element',
1662     namespace_uri => $NS_XHTML1,
1663     local_name => 'pre');
1664     $pre->set_attribute (class => $1) if $1;
1665     $pre->set_attribute (space => 'preserve', namespace_uri => NS_xml_URI);
1666     my $f = 1;
1667     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
1668     my $line = $1;
1669     if ($line =~ /^\]PRE\]\s*$/) {
1670     undef $pre;
1671     last;
1672     } else {
1673     $f ? undef $f : $pre->append_text ("\x0A");
1674 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $pre, %opt);
1675 wakaba 1.1 }
1676     }
1677     if (ref $pre) {
1678     # warn unmatched start-tag
1679     }
1680     } elsif ($line =~ /^\s/) {
1681     $current->append_text ("\x0A");
1682     my $pre = $current->append_new_node (type => '#element',
1683     namespace_uri => $NS_XHTML1,
1684     local_name => 'pre');
1685     $pre->set_attribute (space => 'preserve', namespace_uri => NS_xml_URI);
1686 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $pre, %opt);
1687 wakaba 1.1 while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
1688     my $line = $1;
1689     if (length $line == 0) {
1690     pos ($$source) -= 1;
1691     last;
1692 wakaba 1.4 } elsif ($opt{return_by_INS} and $line =~ /^\]INS\]\s*$/) {
1693     return;
1694     } elsif ($opt{return_by_DEL} and $line =~ /^\]DEL\]\s*$/) {
1695     return;
1696 wakaba 1.1 } else {
1697     $pre->append_text ("\x0A");
1698 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$line => $pre, %opt);
1699 wakaba 1.1 }
1700     }
1701     } elsif ($line =~ /^,/) {
1702     $current->append_text ("\x0A");
1703     my $tbody = $current->append_new_node (type => '#element',
1704     namespace_uri => $NS_XHTML2,
1705     local_name => 'table')
1706     ->append_new_node (type => '#element',
1707     namespace_uri => $NS_XHTML2,
1708     local_name => 'tbody');
1709 wakaba 1.4 __FUNCPACK__->tablerow_text_to_xml (\$line => $tbody, %opt);
1710 wakaba 1.1 while ($$source =~ /\G(,[^\x0A]*)\x0A/gc) {
1711 wakaba 1.4 __FUNCPACK__->tablerow_text_to_xml (\"$1" => $tbody, %opt);
1712 wakaba 1.1 }
1713     } else {
1714     my $current_type = $current->local_name;
1715     if ($current_type eq 'section'
1716     or $current_type eq 'body'
1717     or $current_type eq 'bodytext'
1718 wakaba 1.4 or $current_type eq 'insert'
1719     or $current_type eq 'delete') {
1720 wakaba 1.1 $current->append_text ("\x0A");
1721     if ($line =~ s/^__&&([^&]+)&&__//) {
1722     $current->append_new_node (type => '#element',
1723     namespace_uri => $NS_SW09,
1724     local_name => 'replace')
1725     ->set_attribute (by => $1);
1726     } elsif ($line =~ s/^\[\[$Reg_Form_Content_M\]\]//o) {
1727     for ($current->append_new_node (type => '#element',
1728     namespace_uri => $NS_SW09,
1729     local_name => 'form')) {
1730     $_->set_attribute (id => $1) if $1;
1731     my ($i, $t, $o) = ($2, $3 || '', $4 || '');
1732 wakaba 1.4 s/\\(.)/$1/g for ($i, $t, $o);
1733 wakaba 1.1 $_->set_attribute (input => $i);
1734     $_->set_attribute (template => $t);
1735     $_->set_attribute (option => $o);
1736     }
1737     } elsif ($line =~ s/^\[\[$Reg_Embed_Content_M\]\]//o) {
1738     for ($current->append_new_node (type => '#element',
1739     namespace_uri => $NS_SW09,
1740     local_name => 'form')) {
1741     $_->set_attribute (ref => $1);
1742     $_->set_attribute (id => $2) if $2;
1743     $_->set_attribute (parameter => $3) if defined $3;
1744     }
1745     }
1746 wakaba 1.4 if (length $line) {
1747     $current = $current->append_new_node
1748     (type => '#element',
1749     namespace_uri => $NS_XHTML2,
1750     local_name => 'p');
1751     __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1752     }
1753 wakaba 1.1 } else {
1754 wakaba 1.4 $current->append_text ("\x0A"); # replacement of prev.line's \n
1755     __FUNCPACK__->inline_text_to_xml (\$line => $current, %opt);
1756 wakaba 1.1 }
1757     }
1758     }
1759    
1760     if ($opt{return_by_INS} or $opt{return_by_DEL}) {
1761     # warn
1762     }
1763    
1764     Function:
1765     @Name: tablerow_text_to_xml
1766     @Description:
1767     @@@:
1768     SuikaWiki/0.9 text format to XML representation - table row
1769     @@lang:en
1770     @Main:
1771     my (undef, $source => $current, %opt) = @_;
1772     $current->append_text ("\x0A");
1773     $current = $current->append_new_node (type => '#element',
1774     namespace_uri => $NS_XHTML2,
1775     local_name => 'tr');
1776     my $prev_cell;
1777     while ($$source =~ /\G,\s*/gc) {
1778 wakaba 1.4 $$source =~ /\G([^,"][^,]*|"(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"\s*)/gc;
1779 wakaba 1.1 my $cell = $1;
1780     if ($cell =~ s/^"//) {
1781     $cell =~ s/"\s*$//g;
1782     $cell =~ s/\\(.)/$1/g;
1783     } else {
1784     $cell =~ s/\s+$//g;
1785     if ($cell eq '==') {
1786     if (ref $prev_cell) {
1787     $prev_cell->set_attribute (colspan =>
1788     $prev_cell->get_attribute_value ('colspan', default => 1)
1789     + 1);
1790     next;
1791     } else {
1792     # TODO: warn
1793     }
1794     }
1795     }
1796     $prev_cell = $current->append_new_node
1797     (type => '#element',
1798     namespace_uri => $NS_XHTML2,
1799     local_name => 'td');
1800 wakaba 1.4 __FUNCPACK__->inline_text_to_xml (\$cell => $prev_cell, %opt);
1801 wakaba 1.1 }
1802     # TODO: warn
1803    
1804     Function:
1805     @Name: inline_text_to_xml
1806     @Description:
1807     @@@:
1808     SuikaWiki/0.9 text format to XML representation - inline level elements
1809     @@lang:en
1810     @Main:
1811 wakaba 1.9 my (undef, $source => $current, %opt) = @_;
1812    
1813 wakaba 1.1 my $ElementDef = {
1814 wakaba 1.5 ABBR => {ln => 'abbr', ns_uri => $NS_XHTML2},
1815 wakaba 1.1 CODE => {ln => 'code', ns_uri => $NS_XHTML2},
1816     DEL => {ln => 'del', ns_uri => $NS_XHTML1},
1817     DFN => {ln => 'dfn', ns_uri => $NS_XHTML2},
1818     INS => {ln => 'ins', ns_uri => $NS_XHTML1},
1819     KBD => {ln => 'kbd', ns_uri => $NS_XHTML2},
1820     Q => {ln => 'q', ns_uri => $NS_XHTML1},
1821     RUBY => {ln => 'ruby', ns_uri => $NS_XHTML2},
1822     RUBYB => {ln => 'rubyb', ns_uri => $NS_SW09},
1823     SAMP => {ln => 'samp', ns_uri => $NS_XHTML2},
1824     SUB => {ln => 'sub', ns_uri => $NS_XHTML2},
1825     SUP => {ln => 'sup', ns_uri => $NS_XHTML2},
1826 wakaba 1.16 VAR => {ln => 'var', ns_uri => $NS_XHTML2},
1827 wakaba 1.1 WEAK => {ln => 'weak', ns_uri => $NS_SW09},
1828 wakaba 1.19 AA => {ln => 'aa', ns_uri => $NS_AA}, ## SuikaWiki/0.10
1829 wakaba 1.16 CITE => {ln => 'cite', ns_uri => $NS_XHTML2}, ## SuikaWiki/0.10
1830 wakaba 1.19 CSECTION => {ln => 'csection', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1831 wakaba 1.16 KEY => {ln => 'key', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1832 wakaba 1.19 QN => {ln => 'qn', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1833 wakaba 1.21 SPAN => {ln => 'span', ns_uri => $NS_XHTML2}, ## SuikaWiki/0.10
1834 wakaba 1.16 SRC => {ln => 'src', ns_uri => $NS_SW010}, ## SuikaWiki/0.10
1835 wakaba 1.1 anchor => {ln => 'anchor', ns_uri => $NS_SW09, has_fragment_no => 1},
1836     del => {has_cite => 1},
1837     ins => {has_cite => 1},
1838 wakaba 1.20 nsuri => {ln => 'nsuri', ns_uri => $NS_SW010, is_nested => 1},
1839     ## SuikaWiki/0.10
1840 wakaba 1.1 q => {has_cite => 1},
1841 wakaba 1.20 qname => {ln => 'qname', ns_uri => $NS_SW010, is_nested => 1},
1842     ## SuikaWiki/0.10
1843 wakaba 1.1 rb => {ln => 'rb', ns_uri => $NS_XHTML2, is_nested => 1},
1844     rt => {ln => 'rt', ns_uri => $NS_XHTML2, is_nested => 1},
1845     };
1846    
1847     if ($$source =~ /\G\[([0-9]+)\]/gc) {
1848     for ($current->append_new_node (type => '#element',
1849     namespace_uri => $NS_SW09,
1850     local_name => 'anchor-end')) {
1851 wakaba 1.4 $_->set_attribute (anchor => 0+$1,
1852     namespace_uri => $NS_SW09);
1853 wakaba 1.1 $_->append_text ('['.$1.']');
1854     }
1855     }
1856     my $depth = 0;
1857     while (pos $$source < length $$source) {
1858     if ($$source =~ /\G\[\[(?=\#)/gc) {
1859     my $form = $current->append_new_node (type => '#element',
1860     namespace_uri => $NS_SW09,
1861     local_name => 'form');
1862     if ($$source =~ /\G$Reg_Form_Content_M\]\]/ogc) {
1863     $form->set_attribute (id => $1) if $1;
1864 wakaba 1.4 my ($i, $t, $o) = ($2, $3, $4);
1865     s/\\(.)/$1/g for ($i, $t, $o);
1866     $form->set_attribute (input => $i);
1867     $form->set_attribute (template => $t);
1868     $form->set_attribute (option => $o);
1869 wakaba 1.1 } elsif ($$source =~ /\G$Reg_Embed_Content_M\]\]/ogc) {
1870     $form->set_attribute (ref => $1);
1871     $form->set_attribute (id => $2) if $2;
1872     $form->set_attribute (parameter => $3) if defined $3;
1873     } else {
1874     ## TODO: error
1875 wakaba 1.4 SuikaWiki::Plugin->module_package('Error')->report_error_simple ($opt{opt}->{o}->{wiki}, InvalidForm => substr ($$source, pos ($$source)));
1876 wakaba 1.1 }
1877 wakaba 1.21 } elsif ($$source =~ /\G\[(?>([A-Z]+)(?>\(((?>[^()\\]*)(?>(?>[^()\\]+|\\.)*))\))?)?(?:\@([A-Za-z0-9-]+))?\[/gc) {
1878 wakaba 1.1 my $type = $1 || 'anchor';
1879     my $param = $2;
1880 wakaba 1.21 my $lang = $3;
1881 wakaba 1.1 my $def = $ElementDef->{ $type };
1882     unless ($def) {
1883     ## TODO: error
1884 wakaba 1.4 $def = $ElementDef->{CODE};
1885 wakaba 1.1 }
1886     $current = $current->append_new_node (type => '#element',
1887     namespace_uri => $def->{ns_uri},
1888     local_name => $def->{ln});
1889     $current->set_attribute (class => $param) if $param;
1890 wakaba 1.21 $current->set_attribute (lang => $lang, namespace_uri => NS_xml_URI)
1891     if defined $lang;
1892 wakaba 1.1 if ($type eq 'RUBY' or $type eq 'RUBYB'
1893     or $type eq 'ABBR') {
1894     $current = $current->append_new_node
1895     (type => '#element',
1896     namespace_uri => $ElementDef->{rb}->{ns_uri},
1897     local_name => $ElementDef->{rb}->{ln});
1898 wakaba 1.19 } elsif ($type eq 'QN') {
1899     $current = $current->append_new_node
1900     (type => '#element',
1901     namespace_uri => $ElementDef->{qname}->{ns_uri},
1902     local_name => $ElementDef->{qname}->{ln});
1903 wakaba 1.1 }
1904     $depth++;
1905     } elsif ($$source =~ /\G\](?> <([0-9A-Za-z_+.%-]+):($Reg_URI_Opaque)>
1906     \ | >>([0-9]+) )?
1907     \ \]/gcox) {
1908     my ($scheme, $opaque, $anchor) = ($1, $2, $3);
1909     unless ($depth) {
1910     $current->append_text (substr ($$source, $-[0], $+[0]-$-[0]));
1911     next;
1912     }
1913     my $def = $ElementDef->{$current->local_name} || {};
1914     if (defined $anchor) {
1915 wakaba 1.4 $current->set_attribute (anchor => $anchor + 0,
1916     namespace_uri => $NS_SW09);
1917     } elsif (defined $scheme) {
1918     if ($scheme =~ /[A-Z]/) {
1919     $current->set_attribute (resScheme => $scheme,
1920     namespace_uri => $NS_SW09);
1921     $current->set_attribute (resParameter => $opaque,
1922     namespace_uri => $NS_SW09);
1923 wakaba 1.1 } else {
1924 wakaba 1.4 $current->set_attribute (resScheme => 'URI',
1925 wakaba 1.1 namespace_uri => $NS_SW09);
1926 wakaba 1.4 $current->set_attribute (resParameter => "$scheme:$opaque",
1927 wakaba 1.1 namespace_uri => $NS_SW09);
1928     }
1929     }
1930     $current = $current->parent_node;
1931     $current = $current->parent_node if $def->{is_nested};
1932     $depth--;
1933 wakaba 1.21 } elsif ($$source =~ /\G\]\s*(?:\@([A-Za-z0-9-]+))?\[/gc) {
1934     my $lang = $1;
1935 wakaba 1.1 if ($current->local_name eq 'rb' or $current->local_name eq 'rt') {
1936     $current = $current->parent_node
1937     ->append_new_node
1938     (type => '#element',
1939     namespace_uri => $ElementDef->{rt}->{ns_uri},
1940     local_name => $ElementDef->{rt}->{ln});
1941 wakaba 1.21 $current->set_attribute (lang => $lang, namespace_uri => NS_xml_URI)
1942     if defined $lang;
1943 wakaba 1.19 } elsif ($current->local_name eq 'qname') {
1944     $current = $current->parent_node
1945     ->append_new_node
1946     (type => '#element',
1947     namespace_uri => $ElementDef->{nsuri}->{ns_uri},
1948     local_name => $ElementDef->{nsuri}->{ln});
1949 wakaba 1.21 $current->set_attribute (lang => $lang, namespace_uri => NS_xml_URI)
1950     if defined $lang;
1951 wakaba 1.1 } else {
1952 wakaba 1.10 $current->append_text (substr ($$source, $-[0], $+[0]-$-[0]-1));
1953     pos ($$source)--;
1954 wakaba 1.1 }
1955     } elsif ($$source =~ /\G'''?/gc) {
1956     my $type = $+[0] - $-[0] == 3 ? 'strong' : 'em';
1957     if ($current->local_name eq $type) {
1958     $current = $current->parent_node;
1959     } else {
1960     $current = $current->append_new_node
1961     (type => '#element',
1962     namespace_uri => $NS_XHTML2,
1963     local_name => $type);
1964     }
1965 wakaba 1.9 } elsif ($$source =~ /\G<([0-9A-Za-z_+.%-]+):($Reg_URI_Opaque)>/gco) {
1966 wakaba 1.1 my ($scheme, $data) = ($1, $2);
1967     my $link = $current->append_new_node
1968     (type => '#element',
1969     namespace_uri => $NS_SW09,
1970 wakaba 1.2 local_name => 'anchor-external');
1971 wakaba 1.1 if (substr ($scheme, 0, 1) =~ /[A-Z]/) {
1972 wakaba 1.4 $link->set_attribute (resScheme => $scheme,
1973     namespace_uri => $NS_SW09);
1974     $link->set_attribute (resParameter => $data,
1975     namespace_uri => $NS_SW09);
1976 wakaba 1.1 } else { # URI Reference
1977 wakaba 1.4 $link->set_attribute (resScheme => 'URI',
1978     namespace_uri => $NS_SW09);
1979     $link->set_attribute (resParameter => $scheme.':'.$data,
1980     namespace_uri => $NS_SW09);
1981 wakaba 1.1 }
1982 wakaba 1.3 $link->append_text ($scheme.':'.$data);
1983 wakaba 1.1 } elsif ($$source =~ /\G__&&/gc) {
1984     if ($$source =~ /\G([^&]+)&&__/gc) {
1985     $current->append_new_node
1986     (type => '#element',
1987     namespace_uri => $NS_SW09,
1988 wakaba 1.2 local_name => 'replace')
1989 wakaba 1.1 ->set_attribute (by => $1);
1990     } else {
1991 wakaba 1.2 $current->append_text ('__&&');
1992 wakaba 1.1 }
1993     } elsif ($$source =~ /\G((?>
1994 wakaba 1.4 [^'\[\]<>_]+
1995 wakaba 1.1 | ' (?!')
1996 wakaba 1.4 | \[ (?!\[|[A-Z]+(?>\([^()\\]*
1997 wakaba 1.21 (?>[^()\\]+|\\.)*\))?
1998     (?>\@[A-Za-z0-9-]+)?\[)
1999 wakaba 1.1 | \] (?! \]
2000     | >>[0-9]+\]
2001     | <[0-9A-Za-z_+.%-]+:$Reg_URI_Opaque>\]
2002 wakaba 1.21 | \s*(?:\@[A-Za-z0-9-]+)?\[ )
2003 wakaba 1.1 | < (?![0-9A-Za-z_+.%-]+:$Reg_URI_Opaque>)
2004     | > (?!>[0-9])
2005     | _ (?!_&&)
2006     )+)/oxgc) {
2007     $current->append_text ($1);
2008     } elsif ($$source =~ /\G>>([0-9]+)/gc) {
2009     for ($current->append_new_node (type => '#element',
2010     namespace_uri => $NS_SW09,
2011 wakaba 1.2 local_name => 'anchor-internal')) {
2012 wakaba 1.4 $_->set_attribute (anchor => 0+$1,
2013     namespace_uri => $NS_SW09);
2014 wakaba 1.1 $_->append_text ('>>'.$1);
2015     }
2016     } else {
2017 wakaba 1.4 CORE::die "Implementation buggy: ", substr ($$source, pos $$source);
2018 wakaba 1.1 }
2019     }
2020    
2021 wakaba 1.2 FormattingRule:
2022 wakaba 1.3 @Category[list]:
2023     page-link
2024     link-to-resource
2025 wakaba 1.2 @Name: sw09--link-anchor-content
2026     @Description:
2027     @@@:
2028     Output content of the anchor element
2029     @@lang:en
2030     @Formatting:
2031     if ($o->{var}->{sw09__anchor_content}) {
2032     $o->{var}->{sw09__anchor_content}->($p->{-parent});
2033     } else {
2034 wakaba 1.9 $WIKIRESOURCE->append_tree
2035 wakaba 1.4 (name => 'Link:SuikaWiki/0.9:link-anchor-content:InvalidContext',
2036     param => $o,
2037     -parent => $p->{-parent},
2038     wiki => $o->{wiki});
2039 wakaba 1.2 }
2040    
2041     Resource:
2042     @Link:SuikaWiki/0.9:link-anchor-content:InvalidContext:
2043 wakaba 1.4 @@@: %percent;sw09--link-anchor-content; cannot be used in this context.
2044 wakaba 1.2 @@lang:en
2045 wakaba 1.3 @Link:SuikaWiki/0.9:toResource:SourceLabel:
2046     @@@:
2047     %select_link_resource_scheme (
2048     URI => {<%link-to-it(
2049     label=>{%link-resource-parameters;}p,
2050     );>},
2051 wakaba 1.15 IW => {%iw--source-label (default => {<%link-to-it (
2052     label => {%link-resource-scheme;:%link-resource-parameters;}p,
2053     );});},
2054 wakaba 1.3 MAIL => {<%link-to-it(
2055     label => {%link-resource-parameters;}p,
2056     description
2057     => {%res (name=>{Link:MailAddress=});<%link-resource-parameters;>}p,
2058     );>},
2059     otherwise => {<%link-to-it(
2060     label => {%sw09--link-anchor-content;}p,
2061     description => {%res (name=>{Link:URIReference=});<%uri-reference;>}p,
2062     );>},
2063     );
2064     @@lang:en
2065 wakaba 1.2 @Link:SuikaWiki/0.9:toWikiPage:SourceLabel:
2066     @@@:
2067     %link-to-it(
2068     label=>{%sw09--link-anchor-content;%if-linked-wikipage-exist(
2069     true=>{%if-link-has-dest-anchor-no(true=>{>>%link-dest-anchor-no;});},
2070     false=>{%res(name=>{Link:toWikiPage:NotExist:Mark});}
2071     );}p,
2072     description=>{%page-name(absolute);; %if-linked-wikipage-exist(
2073     true=>{%page-headline;},
2074     false=>{(%res(name=>{Link:toWikiPage:NotExist:Description});)},
2075     );}p,
2076     class=>{%if-linked-wikipage-exist(false=>{not-exist});}p,
2077     );
2078 wakaba 1.5 @SuikaWiki/0.9:form:comment:input:
2079     %line (content => {%textarea (id=>msg,size=>20,lines=>3);}p);
2080     %line (content => {
2081     (%text (description => {%res (name => {Form:Description:HumanName});}p,
2082     id => name, size => 6);
2083     [%text (description =>
2084     {%res (name => {Form:Description:MailAddress});}p,
2085     id => mail, size => 5);]
2086     %check (default, id => record-date,
2087     label => {%res (name => {Form:Label:LogDate});}p,
2088     description => {%res (name => {Form:Description:LogDate});}p);)
2089     %submit (label => {%res (name => {Form:Label:Add});}p,
2090     description => {%res (name => {Form:Description:Add});}p);
2091     %we--update-lastmodified-datetime;
2092     }p);
2093     @SuikaWiki/0.9:form:comment:template:
2094     %n
2095     ;[%index;]%n
2096     ;%text(source=>msg);%n;(%name;%text(source=>mail,prefix=>" [",suffix=>"]");%iif(source=>record-date,true=>" [WEAK[%date;]]");)%n;
2097     @SuikaWiki/0.9:form:comment:option:
2098     %require (msg);
2099     @SuikaWiki/0.9:form:footannotate:input:
2100     %line (content => {%textarea (id=>msg,size=>20,lines=>3);}p);
2101     %line (content => {
2102     (%text (description => {%res (name => {Form:Description:HumanName});}p,
2103     id => name, size => 6);
2104     [%text (description =>
2105     {%res (name => {Form:Description:MailAddress});}p,
2106     id => mail, size => 5);]
2107     %check (default, id => record-date,
2108     label => {%res (name => {Form:Label:LogDate});}p,
2109     description => {%res (name => {Form:Description:LogDate});}p);)
2110     %submit (label => {%res (name => {Form:Label:Add});}p,
2111     description => {%res (name => {Form:Description:Add});}p);
2112     %we--update-lastmodified-datetime;
2113     }p);
2114     @SuikaWiki/0.9:form:footannotate:template:
2115     %n
2116     ;[%index;]%n
2117     ;%text(source=>msg);%n
2118     ;(%name;%text(source=>mail,prefix=>" [",suffix=>"]");%iif(source=>record-date,true=>" [WEAK[%date;]]");)%n;
2119     @SuikaWiki/0.9:form:footannotate:option:
2120     %require (msg);
2121 wakaba 1.13 @WikiFormat:MediaType:Description:IMT:text/x-suikawiki;version="0.9"##:
2122     @@@: SuikaWiki/0.9 (text format), as used in SuikaWiki 2
2123     @@lang: en
2124 wakaba 1.16 @WikiFormat:MediaType:Description:IMT:text/x-suikawiki;version="0.10"##:
2125     @@@: SuikaWiki/0.10 (text format)
2126     @@lang: en
2127 wakaba 1.13 @WikiFormat:MediaType:Label:IMT:text/x-suikawiki;version="0.9"##:
2128 wakaba 1.16 @@@: SuikaWiki/0.9 (text)
2129     @@lang: en
2130     @WikiFormat:MediaType:Label:IMT:text/x-suikawiki;version="0.10"##:
2131     @@@: SuikaWiki/0.10 (text)
2132 wakaba 1.13 @@lang: en
2133     @WikiFormat:MediaType:Description:MAGIC:SuikaWiki/0.9##:
2134     @@@: SuikaWiki/0.9 (text format), as used in SuikaWiki 2
2135     @@lang: en
2136 wakaba 1.16 @WikiFormat:MediaType:Description:MAGIC:SuikaWiki/0.10##:
2137     @@@: SuikaWiki/0.10 (text format)
2138     @@lang: en
2139 wakaba 1.13 @WikiFormat:MediaType:Label:MAGIC:SuikaWiki/0.9##:
2140     @@@: SuikaWiki/0.9 (text format)
2141 wakaba 1.16 @@lang: en
2142     @WikiFormat:MediaType:Label:MAGIC:SuikaWiki/0.10##:
2143     @@@: SuikaWiki/0.10 (text)
2144 wakaba 1.13 @@lang: en
2145    
2146 wakaba 1.3
2147 wakaba 1.4 Error:
2148     @Name: text_parse
2149     @Definition:
2150     @@INLINE_NO_CLOSE_TAG:
2151     @@@description:
2152     Close tag of element "%t (name => element_type);" not found.
2153     @@@level: non-fatal
2154     @@BLOCK_NO_CLOSE_TAG:
2155     @@@description:
2156     Close tag of element "%t (name => element_type);" not found.
2157     @@@level: non-fatal
2158     @@INVALID_FORM:
2159     @@@description:
2160     Invalid syntax of WikiForm
2161     @@@level: non-fatal
2162    
2163     Error:
2164     @Name: xml_to_text
2165     @IsA[list]:
2166     ::SuikaWiki::Format::
2167     @Definition:
2168     @@
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24