digraphs: reuse unicode character details
authorMischa POSLAWSKY <perl@shiar.org>
Sat, 21 Feb 2015 02:58:21 +0000 (03:58 +0100)
committerMischa POSLAWSKY <perl@shiar.org>
Tue, 9 Jun 2015 03:43:41 +0000 (05:43 +0200)
Makefile
digraphs.plp
tools/mkcharinfo
tools/mkdigraphlist

index 6314e18f154cd29d25ddcc43d0a0e2005d7a74e7..c94599666838d3c4003c47cf3580a6385bdd3e07 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all: unicode-char.inc.pl unicode-cover.inc.pl countries.inc.pl data/browser/support.inc.pl
+all: digraphs.inc.pl unicode-cover.inc.pl countries.inc.pl data/browser/support.inc.pl
 
 download: data/DerivedAge.txt data/rfc1345.txt data/countryInfo.txt data/caniuse.json
 .PHONY: download
 
 download: data/DerivedAge.txt data/rfc1345.txt data/countryInfo.txt data/caniuse.json
 .PHONY: download
@@ -18,10 +18,10 @@ data/digraphs-rfc.inc.pl: tools/mkdigraphs-rfc data/rfc1345.txt
 data/digraphs-shiar.inc.pl: tools/mkdigraphs-shiar shiar.inc.txt
        $< $(word 2,$^) >$@
 
 data/digraphs-shiar.inc.pl: tools/mkdigraphs-shiar shiar.inc.txt
        $< $(word 2,$^) >$@
 
-digraphs.inc.pl: tools/mkdigraphlist data/digraphs-rfc.inc.pl data/digraphs-shiar.inc.pl
+digraphs.inc.pl: tools/mkdigraphlist data/digraphs-rfc.inc.pl data/digraphs-shiar.inc.pl unicode-char.inc.pl
        $< >$@
 
        $< >$@
 
-unicode-char.inc.pl: tools/mkcharinfo digraphs.inc.pl unicode-age.inc.pl
+unicode-char.inc.pl: tools/mkcharinfo data/digraphs-rfc.inc.pl data/digraphs-shiar.inc.pl unicode-age.inc.pl
        $< >$@
 
 ttfsupport: tools/mkttfinfo
        $< >$@
 
 ttfsupport: tools/mkttfinfo
