simple-rules.pl 6.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186
  1. # Copyright (C) 2004 Alex Schroeder <alex@emacswiki.org>
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 3 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. use strict;
  16. use v5.10;
  17. AddModuleDescription('simple-rules.pl', 'Simple Fast Alternate Text Formatting Rules');
  18. our ($q, $OpenPageName, $FS, $UrlPattern, $FreeLinkPattern);
  19. *ApplyRules = \&NewSimpleRulesApplyRules;
  20. my $PROT = "\x1c";
  21. my $DIRT = "\x1d";
  22. # Variables which are essentially global and which contain state are localized before they are set. In order to localize
  23. # them, they have to be declared here, first.
  24. our ($counter, %protected, %dirty);
  25. sub NewSimpleRulesApplyRules {
  26. # locallinks: apply rules that create links depending on local config (incl. interlink!)
  27. my ($text, $locallinks, $withanchors, $revision) = @_;
  28. # shortcut for dirty blocks (if this is the content of a real page: no caching!)
  29. local $counter = 0;
  30. local %protected = ();
  31. local %dirty = ();
  32. my $result;
  33. $text = NewSimpleRulesApplyDirtyInlineRules($text, $locallinks);
  34. if ($text =~ /^${DIRT}[0-9]+${DIRT}$/) { # shortcut
  35. $result = $text;
  36. } else {
  37. $text =~ s/[ \t]+\n/\n/g; # no trailing whitespace to worry about
  38. $text =~ s/\n$//g;
  39. $text =~ s/^\n//g;
  40. my @paragraphs = split(/\n\n+/, $text);
  41. foreach my $block (@paragraphs) {
  42. if ($block =~ /^(.+?)\n(--+)$/ and length($1) == length($2)) {
  43. $block = SimpleRulesProtect($q->h3($1));
  44. } elsif ($block =~ /^(.+?)\n(==+)$/ and length($1) == length($2)) {
  45. $block = SimpleRulesProtect($q->h2($1));
  46. } elsif ($block =~ /^\* (.*)/s) {
  47. $block = SimpleRulesProtect($q->ul(join('', # avoid extra space in CGI.pm code
  48. map{$q->li(NewSimpleRulesApplyInlineRules($_))}
  49. split(/\n\* +/, $1))));
  50. } elsif ($block =~ /^[0-9]\. (.*)/s) {
  51. $block = SimpleRulesProtect($q->ol(join('', # avoid extra space in CGI.pm code
  52. map{$q->li(NewSimpleRulesApplyInlineRules($_))}
  53. split(/\n[0-9]\. */, $1))));
  54. } elsif ($block =~ m/^#FILE ([^ \n]+)\n(.*)/s) {
  55. $block = SimpleRulesProtect(GetDownloadLink(
  56. $OpenPageName, (substr($1, 0, 6) eq 'image/'), $revision));
  57. } else {
  58. $block = SimpleRulesProtect('<p>') . $block . SimpleRulesProtect('</p>');
  59. }
  60. ($block =~ s/(\&lt;journal(\s+(\d*))?(\s+"(.*)")?(\s+(reverse))?\&gt;)/
  61. my ($str, $num, $regexp, $reverse) = ($1, $3, $5, $7);
  62. SimpleRulesDirty($str, sub { PrintJournal($num, $regexp, $reverse)});/eg);
  63. $result .= NewSimpleRulesApplyInlineRules($block);
  64. }
  65. }
  66. return SimpleRulesMungeResult($result);
  67. }
  68. sub NewSimpleRulesApplyInlineRules {
  69. my ($block, $locallinks) = @_;
  70. $block = NewSimpleRulesApplyDirtyInlineRules($block, $locallinks);
  71. $block =~ s/$UrlPattern/SimpleRulesProtect($q->a({-href=>$1}, $1))/egs;
  72. $block =~ s/~(\S+)~/SimpleRulesProtect($q->em($1))/eg;
  73. $block =~ s/\*\*(.+?)\*\*/SimpleRulesProtect($q->strong($1))/egs;
  74. $block =~ s/\/\/(.+?)\/\//SimpleRulesProtect($q->em($1))/egs;
  75. $block =~ s/\_\_(.+?)\_\_/SimpleRulesProtect($q->u($1))/egs;
  76. $block =~ s/\*(.+?)\*/SimpleRulesProtect($q->b($1))/egs;
  77. $block =~ s/\/(.+?)\//SimpleRulesProtect($q->i($1))/egs;
  78. $block =~ s/\_(.+?)\_/SimpleRulesProtect($q->u($1))/egs;
  79. return $block;
  80. }
  81. sub NewSimpleRulesApplyDirtyInlineRules {
  82. my ($block, $locallinks) = @_;
  83. if ($locallinks) {
  84. ($block =~ s/(\[\[$FreeLinkPattern\]\])/
  85. my ($str, $link) = ($1, $2);
  86. SimpleRulesDirty($str, GetPageOrEditLink($link,0,0,1))/eg);
  87. ($block =~ s/(\[\[image:$FreeLinkPattern\]\])/
  88. my ($str, $link) = ($1, $2);
  89. SimpleRulesDirty($str, GetDownloadLink($link, 1))/eg);
  90. }
  91. return $block;
  92. }
  93. sub SimpleRulesProtect {
  94. my $html = shift;
  95. $counter++;
  96. $protected{$counter} = $html;
  97. return $PROT . $counter . $PROT;
  98. }
  99. sub SimpleRulesDirty {
  100. my ($str, $html) = @_;
  101. $counter++;
  102. $dirty{$counter} = $str;
  103. $protected{$counter} = $html;
  104. return $DIRT . $counter . $DIRT;
  105. }
  106. sub SimpleRulesMungeResult {
  107. my $raw = shift;
  108. $raw = SimpleRulesUnprotect($raw);
  109. # now do the dirty and clean block stuff
  110. my @blocks;
  111. my @flags;
  112. my $count = 0;
  113. my $html;
  114. foreach my $item (split(/$DIRT([0-9]+)$DIRT/, $raw)) {
  115. if ($count % 2) { # deal with reference
  116. if ($dirty{$item}) { # dirty block
  117. if ($html) {
  118. push (@blocks, $html); # store what we have as a clean block
  119. push (@flags, 0);
  120. print $html; # flush what we have
  121. $html = '';
  122. }
  123. push (@blocks, $dirty{$item}); # store the raw fragment as dirty block
  124. push (@flags, 1);
  125. if (ref($protected{$item}) eq 'CODE') { # print stored html or execute code
  126. &{$protected{$item}};
  127. } else {
  128. print $protected{$item};
  129. }
  130. } else { # clean reference
  131. $html .= $protected{$item};
  132. }
  133. } else { # deal with normal text
  134. $html .= $item;
  135. }
  136. $count++;
  137. }
  138. if ($html) { # deal last bit of unprinted normal text
  139. print $html;
  140. push (@blocks, $html); # store what we have as a clean block
  141. push (@flags, 0);
  142. }
  143. return (join($FS, @blocks), join($FS, @flags));
  144. }
  145. sub SimpleRulesUnprotect {
  146. my $raw = shift;
  147. $raw =~ s/$PROT([0-9]+)$PROT/$protected{$1}/eg
  148. while $raw =~ /$PROT([0-9]+)$PROT/; # find recursive replacements!
  149. return $raw;
  150. }
  151. __DATA__
  152. This is the text page for the rules.
  153. This is a single paragraph.
  154. With a link to [[other paragraphs]].
  155. * This is a list
  156. with three items.
  157. * Second item.
  158. * Third item with a link: [[list items]].
  159. We also have numbered lists:
  160. 1. We use something like setext...
  161. 2. But we ~extend~ it.
  162. 3. **Really we do!**
  163. //multi-word emphasis// and
  164. __multi-word underlining__, and we also
  165. allow the similar /single/ _word_ *rules*.
  166. I think that's all the rules we [[implemented]].