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