modules/tables-long.pl

   1 # Copyright (C) 2004, 2005  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 2 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, write to the
  15 #    Free Software Foundation, Inc.
  16 #    59 Temple Place, Suite 330
  17 #    Boston, MA 02111-1307 USA
  18
  19 $ModulesDescription .= '<p><a href="http://git.savannah.gnu.org/cgit/oddmuse.git/tree/modules/tables-long.pl">tables-long.pl</a>, see <a href="http://www.oddmuse.org/cgi-bin/oddmuse/Long_Table_Markup_Extension">Long Table Markup Extension</a></p>';
  20
  21 push(@MyRules, \&TablesLongRule);
  22
  23 my $TablesLongLabels = '';
  24
  25 sub TablesLongRule {
  26   # start table by declaring the abbreviations used:
  27   # <table foo,bar,baz>
  28   # end with a horizontal line:
  29   # ----
  30   # use label: or label= to start a cell
  31   # label: bla
  32   #   bla bla bla
  33   # a new row is started when a cell is repeated
  34   # if cells are missing, column spans are created (the first row
  35   # could use row spans...)
  36   if ($bol && m|\G\s*\n*\&lt;table(/[A-Za-z\x{0080}-\x{fffd}/]+)? +([A-Za-z\x{0080}-\x{fffd},;\/ ]+)\&gt; *\n|cg) {
  37     my $class = join(' ', split(m|/|, $1)); # leading / in $1 will make sure we have leading space
  38     Clean(CloseHtmlEnvironments() . "<table class=\"user long$class\">");
  39     # labels and their default class
  40     my %default_class = ();
  41     my @labels = map { my ($label, @classes) = split m|/|;
  42                        $default_class{$label} = join(' ', @classes);
  43                        $label;
  44                      } split(/ *[,;] */, $2);
  45     my $regexp = join('|', @labels);
  46     # read complete table
  47     my @lines = ();
  48     while (m/\G(.*)\n?/cg) { # last line may miss newline
  49       my $line = $1;
  50       last if substr($line,0,4) eq ('----'); # the rest of this line is ignored!
  51       push(@lines, $line);
  52     }
  53     # parse lines and print table rows
  54     my $lastpos = pos;
  55     my @rows = ();
  56     my %row = ();
  57     my %class = %default_class;
  58     my %rowspan = ();
  59     my $label = '';
  60     my $rowspan = '';
  61     my $first = 1;
  62     for my $line (@lines) {
  63       if ($line =~ m|^($regexp)/?([0-9]+)?/?([A-Za-z\x{0080}-\x{fffd}/]+)?[:=] *(.*)|) { # regexp changes for other tables
  64         $label = $1;
  65         $rowspan = $2;
  66         $class = join(' ', split(m|/|, $3)); # no leading / therefore no leading space
  67         $line = $4;
  68         if ($row{$label}) { # repetition of label, we must start a new row
  69           TablesLongRow(\@labels, \%row, \%class, \%rowspan, $first);
  70           $first = 0;
  71           %row = ();
  72           %class = %default_class;
  73           foreach my $key (keys %rowspan) {
  74             delete $rowspan{$key} if $rowspan{$key} == 1;
  75             $rowspan{$key}--; # 0 will turn into negative numbers
  76           }
  77         }
  78         $class{$label} = $class if $class;
  79         $rowspan{$label} = $rowspan if $rowspan;
  80       }
  81       $row{$label} .= $line . "\n";
  82     }
  83     TablesLongRow(\@labels, \%row, \%class, \%rowspan, $first); # don't forget the last row
  84     Clean('</table>' . AddHtmlEnvironment('p'));
  85     pos = $lastpos;
  86     return '';
  87   }
  88   return undef;
  89 }
  90
  91 sub TablesLongRow {
  92   my @labels = @{$_[0]};
  93   my %row = %{$_[1]};
  94   my %class = %{$_[2]};
  95   my %rowspan = %{$_[3]};
  96   my $first = $_[4];
  97   Clean('<tr>');
  98   # first print the old row
  99   for my $i (0 .. $#labels) {
 100     next if not $row{$labels[$i]}; # should only happen after previous cellspans
 101     my $colspan = 1;
 102     while ($i + $colspan < $#labels + 1
 103            and not $row{$labels[$i+$colspan]}
 104            and not $rowspan{$labels[$i+$colspan]}) {
 105       $colspan++;
 106     }
 107     my $rowspan = $rowspan{$labels[$i]};
 108     my $class = $class{$labels[$i]};
 109     my $html = '<';
 110     $html .= $first ? 'th' : 'td';
 111     $html .= " colspan=\"$colspan\"" if $colspan != 1;
 112     $html .= " rowspan=\"$rowspan\"" if defined $rowspan and $rowspan >= 0; # ignore negatives
 113     $html .= " class=\"$class\"" if $class;
 114     $html .= '>';
 115     Clean($html);
 116
 117     # WATCH OUT: here comes the evil magic messing with the internals!
 118     # first, clean everything up like at the end of ApplyRules
 119
 120     if ($Fragment ne '') {
 121       $Fragment =~ s|<p></p>||g; # clean up extra paragraphs (see end Dirty())
 122       print $Fragment;
 123       push(@Blocks, $Fragment);
 124       push(@Flags, 0);
 125       $Fragment = '';
 126     }
 127     # call ApplyRules, and *inline* the results; ignoring $PortraitSupportColorDiv
 128     local $PortraitSupportColorDiv;
 129     my ($blocks, $flags) = ApplyRules($row{$labels[$i]}, 1, 1); # local links, anchors
 130     push(@Blocks, split(/$FS/, $blocks));
 131     push(@Flags, split(/$FS/, $flags));
 132     # end of evil magic
 133
 134     # Alternatively, just use
 135     # Clean($row{$labels[$i]});
 136     # or mark this block as dirty.
 137     Clean(CloseHtmlEnvironments() . '</' . ($first ? 'th' : 'td') . '>');
 138   }
 139   Clean('</tr>');
 140 }