/[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.10 - (hide annotations) (download)
Sat Mar 20 03:21:19 2004 UTC (20 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.9: +7 -4 lines
(Function[text_to_xml_inline]): Don't eat "] [" unless within RUBY or RUBYB or ABBR

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24