/[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.3 - (hide annotations) (download)
Fri Dec 26 06:55:35 2003 UTC (20 years, 10 months ago) by wakaba
Branch: MAIN
Changes since 1.2: +53 -384 lines
Old code is removed

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     @License: %%GPL%%
9     @Author:
10     @@Name:
11     @@@@: Wakaba
12     @@@lang:ja
13     @@@script:Latn
14     @@Mail[list]: w@suika.fam.cx
15 wakaba 1.3 @Date.RCS: $Date: 2003/12/13 04:53:59 $
16 wakaba 1.1 @RequiredPlugin[list]:
17 wakaba 1.2 WikiLinking
18 wakaba 1.1 @Use:
19     use Message::Markup::XML::QName qw/NS_xml_URI/;
20     my $Reg_Form_Content_M = qr{
21     \ \#form
22     \ (?:
23     \ \( (\w+) \) ## id
24     \ )?
25     \ : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## input
26     \ (?: : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' ## template
27     \ (?: : ' ((?>[^\\']*)(?>(?>[^\\']+|\\.)*)) ' )? )? ## option
28     }x;
29     my $Reg_Embed_Content_M = qr{
30     \ \#([a-z-]+)
31     \ (?>
32     \ \( (\w+) \) ## id
33     \ )?
34     \ (?>
35     \ : ( \w+ (?> : \w+ )* ) ## parameter
36     \ )?
37     }x;
38     my $Reg_URI_Opaque = qr{
39     \ (?>[^<>"]*)
40     \ (?>
41     \ (?>
42     \ [^<>"]+
43     \ | "(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"
44     \ )*
45     \ )
46     }x;
47    
48 wakaba 1.2 PluginConst:
49     @NS_SW09:
50     urn:x-suika-fam-cx:markup:suikawiki:0:9:
51     @NS_HTML3:
52     urn:x-suika-fam-cx:markup:ietf:html:3:draft:00:
53     @NS_XHTML1:
54     http://www.w3.org/1999/xhtml
55     @NS_XHTML2:
56     http://www.w3.org/2002/06/xhtml2
57    
58 wakaba 1.1 Format:
59     @ModuleName:
60     SuikaWiki::V0
61     @Description:
62     @@@: Dummy base format for SuikaWiki/0.*
63     @@lang:en
64     @Inherit[list]:
65     Text::Plain
66    
67     Format:
68     @Name: SuikaWiki
69     @Version: 0.9
70     @Type:
71     @@@: text/x-suikawiki
72     @@version: 0.9
73     @ModuleName:
74     SuikaWiki::V0_9
75     @Inherit[list]:
76     SuikaWiki::V0
77     @Description:
78     @@@: SuikaWiki/0.9 document format (Standard document format for SuikaWiki 2)
79     @@lang:en
80 wakaba 1.2
81     @Use:
82     use Message::Markup::XML::QName qw/NS_xml_URI/;
83 wakaba 1.1
84     @Converter:
85     @@Type: text/html
86     @@IsFragment: 1
87     @@Description:
88     @@@@: Converting SuikaWiki/0.9 to Hypertext Markup Language fragment
89     @@@lang:en
90     @@Main:
91 wakaba 1.2 # __FUNCPACK__->to_html ($source, %$opt);
92     ## Text format -> XML format
93     my $xml = new Message::Markup::XML::Node type => '#fragment';
94     __FUNCPACK__->text_to_xml ($source, {%$opt, -parent => $xml});
95    
96     my ($apply_template, $apply_template_children);
97     $apply_template_children = sub {
98     my ($parent, $result) = @_;
99     for (@{$parent->child_nodes}) {
100     $apply_template->($_ => $result) unless $_->node_type eq '#attribute';
101     }
102     };
103     $apply_template = sub {
104     my ($source, $result) = @_;
105     my $ln = $source->local_name;
106     if ($source->node_type eq '#text') {
107     $result->append_text ($source->inner_text);
108     } elsif ({qw/code 1 samp 1 var 1 dfn 1 kbd 1 sub 1 sup 1/}->{$ln}) {
109     my $node = $result->append_new_node
110     (type => '#element',
111     namespace_uri => $NS_XHTML1,
112     local_name => $ln);
113     my $class = $source->get_attribute_value ('class', default => '');
114     $node->set_attribute (class => $class) if $class;
115     $apply_template_children->($source => $node);
116     } elsif ({qw/ins 1 del 1/}->{$ln}) {
117     my $node = $result->append_new_node
118     (type => '#element',
119     namespace_uri => $NS_XHTML1,
120     local_name => $ln);
121     my $class = $source->get_attribute_value ('class', default => '');
122     $node->set_attribute (class => $class) if $class;
123     ## TODO: cite
124     $apply_template_children->($source => $node);
125     } elsif ({qw/table 1 tbody 1 tr 1 td 1 blockquote 1 ul 1 ol 1
126     li 1 pre 1 dl 1 dt 1 dd 1 em 1 strong 1/}->{$ln}) {
127     my $node = $result->append_new_node
128     (type => '#element',
129     namespace_uri => $NS_XHTML1,
130     local_name => $ln);
131     if ($ln eq 'td') {
132     my $colspan = $source->get_attribute_value ('colspan', default => 0);
133     $node->set_attribute (colspan => $colspan) if $colspan;
134     } elsif ($ln eq 'pre') {
135     $node->set_attribute (space => 'preserve',
136     namespace_uri => NS_xml_URI);
137     }
138     $apply_template_children->($source => $node);
139     } elsif ($ln eq 'anchor') {
140     local $opt->{o}->{var}->{sw09__anchor_content} = sub {
141     $apply_template_children->($source => shift);
142     };
143     SuikaWiki::Plugin->module_package ('WikiLinking')
144     ->to_wikipage_in_html ({
145     label => SuikaWiki::Plugin->resource
146     ('Link:SuikaWiki/0.9:toWikiPage:SourceLabel'),
147     } => {
148     ## TODO:
149     page_name_relative => [split m#//#, $source->inner_text],
150     page_anchor_no => $source->get_attribute_value ('anchor'),
151     }, {
152     o => $opt->{o},
153     parent => $result,
154     });
155     } elsif ($ln eq 'p') {
156     $apply_template_children->($source => $result->append_new_node
157     (type => '#element',
158     namespace_uri => $NS_XHTML1,
159     local_name => 'p'));
160     } elsif ($ln eq 'h') {
161     my $node;
162     if ($opt->{o}->{var}->{ws__section_depth} > 6) {
163     $node = $result->append_new_node
164     (type => '#element',
165     namespace_uri => $NS_XHTML1,
166     local_name => 'div');
167     $node->set_attribute (class => 'heading h'.$opt->{o}->{var}
168     ->{ws__section_depth});
169     } else {
170     $node = $result->append_new_node
171     (type => '#element',
172     namespace_uri => $NS_XHTML1,
173     local_name => 'h'.$opt->{o}->{var}
174     ->{ws__section_depth});
175     }
176     $apply_template_children->($source => $node);
177     } elsif ($ln eq 'ruby' or $ln eq 'rubyb') {
178     my @child;
179     for (@{$source->child_nodes}) {
180     if ({qw/rb 1 rt 1/}->{$_->local_name}) {
181     push @child, $_;
182     }
183     }
184     for ($result->append_new_node (type => '#element',
185     namespace_uri => $NS_XHTML1,
186     local_name => 'ruby')) {
187     if ($ln eq 'rubyb') {
188     my $class = join ' ',
189     'descriptive',
190     split /\s+/, $source->get_attribute_value
191     ('class', default => '');
192     $_->set_attribute (class => $class) if $class;
193     } else {
194     my $class = $source->get_attribute_value ('class', default => '');
195     $_->set_attribute (class => $class) if $class;
196     }
197     $apply_template_children->($child[0]
198     => $_->append_new_node (type => '#element',
199     namespace_uri => $NS_XHTML1,
200     local_name => 'rb'));
201     $_->append_new_node (type => '#element',
202     namespace_uri => $NS_XHTML1,
203     local_name => 'rp')
204     ->append_text ('(');
205     if ($child[1]) {
206     $apply_template_children->($child[1]
207     => $_->append_new_node (type => '#element',
208     namespace_uri => $NS_XHTML1,
209     local_name => 'rt'));
210     } else {
211     $_->append_new_node (type => '#element',
212     namespace_uri => $NS_XHTML1,
213     local_name => 'rt');
214     }
215     if ($child[2]) {
216     $_->append_new_node (type => '#element',
217     namespace_uri => $NS_XHTML1,
218     local_name => 'rp')
219     ->append_text ('/');
220     $apply_template_children->($child[2]
221     => $_->append_new_node (type => '#element',
222     namespace_uri => $NS_XHTML1,
223     local_name => 'rt'));
224     }
225     $_->append_new_node (type => '#element',
226     namespace_uri => $NS_XHTML1,
227     local_name => 'rp')
228     ->append_text (')');
229     }
230     } elsif ($ln eq 'abbr') {
231     my (@b);
232     for (@{$source->child_nodes}) {
233     push @b, $_ if {qw/rb 1 rt 1/}->{$_->local_name};
234     }
235     my $node = $result->append_new_node
236     (type => '#element',
237     namespace_uri => $NS_XHTML1,
238     local_name => 'abbr');
239     $node->set_attribute (title => $b[1]->inner_text) if $b[1];
240     $apply_template_children->($b[0] => $node);
241     } elsif ($ln eq 'q') {
242     my $node = $result->append_new_node
243     (type => '#element',
244     namespace_uri => $NS_XHTML1,
245     local_name => 'q');
246     ## TODO: cite
247     $apply_template_children->($source => $node);
248     } elsif ($ln eq 'weak') {
249     my $node = $result->append_new_node
250     (type => '#element',
251     namespace_uri => $NS_XHTML1,
252     local_name => 'span');
253     $node->set_attribute (class => 'weak');
254     $apply_template_children->($source => $node);
255     } elsif ({qw/section 1 bodytext 1/}->{$ln}) {
256     my $node = $result->append_new_node
257     (type => '#element',
258     namespace_uri => $NS_XHTML1,
259     local_name => 'div');
260     $node->set_attribute (class => $ln);
261     local $opt->{o}->{var}->{ws__section_depth}
262     = $opt->{o}->{var}->{ws__section_depth} + 1;
263     $apply_template_children->($source => $node);
264     } elsif ($ln eq 'anchor-end') {
265     my $node = $result->append_new_node
266     (type => '#element',
267     namespace_uri => $NS_XHTML1,
268     local_name => 'a');
269     $node->set_attribute (id => 'anchor-'.$source->get_attribute_value
270     ('anchor', default => '0'));
271     $node->append_text ($source->inner_text);
272     } elsif ($ln eq 'anchor-internal') {
273     my $node = $result->append_new_node
274     (type => '#element',
275     namespace_uri => $NS_XHTML1,
276     local_name => 'a');
277     $node->set_attribute (href => '#anchor-'.$source->get_attribute_value
278     ('anchor', default => '0'));
279     $node->set_attribute (class => 'wiki-anchor');
280     $node->append_text ($source->inner_text);
281 wakaba 1.3 } elsif ($ln eq 'anchor-external') {
282     local $opt->{o}->{var}->{sw09__anchor_content} = sub {
283     $apply_template_children->($source => shift);
284     };
285     SuikaWiki::Plugin->module_package ('WikiLinking')
286     ->to_resource_in_html (
287     {
288     label => SuikaWiki::Plugin->resource
289     ('Link:SuikaWiki/0.9:toResource:SourceLabel'),
290     }, {
291     resource_scheme =>
292     $source->get_attribute_value ('scheme',
293     default => 'URI'),
294     resource_parameter =>
295     $source->get_attribute_value ('data', default => ''),
296     }, {
297     o => $opt->{o},
298     parent => $result,
299     });
300 wakaba 1.2 } elsif ($ln eq 'dr') {
301     $apply_template_children->($source => $result);
302     } elsif ($ln eq 'document') {
303     my $body;
304     for (@{$source->child_nodes}) {
305     $body = $_ and last if $_->local_name eq 'body';
306     }
307     my $body_block = $result->append_new_node
308     (type => '#element',
309     namespace_uri => $NS_XHTML1,
310     local_name => 'div');
311     $body_block->set_attribute (class => 'block SuikaWiki-0-9');
312     local $opt->{o}->{var}->{ws__section_depth}
313     = $opt->{o}->{var}->{ws__section_depth} + 1;
314     $apply_template_children->($body => $body_block);
315     } else {
316     my $node = $result->append_new_node
317     (type => '#element',
318     namespace_uri => $NS_XHTML1,
319     local_name => 'span');
320     $node->set_attribute (class => 'warn');
321     for ($node->append_new_node
322     (type => '#element',
323     namespace_uri => $NS_XHTML1,
324     local_name => 'ins')
325     ->append_new_node
326     (type => '#element',
327     namespace_uri => $NS_XHTML1,
328     local_name => 'code')) {
329     $_->set_attribute (class => 'XML element');
330     $_->append_text ("<".$source->namespace_uri.">:$ln");
331     }
332     $apply_template_children->($source => $node);
333     }
334     };
335    
336     $apply_template_children->($xml => $opt->{-parent});
337    
338 wakaba 1.1
339     @Converter:
340     @@Type:
341     @@@@: application/x-suikawiki+xml
342     @@@version: 0.9
343     @@Description:
344     @@@@: Converting SuikaWiki/0.9 text format to XML format
345     @@@lang: en
346     @@Main:
347     __FUNCPACK__->text_to_xml ($source, $opt);
348    
349     Function:
350     @Name: text_to_xml
351     @Description:
352     @@@:
353     Converting SuikaWiki/0.9 text format to XML representation
354     @@lang: en
355     @Main:
356     my (undef, $source, $opt) = @_;
357     $source =~ s/\x0D\x0A/\x0A/g;
358     $source =~ tr/\x0D/\x0A/;
359     $source .= "\x0A";
360     my $root = $opt->{-parent}
361     ->append_new_node (type => '#element',
362     namespace_uri => $NS_SW09,
363     local_name => 'document');
364     my $head = $root->append_new_node (type => '#element',
365     namespace_uri => $NS_XHTML2,
366     local_name => 'head');
367     if ($source =~ s#^\#\?SuikaWiki/0\.9\b((?>.*))\s*##) {
368     my $param = $1;
369     while ($param =~ /\G\s+([a-z-]+)="((?>[^"\\]*)(?>(?>[^"\\]+|\\.)*))"/g) {
370     my ($name, $value) = ($1, $2);
371     $value =~ s/\\(.)/$1/g;
372     for ($head->append_new_node (type => '#element',
373     namespace_uri => $NS_SW09,
374     local_name => 'parmeter')) {
375     $_->set_attribute (name => $name);
376     for my $value (split /,/, $value) {
377     $_->append_new_node (type => '#element',
378     namespace_uri => $NS_SW09,
379     local_name => 'value')
380     ->append_text ($value);
381     }
382     }
383     $head->append_text ("\x0A");
384     }
385     } else {
386     ## TODO: warn
387     }
388     $root->append_text ("\x0A");
389    
390     my $body = $root->append_new_node (type => '#element',
391     namespace_uri => $NS_XHTML2,
392     local_name => 'body');
393     __FUNCPACK__->block_text_to_xml (\$source => $body);
394    
395     Function:
396     @Name:block_text_to_xml
397     @Description:
398     @@@:
399     SuikaWiki/0.9 text format to XML representation convertion - block
400     level elements
401     @@lang:en
402     @Main:
403     my (undef, $source, $current, %opt) = @_;
404     my %depth;
405     my $back_to_section = sub {
406     my $cur_type = $current->local_name;
407     while (not (
408     $cur_type eq 'section'
409     or $cur_type eq 'body'
410     or $cur_type eq 'bodytext'
411     or $cur_type eq 'ins'
412     or $cur_type eq 'del'
413     )
414     ) {
415     $current = $current->parent_node;
416     $cur_type = $current->local_name;
417     }
418     delete $depth{list};
419     };
420     my $back_to_real_section = sub {
421     my $cur_type = $current->local_name;
422     while (not (
423     $cur_type eq 'section'
424     or $cur_type eq 'body'
425     or $cur_type eq 'ins'
426     or $cur_type eq 'del'
427     )
428     ) {
429     $current = $current->parent_node;
430     $cur_type = $current->local_name;
431     }
432     delete $depth{bq};
433     delete $depth{list};
434     };
435     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
436     my $line = $1;
437     if ($line eq '') {
438     $back_to_real_section->();
439     } elsif ($line =~ s/^([-=]+)\s*//) {
440     my $list_type = substr ($1, -1) eq '-' ? 'ul' : 'ol';
441     my $depth = length $1;
442     my $parent_type = $current->parent_node->local_name;
443     ## Parent node is list element
444     if ($parent_type eq 'ul' or $parent_type eq 'ol') {
445     if ($depth{list} == $depth) {
446     if ($parent_type eq $list_type) {
447     $current = $current->parent_node;
448     } else {
449     $current = $current->parent_node
450     ->parent_node
451     ->append_new_node
452     (type => '#element',
453     namespace_uri => $NS_XHTML2,
454     local_name => $list_type);
455     }
456     } elsif ($depth < $depth{list}) {
457     for ($depth+1..$depth{list}) {
458     $current = $current->parent_node->parent_node;
459     }
460     $current = $current->parent_node;
461     if ($current->local_name ne $list_type) {
462     $current = $current->parent_node
463     ->append_new_node
464     (type => '#element',
465     namespace_uri => $NS_XHTML2,
466     local_name => $list_type);
467     }
468     $depth{list} = $depth;
469     } else { # $depth{list} < $depth
470     $current = $current->append_new_node
471     (type => '#element',
472     namespace_uri => $NS_XHTML2,
473     local_name => $list_type);
474     $depth{list}++;
475     }
476     ## Parent node is non-list element
477     } else {
478     $current = $current->append_new_node (type => '#element',
479     namespace_uri => $NS_XHTML2,
480     local_name => $list_type);
481     $depth{list} = 1;
482     }
483     $current->append_text ("\x0A".(" " x $depth{list}));
484     $current = $current->append_new_node (type => '#element',
485     namespace_uri => $NS_XHTML2,
486     local_name => 'li');
487     __FUNCPACK__->inline_text_to_xml (\$line => $current);
488     } elsif ($line =~ s/^(\*+)\s*//) {
489     my $depth = length $1;
490     $back_to_real_section->();
491     if ($depth <= $depth{section}) {
492     for ($depth..$depth{section}) {
493     $back_to_real_section->();
494     $current = $current->parent_node;
495     }
496     $depth{section} = $depth;
497     } else { # $depth{section} < $depth
498     for ($depth{section}+2..$depth) {
499     $current = $current->append_new_node
500     (type => '#element',
501     namespace_uri => $NS_XHTML2,
502     local_name => 'section');
503     }
504     $depth{section} = $depth;
505     }
506     $current = $current->append_new_node
507     (type => '#element',
508     namespace_uri => $NS_XHTML2,
509     local_name => 'section');
510     __FUNCPACK__->inline_text_to_xml (\$line =>
511     $current->append_new_node (type => '#element',
512     namespace_uri => $NS_XHTML2,
513     local_name => 'h')
514     );
515     } elsif ($line =~ s/^(?!>>[0-9])(>+)\s*//) {
516     my $depth = length $1;
517     if ($depth <= $depth{bq}) {
518     for ($depth+1..$depth{bq}) {
519     $back_to_section->();
520     $current = $current->parent_node->parent_node;
521     }
522     $back_to_section->();
523     $current->append_text ("\x0A");
524     $depth{bq} = $depth;
525     } else { # $depth{bq} < $depth
526     $back_to_section->();
527     for ($depth{bq}+1..$depth) {
528     $current = $current->append_new_node
529     (type => '#element',
530     namespace_uri => $NS_XHTML2,
531     local_name => 'blockquote')
532     ->append_new_node
533     (type => '#element',
534     namespace_uri => $NS_HTML3,
535     local_name => 'bodytext');
536     $current->append_text ("\x0A");
537     }
538     $depth{bq} = $depth;
539     }
540     if (length $line) {
541     $current = $current->append_new_node
542     (type => '#element',
543     namespace_uri => $NS_XHTML2,
544     local_name => 'p');
545     __FUNCPACK__->inline_text_to_xml (\$line => $current);
546     }
547     } elsif ($line =~ s/^(?>:\s*)([^:]+?)\s*:\s*//) {
548     my $parent_type = $current->local_name;
549     if ($parent_type eq 'dd') {
550     $current = $current->parent_node->parent_node;
551     $current->append_text ("\x0A");
552     } else { #if ($parent_type ne 'dl') {
553     $current = $current->append_new_node (type => '#element',
554     namespace_uri => $NS_XHTML2,
555     local_name => 'dl');
556     }
557     $current = $current->append_new_node
558     (type => '#element',
559     namespace_uri => $NS_SW09,
560     local_name => 'dr');
561     __FUNCPACK__->inline_text_to_xml (\"$1" =>
562     $current->append_new_node (type => '#element',
563     namespace_uri => $NS_XHTML2,
564     local_name => 'dt')
565     );
566     $current->append_text ("\x0A");
567     $current = $current->append_new_node (type => '#element',
568     namespace_uri => $NS_XHTML2,
569     local_name => 'dd');
570     __FUNCPACK__->inline_text_to_xml (\$line => $current);
571     } elsif ($line =~ /^\[(INS|DEL)(\([^()\\]*\))?\[\s*$/) {
572     $current->append_text ("\x0A");
573     my $mod = $current->append_new_node (type => '#element',
574     namespace_uri => $NS_XHTML1,
575     local_name => lc $1);
576     $mod->set_attribute (class => $2) if $2;
577     __FUNCPACK__->block_text_to_xml ($source => $mod,
578     'return_by_'.$1 => 1);
579     } elsif ($line =~ /^\](INS|DEL)\]\s*$/) {
580     if ($opt{'return_by_'.$1}) {
581     return;
582     } else {
583     ## TODO: warn
584     }
585     } elsif ($line =~ /^\[PRE(\([^()\\]*\))?\[\s*$/) {
586     $current->append_text ("\x0A");
587     my $pre = $current->append_new_node (type => '#element',
588     namespace_uri => $NS_XHTML1,
589     local_name => 'pre');
590     $pre->set_attribute (class => $1) if $1;
591     $pre->set_attribute (space => 'preserve', namespace_uri => NS_xml_URI);
592     my $f = 1;
593     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
594     my $line = $1;
595     if ($line =~ /^\]PRE\]\s*$/) {
596     undef $pre;
597     last;
598     } else {
599     $f ? undef $f : $pre->append_text ("\x0A");
600     __FUNCPACK__->inline_text_to_xml (\$line => $pre);
601     }
602     }
603     if (ref $pre) {
604     # warn unmatched start-tag
605     }
606     } elsif ($line =~ /^\s/) {
607     $current->append_text ("\x0A");
608     my $pre = $current->append_new_node (type => '#element',
609     namespace_uri => $NS_XHTML1,
610     local_name => 'pre');
611     $pre->set_attribute (space => 'preserve', namespace_uri => NS_xml_URI);
612     __FUNCPACK__->inline_text_to_xml (\$line => $pre);
613     while ($$source =~ /\G([^\x0A]*)\x0A/gc) {
614     my $line = $1;
615     if (length $line == 0) {
616     pos ($$source) -= 1;
617     last;
618     } else {
619     $pre->append_text ("\x0A");
620     __FUNCPACK__->inline_text_to_xml (\$line => $pre);
621     }
622     }
623     } elsif ($line =~ /^,/) {
624     $current->append_text ("\x0A");
625     my $tbody = $current->append_new_node (type => '#element',
626     namespace_uri => $NS_XHTML2,
627     local_name => 'table')
628     ->append_new_node (type => '#element',
629     namespace_uri => $NS_XHTML2,
630     local_name => 'tbody');
631     __FUNCPACK__->tablerow_text_to_xml (\$line => $tbody);
632     while ($$source =~ /\G(,[^\x0A]*)\x0A/gc) {
633     __FUNCPACK__->tablerow_text_to_xml (\"$1" => $tbody);
634     }
635     } else {
636     my $current_type = $current->local_name;
637     if ($current_type eq 'section'
638     or $current_type eq 'body'
639     or $current_type eq 'bodytext'
640     or $current_type eq 'ins'
641     or $current_type eq 'del') {
642     $current->append_text ("\x0A");
643     if ($line =~ s/^__&&([^&]+)&&__//) {
644     $current->append_new_node (type => '#element',
645     namespace_uri => $NS_SW09,
646     local_name => 'replace')
647     ->set_attribute (by => $1);
648     } elsif ($line =~ s/^\[\[$Reg_Form_Content_M\]\]//o) {
649     for ($current->append_new_node (type => '#element',
650     namespace_uri => $NS_SW09,
651     local_name => 'form')) {
652     $_->set_attribute (id => $1) if $1;
653     my ($i, $t, $o) = ($2, $3 || '', $4 || '');
654     s/\\(.)/$1/g for $i, $t, $o;
655     $_->set_attribute (input => $i);
656     $_->set_attribute (template => $t);
657     $_->set_attribute (option => $o);
658     }
659     } elsif ($line =~ s/^\[\[$Reg_Embed_Content_M\]\]//o) {
660     for ($current->append_new_node (type => '#element',
661     namespace_uri => $NS_SW09,
662     local_name => 'form')) {
663     $_->set_attribute (ref => $1);
664     $_->set_attribute (id => $2) if $2;
665     $_->set_attribute (parameter => $3) if defined $3;
666     }
667     }
668     $current = $current->append_new_node
669     (type => '#element',
670     namespace_uri => $NS_XHTML2,
671     local_name => 'p');
672     __FUNCPACK__->inline_text_to_xml (\$line => $current);
673     } else {
674     $current->append_text (" "); # replacement of prev.line's \n
675     __FUNCPACK__->inline_text_to_xml (\$line => $current);
676     }
677     }
678     }
679    
680     if ($opt{return_by_INS} or $opt{return_by_DEL}) {
681     # warn
682     }
683    
684     Function:
685     @Name: tablerow_text_to_xml
686     @Description:
687     @@@:
688     SuikaWiki/0.9 text format to XML representation - table row
689     @@lang:en
690     @Main:
691     my (undef, $source => $current, %opt) = @_;
692     $current->append_text ("\x0A");
693     $current = $current->append_new_node (type => '#element',
694     namespace_uri => $NS_XHTML2,
695     local_name => 'tr');
696     my $prev_cell;
697     while ($$source =~ /\G,\s*/gc) {
698     $$source =~ /\G([^,"]+|"(?>[^"\\]*)(?>(?>[^"\\]+|\\.)*)"\s*)/gc;
699     my $cell = $1;
700     if ($cell =~ s/^"//) {
701     $cell =~ s/"\s*$//g;
702     $cell =~ s/\\(.)/$1/g;
703     } else {
704     $cell =~ s/\s+$//g;
705     if ($cell eq '==') {
706     if (ref $prev_cell) {
707     $prev_cell->set_attribute (colspan =>
708     $prev_cell->get_attribute_value ('colspan', default => 1)
709     + 1);
710     next;
711     } else {
712     # TODO: warn
713     }
714     }
715     }
716     $prev_cell = $current->append_new_node
717     (type => '#element',
718     namespace_uri => $NS_XHTML2,
719     local_name => 'td');
720     __FUNCPACK__->inline_text_to_xml (\$cell => $prev_cell);
721     }
722     # TODO: warn
723    
724     Function:
725     @Name: inline_text_to_xml
726     @Description:
727     @@@:
728     SuikaWiki/0.9 text format to XML representation - inline level elements
729     @@lang:en
730     @Main:
731     my $ElementDef = {
732     ABBR => {ln => 'abbr', ns_uri => $NS_SW09},
733     CODE => {ln => 'code', ns_uri => $NS_XHTML2},
734     DEL => {ln => 'del', ns_uri => $NS_XHTML1},
735     DFN => {ln => 'dfn', ns_uri => $NS_XHTML2},
736     INS => {ln => 'ins', ns_uri => $NS_XHTML1},
737     KBD => {ln => 'kbd', ns_uri => $NS_XHTML2},
738     Q => {ln => 'q', ns_uri => $NS_XHTML1},
739     RUBY => {ln => 'ruby', ns_uri => $NS_XHTML2},
740     RUBYB => {ln => 'rubyb', ns_uri => $NS_SW09},
741     SAMP => {ln => 'samp', ns_uri => $NS_XHTML2},
742     SUB => {ln => 'sub', ns_uri => $NS_XHTML2},
743     SUP => {ln => 'sup', ns_uri => $NS_XHTML2},
744     VAR => {ln => 'var', ns_uri => $NS_XHTML2},
745     WEAK => {ln => 'weak', ns_uri => $NS_SW09},
746     anchor => {ln => 'anchor', ns_uri => $NS_SW09, has_fragment_no => 1},
747     del => {has_cite => 1},
748     ins => {has_cite => 1},
749     q => {has_cite => 1},
750     rb => {ln => 'rb', ns_uri => $NS_XHTML2, is_nested => 1},
751     rt => {ln => 'rt', ns_uri => $NS_XHTML2, is_nested => 1},
752     };
753    
754     my (undef, $source => $current, %opt) = @_;
755     if ($$source =~ /\G\[([0-9]+)\]/gc) {
756     for ($current->append_new_node (type => '#element',
757     namespace_uri => $NS_SW09,
758     local_name => 'anchor-end')) {
759 wakaba 1.2 $_->set_attribute (anchor => 0+$1);
760 wakaba 1.1 $_->append_text ('['.$1.']');
761     }
762     }
763     my $depth = 0;
764     while (pos $$source < length $$source) {
765     if ($$source =~ /\G\[\[(?=\#)/gc) {
766     my $form = $current->append_new_node (type => '#element',
767     namespace_uri => $NS_SW09,
768     local_name => 'form');
769     if ($$source =~ /\G$Reg_Form_Content_M\]\]/ogc) {
770     $form->set_attribute (id => $1) if $1;
771     $form->set_attribute (input => $2);
772     $form->set_attribute (template => $3);
773     $form->set_attribute (option => $4);
774     } elsif ($$source =~ /\G$Reg_Embed_Content_M\]\]/ogc) {
775     $form->set_attribute (ref => $1);
776     $form->set_attribute (id => $2) if $2;
777     $form->set_attribute (parameter => $3) if defined $3;
778     } else {
779     ## TODO: error
780     CORE::die $$source;
781     }
782     } elsif ($$source =~ /\G\[(?>([A-Z]+)(?>\(([^)]*)\))?)?\[/gc) {
783     my $type = $1 || 'anchor';
784     my $param = $2;
785     my $def = $ElementDef->{ $type };
786     unless ($def) {
787     ## TODO: error
788     }
789     $current = $current->append_new_node (type => '#element',
790     namespace_uri => $def->{ns_uri},
791     local_name => $def->{ln});
792     $current->set_attribute (class => $param) if $param;
793     if ($type eq 'RUBY' or $type eq 'RUBYB'
794     or $type eq 'ABBR') {
795     $current = $current->append_new_node
796     (type => '#element',
797     namespace_uri => $ElementDef->{rb}->{ns_uri},
798     local_name => $ElementDef->{rb}->{ln});
799     }
800     $depth++;
801     } elsif ($$source =~ /\G\](?> <([0-9A-Za-z_+.%-]+):($Reg_URI_Opaque)>
802     \ | >>([0-9]+) )?
803     \ \]/gcox) {
804     my ($scheme, $opaque, $anchor) = ($1, $2, $3);
805     unless ($depth) {
806     $current->append_text (substr ($$source, $-[0], $+[0]-$-[0]));
807     next;
808     }
809     my $def = $ElementDef->{$current->local_name} || {};
810     if (defined $anchor) {
811     if ($def->{has_fragment_no}) {
812     $current->set_attribute (anchor => $anchor + 0);
813     } else {
814     $current->set_attribute (anchor => $anchor + 0,
815     namespace_uri => $NS_SW09);
816     }
817     } elsif (defined $scheme) {
818     if ($def->{has_cite}) {
819     $current->set_attribute (cite => "$scheme:$opaque");
820     } else {
821     $current->set_attribute (cite => "$scheme:$opaque",
822     namespace_uri => $NS_SW09);
823     }
824     }
825     $current = $current->parent_node;
826     $current = $current->parent_node if $def->{is_nested};
827     $depth--;
828     } elsif ($$source =~ /\G\]\s+\[/gc) {
829     if ($current->local_name eq 'rb' or $current->local_name eq 'rt') {
830     $current = $current->parent_node
831     ->append_new_node
832     (type => '#element',
833     namespace_uri => $ElementDef->{rt}->{ns_uri},
834     local_name => $ElementDef->{rt}->{ln});
835     } else {
836     $current->append_text ($$source, $-[0], $+[0]-$-[0]);
837     }
838     } elsif ($$source =~ /\G'''?/gc) {
839     my $type = $+[0] - $-[0] == 3 ? 'strong' : 'em';
840     if ($current->local_name eq $type) {
841     $current = $current->parent_node;
842     } else {
843     $current = $current->append_new_node
844     (type => '#element',
845     namespace_uri => $NS_XHTML2,
846     local_name => $type);
847     }
848     } elsif ($$source =~ /\G<([0-9A-Za-z_+.%-]+):($Reg_URI_Opaque)>/gc) {
849     my ($scheme, $data) = ($1, $2);
850     my $link = $current->append_new_node
851     (type => '#element',
852     namespace_uri => $NS_SW09,
853 wakaba 1.2 local_name => 'anchor-external');
854 wakaba 1.1 if (substr ($scheme, 0, 1) =~ /[A-Z]/) {
855     $link->set_attribute (scheme => $scheme);
856     $link->set_attribute (data => $data);
857     } else { # URI Reference
858 wakaba 1.3 $link->set_attribute (scheme => 'URI');
859     $link->set_attribute (data => $scheme.':'.$data);
860 wakaba 1.1 }
861 wakaba 1.3 $link->append_text ($scheme.':'.$data);
862 wakaba 1.1 } elsif ($$source =~ /\G__&&/gc) {
863     if ($$source =~ /\G([^&]+)&&__/gc) {
864     $current->append_new_node
865     (type => '#element',
866     namespace_uri => $NS_SW09,
867 wakaba 1.2 local_name => 'replace')
868 wakaba 1.1 ->set_attribute (by => $1);
869     } else {
870 wakaba 1.2 $current->append_text ('__&&');
871 wakaba 1.1 }
872     } elsif ($$source =~ /\G((?>
873     [^'\[\]<>]+
874     | ' (?!')
875     | \[ (?![A-Z\[])
876     | \] (?! \]
877     | >>[0-9]+\]
878     | <[0-9A-Za-z_+.%-]+:$Reg_URI_Opaque>\]
879     | \s*\[ )
880     | < (?![0-9A-Za-z_+.%-]+:$Reg_URI_Opaque>)
881     | > (?!>[0-9])
882     | _ (?!_&&)
883     )+)/oxgc) {
884     $current->append_text ($1);
885     } elsif ($$source =~ /\G>>([0-9]+)/gc) {
886     for ($current->append_new_node (type => '#element',
887     namespace_uri => $NS_SW09,
888 wakaba 1.2 local_name => 'anchor-internal')) {
889     $_->set_attribute (anchor => 0+$1);
890 wakaba 1.1 $_->append_text ('>>'.$1);
891     }
892     } else {
893     die "Implementation buggy: ", substr ($$source, pos $$source);
894     }
895     }
896    
897 wakaba 1.3 OldFunction:
898     @Name: embedded_to_html
899 wakaba 1.1 @Main:
900 wakaba 1.3
901 wakaba 1.1 my ($embedded, $bPage) = @_;
902     my $CommentIndex = SuikaWiki::Plugin->new_index ('sw09--comment');
903     if ($embedded eq '[[#comment]]' or $embedded eq '[[#rcomment]]') {
904     unless ($main::_EMBEDED) {
905     my $lastmodified = SuikaWiki::Plugin->get_data (lastmodified => [split m!//!, $bPage]);
906 wakaba 1.3 return <<"EOD:";
907 wakaba 1.1 <form action="@{[SuikaWiki::Plugin->uri ('wiki')]}" method="post" id="x-comment-@{[$CommentIndex]}" class="comment"><p>
908     <input type="hidden" name="mycmd" value="comment" />
909     <input type="hidden" name="mypage" value="@{[SuikaWiki::Plugin->escape($bPage)]}" />
910     <input type="hidden" name="myLastModified" value="$lastmodified" />
911     <input type="hidden" name="mytouch" value="on" />
912     <input type="hidden" name="comment_index" value="$CommentIndex" />
913     \ @{[SuikaWiki::Plugin->resource('WikiForm:WikiComment:Name=',escape=>1)]}
914     <input type="text" name="myname" value="" size="10" class="comment-name" />
915     <input type="text" name="mymsg" value="" size="30" class="comment-msg" />
916     <input type="submit" value="@{[SuikaWiki::Plugin->resource('WikiForm:Add',escape=>1)]}" title="@{[SuikaWiki::Plugin->resource('WikiForm:AddLong',escape=>1)]}" class="comment-submit" />
917     </p></form>
918 wakaba 1.3 EOD:
919 wakaba 1.1 } else {
920 wakaba 1.3 return <<"EOD:";
921 wakaba 1.1 <del><form action="@{[SuikaWiki::Plugin->uri ('wiki')]}" method="get">
922     <input type="hidden" name="mycmd" value="default" />
923     <input type="hidden" name="mypage" value="@{[SuikaWiki::Plugin->escape($bPage)]}" />
924     \ @{[SuikaWiki::Plugin->resource('WikiForm:WikiComment:Name=',escape=>1)]}
925     <input type="text" name="myname" value="" size="10" disabled="disabled" />
926     <input type="text" name="mymsg" value="" size="60" disabled="disabled" />
927     </form></del>
928 wakaba 1.3 EOD:
929 wakaba 1.1 }
930 wakaba 1.3
931     EOD:
932 wakaba 1.2
933     FormattingRule:
934 wakaba 1.3 @Category[list]:
935     page-link
936     link-to-resource
937 wakaba 1.2 @Name: sw09--link-anchor-content
938     @Description:
939     @@@:
940     Output content of the anchor element
941     @@lang:en
942     @Formatting:
943     if ($o->{var}->{sw09__anchor_content}) {
944     $o->{var}->{sw09__anchor_content}->($p->{-parent});
945     } else {
946     $p->{-parent}->append_node (SuikaWiki::Plugin->resource
947     ('Link:SuikaWiki/0.9:link-anchor-content:InvalidContext'),
948     node_or_text => 1);
949     }
950    
951     Resource:
952     @Link:SuikaWiki/0.9:link-anchor-content:InvalidContext:
953     @@@: %sw09--link-anchor-content; cannot be used in this context.
954     @@lang:en
955 wakaba 1.3 @Link:SuikaWiki/0.9:toResource:SourceLabel:
956     @@@:
957     %select_link_resource_scheme (
958     URI => {<%link-to-it(
959     label=>{%link-resource-parameters;}p,
960     );>},
961     MAIL => {<%link-to-it(
962     label => {%link-resource-parameters;}p,
963     description
964     => {%res (name=>{Link:MailAddress=});<%link-resource-parameters;>}p,
965     );>},
966     otherwise => {<%link-to-it(
967     label => {%sw09--link-anchor-content;}p,
968     description => {%res (name=>{Link:URIReference=});<%uri-reference;>}p,
969     );>},
970     );
971     @@lang:en
972 wakaba 1.2 @Link:SuikaWiki/0.9:toWikiPage:SourceLabel:
973     @@@:
974     %link-to-it(
975     label=>{%sw09--link-anchor-content;%if-linked-wikipage-exist(
976     true=>{%if-link-has-dest-anchor-no(true=>{>>%link-dest-anchor-no;});},
977     false=>{%res(name=>{Link:toWikiPage:NotExist:Mark});}
978     );}p,
979     description=>{%page-name(absolute);; %if-linked-wikipage-exist(
980     true=>{%page-headline;},
981     false=>{(%res(name=>{Link:toWikiPage:NotExist:Description});)},
982     );}p,
983     class=>{%if-linked-wikipage-exist(false=>{not-exist});}p,
984     );
985 wakaba 1.3

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24