charset: avoid encode aliases for special requests

[sheet.git] / charset.plp

diff --git a/charset.plp b/charset.plp
index 74ea8e7c2d4095cc57aee87b80d64e96f495c277..aa81d0b36de07426d29b5db5ea249bee3252e2ea 100644 (file)
--- a/charset.plp
+++ b/charset.plp
@@ -43,7 +43,7 @@ sub optionlink {
 print join " •\n", (
        map {
                join " ·\n", pairmap {
-                       optionlink($b || ucfirst $a, "/charset/$a?compare", $a eq $Request);
+                       optionlink($b || ucfirst $a, '/charset'.($a && "/$a?compare"), $a eq $Request);
                } @{$_}
        }
        [
@@ -51,6 +51,7 @@ print join " •\n", (
                dos      => 'DOS',
                mac      => 'Apple',
                ebcdic   => 'EBCDIC',
+               $tablist[0] eq 'default' ? () : ('' => 'common'),
        ],
        [
                westeur  => 'West',
@@ -77,7 +78,7 @@ sub tabinput {
        my $input = shift or return;
 
        state $ALIAS = {
-               default    => [qw( unicode+0-639 utf-8 iso-8859-1 iso-8859-15 cp1252 cp437 cp850 )],
+               default    => [qw( unicode+0-639 utf-8+realsize iso-8859-1 iso-8859-15 cp1252 cp437 cp850 )],
                uc         => [qw( U+cols=32 unicode+0-4095 unicode+4096-6319  unicode+6320-8191 )],
                us         => [qw( cp437 cp863 gsm0338 AdobeStandardEncoding )],
                ebcdic     => [qw( cp37 cp500 cp1047 posix-bc cp1026 cp875 )],
@@ -222,7 +223,10 @@ sub tabinput {
        }
 
        for my $param (split /[+]+/, $params // '') {
-               if ($param =~ m{ \A cols = (\d+) \z }x) {
+               if ($param eq 'realsize') {
+                       $row{realsize}++;
+               }
+               elsif ($param =~ m{ \A cols = (\d+) \z }x) {
                        $row{cols} = $1;
                }
                elsif ($param =~ m{ \A (?<offset> \d+) (?: [-] (?<endpoint> \d+) )? \z }x) {
@@ -258,44 +262,49 @@ sub tabinput {
                        or Alert('Table data could not be read', $@ || $!);
                $row{endpoint} = 1023 * $row{cell}->{colsize};
        }
+       elsif ($input eq 'unicode') {
+               $row{cell} = do 'charset-unicode.inc.pl'
+                       or Alert('Table data could not be read', $@ || $!);
+
+               $row{endpoint} ||= 8191;
+               $row{endpoint}  *= $row{cell}->{colsize};
+               $row{startpoint} = $row{cell}->{colsize} * $row{offset};
+               $row{offset} = 0;
+               $row{set} = 'Unicode ' . (
+                       $row{startpoint} <  0x10000 && $row{endpoint} < 0x10000 ? 'BMP' :
+                       $row{startpoint} >= 0x10000 && $row{endpoint} < 0x20000 ? 'SMP' :
+                       'allocations'
+               );
+       }
+       elsif ($input =~ m/^utf-*8$/i) {
+               $row{set} = 'UTF-8';
+               $row{cell} = do 'charset-utf8.inc.pl'
+                       or Alert('Table data could not be read', $@ || $!);
+               $row{endpoint} = 255;
+       }
        elsif ($row{set} = Encode::resolve_alias($input)) {
-               if ($row{set} eq 'Internal') {
-                       $row{cell} = do 'charset-unicode.inc.pl'
-                               or Alert('Table data could not be read', $@ || $!);
-
-                       $row{endpoint} ||= 8191;
-                       $row{endpoint}  *= $row{cell}->{colsize};
-                       $row{startpoint} = $row{cell}->{colsize} * $row{offset};
-                       $row{offset} = 0;
-                       $row{set} = 'Unicode ' . (
-                               $row{startpoint} <  0x10000 && $row{endpoint} < 0x10000 ? 'BMP' :
-                               $row{startpoint} >= 0x10000 && $row{endpoint} < 0x20000 ? 'SMP' :
-                               'allocations'
-                       );
-               }
-               elsif ($row{set} eq 'utf-8-strict') {
-                       $row{set} = 'UTF-8';
-                       $row{cell} = do 'charset-utf8.inc.pl'
-                               or Alert('Table data could not be read', $@ || $!);
-                       $row{endpoint} = 255;
+               $row{endpoint} ||= 255;
+               if ($row{set} eq 'MacHebrew' or $row{set} eq 'MacThai') {
+                       # array of possibly multiple characters per code point
+                       $row{table} = [
+                               map { Encode::decode($row{set}, pack 'C*', $_) } $row{offset} .. $row{endpoint}
+                       ];
                }
                else {
-                       $row{endpoint} ||= 255;
-                       if ($row{set} eq 'MacHebrew' or $row{set} eq 'MacThai') {
-                               # array of possibly multiple characters per code point
-                               $row{table} = [
-                                       map { Encode::decode($row{set}, pack 'C*', $_) } $row{offset} .. $row{endpoint}
-                               ];
-                       }
-                       else {
-                               # ~16x faster than decoding in loop;
-                               # substr strings is twice as fast as splitting to an array
-                               $row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $row{endpoint});
-                       }
-                       $row{endpoint} -= $row{offset};
+                       # ~16x faster than decoding in loop;
+                       # substr strings is twice as fast as splitting to an array
+                       $row{table} = Encode::decode($row{set}, pack 'C*', $row{offset} .. $row{endpoint});
+               }
+               $row{endpoint} -= $row{offset};
 
-                       if ($row{set} eq 'cp437' and !$row{offset}) {
-                               substr($row{table}, 237, 1) = pack 'U*', 0x3D5; # phi sign
+               if ($row{set} eq 'cp437') {
+                       for my $phipos (237 - $row{offset}) {
+                               next if $phipos < 0 or $phipos > $row{endpoint};
+                               # replace phi glyph
+                               substr($row{table}, $phipos, 1) = pack 'U*', 0x3D5;
+                       }
+                       if ($row{offset} == 0) {
+                               # replace control characters by visible variants
                                substr($row{table}, 0, 32) = pack 'U*', map {hex} qw(
                                        2007 263A 263B 2665 2666 2663 2660 2022
                                        25D8 25CB 25D9 2642 2640 266A 266B 263C
@@ -303,10 +312,10 @@ sub tabinput {
                                        2191 2193 2192 2190 221F 2194 25B2 25BC
                                );
                        }
-
-                       $visible->{ascii} =  # assume common base
-                       $visible->{ $row{set} } = 1;
                }
+
+               $visible->{ascii} =  # assume common base
+               $visible->{ $row{set} } = 1;
        }
        else {
                Alert("Encoding <q>$input</q> unknown");
@@ -361,13 +370,15 @@ sub range_cell {
                        $class .= ' joind';
                }
 
-               # coalesce multiple rows
-               while ($rows > 3) {
-                       $info->{skip}->{$offset += $rowsize}++;
-                       $rows--;
-               }
-               if ($rows > 2) {
-                       $info->{skip}->{$offset += $rowsize} = 0;
+               unless ($info->{realsize}) {
+                       # coalesce multiple rows
+                       while ($rows > 3) {
+                               $info->{skip}->{$offset += $rowsize}++;
+                               $rows--;
+                       }
+                       if ($rows > 2) {
+                               $info->{skip}->{$offset += $rowsize} = 0;
+                       }
                }
 
                $attr .= sprintf ' rowspan=%d', $rows;