index 3f2d1bf090127d5028ca28f16b381cb4a4755fbf..702e3e6054fcdc959eba43ea7be0f4d32d83e3d6 100644 (file)
@@ -63,7 +63,7 @@ for my $c1group (@chars) {
                        my @class = ('X', grep {$_} $prop, $script);
 
                        $glyph = EscapeHTML($glyph);
                        my @class = ('X', grep {$_} $prop, $script);
 
                        $glyph = EscapeHTML($glyph);
-                       $glyph = "<span>$glyph</span>" if $prop eq 'Zs';
+                       $glyph = "<span>$glyph</span>" if $prop =~ /\bZs\b/;
 
                        printf "\n".'<td class="%s" title="%s">%s',
                                join(' ', @class), EscapeHTML($desc), $glyph;
 
                        printf "\n".'<td class="%s" title="%s">%s',
                                join(' ', @class), EscapeHTML($desc), $glyph;
index 23154959e50b654ff454ce50d8e6da1b5e842523..b58f0c373f6215e828e4ad787683d1cfc23cd114 100755 (executable)
@@ -47,7 +47,8 @@ eval {
 } or warn "Failed importing html entities: $@";
 
 my %diinc = (
 } or warn "Failed importing html entities: $@";
 
 my %diinc = (
-       'digraphs.inc.pl' => 'u-di',
+       'data/digraphs-rfc.inc.pl' => 'u-di',
+       'data/digraphs-shiar.inc.pl' => 'u-prop Xz',
 );
 for (keys %diinc) {
        -e $_ or next;
 );
 for (keys %diinc) {
        -e $_ or next;
@@ -55,13 +56,8 @@ for (keys %diinc) {
        while (my ($mnem, $cp) = each %$di) {
                length $mnem == 2 or next;  # limit to digraphs
                my $class = $diinc{$_};
        while (my ($mnem, $cp) = each %$di) {
                length $mnem == 2 or next;  # limit to digraphs
                my $class = $diinc{$_};
-               if (ref $cp) {
-                       # old style array
-                       $class = 'u-prop' if $cp->[2] and $cp->[2] =~ m/\bXz\b/;
-                       $cp = chr $cp->[0];
-               }
-               $info{$cp}->{di} //= $mnem;
-               $info{$cp}->{class}->{$class}++;
+               $info{chr $cp}->{di} //= $mnem;
+               $info{chr $cp}->{class}->{$class}++;
        }
 }
 
        }
 }
 
index 4cacc6c4b9aec1c15ef26cde73813acc99b36d2d..4af35901004c4fb1d57d681d70bc7dc1ee26ce3f 100755 (executable)
@@ -18,51 +18,15 @@ my $extra = do 'data/digraphs-shiar.inc.pl'
        or warn "could not include shiar proposals: ", $@ // $!;
 $di = { %{$di}, %{$extra // {}} };
 
        or warn "could not include shiar proposals: ", $@ // $!;
 $di = { %{$di}, %{$extra // {}} };
 
-$di->{chr $_} = $_ for 32 .. 126;
-$di->{'\\'.$_} = delete $di->{$_} for '{', '}', '\\';
-
 # optionally get unicode character information
 # optionally get unicode character information
-my %info = eval {
-       require Unicode::UCD;
-       map {
-               $_ => Unicode::UCD::charinfo($di->{$_})
-                       || { block => '?', category => 'Xn', name => '', script => '' }
-       } keys %{$di};
-};
-
-# add custom categories for certain blocks
-for (values %info) {
-       $_->{category} .= ' Xa' if $_->{block} eq 'Basic Latin';
-       $_->{category} .= ' Xl' if $_->{block} eq 'Latin-1 Supplement';
-}
-
-# mark unofficial extras as such
-$info{$_}->{category} .= ' Xz' for keys %{$extra};
-
-for (keys %{$di}) {
-       $info{$_}->{string} = chr(9676) . chr($di->{$_}) if $info{$_}->{combining};
-       # find control characters (first 32 chars from 0 and 128)
-       next unless ($di->{$_} & ~0b1001_1111) == 0 or $di->{$_} == 127;
-       # rename to something more descriptive
-       $info{$_}->{name} = $info{$_}->{unicode10}
-               ? '<'.$info{$_}->{unicode10}.'>'  # the old name was much more useful
-               : sprintf('<control U+%04X>', $di->{$_});  # at least identify by value
-       # show descriptive symbols instead of control chars themselves
-       $info{$_}->{string} = $di->{$_} < 32 ? chr($di->{$_} + 0x2400) : chr(0xFFFD);
-}
-# presentational string for some control(lish) entries
-$info{$_}->{string} = '-' for grep { $di->{$_} == 0x00AD } keys %{$di};
-$info{$_}->{string} = '␣' for grep { $di->{$_} == 0x200B } keys %{$di};
-$info{$_}->{string} = '|' for grep { $di->{$_} == 0x200C } keys %{$di};
-$info{$_}->{string} = '⁀' for grep { $di->{$_} == 0x200D } keys %{$di};
-$info{$_}->{string} = '→' for grep { $di->{$_} == 0x200E } keys %{$di};
-$info{$_}->{string} = '←' for grep { $di->{$_} == 0x200F } keys %{$di};
+my $uninfo = do 'unicode-char.inc.pl'
+       or warn "could not include unicode details: ", $@ // $!;
 
 # convert info hashes into arrays of strings to output in display order
 
 # convert info hashes into arrays of strings to output in display order
-for my $row (values %info) {
-       $row = [ map { $row->{$_} } qw/name category script string/ ];
-       # strip off trailing missing values (especially string may be unknown)
-       defined $row->[-1] ? last : pop @$row for 1 .. @$row;
+for my $row (values %{$uninfo}) {
+       my ($class, $name, $di, $html, $string) = @{$row};
+       $row = [$name, $class];
+       push @{$row}, '', $string if defined $string;
 }
 
 # output perl code of hash
 }
 
 # output perl code of hash
@@ -75,9 +39,7 @@ printf '(map {$_=>0} qw{%s}),'."\n", join(' ',
 );
 printf "q{%s}=>[%s],\n", $_, join(',',
        $di->{$_},   # original code point
 );
 printf "q{%s}=>[%s],\n", $_, join(',',
        $di->{$_},   # original code point
-       $info{$_}  # optional additional arguments
-               ? map {"'$_'"} @{ $info{$_} }
-               : ()
+       (map {"'$_'"} @{ $uninfo->{ chr $di->{$_} } // [] }),  # optional additional arguments
 ) for sort keys %{$di};
 print "}\n";
 
 ) for sort keys %{$di};
 print "}\n";