SYN SYN
[p5sagit/p5-mst-13.2.git] / lib / unicode / mktables.PL
index 4f705a4..37b6e84 100755 (executable)
@@ -1,12 +1,17 @@
 #!../../miniperl
 
-$UnicodeData = "Unicode.300";
+use bytes;
+
+$UnicodeData = "Unicode.301";
+$SyllableData = "syllables.txt";
+$PropData = "PropList.txt";
+
 
 # Note: we try to keep filenames unique within first 8 chars.  Using
 # subdirectories for the following helps.
-mkdir "In", 0777;
-mkdir "Is", 0777;
-mkdir "To", 0777;
+mkdir "In", 0755;
+mkdir "Is", 0755;
+mkdir "To", 0755;
 
 @todo = (
 # typical
@@ -14,16 +19,15 @@ mkdir "To", 0777;
     ['IsWord',  '$cat =~ /^L[ulot]|^Nd/ or $code eq "005F"',   ''],
     ['IsAlnum', '$cat =~ /^L[ulot]|^Nd/',      ''],
     ['IsAlpha',  '$cat =~ /^L[ulot]/', ''],
-    # XXX broken: recursive definition (/\s/ will look up IsSpace in future)
-    ['IsSpace',  '$cat =~ /^Z/ or $code lt "0020" and chr(hex $code) =~ /^\s/',        ''],
+    ['IsSpace',  'White space',        $PropData],
     ['IsDigit',  '$cat =~ /^Nd$/',     ''],
-    ['IsUpper',  '$cat =~ /^Lu$/',     ''],
+    ['IsUpper',  '$cat =~ /^L[ut]$/',  ''],
     ['IsLower',  '$cat =~ /^Ll$/',     ''],
     ['IsASCII',  'hex $code <= 127',   ''],
     ['IsCntrl',  '$cat =~ /^C/',       ''],
-    ['IsGraph',  '$cat =~ /^[^C]/ and $code ne "0020"',        ''],
+    ['IsGraph',  '$cat =~ /^[^C]/ and ($cat !~ /^Z/ and $code ne "0020" or chr(hex $code) !~ /^\s/)',  ''],
     ['IsPrint',  '$cat =~ /^[^C]/',    ''],
-    ['IsPunct',  '$cat =~ /^P/',       ''],
+    ['IsPunct',  'Punctuation',        $PropData],
     ['IsXDigit', '$code =~ /^00(3[0-9]|[46][1-6])$/',  ''],
     ['ToUpper',  '$up',                        '$up'],
     ['ToLower',  '$down',              '$down'],
@@ -43,12 +47,14 @@ mkdir "To", 0777;
     ['IsM',    '$cat =~ /^M/',         ''],    # Mark
     ['IsMn',   '$cat eq "Mn"',         ''],    # Mark, Non-Spacing 
     ['IsMc',   '$cat eq "Mc"',         ''],    # Mark, Combining
+    ['IsMe',   '$cat eq "Me"',         ''],    # Mark, Enclosing
 
     ['IsN',    '$cat =~ /^N/',         ''],    # Number
     ['IsNd',   '$cat eq "Nd"',         ''],    # Number, Decimal Digit
     ['IsNo',   '$cat eq "No"',         ''],    # Number, Other
+    ['IsNl',   '$cat eq "Nl"',         ''],    # Number, Letter
 
-    ['IsZ',    '$cat =~ /^Z/',         ''],    # Zeparator
+    ['IsZ',    '$cat =~ /^Z/',         ''],    # Separator
     ['IsZs',   '$cat eq "Zs"',         ''],    # Separator, Space
     ['IsZl',   '$cat eq "Zl"',         ''],    # Separator, Line
     ['IsZp',   '$cat eq "Zp"',         ''],    # Separator, Paragraph
@@ -57,6 +63,9 @@ mkdir "To", 0777;
     ['IsCc',   '$cat eq "Cc"',         ''],    # Other, Control or Format
     ['IsCo',   '$cat eq "Co"',         ''],    # Other, Private Use
     ['IsCn',   '$cat eq "Cn"',         ''],    # Other, Not Assigned
+    ['IsCf',   '$cat eq "Cf"',         ''],    # Other, Format
+    ['IsCs',   '$cat eq "Cs"',         ''],    # Other, Surrogate
+    ['IsCn',   'Unassigned Code Value',$PropData],     # Other, Not Assigned
  
 # Informative
 
@@ -72,9 +81,13 @@ mkdir "To", 0777;
     ['IsPs',   '$cat eq "Ps"',         ''],    # Punctuation, Open
     ['IsPe',   '$cat eq "Pe"',         ''],    # Punctuation, Close
     ['IsPo',   '$cat eq "Po"',         ''],    # Punctuation, Other
+    ['IsPc',   '$cat eq "Pc"',         ''],    # Punctuation, Connector
+    ['IsPi',   '$cat eq "Pi"',         ''],    # Punctuation, Initial quote
+    ['IsPf',   '$cat eq "Pf"',         ''],    # Punctuation, Final quote
 
     ['IsS',    '$cat =~ /^S/',         ''],    # Symbol
     ['IsSm',   '$cat eq "Sm"',         ''],    # Symbol, Math
+    ['IsSk',   '$cat eq "Sk"',         ''],    # Symbol, Modifier
     ['IsSc',   '$cat eq "Sc"',         ''],    # Symbol, Currency
     ['IsSo',   '$cat eq "So"',         ''],    # Symbol, Other
 
@@ -95,6 +108,15 @@ mkdir "To", 0777;
                                                # and punctuation specific to
                                                # those scripts
 
+    ['IsBidiLRE', '$bid eq "LRE"',       ''],    # Left-to-Right Embedding
+    ['IsBidiLRO', '$bid eq "LRO"',       ''],    # Left-to-Right Override
+    ['IsBidiAL', '$bid eq "AL"',         ''],    # Right-to-Left Arabic
+    ['IsBidiRLE', '$bid eq "RLE"',       ''],    # Right-to-Left Embedding
+    ['IsBidiRLO', '$bid eq "RLO"',       ''],    # Right-to-Left Override
+    ['IsBidiPDF', '$bid eq "PDF"',       ''],    # Pop Directional Format
+    ['IsBidiNSM', '$bid eq "NSM"',       ''],    # Non-Spacing Mark
+    ['IsBidiBN', '$bid eq "BN"',         ''],    # Boundary Neutral
+
 # Weak types:
 
     ['IsBidiEN','$bid eq "EN"',                ''],    # European Number
@@ -134,11 +156,12 @@ mkdir "To", 0777;
     ['IsDCnarrow',     '$decomp =~ /^<narrow>/',       ''],
     ['IsDCsmall',      '$decomp =~ /^<small>/',        ''],
     ['IsDCsquare',     '$decomp =~ /^<square>/',       ''],
+    ['IsDCfraction',   '$decomp =~ /^<fraction>/',     ''],
     ['IsDCcompat',     '$decomp =~ /^<compat>/',       ''],
 
 # Number
 
-    ['Number',         '$num',                 '$num'],
+    ['Number',         '$num ne ""',           '$num'],
 
 # Mirrored
 
@@ -155,19 +178,8 @@ mkdir "To", 0777;
 
 # Syllables
 
-    ['IsSylV', '$syl eq "V"',          ''],
-    ['IsSylU', '$syl eq "U"',          ''],
-    ['IsSylI', '$syl eq "I"',          ''],
-    ['IsSylA', '$syl eq "A"',          ''],
-    ['IsSylE', '$syl eq "E"',          ''],
-    ['IsSylC', '$syl eq "C"',          ''],
-    ['IsSylO', '$syl eq "O"',          ''],
-    ['IsSylWV',        '$syl eq "V"',          ''],
-    ['IsSylWI',        '$syl eq "I"',          ''],
-    ['IsSylWA',        '$syl eq "A"',          ''],
-    ['IsSylWE',        '$syl eq "E"',          ''],
-    ['IsSylWC',        '$syl eq "C"',          ''],
-    
+    syllable_defs(),
+
 # Line break properties - Normative
 
     ['IsLbrkBK','$brk eq "BK"',                ''],    # Mandatory Break
@@ -232,8 +244,8 @@ END
 
 exit if @ARGV and not grep { $_ eq Block } @ARGV;
 print "Block\n";
-open(UD, 'Blocks.txt') or die "Can't open blocks.txt: $!\n";
-open(OUT, ">Block.pl") or die "Can't create $table.pl: $!\n";
+open(UD, 'Blocks.txt') or die "Can't open Blocks.txt: $!\n";
+open(OUT, ">Block.pl") or die "Can't create Block.pl: $!\n";
 print OUT <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 # This file is built by $0 from e.g. $UnicodeData.
@@ -277,6 +289,8 @@ sub proplist {
     my $out;
     my $split;
 
+    return listFromPropFile($wanted) if $val eq $PropData;
+
     if ($table =~ /^Arab/) {
        open(UD, "ArabShap.txt") or warn "Can't open $table: $!";
 
@@ -288,7 +302,7 @@ sub proplist {
        $split = '($code, $short, $name) = split(/; */); $code =~ s/^U\+//;';
     }
     elsif ($table =~ /^IsSyl/) {
-       open(UD, "syllables.txt") or warn "Can't open $table: $!";
+       open(UD, $SyllableData) or warn "Can't open $table: $!";
 
        $split = '($code, $short, $syl) = split(/; */); $code =~ s/^U\+//;';
     }
@@ -308,8 +322,8 @@ sub proplist {
        eval <<"END";
            while (<UD>) {
                next if /^#/;
-               next if /^\s/;
-               chop;
+               next if /^\\s/;
+               s/\\s+\$//;
                $split
                if ($wanted) {
                    push(\@wanted, [hex \$code, hex $val, \$name =~ /, First>\$/]);
@@ -343,7 +357,7 @@ END
        eval <<"END";
            while (<UD>) {
                next if /^#/;
-               next if /^\s*\$/;
+               next if /^\\s*\$/;
                chop;
                $split
                if ($wanted) {
@@ -376,4 +390,44 @@ END
     $out;
 }
 
+sub listFromPropFile {
+    my ($wanted) = @_;
+    my $out;
+
+    open (UD, $PropData) or die "Can't open $PropData: $!\n";
+    local($/) = "\n" . '*' x 43 . "\n\nProperty dump for:";   # not 42?
+
+    <UD>;
+    while (<UD>) {
+        chomp;
+        if (s/0x[\d\w]+\s+\((.*?)\)// and $wanted eq $1) {
+            s/\(\d+ chars\)//g;
+            s/^\s+//mg;
+            s/\s+$//mg;
+            s/\.\./\t/g;
+           $out = lc $_;
+           last;
+        }
+    }
+    close (UD);
+    "$out\n";
+}
+
+sub syllable_defs {
+    my @defs;
+    my %seen;
+
+    open (SD, $SyllableData) or die "Can't open $SyllableData: $!\n";
+    while (<SD>) {
+        next if /^\s*(#|$)/;
+        s/\s+$//;
+        ($code, $name, $syl) = split /; */;
+        next unless $syl;
+        push (@defs, ["IsSyl$syl", qq{\$syl eq "$syl"}, ''])
+                                                     unless $seen{$syl}++;
+    }
+    close (SD);
+    return (@defs);
+}
+
 # eof