browser: truncate maximum usage score to 99
[sheet.git] / tools / mkdigraphlist
index a1bfbcd05476d2bd77c6ee52365a1529d26256fd..a0c5ab23488f8e331a7d876a20a57c4ee2202c1d 100755 (executable)
@@ -5,204 +5,74 @@ use warnings;
 use utf8;
 
 use open OUT => ':utf8', ':std';
-use Data::Dumper;
-
-our $VERSION = '1.02';
-
-# expect input data source at command line
-@ARGV or die "Specify input source file or - for STDIN\n";
-
-# skip everything until a character indented by 1 space (table start)
-do {
-       $_ = readline;
-       defined or die "Premature input end";
-} until /^\s\S/;
-
-my @t = $_;  # add first line (already read, assume it's ok)
-
-# read the rest of the character table
-while ($_ = readline) {
-       # check for table end (chapter 4)
-       last if /^\d/;
-
-       # parse table lines (ignore (unindented) page break)
-       next unless s/^ //;
-       chomp;
-
-       # add the line to @t
-       if (s/^ {15}/ /) {
-               # continuation line (add to last entry)
-               $t[-1] .= $_;
-       }
-       else {
-               # add a new entry
-               push @t, $_;
-       }
-}
-
-# create a hash of desired input
-my %di;
-for (@t) {
-       my ($mnem, $char, $name) = split / +/, $_, 3;
-       next if length $mnem != 2;
-       $di{$mnem} = hex $char;
-}
-
-# XXX
-my %trans = (
-       0xE001 => 0,  # join lines: not accepted
-       0xE004 => 0,  # umlaut is no different from diaeresis 0x0308
-       0xE005 => 0x0344, # discouraged
-       0xE006 => 0x0300,
-       0xE007 => 0x0301,
-       0xE008 => 0x0302,
-       0xE009 => 0x0303,
-       0xE00A => 0x0304,
-       0xE00B => 0x0306,
-       0xE00C => 0x0307,
-       0xE00D => 0x0308,
-       0xE00E => 0x030A,
-       0xE00F => 0x030B,
-       0xE010 => 0x030C,
-       0xE011 => 0x0327,
-       0xE012 => 0x0328,
-       0xE013 => 0x0332,
-       0xE014 => 0x0333,
-       0xE015 => 0x0338,
-       0xE016 => 0x0345,
-       0xE017 => 0x0314,
-       0xE018 => 0x0313,
-       0xE019 => 0x1FFE,
-       0xE01A => 0x1FBF,
-       0xE01B => 0x03D0,  # middle beta = curled beta?
-       0xE01C => 0x25CB,
-       0xE01D => 0x0192,
-       0xE01E => 0x0292,
-       0xE01F => 0x33C2,  # am, compatibility char
-       0xE020 => 0x33D8,  # pm, compatibility char
-       0xE021 => 0x2121,
-       0xE022 => 0xFE8E,
-       0xE023 => 0,  # dutch guilder 0192 is already encoded, and not very useful anyway
-       0xE024 => 0x0393,
-       0xE025 => 0x20D7,  # also 20D1; non-spacing
-       0xE026 => 0x1FEF,
-       0xE027 => 0x1FC0,
-       0xE028 => 0x01F0, #but uppercase
-);
-for (values %di) {
-       $_ >= 0xE000 or next;
-       $_ = $trans{$_} if defined $trans{$_};
-}
-
-# personal addendums
-my @extra;
-if (-r 'shiar.inc.txt') {
-       open my $include, '<:utf8', 'shiar.inc.txt';
-       for (readline $include) {
-               m{^(\$?[!"%'-Z_a-z]{2}) (.)} or next;
-               warn("$1 already defined"), next if defined $di{$1};
-               $di{$1} = ord $2;
-               push @extra, $1;
-       }
-}
-warn $@ if $@;
-
-$di{chr $_} = $_ for 32 .. 126;
-$di{'\\'.$_} = delete $di{$_} for '{', '}', '\\';
+
+our $VERSION = '1.06';
+
+# import and combine various digraph data
+my $rfc = do 'data/digraphs-rfc.inc.pl'
+       or die "error reading digraphs include: ", $@ // $!;
+my $extra = do 'data/digraphs-shiar.inc.pl'
+       or warn "could not include shiar proposals: ", $@ // $!;
+my $vim = do 'data/digraphs-vim.inc.pl'
+       or warn "could not include vim extensions ", $@ // $!;
+my $vimold = do 'data/digraphs-vim-74.inc.pl'
+       or warn "could not include vim compatibility ", $@ // $!;
+my $di = { %{$vim // {}}, %{$rfc}, %{$extra // {}} };
 
 # 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 @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{$_} == 0x200E } keys %di;
-$info{$_}->{string} = '←' for grep { $di{$_} == 0x200F } keys %di;
-
-# 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;
-}
+my $uninfo = do 'unicode-char.inc.pl'
+       or warn "could not include unicode details: ", $@ // $!;
 
 # output perl code of hash
 # (assume no backslashes or curlies, so we can just q{} w/o escaping)
+print "# automatically generated by $0\n";
 print "use utf8;\n";
 print "+{\n";
 printf '(map {$_=>0} qw{%s}),'."\n", join(' ',
-       map { substr($_, 1, 1).substr($_, 0, 1) } sort keys %di
+       grep { !defined $di->{$_} }
+       map { substr($_, 1, 1).substr($_, 0, 1) } sort keys %{$di}
 );
-printf "q{%s}=>[%s],\n", $_, join(',',
-       $di{$_},   # original code point
-       $info{$_}  # optional additional arguments
-               ? map {"'$_'"} @{ $info{$_} }
-               : ()
-) for sort keys %di;
+printf "q{%s}=>[%s],\n", s/(?=[\\}])/\\/gr, join(',',
+       ord $di->{$_},   # original code point
+       map {"'$_'"}
+       $uninfo->{ $di->{$_} }->[1] // '',  # name
+       join(' ',
+               $rfc->{$_}
+                       ? $vim->{$_} ? 'l4' : 'l1'  # vim+rfc or rfc only
+                       : $vim->{$_} ? 'l3' : 'l2', # vim only or neither
+               $vimold && $vim->{$_} && !$vimold->{$_} ? 'ex' : (), # new vim feature
+       ),
+       ($uninfo->{ $di->{$_} }->[0] // '') =~ s/ u-di| u-prop| ex//gr,  # class
+       $uninfo->{ $di->{$_} }->[4] // (),  # string
+) for sort keys %{$di};
 print "}\n";
 
 __END__
 
 =head1 NAME
 
-mkdigraphlist - Output digraph data from RFC-1345
+mkdigraphlist - Output character list of combined digraph data
 
 =head1 SYNOPSIS
 
-Extract digraphs from text specifications as a perl hash:
-
-    mkdigraphlist rfc1345.txt custom.txt > digraphs.inc.pl
-
-Input can be the literal RFC (or similar) document:
-
-    curl http://www.ietf.org/rfc/rfc1345.txt | mkdigraphlist -
-
-Test by printing the character for DO (should be a dollar sign):
-
+    mkdigraphlist >digraphs.inc.pl
     perl -e'$di = do "digraphs.inc.pl"; print chr $di->{DO}->[0]'
 
 =head1 DESCRIPTION
 
-Parses the official RFC-1345 document, searching the
-'character mnemonic table' for all digraph definitions.
-If successful, Perl code is output resulting in a hash
-with character data keyed by digraph.
-Any errors and warnings are given at STDERR.
+Combines precompiled digraph includes of rfc (1345), vim, and shiar
+and outputs a complete map including character details and usage classes.
 
 The value can either be a scalar string containing another
 digraph which can be considered identical (usually inverted),
 or an array ref containing at least the resulting character's
 Unicode code point value.  If available, the following UCD data
-is appended: character name, category, script, and output string.
+is appended: character name, usage classes, unicode classes,
+and replacement output string.
 For example:
 
  +{
-   AE => [198, 'LATIN CAPITAL LETTER AE', 'Lu Xl', 'Latin'],
+   AE => [198, 'LATIN CAPITAL LETTER AE', 'u-di', 'Latin Lu Xl u-v11'],
    EA => 'AE',
   }