forked from github/kensanata.oddmuse
211 lines
6.8 KiB
Perl
211 lines
6.8 KiB
Perl
# Copyright (C) 2006, 2007 Alex Schroeder <alex@emacswiki.org>
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the
|
|
# Free Software Foundation, Inc.
|
|
# 59 Temple Place, Suite 330
|
|
# Boston, MA 02111-1307 USA
|
|
|
|
$ModulesDescription .= '<p>$Id: creole.pl,v 1.37 2008/03/31 14:56:30 as Exp $</p>';
|
|
|
|
use vars qw($CreoleLineBreaks $CreoleTildeAlternative);
|
|
|
|
# single newlines don't insert a linebreak
|
|
$CreoleLineBreaks = 0;
|
|
# the tilde does not disappear in front of a-z, A-Z, 0-9.
|
|
$CreoleTildeAlternative = 0;
|
|
|
|
push(@MyRules, \&CreoleRule, \&CreoleHeadingRule);
|
|
# [[link|{{Image:foo}}]] conflicts with default link rule
|
|
$RuleOrder{\&CreoleRule} = -10;
|
|
# == headings rule must come after the TocRule
|
|
$RuleOrder{\&CreoleHeadingRule} = 100;
|
|
|
|
sub CreoleHeadingRule {
|
|
# = to ====== for h1 to h6
|
|
if ($bol && m/\G(\s*\n)*(=+)[ \t]*(.*?)[ \t]*=*[ \t]*(\n|\Z)/cg) {
|
|
my $depth = length($2);
|
|
$depth = 6 if $depth > 6;
|
|
my $text = $3;
|
|
return CloseHtmlEnvironments() . "<h$depth>$text</h$depth>"
|
|
. AddHtmlEnvironment('p');
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub CreoleRule {
|
|
# escape next char (and prevent // in URLs from enabling italics)
|
|
# ~
|
|
if (m/\G(~($FullUrlPattern|\S))/cgo) {
|
|
if ($CreoleTildeAlternative
|
|
and index('ABCDEFGHIJKLMNOPQRSTUVWXYZ'
|
|
. 'abcdefghijklmnopqrstuvwxyz'
|
|
. '0123456789', $2) != -1) {
|
|
return $1; # tilde stays
|
|
} else {
|
|
return $2; # tilde disappears
|
|
}
|
|
}
|
|
# horizontal line
|
|
# ----
|
|
elsif ($bol && m/\G(\s*\n)*[ \t]*----+[ \t]*\n?/cg
|
|
or m/\G\s*\n----+[ \t]*\n?/cg ) {
|
|
return CloseHtmlEnvironments() . $q->hr()
|
|
. AddHtmlEnvironment('p');
|
|
}
|
|
# //**bold italic//**bold
|
|
elsif (defined $HtmlStack[0] && defined $HtmlStack[1]
|
|
&& $HtmlStack[0] eq 'strong'
|
|
&& $HtmlStack[1] eq 'em'
|
|
&& m/\G\/\//cg) {
|
|
return CloseHtmlEnvironment() . CloseHtmlEnvironment();
|
|
}
|
|
# **//bold italic**//italic
|
|
elsif (defined $HtmlStack[0] && defined $HtmlStack[1]
|
|
&& $HtmlStack[0] eq 'em'
|
|
&& $HtmlStack[1] eq 'strong'
|
|
&& m/\G\*\*/cg) {
|
|
return CloseHtmlEnvironment() . CloseHtmlEnvironment();
|
|
}
|
|
# **bold**
|
|
elsif (m/\G\*\*/cg and not ($bol && InElement('li'))) {
|
|
return (defined $HtmlStack[0] && $HtmlStack[0] eq 'strong')
|
|
? CloseHtmlEnvironment() : AddHtmlEnvironment('strong');
|
|
}
|
|
# //italic//
|
|
elsif (m/\G\/\//cg) {
|
|
return (defined $HtmlStack[0] && $HtmlStack[0] eq 'em')
|
|
? CloseHtmlEnvironment() : AddHtmlEnvironment('em');
|
|
}
|
|
# # number list
|
|
elsif ($bol && m/\G\s*(#)[ \t]*/cg
|
|
or InElement('li') && m/\G\s*\n[ \t]*(#+)[ \t]*/cg) {
|
|
return CloseHtmlEnvironmentUntil('li')
|
|
. OpenHtmlEnvironment('ol', length($1))
|
|
. AddHtmlEnvironment('li');
|
|
}
|
|
# * bullet list
|
|
# - bullet list (not nested, requires space)
|
|
elsif ($bol && (m/\G\s*(\*)[ \t]*/cg
|
|
|| m/\G\s*(-)[ \t]+/cg)
|
|
or InElement('li') && (m/\G\s*\n[ \t]*(\*+)[ \t]*/cg
|
|
|| m/\G\s*\n[ \t]*(-)[ \t]+/cg)) {
|
|
return CloseHtmlEnvironmentUntil('li')
|
|
. OpenHtmlEnvironment('ul', length($1))
|
|
. AddHtmlEnvironment('li');
|
|
}
|
|
# tables using | -- end of the row or table
|
|
elsif (InElement('td') || InElement('th')
|
|
and (m/\G[ \t]*\|?[ \t]*(\n)?(\n|$)/cg)) {
|
|
if ($1) {
|
|
return CloseHtmlEnvironments() . AddHtmlEnvironment('p');
|
|
} else {
|
|
return CloseHtmlEnvironmentUntil('table');
|
|
}
|
|
}
|
|
# tables using | -- an ordinary table cell
|
|
elsif (m/\G[ \t]*(\|+)(=)?([ \t]*)/cg) {
|
|
my $html = '';
|
|
$html .= OpenHtmlEnvironment('table',1,'user') unless InElement('table');
|
|
$html .= AddHtmlEnvironment('tr') unless InElement('tr');
|
|
$html .= CloseHtmlEnvironmentUntil('tr')
|
|
if InElement('td') || InElement('th');
|
|
$html .= AddHtmlEnvironment(($2 ? 'th' : 'td'),
|
|
TableAttributes(length($1), $3));
|
|
return $html;
|
|
}
|
|
# paragraphs: at least two newlines
|
|
elsif (m/\G\s*\n(\s*\n)+/cg) {
|
|
return CloseHtmlEnvironments() . AddHtmlEnvironment('p');
|
|
}
|
|
# line break: one newline, or \\
|
|
elsif ($CreoleLineBreaks && m/\G\s*\n/cg or m/\G\\\\/cg) {
|
|
return $q->br();
|
|
}
|
|
# {{{
|
|
# preformatted
|
|
# }}}
|
|
elsif ($bol && m/\G\{\{\{[ \t]*\n(.*?\n)\}\}\}[ \t]*(\n|\z)/cgs) {
|
|
my $str = $1;
|
|
$str =~ s/\n }}}/\n}}}/g;
|
|
return CloseHtmlEnvironments() . $q->pre({-class=>'real'}, $str)
|
|
. AddHtmlEnvironment('p');
|
|
}
|
|
# {{{unformatted}}}
|
|
elsif (m/\G\{\{\{(.*?}*)\}\}\}/cgs) {
|
|
return $q->code($1);
|
|
}
|
|
# {{pic}}
|
|
elsif (m/\G(\{\{$FreeLinkPattern(\|.+?)?\}\})/cgos) {
|
|
Dirty($1);
|
|
# FIXME: inlining this gives "substr outside of string" error
|
|
my $alt = substr($3,1);
|
|
print GetDownloadLink($2, 1, undef, $alt);
|
|
return '';
|
|
}
|
|
# {{url}}
|
|
elsif (m/\G\{\{$FullUrlPattern\s*(\|.+?)?\}\}/cgos) {
|
|
return $q->a({-href=>$1,
|
|
-class=>'image outside'},
|
|
$q->img({-src=>$1,
|
|
-alt=>substr($2,1),
|
|
-class=>'url outside'}));
|
|
}
|
|
# link: [[link|{{pic}}]]
|
|
elsif (m/\G\[\[$FreeLinkPattern\|\{\{$FreeLinkPattern(\|.+?)?\}\}\]\]/cgos) {
|
|
return ScriptLink($1, $q->img({-src=>GetDownloadLink($2, 2),
|
|
-alt=>substr($3,1)||NormalToFree($1),
|
|
-class=>'upload'}),
|
|
'image');
|
|
}
|
|
# link: [[link|{{url}}]]
|
|
elsif (m/\G\[\[$FreeLinkPattern\|\{\{$FullUrlPattern\s*(\|.+?)?\}\}\]\]/cgos) {
|
|
return ScriptLink($1, $q->img({-src=>$2,
|
|
-class=>'url outside',
|
|
-alt=>substr($3,1)||$1}),
|
|
'image');
|
|
}
|
|
# link: [[url|{{pic}}]]
|
|
elsif (m/\G\[\[$FullUrlPattern\s*\|\{\{$FreeLinkPattern(\|.+?)?\}\}\]\]/cgos) {
|
|
return $q->a({-href=>$1, -class=>'image outside'},
|
|
$q->img({-src=>GetDownloadLink($2, 2),
|
|
-class=>'upload',
|
|
-alt=>substr($3,1)||$2}));
|
|
}
|
|
# link: [[url|{{url}}]]
|
|
elsif (m/\G\[\[$FullUrlPattern\s*\|\{\{$FullUrlPattern\s*(\|.+?)?\}\}\]\]/cgos) {
|
|
return $q->a({-href=>$1, -class=>'image outside'},
|
|
$q->img({-src=>$2,
|
|
-class=>'url outside',
|
|
-alt=>substr($3,1)}));
|
|
}
|
|
# link: [[url]] and [[url|text]]
|
|
elsif (m/\G\[\[$FullUrlPattern\s*(\|\s*([^]]+))?\]\]/cgos) {
|
|
return GetUrl($1, $3||$1, 1);
|
|
}
|
|
return undef;
|
|
}
|
|
|
|
sub TableAttributes {
|
|
my ($span, $left, $right) = @_;
|
|
my $attr = '';
|
|
$attr = "colspan=\"$span\"" if ($span != 1);
|
|
m/\G(?=.*?([ \t]*)\|)/ and $right = $1 unless $right;
|
|
$attr .= ' ' if ($attr and ($left or $right));
|
|
if ($left and $right) { $attr .= 'align="center"' }
|
|
elsif ($left) { $attr .= 'align="right"' }
|
|
# this is the default:
|
|
# elsif ($right) { $attr .= 'align="left"' }
|
|
return $attr;
|
|
}
|