/[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.1 - (hide annotations) (download)
Sat Dec 13 02:51:29 2003 UTC (20 years, 10 months ago) by wakaba
Branch: MAIN
SuikaWiki/0.9 text to XML converter implemented

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24