#!/usr/bin/perl
use strict;
require 'html-content.pl';
our $LIST;

my %argv;
for (@ARGV) {
  $argv{$1} = 1 if /^--([^\s=]+)$/;
}
if ($argv{help}) {
  require Pod::Usage;
  Pod::Usage::pod2usage (-exitval => 0, -verbose => 1);
}

sub add (%) {
  my (%opt) = @_;
  push @{$opt{table}->[0]}, $opt{name};
  push @{$opt{table}->[$_]}, [] for 1..$#{$opt{table}};
  for my $class (sort keys %{$opt{list}}) {
    ELEMENT: for my $element (split /[\s|]+/, $opt{list}->{$class}) {
      for (@{$opt{table}}) {
        if ($_->[0] eq $element) {
          push @{$_->[-1]}, $class;
          next ELEMENT;
        }
      }
      my $row = [$element];
      for (my $i = $#{$opt{table}->[0]} - 1; $i > 0; $i--) {
        push @$row, [];
      }
      push @$row, [$class];
      push @{$opt{table}}, $row;
    }
  }
}

sub element ($) {
  my $el = shift;
  if ($el =~ /[A-Z%]/) {
    qq<<code>$el</code>>;
  } else {
    qq<<code class="HTMLe">$el</code>>;
  }
}

sub elements ($) {
  join ', ', map {element $_} @{$_[0]};
}

sub serialize ($$) {
  my ($tbl, $span) = @_;
  my $r = q<<table border><thead><tr>>;
  $r .= join '', map {qq<<th>$_</th>>} @{$tbl->[0]};
  $r .= q<</tr></thead><tbody>>;
  for my $i (1..$#$tbl) {
    $r .= q<<tr>>;
    $r .= q<<th>>.element ($tbl->[$i]->[0]).q<</th>>;
    for my $j (1..$#{$tbl->[$i]}) {
      if ($tbl->[$i]->[$j]) {
        $r .= q{<td};
        $r .= q< rowspan=">.$span->[$i]->[$j]->{row}.q<"> if $span->[$i]->[$j]->{row};
        $r .= q< colspan=">.$span->[$i]->[$j]->{col}.q<"> if $span->[$i]->[$j]->{col};
        $r .= q{>};
        $r .= elements ($tbl->[$i]->[$j]) || '-';
        $r .= q<</td>>;
      }
    }
    $r .= qq<</tr>\n>;
  }
  $r .= qq<</tbody></table>\n>;
  $r;
}

sub equal ($$) {
  my ($x, $y) = @_;
  return 0 unless @$x and @$y;
  for (0..$#$x) {
    return 0 unless $x->[$_] eq $y->[$_];
  }
  return 1;
}

