X-Git-Url: http://git.shiar.nl/sheet.git/blobdiff_plain/8b97a83492e41bb4a90081c1ad58f90ac031def3..5f257afb85ce61ae765dffad95ce755acb760234:/Shiar_Sheet/FormatChar.pm?ds=sidebyside diff --git a/Shiar_Sheet/FormatChar.pm b/Shiar_Sheet/FormatChar.pm index ef0445d..0a8a50a 100644 --- a/Shiar_Sheet/FormatChar.pm +++ b/Shiar_Sheet/FormatChar.pm @@ -8,7 +8,7 @@ use utf8; use Data::Dump 'pp'; use PLP::Functions 'EscapeHTML'; -our $VERSION = '1.07'; +our $VERSION = '1.08'; our $uc = do 'unicode-char.inc.pl'; @@ -183,7 +183,7 @@ sub cell { return sprintf('<%s>%s%s', join(' ', 'td', - defined $title ? qq{ title="$title"} : (), + defined $title ? qq{title="$title"} : (), @class ? sprintf('class="%s"', join ' ', @class) : (), $html || (), ), @@ -192,33 +192,20 @@ sub cell { ); } -sub table { - my ($self, $digraphs) = @_; - - my @rows; - - my @colheads; - while ($digraphs->[0] !~ /^\./) { - my $cell = shift @$digraphs or last; - push @colheads, sprintf( - '<%s%s>%s', - $cell =~ s/^-// ? 'td' : 'th', - $cell =~ s/:(.*)// ? qq{ title="$1"} : '', - $cell eq '_' ? ' ' : $cell - ); - } - push @rows, sprintf '%s', join '', @colheads if @colheads; +sub row { + my ($self, $cells) = @_; + my @html; my $colspan = 1; - for my $cell (@$digraphs) { + for my $cell (@{$cells}) { if ($cell =~ s/^\.//) { # dot indicates start of a new row - push @rows, ''; + push @html, ''; if ($cell =~ s/^>//) { # header cell text follows $cell =~ s/_/ /g; # underscores may be used instead of whitespace (for qw//ability) my $class = $cell =~ s/^-// && ' class="ex"'; - $rows[-1] .= "".($cell || ' '); + $html[-1] .= "".($cell || ' '); } next; } @@ -228,24 +215,50 @@ sub table { next; } elsif ($cell eq '>-') { - $rows[-1] .= ''; + $html[-1] .= ''; next; } elsif ($cell =~ m/^'.$cell; + $html[-1] .= ''.$cell; next; } - $rows[-1] .= $self->cell($cell, + $html[-1] .= $self->cell($cell, $colspan > 1 && qq{colspan="$colspan"}, ); $colspan = 1; } - return sprintf qq{\n%s
\n}, - @{ $self->{anno} } ? ' dilabel' : '', - join '', map {"$_\n"} @rows; + return @html; +} + +sub tabletag { + my ($self) = @_; + my $class = 'glyphs'; + $class .= ' dilabel' if @{ $self->{anno} }; + return sprintf '', $class; +} + +sub table { + my ($self, $digraphs) = @_; + + my @rows; + + my @colheads; + while ($digraphs->[0] !~ /^\./) { + my $cell = shift @$digraphs or last; + push @colheads, sprintf( + '<%s%s>%s', + $cell =~ s/^-// ? 'td' : 'th', + $cell =~ s/:(.*)// ? qq{ title="$1"} : '', + $cell eq '_' ? ' ' : $cell + ); + } + push @rows, sprintf '%s', join '', @colheads if @colheads; + push @rows, $self->row($digraphs); + + return join '', map {"$_\n"} $self->tabletag, @rows, '
'; } sub print {