/[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.12 - (hide annotations) (download)
Fri Apr 2 03:20:06 2004 UTC (20 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.11: +2 -1 lines
(Function): Set @class=anchor to XHTML correspond to anchor-end element

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24