modules/markup.pl

   1 # Copyright (C) 2004, 2005, 2006, 2009  Alex Schroeder <alex@gnu.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
  16 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/markup.pl">markup.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Markup_Erweiterung">Markup Erweiterung</a></p>';
  17
  18 use vars qw(%MarkupPairs %MarkupForcedPairs %MarkupSingles %MarkupLines
  19             $MarkupQuotes $MarkupQuoteTable);
  20
  21 $MarkupQuotes = 1;
  22
  23 # $MarkupQuotes 'hi'    "hi"    I'm     Favored in
  24 #       0       'hi'    "hi"    I'm     Typewriters
  25 #       1       ‘hi’        “hi”        I’m   Britain and North America
  26 #       2       ‹hi›        «hi»  I’m   France and Italy
  27 #       3       ›hi‹        »hi«  I’m   Germany
  28 #       4       ‚hi’        „hi”        I’m   Germany
  29
  30 #                        0           1           2           3           4
  31 $MarkupQuoteTable = [[  "'",        "'",        '"',        '"'     ,   "'"     ], # 0
  32                      ['&#x2018;', '&#x2019;', '&#x201d;', '&#x201c;', '&#x2019;'], # 1
  33                      ['&#x2039;', '&#x203a;', '&#x00bb;', '&#x00ab;', '&#x2019;'], # 2
  34                      ['&#x203a;', '&#x2039;', '&#x00ab;', '&#x00bb;', '&#x2019;'], # 3
  35                      ['&#x201a;', '&#x2018;', '&#x201c;', '&#x201e;', '&#x2019;'], # 4
  36                     ];
  37
  38 # $MarkupQuoteTable->[2]->[0] ‹
  39 # $MarkupQuoteTable->[2]->[1] ›
  40 # $MarkupQuoteTable->[2]->[2] »
  41 # $MarkupQuoteTable->[2]->[3] «
  42 # $MarkupQuoteTable->[2]->[4] ’
  43
  44 push(@MyRules, \&MarkupRule);
  45 # The ---- rule in usemod.pl conflicts with the --- rule
  46 $RuleOrder{\&MarkupRule} = 150;
  47
  48 %MarkupPairs = ('*' => 'b',
  49                 '/' => 'i',
  50                 '_' => ['em', {'style'=>'text-decoration: underline; font-style: normal;'}],
  51                 '~' => 'em',
  52                );
  53
  54 %MarkupForcedPairs = ("{{{\n" => ['pre', undef, '}}}'],
  55                       '##' => 'code',
  56                       '%%' => 'span',
  57                       '**' => 'b',
  58                       '//' => 'i',
  59                       '__' => ['em', {'style'=>'text-decoration: underline; font-style: normal;'}],
  60                       '~~' => 'em',
  61                      );
  62
  63 # This could be done using macros, however: If we convert to the
  64 # numbered entity, the next person editing finds it hard to read.  If
  65 # we convert to a unicode character, it is no longer obvious how to
  66 # achieve it.
  67 %MarkupSingles = ('...' => '&#x2026;', # HORIZONTAL ELLIPSIS
  68                   '---' => '&#x2014;', # EM DASH
  69                   '-- ' => '&#x2013; ', # EN DASH
  70                   '-> ' => '&#x2192;&#x00a0;', # RIGHTWARDS ARROW, NO-BREAK SPACE
  71                   '<-'  => '&#8592;',
  72                   '<--' => '&#8592;',
  73                   '-->' => '&#x2192;',
  74                   '=>'  => '&#8658;',
  75                   '==>' => '&#8658;',
  76                   '<=>' => '&#8660;',
  77                   '+/-' => '&#x00b1;',
  78                  );
  79
  80 %MarkupLines = ('>' => 'pre',
  81                );
  82
  83 my $words = '([A-Za-z\x{0080}-\x{fffd}][-%.,:;\'"!?0-9 A-Za-z\x{0080}-\x{fffd}]*?)';
  84 # zero-width look-ahead assertion to prevent km/h from counting
  85 my $noword = '(?=[^-0-9A-Za-z\x{0080}-\x{fffd}]|$)';
  86
  87 my $markup_pairs_re = '';
  88 my $markup_forced_pairs_re = '';
  89 my $markup_singles_re = '';
  90 my $markup_lines_re = '';
  91
  92 # do not add all block elements, because not all of them make sense,
  93 # as they cannot be nested -- thus it would not be possible to put
  94 # list items inside a list element, for example.
  95 my %block_element = map { $_ => 1 } qw(p blockquote address div h1 h2
  96                                        h3 h4 h5 h6 pre);
  97
  98 # do this later so that the user can customize the vars
  99 push(@MyInitVariables, \&MarkupInit);
 100
 101 sub MarkupInit {
 102   $markup_pairs_re = '\G([' . join('', (map { quotemeta(QuoteHtml($_)) }
 103                                         keys(%MarkupPairs))) . '])';
 104   $markup_pairs_re = qr/${markup_pairs_re}${words}\1${noword}/;
 105   $markup_forced_pairs_re = '\G(' . join('|', (map { quotemeta(QuoteHtml($_)) }
 106                                                keys(%MarkupForcedPairs))) . ')';
 107   $markup_forced_pairs_re = qr/$markup_forced_pairs_re/;
 108   $markup_singles_re = '\G(' . join('|', (map { quotemeta(QuoteHtml($_)) }
 109                                           sort {$b cmp $a} # longer regex first
 110                                           keys(%MarkupSingles))) . ')';
 111   $markup_singles_re = qr/$markup_singles_re/;
 112   $markup_lines_re = '\G(' . join('|', (map { quotemeta(QuoteHtml($_)) }
 113                                         keys(%MarkupLines))) . ')(.*\n?)';
 114   $markup_lines_re = qr/$markup_lines_re/;
 115 }
 116
 117 sub MarkupTag {
 118   my ($tag, $str) = @_;
 119   my ($start, $end);
 120   if (ref($tag)) {
 121     my $arrayref = $tag;
 122     my ($tag, $hashref) = @{$arrayref};
 123     my %hash = %{$hashref};
 124     $start = $end = $tag;
 125     foreach my $attr (keys %hash) {
 126       $start .= ' ' . $attr . '="' . $hash{$attr} . '"';
 127     }
 128   } else {
 129     $start = $end = $tag;
 130   }
 131   my $result = "<$start>$str</$end>";
 132   $result = CloseHtmlEnvironments() . $result . AddHtmlEnvironment('p')
 133     if $block_element{$start};
 134   return $result;
 135 }
 136
 137 sub MarkupRule {
 138   if ($bol and %MarkupLines and m/$markup_lines_re/gc) {
 139     my ($tag, $str) = ($1, $2);
 140     $str = $q->span($tag) . $str;
 141     while (m/$markup_lines_re/gc) {
 142       $str .= $q->span($1) . $2;
 143     }
 144     return CloseHtmlEnvironments()
 145       . MarkupTag($MarkupLines{UnquoteHtml($tag)}, $str)
 146       . AddHtmlEnvironment('p');
 147   } elsif (%MarkupSingles and m/$markup_singles_re/gc) {
 148     return $MarkupSingles{UnquoteHtml($1)};
 149   } elsif (%MarkupForcedPairs and m/$markup_forced_pairs_re/gc) {
 150     my $tag = $1;
 151     my $start = $tag;
 152     my $end = $tag;
 153     # handle different end tag
 154     my $data = $MarkupForcedPairs{UnquoteHtml($tag)};
 155     if (ref($data)) {
 156       my @data = @{$data};
 157       $start = $data[0] if $data[0];
 158       $end = $data[2] if $data[2];
 159     }
 160     my $endre = quotemeta($end);
 161     $endre .= '[ \t]*\n?' if $block_element{$start}; # skip trailing whitespace if block
 162     # may match the empty string, or multiple lines, but may not span
 163     # paragraphs.
 164     if ($endre and m/\G$endre/gc) {
 165       return $tag . $end;
 166     } elsif ($tag eq $end && m/\G((:?.+?\n)*?.+?)$endre/gc) { # may not span paragraphs
 167       return MarkupTag($data, $1);
 168     } elsif ($tag ne $end && m/\G((:?.|\n)+?)$endre/gc) {
 169       return MarkupTag($data, $1);
 170     } else {
 171       return $tag;
 172     }
 173   } elsif (%MarkupPairs and m/$markup_pairs_re/gc) {
 174     return MarkupTag($MarkupPairs{UnquoteHtml($1)}, $2);
 175   } elsif ($MarkupPairs{'/'} and m|\G~/|gc) {
 176     return '~/'; # fix ~/elisp/ example
 177   } elsif ($MarkupPairs{'/'} and m|\G(/[-A-Za-z0-9\x{0080}-\x{fffd}/]+/$words/)|gc) {
 178     return $1; # fix /usr/share/lib/! example
 179   }
 180   # "foo
 181   elsif ($MarkupQuotes and (m/\G(?<=[[:space:]])"/cg
 182                             or pos == 0 and m/\G"/cg)) {
 183     return $MarkupQuoteTable->[$MarkupQuotes]->[3];
 184   }
 185   # foo"
 186   elsif ($MarkupQuotes and (m/\G"(?=[[:space:][:punct:]])/cg
 187                               or m/\G"\z/cg)) {
 188     return $MarkupQuoteTable->[$MarkupQuotes]->[2];
 189   }
 190   # foo."
 191   elsif ($MarkupQuotes and (m/\G(?<=[[:punct:]])"/cg)) {
 192     return $MarkupQuoteTable->[$MarkupQuotes]->[3];
 193   }
 194   # single quotes at the beginning of the buffer
 195   elsif ($MarkupQuotes and pos == 0 and m/\G'/cg) {
 196     return $MarkupQuoteTable->[$MarkupQuotes]->[0];
 197   }
 198   # 'foo
 199   elsif ($MarkupQuotes and (m/\G(?<=[[:space:]])'/cg
 200                             or pos == 0 and m/\G'/cg)) {
 201     return $MarkupQuoteTable->[$MarkupQuotes]->[0];
 202   }
 203   # foo'
 204   elsif ($MarkupQuotes and (m/\G'(?=[[:space:][:punct:]])/cg
 205                             or m/\G'\z/cg)) {
 206     return $MarkupQuoteTable->[$MarkupQuotes]->[1];
 207   }
 208   # foo's
 209   elsif ($MarkupQuotes and m/\G(?<![[:space:]])'(?![[:space:][:punct:]])/cg) {
 210     return $MarkupQuoteTable->[$MarkupQuotes]->[4];
 211   }
 212   return undef;
 213 }