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