sub merge_row ($$) {
  my ($tbl, $span) = @_;
  for my $i (1..($#$tbl-1)) {
    for my $j (1..$#{$tbl->[$i]}) {
      if ($tbl->[$i]->[$j]) {
        my $s = 1;
        for my $ii (($i+1)..$#$tbl) {
          if ($tbl->[$ii]->[$j] and
              $span->[$i]->[$j]->{col} == $span->[$ii]->[$j]->{col} and
              equal $tbl->[$i]->[$j] => $tbl->[$ii]->[$j]) {
            $s++;
            $tbl->[$ii]->[$j] = 0;
          } else {
            last;
          }
        }
        $span->[$i]->[$j]->{row} = $s if $s > 1;
      }
    }
  }
}

sub merge_col ($$) {
  my ($tbl, $span) = @_;
  for my $i (1..$#$tbl) {
    for my $j (1..($#{$tbl->[$i]}-1)) {
      if ($tbl->[$i]->[$j]) {
        my $s = 1;
        for my $jj (($j+1)..$#{$tbl->[$i]}) {
          if ($tbl->[$i]->[$jj] and
              $span->[$i]->[$j]->{row} == $span->[$i]->[$jj]->{row} and
              equal $tbl->[$i]->[$j] => $tbl->[$i]->[$jj]) {
            $s++;
            $tbl->[$i]->[$jj] = 0;
          } else {
            last;
          }
        }
        $span->[$i]->[$j]->{col} = $s if $s > 1;
      }
    }
  }
}

sub remove_empty_row ($) {
  my @tbl = @{+shift};
  ROW: for (my $i = $#tbl; $i > 1; $i--) {
    for my $j (1..$#{$tbl[$i]}) {
      next ROW if not $tbl[$i]->[$j] or
                  @{$tbl[$i]->[$j]};
    }
    delete $tbl[$i];
  }
  [grep defined $_, @tbl];
}

my $tbl = [map {[$_]} '', qw/p div noframes center hr address blockquote pre xmp listing h1 h2 h3 h4 h5 h6 menu dir ul ol dl form isindex fieldset table %blocktext %heading %Heading.class Heading %block.forms %preformatted %list %lists %List.class List %BlkStruct.class %BlkPhras.class %BlkPres.class %Form.class Form %Fieldset.class %Table.class Table %BlkSpecial.class %Block.extra %block %Block %Block.class %Block.mix Block
em strong code samp kbd var cite dfn abbr acronym q sub sup tt i b u strike s big small font basefont applet iframe object img map br span bdo input select textarea label button ruby a #PCDATA %phrase.basic %phrase.extra %logical.styles %phrase %InlPhras.class %fontstyle.basic %fontstyle.extra %font %physical.styles %fontstyle %InlPres.class %special.pre %special.basic %special.extra %special %InlStruct.class %I18n.class %InlSpecial.class %form %formctrl %form.fields %inline.forms %InlForm.class Formctrl %Ruby.class %Anchor.class %InlNoRuby.class %InlNoAnchor.class %Inline.extra %text %inline %Inline %Inline.class %Inline.mix Inline
ins del script noscript %Edit.class %Script.class %Misc.extra %misc.inline %misc %Misc.class
%flow %Flow %Flow.class %Flow.mix Flow/];
my @span;

for (@$LIST) {
  next if $argv{'no-strict'} and $_->{name} =~ /Strict|ISO-HTML|XHTML 1.1/
                                   and not $_->{name} =~ /Legacy/;
  next if $argv{'no-transitional'} and $_->{name} =~ /Transitional|Legacy/
                                   and not $_->{name} =~ /Frameset/;
  next if $argv{'no-frameset'} and $_->{name} =~ /Frameset/
                                   and not $_->{name} =~ /Transitional/;
  add table => $tbl, name => $_->{name}, list => $_->{class};
}
$tbl = remove_empty_row $tbl;
merge_col $tbl, \@span;
merge_row $tbl, \@span;

print STDOUT qq<<!DOCTYPE table SYSTEM>\n>;
print STDOUT serialize $tbl, \@span;

=head1 NAME

mkclstbl - HTML Element Type Class History Table Generator

=head1 SYNOPSIS

  mkclstbl.pl [--no-strict] [--no-transitional] [--no-frameset] > table.html
  mkclstbl.pl --help

=head1 DESCRIPTION

This script generates an HTML table that describes what element type belongs
what element class(es) in versions of HTML.

=head1 OPTIONS

This script has four arguments:

=over 4

=item --help

Show help message.

=item --no-frameset

Omit some columns that describes Frameset DTDs.

=item --no-strict

Omit some columns that describes Strict DTDs, ISO-HTML, XHTML 1.1 or
XHTML m12n Abstract Modules.

=item --no-transitional

Omit some columns that describes Transitional DTDs.

=back

=head1 SEE ALSO

HTML Specifications and DTDs.

<http://suika.fam.cx/www/2004/html/>.

=head1 LICENSE

Copyright 2004 Wakaba <w@suika.fam.cx>

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut

# $Date: 2004/09/23 01:29:03 $