org-anchors.pl

   1 # Copyright (C) 2004, 2005, 2009  Alex Schroeder <alex@gnu.org>
   2 #
   3 # This program is free software: you can redistribute it and/or modify it under
   4 # the terms of the GNU General Public License as published by the Free Software
   5 # Foundation, either version 3 of the License, or (at your option) any later
   6 # version.
   7 #
   8 # This program is distributed in the hope that it will be useful, but WITHOUT
   9 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
  10 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  11 #
  12 # You should have received a copy of the GNU General Public License along with
  13 # this program. If not, see <http://www.gnu.org/licenses/>.
  14
  15 $ModulesDescription .= '<p>See <a href="http://oddmuse.org/wiki/Org_Markup_Extension">Org Markup Extension</a></p>';
  16
  17
  18 push(@MyRules, \&AnchorsRule);
  19
  20 sub AnchorsRule {
  21   if (m/\G\[\[\#$FreeLinkPattern\]\]/gc) {
  22     return $q->a({-href=>'#' . FreeToNormal($1), -class=>'local anchor'}, $1);
  23   } elsif ($BracketWiki && m/\G\[\[\#$FreeLinkPattern\]\[([^\]]+)\]\]/gc) {
  24     return $q->a({-href=>'#' . FreeToNormal($1), -class=>'local anchor'}, $2);
  25   } elsif ($BracketWiki && m/\G(\[\[$FreeLinkPattern\#$FreeLinkPattern\]\[([^\]]+)\]\])/cog
  26            or m/\G(\[\[\[$FreeLinkPattern\#$FreeLinkPattern\]\]\])/cog
  27            or m/\G(\[\[$FreeLinkPattern\#$FreeLinkPattern\]\])/cog) {
  28     # This one is not a dirty rule because the output is always a page
  29     # link, never an edit link (unlike normal free links).
  30     my $bracket = (substr($1, 0, 3) eq '[[[');
  31     my $id = $2 . '#' . $3;
  32     my $text = $4;
  33     my $class = 'local anchor';
  34     my $title = '';
  35     $id = FreeToNormal($id);
  36     if (!$text && $bracket) {
  37       $text = BracketLink(++$FootnoteNumber); # s/_/ /g happens further down!
  38       $class .= ' number';
  39       $title = $id; # override title
  40       $title =~ s/_/ /g if $free;
  41     }
  42     $text = $id unless $text;
  43     $text =~ s/_/ /g;
  44     return ScriptLink(UrlEncode($id), $text, $class, undef, $title);
  45   } elsif (m/\G\[\:$FreeLinkPattern\]/gc) {
  46     return $q->a({-name=>FreeToNormal($1), -class=>'anchor'}, '');
  47   }
  48   return undef;
  49 }