Salvage bits and pieces from the experimental 'utf8 everywhere'

[p5sagit/p5-mst-13.2.git] / lib / unicode / mktables.PL

diff --git a/lib/unicode/mktables.PL b/lib/unicode/mktables.PL
index 608a325..637050a 100755 (executable)
--- a/lib/unicode/mktables.PL
+++ b/lib/unicode/mktables.PL
@@ -2,32 +2,46 @@
 
 use bytes;
 
-$UnicodeData = "Unicode.301";
+$UnicodeData = "Unicode.txt";
 $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
 
-    ['IsWord',  '$cat =~ /^L[ulot]|^Nd/ or $code eq "005F"',   ''],
-    ['IsAlnum', '$cat =~ /^L[ulot]|^Nd/',      ''],
-    ['IsAlpha',  '$cat =~ /^L[ulot]/', ''],
-    ['IsSpace',  'White space',        $PropData],
+    # 005F: SPACING UNDERSCROE
+    ['IsWord',   '$cat =~ /^[LMN]/ or $code eq "005F"',        ''],
+    ['IsAlnum',  '$cat =~ /^[LMN]/',   ''],
+    ['IsAlpha',  '$cat =~ /^[LM]/',    ''],
+    # 0009: HORIZONTAL TABULATION
+    # 000A: LINE FEED
+    # 000B: VERTICAL TABULATION
+    # 000C: FORM FEED
+    # 000D: CARRIAGE RETURN
+    # 0020: SPACE
+    ['IsSpace',  '$cat  =~ /^Z/ ||
+                  $code =~ /^(0009|000A|000B|000C|000D)$/',    ''],
+    ['IsSpacePerl',
+                 '$cat  =~ /^Z/ ||
+                  $code =~ /^(0009|000A|000C|000D)$/',         ''],
+    ['IsBlank',  '$code =~ /^(0020|0009)$/ ||
+                 $cat  =~ /^Z[^lp]$/', ''],
     ['IsDigit',  '$cat =~ /^Nd$/',     ''],
     ['IsUpper',  '$cat =~ /^L[ut]$/',  ''],
     ['IsLower',  '$cat =~ /^Ll$/',     ''],
-    ['IsASCII',  'hex $code <= 127',   ''],
+    ['IsASCII',  '$code le "007f"',    ''],
     ['IsCntrl',  '$cat =~ /^C/',       ''],
-    ['IsGraph',  '$cat =~ /^[^C]/ and ($cat !~ /^Z/ and $code ne "0020" or chr(hex $code) !~ /^\s/)',  ''],
-    ['IsPrint',  '$cat =~ /^[^C]/',    ''],
-    ['IsPunct',  'Punctuation',        $PropData],
+    ['IsGraph',  '$cat =~ /^([LMNPS]|Co)/',    ''],
+    ['IsPrint',  '$cat =~ /^([LMNPS]|Co|Zs)/', ''],
+    ['IsPunct',  '$cat =~ /^P/',       ''],
+    # 003[0-9]: DIGIT ZERO..NINE, 00[46][1-6]: A..F, a..f
     ['IsXDigit', '$code =~ /^00(3[0-9]|[46][1-6])$/',  ''],
     ['ToUpper',  '$up',                        '$up'],
     ['ToLower',  '$down',              '$down'],
@@ -145,7 +159,7 @@ mkdir "To", 0777;
     ['IsDCfont',       '$decomp =~ /^<font>/',         ''],
     ['IsDCnoBreak',    '$decomp =~ /^<noBreak>/',      ''],
     ['IsDCinitial',    '$decomp =~ /^<initial>/',      ''],
-    ['IsDCinital',     '$decomp =~ /^<medial>/',       ''],
+    ['IsDCmedial',     '$decomp =~ /^<medial>/',       ''],
     ['IsDCfinal',      '$decomp =~ /^<final>/',        ''],
     ['IsDCisolated',   '$decomp =~ /^<isolated>/',     ''],
     ['IsDCcircle',     '$decomp =~ /^<circle>/',       ''],
@@ -217,11 +231,24 @@ mkdir "To", 0777;
 
 # This is not written for speed...
 
+my %InId;
+my $InId = 0;
+
 foreach $file (@todo) {
     my ($table, $wanted, $val) = @$file;
     next if @ARGV and not grep { $_ eq $table } @ARGV;
-    print $table,"\n";
-    if ($table =~ /^(Is|In|To)(.*)/) {
+    print $table, "\n";
+    $table =~ s/\W+//g;
+    if ($table =~ /^In(.+)/) {
+       my $id;
+        unless (exists $InId{$1}) {
+           $InId{$1} = $InId++;
+       }
+       $id = $InId{$1};
+       open(OUT, ">In/$id.pl") or die "Can't create In/$id.pl: $!\n";
+       print OUT "# In/$id.pl $1\n";
+    }
+    elsif ($table =~ /^(Is|To)(.+)/) {
        open(OUT, ">$1/$2.pl") or die "Can't create $1/$2.pl: $!\n";
     }
     else {
@@ -243,9 +270,9 @@ END
 # Must treat blocks specially.
 
 exit if @ARGV and not grep { $_ eq Block } @ARGV;
-print "Block\n";
+print "Blocks\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";
+open(OUT, ">Blocks.pl") or die "Can't create Blocks.pl: $!\n";
 print OUT <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 # This file is built by $0 from e.g. $UnicodeData.
@@ -259,11 +286,17 @@ while (<UD>) {
     next if /^#/;
     next if /^$/;
     chomp;
-    ($code, $last, $name) = split(/; */);
+    ($code, $last, $name) = /^([0-9a-f]+)\.\.([0-9a-f]+); (.+)/i;
     if ($name) {
        print OUT "$code        $last   $name\n";
-       $name =~ s/\s+//g;
-       open(BLOCK, ">In/$name.pl");
+       $name =~ s/\W+//g;
+       my $id;
+        unless (exists $InId{$name}) {
+           $InId{$name} = $InId++;
+       }
+       $id = $InId{$name};
+       open(BLOCK, ">In/$id.pl");
+       print OUT "# In/$id.pl $name\n";
        print BLOCK <<EOH;
 # !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
 # This file is built by $0 from e.g. $UnicodeData.
@@ -281,6 +314,24 @@ END2
 print OUT "END\n";
 close OUT;
 
+open(INID, ">In.pl");
+
+print INID <<EOH;
+# !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!! 
+# This file is built by $0 from e.g. $UnicodeData.
+# Any changes made here will be lost!
+%utf8::In = (
+EOH
+
+# Order doesn't matter but let's prettyprint anyway.
+foreach my $in (sort { $InId{$a} <=> $InId{$b} } keys %InId) {
+    printf INID "%-40s => %3d,\n", "'$in'", $InId{$in};
+}
+
+print INID ");\n";
+
+close(INID);
+
 ##################################################
 
 sub proplist {
@@ -309,7 +360,7 @@ sub proplist {
     elsif ($table =~ /^IsLbrk/) {
        open(UD, "LineBrk.txt") or warn "Can't open $table: $!";
 
-       $split = '($code, $brk, $name) = split(/;/);';
+       $split = '($code, $brk, $name) = /^([0-9a-f]+);(\w+) # (.+)/i;';
     }
     else {
        open(UD, $UnicodeData) or warn "Can't open $UnicodeData: $!";