forked from github/kensanata.oddmuse
There were some modules that did not offer "or (at your option) any later version" in their license and these had to be left alone. This should solve the incorrect FSF address issue #4 on GitHub.
186 lines
6.1 KiB
Perl
186 lines
6.1 KiB
Perl
# Copyright (C) 2004 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 3 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, see <http://www.gnu.org/licenses/>.
|
|
|
|
use strict;
|
|
use v5.10;
|
|
|
|
AddModuleDescription('simple-rules.pl', 'Simple Fast Alternate Text Formatting Rules');
|
|
our ($q, $OpenPageName, $FS, $UrlPattern, $FreeLinkPattern);
|
|
|
|
*ApplyRules = \&NewSimpleRulesApplyRules;
|
|
|
|
my $PROT = "\x1c";
|
|
my $DIRT = "\x1d";
|
|
|
|
# Variables which are essentially global and which contain state are localized before they are set. In order to localize
|
|
# them, they have to be declared here, first.
|
|
our ($counter, %protected, %dirty);
|
|
|
|
sub NewSimpleRulesApplyRules {
|
|
# locallinks: apply rules that create links depending on local config (incl. interlink!)
|
|
my ($text, $locallinks, $withanchors, $revision) = @_;
|
|
# shortcut for dirty blocks (if this is the content of a real page: no caching!)
|
|
local $counter = 0;
|
|
local %protected = ();
|
|
local %dirty = ();
|
|
my $result;
|
|
$text = NewSimpleRulesApplyDirtyInlineRules($text, $locallinks);
|
|
if ($text =~ /^${DIRT}[0-9]+${DIRT}$/) { # shortcut
|
|
$result = $text;
|
|
} else {
|
|
$text =~ s/[ \t]+\n/\n/g; # no trailing whitespace to worry about
|
|
$text =~ s/\n$//g;
|
|
$text =~ s/^\n//g;
|
|
my @paragraphs = split(/\n\n+/, $text);
|
|
foreach my $block (@paragraphs) {
|
|
if ($block =~ /^(.+?)\n(--+)$/ and length($1) == length($2)) {
|
|
$block = SimpleRulesProtect($q->h3($1));
|
|
} elsif ($block =~ /^(.+?)\n(==+)$/ and length($1) == length($2)) {
|
|
$block = SimpleRulesProtect($q->h2($1));
|
|
} elsif ($block =~ /^\* (.*)/s) {
|
|
$block = SimpleRulesProtect($q->ul(join('', # avoid extra space in CGI.pm code
|
|
map{$q->li(NewSimpleRulesApplyInlineRules($_))}
|
|
split(/\n\* +/, $1))));
|
|
} elsif ($block =~ /^[0-9]\. (.*)/s) {
|
|
$block = SimpleRulesProtect($q->ol(join('', # avoid extra space in CGI.pm code
|
|
map{$q->li(NewSimpleRulesApplyInlineRules($_))}
|
|
split(/\n[0-9]\. */, $1))));
|
|
} elsif ($block =~ m/^#FILE ([^ \n]+)\n(.*)/s) {
|
|
$block = SimpleRulesProtect(GetDownloadLink(
|
|
$OpenPageName, (substr($1, 0, 6) eq 'image/'), $revision));
|
|
} else {
|
|
$block = SimpleRulesProtect('<p>') . $block . SimpleRulesProtect('</p>');
|
|
}
|
|
($block =~ s/(\<journal(\s+(\d*))?(\s+"(.*)")?(\s+(reverse))?\>)/
|
|
my ($str, $num, $regexp, $reverse) = ($1, $3, $5, $7);
|
|
SimpleRulesDirty($str, sub { PrintJournal($num, $regexp, $reverse)});/eg);
|
|
$result .= NewSimpleRulesApplyInlineRules($block);
|
|
}
|
|
}
|
|
return SimpleRulesMungeResult($result);
|
|
}
|
|
|
|
sub NewSimpleRulesApplyInlineRules {
|
|
my ($block, $locallinks) = @_;
|
|
$block = NewSimpleRulesApplyDirtyInlineRules($block, $locallinks);
|
|
$block =~ s/$UrlPattern/SimpleRulesProtect($q->a({-href=>$1}, $1))/egs;
|
|
$block =~ s/~(\S+)~/SimpleRulesProtect($q->em($1))/eg;
|
|
$block =~ s/\*\*(.+?)\*\*/SimpleRulesProtect($q->strong($1))/egs;
|
|
$block =~ s/\/\/(.+?)\/\//SimpleRulesProtect($q->em($1))/egs;
|
|
$block =~ s/\_\_(.+?)\_\_/SimpleRulesProtect($q->u($1))/egs;
|
|
$block =~ s/\*(.+?)\*/SimpleRulesProtect($q->b($1))/egs;
|
|
$block =~ s/\/(.+?)\//SimpleRulesProtect($q->i($1))/egs;
|
|
$block =~ s/\_(.+?)\_/SimpleRulesProtect($q->u($1))/egs;
|
|
return $block;
|
|
}
|
|
|
|
sub NewSimpleRulesApplyDirtyInlineRules {
|
|
my ($block, $locallinks) = @_;
|
|
if ($locallinks) {
|
|
($block =~ s/(\[\[$FreeLinkPattern\]\])/
|
|
my ($str, $link) = ($1, $2);
|
|
SimpleRulesDirty($str, GetPageOrEditLink($link,0,0,1))/eg);
|
|
($block =~ s/(\[\[image:$FreeLinkPattern\]\])/
|
|
my ($str, $link) = ($1, $2);
|
|
SimpleRulesDirty($str, GetDownloadLink($link, 1))/eg);
|
|
}
|
|
return $block;
|
|
}
|
|
|
|
sub SimpleRulesProtect {
|
|
my $html = shift;
|
|
$counter++;
|
|
$protected{$counter} = $html;
|
|
return $PROT . $counter . $PROT;
|
|
}
|
|
|
|
sub SimpleRulesDirty {
|
|
my ($str, $html) = @_;
|
|
$counter++;
|
|
$dirty{$counter} = $str;
|
|
$protected{$counter} = $html;
|
|
return $DIRT . $counter . $DIRT;
|
|
}
|
|
|
|
sub SimpleRulesMungeResult {
|
|
my $raw = shift;
|
|
$raw = SimpleRulesUnprotect($raw);
|
|
# now do the dirty and clean block stuff
|
|
my @blocks;
|
|
my @flags;
|
|
my $count = 0;
|
|
my $html;
|
|
foreach my $item (split(/$DIRT([0-9]+)$DIRT/, $raw)) {
|
|
if ($count % 2) { # deal with reference
|
|
if ($dirty{$item}) { # dirty block
|
|
if ($html) {
|
|
push (@blocks, $html); # store what we have as a clean block
|
|
push (@flags, 0);
|
|
print $html; # flush what we have
|
|
$html = '';
|
|
}
|
|
push (@blocks, $dirty{$item}); # store the raw fragment as dirty block
|
|
push (@flags, 1);
|
|
if (ref($protected{$item}) eq 'CODE') { # print stored html or execute code
|
|
&{$protected{$item}};
|
|
} else {
|
|
print $protected{$item};
|
|
}
|
|
} else { # clean reference
|
|
$html .= $protected{$item};
|
|
}
|
|
} else { # deal with normal text
|
|
$html .= $item;
|
|
}
|
|
$count++;
|
|
}
|
|
if ($html) { # deal last bit of unprinted normal text
|
|
print $html;
|
|
push (@blocks, $html); # store what we have as a clean block
|
|
push (@flags, 0);
|
|
}
|
|
return (join($FS, @blocks), join($FS, @flags));
|
|
}
|
|
|
|
sub SimpleRulesUnprotect {
|
|
my $raw = shift;
|
|
$raw =~ s/$PROT([0-9]+)$PROT/$protected{$1}/eg
|
|
while $raw =~ /$PROT([0-9]+)$PROT/; # find recursive replacements!
|
|
return $raw;
|
|
}
|
|
|
|
__DATA__
|
|
|
|
This is the text page for the rules.
|
|
This is a single paragraph.
|
|
With a link to [[other paragraphs]].
|
|
|
|
* This is a list
|
|
with three items.
|
|
* Second item.
|
|
* Third item with a link: [[list items]].
|
|
|
|
We also have numbered lists:
|
|
|
|
1. We use something like setext...
|
|
2. But we ~extend~ it.
|
|
3. **Really we do!**
|
|
|
|
//multi-word emphasis// and
|
|
__multi-word underlining__, and we also
|
|
allow the similar /single/ _word_ *rules*.
|
|
|
|
I think that's all the rules we [[implemented]].
|