/[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.11 - (hide annotations) (download)
Mon Mar 29 03:21:24 2004 UTC (22 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.10: +19 -4 lines
2004-03-24  Wakaba  <wakaba@suika.fam.cx>

       * bugtrack.wp2 (Resource): Typo fixed.
       * SuikaWiki09.wp2 (Format/WikiForm): "required" field check implemented.

2004-03-20  Wakaba  <wakaba@suika.fam.cx>

       * calender.wp2 (FormattingRule[cal--year-page, cal--month-page, cal--day-p
age]): Defaults to "today".

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

[email protected]
ViewVC Help
Powered by ViewVC 1.1.24