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