glib/gen-unicode-tables.pl

   1 #! /usr/bin/perl -w
   2
   3 #    Copyright (C) 1998, 1999 Tom Tromey
   4 #    Copyright (C) 2001 Red Hat Software
   5
   6 #    This program is free software; you can redistribute it and/or modify
   7 #    it under the terms of the GNU General Public License as published by
   8 #    the Free Software Foundation; either version 2, or (at your option)
   9 #    any later version.
  10
  11 #    This program is distributed in the hope that it will be useful,
  12 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #    GNU General Public License for more details.
  15
  16 #    You should have received a copy of the GNU General Public License
  17 #    along with this program; if not, write to the Free Software
  18 #    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  19 #    02111-1307, USA.
  20
  21 # gen-unicode-tables.pl - Generate tables for libunicode from Unicode data.
  22 # See http://www.unicode.org/Public/UNIDATA/UnicodeCharacterDatabase.html
  23 # Usage: gen-unicode-tables.pl [-decomp | -both] UNICODE-VERSION UnicodeData.txt LineBreak.txt SpecialCasing.txt CaseFolding.txt
  24 # I consider the output of this program to be unrestricted.  Use it as
  25 # you will.
  26
  27 # FIXME:
  28 # * We could save even more space in the generated table by using
  29 #   indexes and not pointers.
  30 # * For decomp table it might make sense to use a shift count other
  31 #   than 8.  We could easily compute the perfect shift count.
  32
  33 use vars qw($CODE $NAME $CATEGORY $COMBINING_CLASSES $BIDI_CATEGORY $DECOMPOSITION $DECIMAL_VALUE $DIGIT_VALUE $NUMERIC_VALUE $MIRRORED $OLD_NAME $COMMENT $UPPER $LOWER $TITLE $BREAK_CODE $BREAK_CATEGORY $BREAK_NAME $CASE_CODE $CASE_LOWER $CASE_TITLE $CASE_UPPER $CASE_CONDITION);
  34
  35 # Names of fields in Unicode data table.
  36 $CODE = 0;
  37 $NAME = 1;
  38 $CATEGORY = 2;
  39 $COMBINING_CLASSES = 3;
  40 $BIDI_CATEGORY = 4;
  41 $DECOMPOSITION = 5;
  42 $DECIMAL_VALUE = 6;
  43 $DIGIT_VALUE = 7;
  44 $NUMERIC_VALUE = 8;
  45 $MIRRORED = 9;
  46 $OLD_NAME = 10;
  47 $COMMENT = 11;
  48 $UPPER = 12;
  49 $LOWER = 13;
  50 $TITLE = 14;
  51
  52 # Names of fields in the line break table
  53 $BREAK_CODE = 0;
  54 $BREAK_PROPERTY = 1;
  55
  56 # Names of fields in the SpecialCasing table
  57 $CASE_CODE = 0;
  58 $CASE_LOWER = 1;
  59 $CASE_TITLE = 2;
  60 $CASE_UPPER = 3;
  61 $CASE_CONDITION = 4;
  62
  63 # Names of fields in the CaseFolding table
  64 $FOLDING_CODE = 0;
  65 $FOLDING_STATUS = 1;
  66 $FOLDING_MAPPING = 2;
  67
  68 # Map general category code onto symbolic name.
  69 %mappings =
  70     (
  71      # Normative.
  72      'Lu' => "G_UNICODE_UPPERCASE_LETTER",
  73      'Ll' => "G_UNICODE_LOWERCASE_LETTER",
  74      'Lt' => "G_UNICODE_TITLECASE_LETTER",
  75      'Mn' => "G_UNICODE_NON_SPACING_MARK",
  76      'Mc' => "G_UNICODE_COMBINING_MARK",
  77      'Me' => "G_UNICODE_ENCLOSING_MARK",
  78      'Nd' => "G_UNICODE_DECIMAL_NUMBER",
  79      'Nl' => "G_UNICODE_LETTER_NUMBER",
  80      'No' => "G_UNICODE_OTHER_NUMBER",
  81      'Zs' => "G_UNICODE_SPACE_SEPARATOR",
  82      'Zl' => "G_UNICODE_LINE_SEPARATOR",
  83      'Zp' => "G_UNICODE_PARAGRAPH_SEPARATOR",
  84      'Cc' => "G_UNICODE_CONTROL",
  85      'Cf' => "G_UNICODE_FORMAT",
  86      'Cs' => "G_UNICODE_SURROGATE",
  87      'Co' => "G_UNICODE_PRIVATE_USE",
  88      'Cn' => "G_UNICODE_UNASSIGNED",
  89
  90      # Informative.
  91      'Lm' => "G_UNICODE_MODIFIER_LETTER",
  92      'Lo' => "G_UNICODE_OTHER_LETTER",
  93      'Pc' => "G_UNICODE_CONNECT_PUNCTUATION",
  94      'Pd' => "G_UNICODE_DASH_PUNCTUATION",
  95      'Ps' => "G_UNICODE_OPEN_PUNCTUATION",
  96      'Pe' => "G_UNICODE_CLOSE_PUNCTUATION",
  97      'Pi' => "G_UNICODE_INITIAL_PUNCTUATION",
  98      'Pf' => "G_UNICODE_FINAL_PUNCTUATION",
  99      'Po' => "G_UNICODE_OTHER_PUNCTUATION",
 100      'Sm' => "G_UNICODE_MATH_SYMBOL",
 101      'Sc' => "G_UNICODE_CURRENCY_SYMBOL",
 102      'Sk' => "G_UNICODE_MODIFIER_SYMBOL",
 103      'So' => "G_UNICODE_OTHER_SYMBOL"
 104      );
 105
 106 %break_mappings =
 107     (
 108      'BK' => "G_UNICODE_BREAK_MANDATORY",
 109      'CR' => "G_UNICODE_BREAK_CARRIAGE_RETURN",
 110      'LF' => "G_UNICODE_BREAK_LINE_FEED",
 111      'CM' => "G_UNICODE_BREAK_COMBINING_MARK",
 112      'SG' => "G_UNICODE_BREAK_SURROGATE",
 113      'ZW' => "G_UNICODE_BREAK_ZERO_WIDTH_SPACE",
 114      'IN' => "G_UNICODE_BREAK_INSEPARABLE",
 115      'GL' => "G_UNICODE_BREAK_NON_BREAKING_GLUE",
 116      'CB' => "G_UNICODE_BREAK_CONTINGENT",
 117      'SP' => "G_UNICODE_BREAK_SPACE",
 118      'BA' => "G_UNICODE_BREAK_AFTER",
 119      'BB' => "G_UNICODE_BREAK_BEFORE",
 120      'B2' => "G_UNICODE_BREAK_BEFORE_AND_AFTER",
 121      'HY' => "G_UNICODE_BREAK_HYPHEN",
 122      'NS' => "G_UNICODE_BREAK_NON_STARTER",
 123      'OP' => "G_UNICODE_BREAK_OPEN_PUNCTUATION",
 124      'CL' => "G_UNICODE_BREAK_CLOSE_PUNCTUATION",
 125      'QU' => "G_UNICODE_BREAK_QUOTATION",
 126      'EX' => "G_UNICODE_BREAK_EXCLAMATION",
 127      'ID' => "G_UNICODE_BREAK_IDEOGRAPHIC",
 128      'NU' => "G_UNICODE_BREAK_NUMERIC",
 129      'IS' => "G_UNICODE_BREAK_INFIX_SEPARATOR",
 130      'SY' => "G_UNICODE_BREAK_SYMBOL",
 131      'AL' => "G_UNICODE_BREAK_ALPHABETIC",
 132      'PR' => "G_UNICODE_BREAK_PREFIX",
 133      'PO' => "G_UNICODE_BREAK_POSTFIX",
 134      'SA' => "G_UNICODE_BREAK_COMPLEX_CONTEXT",
 135      'AI' => "G_UNICODE_BREAK_AMBIGUOUS",
 136      'XX' => "G_UNICODE_BREAK_UNKNOWN"
 137      );
 138
 139 # Title case mappings.
 140 %title_to_lower = ();
 141 %title_to_upper = ();
 142
 143 # Maximum length of special-case strings
 144
 145 my $special_case_len = 0;
 146 my @special_cases;
 147
 148 $do_decomp = 0;
 149 $do_props = 1;
 150 if (@ARGV && $ARGV[0] eq '-decomp')
 151 {
 152     $do_decomp = 1;
 153     $do_props = 0;
 154     shift @ARGV;
 155 }
 156 elsif (@ARGV && $ARGV[0] eq '-both')
 157 {
 158     $do_decomp = 1;
 159     shift @ARGV;
 160 }
 161
 162 if (@ARGV != 6) {
 163     $0 =~ s@.*/@@;
 164     die "Usage: $0 [-decomp | -both] UNICODE-VERSION UnicodeData.txt LineBreak.txt SpecialCasing.txt CaseFolding.txt CompositionExclusions.txt\n";
 165 }
 166
 167 print "Creating decomp table\n" if ($do_decomp);
 168 print "Creating property table\n" if ($do_props);
 169
 170 print "Composition exlusions from $ARGV[5]\n";
 171
 172 open (INPUT, "< $ARGV[5]") || exit 1;
 173
 174 while (<INPUT>) {
 175
 176     chop;
 177
 178     next if /^#/;
 179     next if /^\s*$/;
 180
 181     s/\s*#.*//;
 182
 183     s/^\s*//;
 184     s/\s*$//;
 185
 186     $composition_exclusions{hex($_)} = 1;
 187 }
 188
 189 close INPUT;
 190
 191 print "Unicode data from $ARGV[1]\n";
 192
 193 open (INPUT, "< $ARGV[1]") || exit 1;
 194
 195 $last_code = -1;
 196 while (<INPUT>)
 197 {
 198     chop;
 199     @fields = split (';', $_, 30);
 200     if ($#fields != 14)
 201     {
 202         printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
 203     }
 204
 205     $code = hex ($fields[$CODE]);
 206
 207     last if ($code > 0xFFFF); # ignore characters out of the basic plane
 208
 209     if ($code > $last_code + 1)
 210     {
 211         # Found a gap.
 212         if ($fields[$NAME] =~ /Last>/)
 213         {
 214             # Fill the gap with the last character read,
 215             # since this was a range specified in the char database
 216             @gfields = @fields;
 217         }
 218         else
 219         {
 220             # The gap represents undefined characters.  Only the type
 221             # matters.
 222             @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
 223                         '', '', '', '');
 224         }
 225         for (++$last_code; $last_code < $code; ++$last_code)
 226         {
 227             $gfields{$CODE} = sprintf ("%04x", $last_code);
 228             &process_one ($last_code, @gfields);
 229         }
 230     }
 231     &process_one ($code, @fields);
 232     $last_code = $code;
 233 }
 234
 235 close INPUT;
 236
 237 @gfields = ('', '', 'Cn', '0', '', '', '', '', '', '', '',
 238             '', '', '', '');
 239 for (++$last_code; $last_code < 0x10000; ++$last_code)
 240 {
 241     $gfields{$CODE} = sprintf ("%04x", $last_code);
 242     &process_one ($last_code, @gfields);
 243 }
 244 --$last_code;                   # Want last to be 0xFFFF.
 245
 246 print "Creating line break table\n";
 247
 248 print "Line break data from $ARGV[2]\n";
 249
 250 open (INPUT, "< $ARGV[2]") || exit 1;
 251
 252 $last_code = -1;
 253 while (<INPUT>)
 254 {
 255     my ($start_code, $end_code);
 256
 257     chop;
 258
 259     next if /^#/;
 260
 261     s/\s*#.*//;
 262
 263     @fields = split (';', $_, 30);
 264     if ($#fields != 1)
 265     {
 266         printf STDERR ("Entry for $fields[$CODE] has wrong number of fields (%d)\n", $#fields);
 267         next;
 268     }
 269
 270     if ($fields[$CODE] =~ /([A-F0-9]{4})..([A-F0-9]{4})/)
 271     {
 272         $start_code = hex ($1);
 273         $end_code = hex ($2);
 274     } else {
 275         $start_code = $end_code = hex ($fields[$CODE]);
 276
 277     }
 278
 279     last if ($start_code > 0xFFFF); # FIXME ignore characters out of the basic plane
 280
 281     if ($start_code > $last_code + 1)
 282     {
 283         # The gap represents undefined characters. If assigned,
 284         # they are AL, if not assigned, XX
 285         for (++$last_code; $last_code < $start_code; ++$last_code)
 286         {
 287             if ($type[$last_code] eq 'Cn')
 288             {
 289                 $break_props[$last_code] = 'XX';
 290             }
 291             else
 292             {
 293                 $break_props[$last_code] = 'AL';
 294             }
 295         }
 296     }
 297
 298     for ($last_code = $start_code; $last_code <= $end_code; $last_code++)
 299     {
 300         $break_props[$last_code] = $fields[$BREAK_PROPERTY];
 301     }
 302
 303     $last_code = $end_code;
 304 }
 305
 306 close INPUT;
 307
 308 for (++$last_code; $last_code < 0x10000; ++$last_code)
 309 {
 310   if ($type[$last_code] eq 'Cn')
 311     {
 312       $break_props[$last_code] = 'XX';
 313     }
 314   else
 315     {
 316       $break_props[$last_code] = 'AL';
 317     }
 318 }
 319 --$last_code;                   # Want last to be 0xFFFF.
 320
 321 print STDERR "Last code is not 0xFFFF" if ($last_code != 0xFFFF);
 322
 323 print "Reading special-casing table for case conversion\n";
 324
 325 open (INPUT, "< $ARGV[3]") || exit 1;
 326
 327 while (<INPUT>)
 328 {
 329     my $code;
 330
 331     chop;
 332
 333     next if /^#/;
 334     next if /^\s*$/;
 335
 336     s/\s*#.*//;
 337
 338     @fields = split ('\s*;\s*', $_, 30);
 339
 340     $raw_code = $fields[$CASE_CODE];
 341     $code = hex ($raw_code);
 342
 343     if ($#fields != 4 && $#fields != 5)
 344     {
 345         printf STDERR ("Entry for $raw_code has wrong number of fields (%d)\n", $#fields);
 346         next;
 347     }
 348
 349     if (!defined $type[$code])
 350     {
 351         printf STDERR "Special case for code point: $code, which has no defined type\n";
 352         next;
 353     }
 354
 355     if (defined $fields[5]) {
 356         # Ignore conditional special cases - we'll handle them in code
 357         next;
 358     }
 359
 360     if ($type[$code] eq 'Lu')
 361     {
 362         (hex $fields[$CASE_UPPER] == $code) || die "$raw_code is Lu and UCD_Upper($raw_code) != $raw_code";
 363
 364         &add_special_case ($code, $value[$code],$fields[$CASE_LOWER], $fields[$CASE_TITLE]);
 365
 366     } elsif ($type[$code] eq 'Lt')
 367     {
 368         (hex $fields[$CASE_TITLE] == $code) || die "$raw_code is Lt and UCD_Title($raw_code) != $raw_code";
 369
 370         &add_special_case ($code, undef,$fields[$CASE_LOWER], $fields[$CASE_UPPER]);
 371     } elsif ($type[$code] eq 'Ll')
 372     {
 373         (hex $fields[$CASE_LOWER] == $code) || die "$raw_code is Ll and UCD_Lower($raw_code) != $raw_code";
 374
 375         &add_special_case ($code, $value[$code],$fields[$CASE_UPPER], $fields[$CASE_TITLE]);
 376     } else {
 377         printf STDERR "Special case for non-alphabetic code point: $raw_code\n";
 378         next;
 379     }
 380 }
 381
 382 close INPUT;
 383
 384 open (INPUT, "< $ARGV[4]") || exit 1;
 385
 386 my $casefoldlen = 0;
 387 my @casefold;
 388
 389 while (<INPUT>)
 390 {
 391     my $code;
 392
 393     chop;
 394
 395     next if /^#/;
 396     next if /^\s*$/;
 397
 398     s/\s*#.*//;
 399
 400     @fields = split ('\s*;\s*', $_, 30);
 401
 402     $raw_code = $fields[$FOLDING_CODE];
 403     $code = hex ($raw_code);
 404
 405     next if $code > 0xffff;     # FIXME!
 406
 407     if ($#fields != 3)
 408     {
 409         printf STDERR ("Entry for $raw_code has wrong number of fields (%d)\n", $#fields);
 410         next;
 411     }
 412
 413     next if ($fields[$FOLDING_STATUS] eq 'S');
 414
 415     @values = map { hex ($_) } split /\s+/, $fields[$FOLDING_MAPPING];
 416
 417     # Check simple case
 418
 419     if (@values == 1 &&
 420         !(defined $value[$code] && $value[$code] >= 0xd800 && $value[$code] < 0xdc00) &&
 421         defined $type[$code]) {
 422
 423         my $lower;
 424         if ($type[$code] eq 'Ll')
 425         {
 426             $lower = $code;
 427         } elsif ($type[$code] eq 'Lt')
 428         {
 429             $lower = $title_to_lower{$code};
 430         } elsif ($type[$code] eq 'Lu')
 431         {
 432             $lower = $value[$code];
 433         } else {
 434             $lower = $code;
 435         }
 436
 437         if ($lower == $values[0]) {
 438             next;
 439         }
 440     }
 441
 442     my $string = pack ("U*", @values);
 443     if (1 + length $string > $casefoldlen) {
 444         $casefoldlen = 1 + length $string;
 445     }
 446
 447     push @casefold, [ $code, $string ];
 448 }
 449
 450 close INPUT;
 451
 452 if ($do_props) {
 453     &print_tables ($last_code)
 454 }
 455 if ($do_decomp) {
 456     &print_decomp ($last_code);
 457     &output_composition_table;
 458 }
 459
 460 &print_line_break ($last_code);
 461
 462 exit 0;
 463
 464 # Process a single character.
 465 sub process_one
 466 {
 467     my ($code, @fields) = @_;
 468
 469     $type[$code] = $fields[$CATEGORY];
 470     if ($type[$code] eq 'Nd')
 471     {
 472         $value[$code] = int ($fields[$DECIMAL_VALUE]);
 473     }
 474     elsif ($type[$code] eq 'Ll')
 475     {
 476         $value[$code] = hex ($fields[$UPPER]);
 477     }
 478     elsif ($type[$code] eq 'Lu')
 479     {
 480         $value[$code] = hex ($fields[$LOWER]);
 481     }
 482
 483     if ($type[$code] eq 'Lt')
 484     {
 485         $title_to_lower{$code} = hex ($fields[$LOWER]);
 486         $title_to_upper{$code} = hex ($fields[$UPPER]);
 487     }
 488
 489     $cclass[$code] = $fields[$COMBINING_CLASSES];
 490
 491     # Handle decompositions.
 492     if ($fields[$DECOMPOSITION] ne '')
 493     {
 494         if ($fields[$DECOMPOSITION] =~ s/\<.*\>\s*//) {
 495            $decompose_compat[$code] = 1;
 496         } else {
 497            $decompose_compat[$code] = 0;
 498
 499            if (!exists $composition_exclusions{$code}) {
 500                $compositions{$code} = $fields[$DECOMPOSITION];
 501            }
 502         }
 503         $decompositions[$code] = $fields[$DECOMPOSITION];
 504     }
 505 }
 506
 507 sub print_tables
 508 {
 509     my ($last) = @_;
 510     my ($outfile) = "gunichartables.h";
 511
 512     local ($bytes_out) = 0;
 513
 514     print "Writing $outfile...\n";
 515
 516     open (OUT, "> $outfile");
 517
 518     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
 519     print OUT "   Instead, edit gen-unicode-tables.pl and re-run.  */\n\n";
 520
 521     print OUT "#ifndef CHARTABLES_H\n";
 522     print OUT "#define CHARTABLES_H\n\n";
 523
 524     print OUT "#define G_UNICODE_DATA_VERSION \"$ARGV[0]\"\n\n";
 525
 526     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
 527
 528     for ($count = 0; $count <= $last; $count += 256)
 529     {
 530         $row[$count / 256] = &print_row ($count, '(char *) ', 'char', 1,
 531                                          'page', \&fetch_type);
 532     }
 533
 534     print OUT "static char *type_table[256] = {\n";
 535     for ($count = 0; $count <= $last; $count += 256)
 536     {
 537         print OUT ",\n" if $count > 0;
 538         print OUT "  ", $row[$count / 256];
 539         $bytes_out += 4;
 540     }
 541     print OUT "\n};\n\n";
 542
 543
 544     #
 545     # Now print attribute table.
 546     #
 547
 548     for ($count = 0; $count <= $last; $count += 256)
 549     {
 550         $row[$count / 256] = &print_row ($count, '', 'unsigned short', 2,
 551                                          'attrpage', \&fetch_attr);
 552     }
 553     print OUT "static unsigned short *attr_table[256] = {\n";
 554     for ($count = 0; $count <= $last; $count += 256)
 555     {
 556         print OUT ",\n" if $count > 0;
 557         print OUT "  ", $row[$count / 256];
 558         $bytes_out += 4;
 559     }
 560     print OUT "\n};\n\n";
 561
 562     #
 563     # print title case table
 564     #
 565
 566     # FIXME: type.
 567     print OUT "static unsigned short title_table[][3] = {\n";
 568     my ($item);
 569     my ($first) = 1;
 570     foreach $item (sort keys %title_to_lower)
 571     {
 572         print OUT ",\n"
 573             unless $first;
 574         $first = 0;
 575         printf OUT "  { 0x%04x, 0x%04x, 0x%04x }", $item, $title_to_upper{$item}, $title_to_lower{$item};
 576         $bytes_out += 6;
 577     }
 578     print OUT "\n};\n\n";
 579
 580     #
 581     # And special case conversion table -- conversions that change length
 582     #
 583     &output_special_case_table (\*OUT);
 584     &output_casefold_table (\*OUT);
 585
 586     print OUT "#endif /* CHARTABLES_H */\n";
 587
 588     close (OUT);
 589
 590     printf STDERR "Generated %d bytes in tables\n", $bytes_out;
 591 }
 592
 593 # A fetch function for the type table.
 594 sub fetch_type
 595 {
 596     my ($index) = @_;
 597     return $mappings{$type[$index]};
 598 }
 599
 600 # A fetch function for the attribute table.
 601 sub fetch_attr
 602 {
 603     my ($index) = @_;
 604     if (defined $value[$index])
 605       {
 606         return sprintf ("0x%04x", $value[$index]);
 607       }
 608     else
 609       {
 610         return "0x0000";
 611       }
 612 }
 613
 614 # Print a single "row" of a two-level table.
 615 sub print_row
 616 {
 617     my ($start, $def_pfx, $typname, $typsize, $name, $fetcher) = @_;
 618
 619     my ($i);
 620     my (@values);
 621     my ($flag) = 1;
 622     my ($off);
 623
 624     for ($off = 0; $off < 256; ++$off)
 625     {
 626         $values[$off] = $fetcher->($off + $start);
 627         if ($values[$off] ne $values[0])
 628         {
 629             $flag = 0;
 630         }
 631     }
 632     if ($flag)
 633     {
 634         return $def_pfx . $values[0];
 635     }
 636
 637     printf OUT "static %s %s%d[256] = {\n  ", $typname, $name, $start / 256;
 638     my ($column) = 2;
 639     for ($i = $start; $i < $start + 256; ++$i)
 640     {
 641         print OUT ", "
 642             if $i > $start;
 643         my ($text) = $values[$i - $start];
 644         if (length ($text) + $column + 2 > 78)
 645         {
 646             print OUT "\n  ";
 647             $column = 2;
 648         }
 649         print OUT $text;
 650         $column += length ($text) + 2;
 651     }
 652     print OUT "\n};\n\n";
 653
 654     $bytes_out += 256 * $typsize;
 655
 656     return sprintf "%s%d", $name, $start / 256;
 657 }
 658
 659 # Generate the character decomposition header.
 660 sub print_decomp
 661 {
 662     my ($last) = @_;
 663     my ($outfile) = "gunidecomp.h";
 664
 665     local ($bytes_out) = 0;
 666
 667     print "Writing $outfile...\n";
 668
 669     open (OUT, "> $outfile") || exit 1;
 670
 671     print OUT "/* This file is automatically generated.  DO NOT EDIT! */\n\n";
 672     print OUT "#ifndef DECOMP_H\n";
 673     print OUT "#define DECOMP_H\n\n";
 674
 675     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
 676
 677     my ($count, @row);
 678     for ($count = 0; $count <= $last; $count += 256)
 679     {
 680         $row[$count / 256] = &print_row ($count, '(unsigned char *) ',
 681                                          'unsigned char', 1, 'cclass',
 682                                          \&fetch_cclass);
 683     }
 684
 685     print OUT "static unsigned char *combining_class_table[256] = {\n";
 686     for ($count = 0; $count <= $last; $count += 256)
 687     {
 688         print OUT ",\n" if $count > 0;
 689         print OUT "  ", $row[$count / 256];
 690         $bytes_out += 4;
 691     }
 692     print OUT "\n};\n\n";
 693
 694     print OUT "typedef struct\n{\n";
 695     # FIXME: type.
 696     print OUT "  unsigned short ch;\n";
 697     print OUT "  unsigned char canon_offset;\n";
 698     print OUT "  unsigned char compat_offset;\n";
 699     print OUT "  unsigned char *expansion;\n";
 700     print OUT "} decomposition;\n\n";
 701
 702     print OUT "static decomposition decomp_table[] =\n{\n";
 703     my ($iter);
 704     my ($first) = 1;
 705     for ($count = 0; $count <= $last; ++$count)
 706     {
 707         if (defined $decompositions[$count])
 708         {
 709             print OUT ",\n"
 710                 if ! $first;
 711             $first = 0;
 712
 713             my $canon_decomp;
 714             my $compat_decomp;
 715
 716             if (!$decompose_compat[$count]) {
 717                 $canon_decomp = make_decomp ($count, 0);
 718             }
 719             $compat_decomp = make_decomp ($count, 1);
 720
 721             if (defined $canon_decomp && $compat_decomp eq $canon_decomp) {
 722                 undef $compat_decomp;
 723             }
 724
 725             my $string = "";
 726             my $canon_offset = 0xff;
 727             my $compat_offset = 0xff;
 728
 729             if (defined $canon_decomp) {
 730                 $canon_offset = 0;
 731                 $string .= $canon_decomp;
 732             }
 733             if (defined $compat_decomp) {
 734                 if (defined $canon_decomp) {
 735                     $string .= "\\x00\\x00";
 736                 }
 737                 $compat_offset = (length $string) / 4;
 738                 $string .= $compat_decomp;
 739             }
 740
 741             $bytes_out += (length $string) / 4; # "\x20"
 742
 743             # Only a single terminator because one is implied in the string.
 744             printf OUT qq(  { 0x%04x, %u, %u, "%s\\0" }),
 745                 $count, $canon_offset, $compat_offset, $string;
 746
 747
 748             $bytes_out += 6;
 749         }
 750     }
 751     print OUT "\n};\n\n";
 752
 753     print OUT "#endif /* DECOMP_H */\n";
 754
 755     printf STDERR "Generated %d bytes in decomp tables\n", $bytes_out;
 756 }
 757
 758 sub print_line_break
 759 {
 760     my ($last) = @_;
 761     my ($outfile) = "gunibreak.h";
 762
 763     local ($bytes_out) = 0;
 764
 765     print "Writing $outfile...\n";
 766
 767     open (OUT, "> $outfile");
 768
 769     print OUT "/* This file is automatically generated.  DO NOT EDIT!\n";
 770     print OUT "   Instead, edit gen-unicode-tables.pl and re-run.  */\n\n";
 771
 772     print OUT "#ifndef BREAKTABLES_H\n";
 773     print OUT "#define BREAKTABLES_H\n\n";
 774
 775     print OUT "#define G_UNICODE_DATA_VERSION \"$ARGV[0]\"\n\n";
 776
 777     printf OUT "#define G_UNICODE_LAST_CHAR 0x%04x\n\n", $last;
 778
 779     for ($count = 0; $count <= $last; $count += 256)
 780     {
 781         $row[$count / 256] = &print_row ($count, '(char *) ', 'char', 1,
 782                                          'page',
 783                                          \&fetch_break_type);
 784     }
 785
 786     print OUT "static char *break_property_table[256] = {\n";
 787     for ($count = 0; $count <= $last; $count += 256)
 788     {
 789         print OUT ",\n" if $count > 0;
 790         print OUT "  ", $row[$count / 256];
 791         $bytes_out += 4;
 792     }
 793     print OUT "\n};\n\n";
 794
 795     print OUT "#endif /* BREAKTABLES_H */\n";
 796
 797     close (OUT);
 798
 799     printf STDERR "Generated %d bytes in break tables\n", $bytes_out;
 800 }
 801
 802
 803 # A fetch function for the break properties table.
 804 sub fetch_break_type
 805 {
 806     my ($index) = @_;
 807     return $break_mappings{$break_props[$index]};
 808 }
 809
 810 # Fetcher for combining class.
 811 sub fetch_cclass
 812 {
 813     my ($i) = @_;
 814     return $cclass[$i];
 815 }
 816
 817 # Expand a character decomposition recursively.
 818 sub expand_decomp
 819 {
 820     my ($code, $compat) = @_;
 821
 822     my ($iter, $val);
 823     my (@result) = ();
 824     foreach $iter (split (' ', $decompositions[$code]))
 825     {
 826         $val = hex ($iter);
 827         if (defined $decompositions[$val] &&
 828             ($compat || !$decompose_compat[$val]))
 829         {
 830             push (@result, &expand_decomp ($val, $compat));
 831         }
 832         else
 833         {
 834             push (@result, $val);
 835         }
 836     }
 837
 838     return @result;
 839 }
 840
 841 sub make_decomp
 842 {
 843     my ($code, $compat) = @_;
 844
 845     my $result = "";
 846     foreach $iter (&expand_decomp ($code, $compat))
 847     {
 848         $result .= sprintf "\\x%02x\\x%02x", $iter / 256, $iter & 0xff;
 849     }
 850
 851     $result;
 852 }
 853 # Generate special case data string from two fields
 854 sub add_special_case
 855 {
 856     my ($code, $single, $field1, $field2) = @_;
 857
 858     @values = (defined $single ? $single : (),
 859                (map { hex ($_) } split /\s+/, $field1),
 860                0,
 861                (map { hex ($_) } split /\s+/, $field2));
 862     $result = "";
 863
 864
 865     for $value (@values) {
 866         $result .= sprintf ("\\x%02x\\x%02x", $value / 256, $value & 0xff);
 867     }
 868
 869     $result .= "\\0";
 870
 871     if (2 * @values + 2 > $special_case_len) {
 872         $special_case_len = 2 * @values + 2;
 873     }
 874
 875     push @special_cases, $result;
 876
 877     #
 878     # We encode special cases in the surrogate pair space
 879     #
 880     $value[$code] = 0xD800 + scalar(@special_cases) - 1;
 881 }
 882
 883 sub output_special_case_table
 884 {
 885     my $out = shift;
 886
 887     print $out <<EOT;
 888
 889 /* Table of special cases for case conversion; each record contains
 890  * First, the best single character mapping to lowercase if Lu,
 891  * and to uppercase if Ll, followed by the output mapping for the two cases
 892  * other than the case of the codepoint, in the order [Ll],[Lu],[Lt],
 893  * separated and terminated by a double NUL.
 894  */
 895 static guchar special_case_table[][$special_case_len] = {
 896 EOT
 897
 898     for $case (@special_cases) {
 899         print $out qq( "$case",\n);
 900     }
 901
 902     print $out <<EOT;
 903 };
 904
 905 EOT
 906
 907     print STDERR "Generated ", ($special_case_len * scalar @special_cases), " bytes in special case table\n";
 908 }
 909
 910 sub enumerate_ordered
 911 {
 912     my ($array) = @_;
 913
 914     my $n = 0;
 915     for my $code (sort { $a <=> $b } keys %$array) {
 916         if ($array->{$code} == 1) {
 917             delete $array->{$code};
 918             next;
 919         }
 920         $array->{$code} = $n++;
 921     }
 922
 923     return $n;
 924 }
 925
 926 sub output_composition_table
 927 {
 928     print STDERR "Generating composition table\n";
 929
 930     local ($bytes_out) = 0;
 931
 932     my %first;
 933     my %second;
 934
 935     # First we need to go through and remove decompositions
 936     # starting with a non-starter, and single-character
 937     # decompositions. At the same time, record
 938     # the first and second character of each decomposition
 939
 940     for $code (keys %compositions) {
 941         @values = map { hex ($_) } split /\s+/, $compositions{$code};
 942         if ($cclass[$values[0]]) {
 943             delete $compositions{$code};
 944             next;
 945         }
 946         if (@values == 1) {
 947             delete $compositions{$code};
 948             next;
 949         }
 950         if (@values != 2) {
 951             die "$code has more than two elements in its decomposition!\n";
 952         }
 953
 954         if (exists $first{$values[0]}) {
 955             $first{$values[0]}++;
 956         } else {
 957             $first{$values[0]} = 1;
 958         }
 959     }
 960
 961     # Assign integer indicices, removing singletons
 962     my $n_first = enumerate_ordered (\%first);
 963
 964     # Now record the second character if each (non-singleton) decomposition
 965     for $code (keys %compositions) {
 966         @values = map { hex ($_) } split /\s+/, $compositions{$code};
 967
 968         if (exists $first{$values[0]}) {
 969             if (exists $second{$values[1]}) {
 970                 $second{$values[1]}++;
 971             } else {
 972                 $second{$values[1]} = 1;
 973             }
 974         }
 975     }
 976
 977     # Assign integer indices, removing duplicate
 978     my $n_second = enumerate_ordered (\%second);
 979
 980     # Build reverse table
 981
 982     my @first_singletons;
 983     my @second_singletons;
 984     my %reverse;
 985     for $code (keys %compositions) {
 986         @values = map { hex ($_) } split /\s+/, $compositions{$code};
 987
 988         my $first = $first{$values[0]};
 989         my $second = $second{$values[1]};
 990
 991         if (defined $first && defined $second) {
 992             $reverse{"$first|$second"} = $code;
 993         } elsif (!defined $first) {
 994             push @first_singletons, [ $values[0], $values[1], $code ];
 995         } else {
 996             push @second_singletons, [ $values[1], $values[0], $code ];
 997         }
 998     }
 999
1000     @first_singletons = sort { $a->[0] <=> $b->[0] } @first_singletons;
1001     @second_singletons = sort { $a->[0] <=> $b->[0] } @second_singletons;
1002
1003     my %vals;
1004
1005     open OUT, ">gunicomp.h" or die "Cannot open gunicomp.h: $!\n";
1006
1007     # Assign values in lookup table for all code points involved
1008
1009     my $total = 1;
1010     my $last = 0;
1011     printf OUT "#define COMPOSE_FIRST_START %d\n", $total;
1012     for $code (keys %first) {
1013         $vals{$code} = $first{$code} + $total;
1014         $last = $code if $code > $last;
1015     }
1016     $total += $n_first;
1017     $i = 0;
1018     printf OUT "#define COMPOSE_FIRST_SINGLE_START %d\n", $total;
1019     for $record (@first_singletons) {
1020         my $code = $record->[0];
1021         $vals{$code} = $i++ + $total;
1022         $last = $code if $code > $last;
1023     }
1024     $total += @first_singletons;
1025     printf OUT "#define COMPOSE_SECOND_START %d\n", $total;
1026     for $code (keys %second) {
1027         $vals{$code} = $second{$code} + $total;
1028         $last = $code if $code > $last;
1029     }
1030     $total += $n_second;
1031     $i = 0;
1032     printf OUT "#define COMPOSE_SECOND_SINGLE_START %d\n\n", $total;
1033     for $record (@second_singletons) {
1034         my $code = $record->[0];
1035         $vals{$code} = $i++ + $total;
1036         $last = $code if $code > $last;
1037     }
1038
1039     # Output lookup table
1040
1041     my @row;
1042     for (my $count = 0; $count <= $last; $count += 256)
1043     {
1044         $row[$count / 256] = &print_row ($count, '(gushort *) ', 'gushort', 2,
1045                                          'compose_page',
1046                                          sub { exists $vals{$_[0]} ? $vals{$_[0]} : 0; });
1047     }
1048
1049     print OUT "static unsigned short *compose_table[256] = {\n";
1050     for (my $count = 0; $count <= $last; $count += 256)
1051     {
1052         print OUT ",\n" if $count > 0;
1053         print OUT "  ", $row[$count / 256];
1054         $bytes_out += 4;
1055     }
1056     print OUT "\n};\n\n";
1057
1058     # Output first singletons
1059
1060     print OUT "static gushort compose_first_single[][2] = {\n";
1061     $i = 0;
1062     for $record (@first_singletons) {
1063         print OUT ",\n" if $i++ > 0;
1064         printf OUT " { %#06x, %#06x }", $record->[1], $record->[2];
1065     }
1066     print OUT "\n};\n";
1067
1068     $bytes_out += @first_singletons * 4;
1069
1070     # Output second singletons
1071
1072     print OUT "static gushort compose_second_single[][2] = {\n";
1073     $i = 0;
1074     for $record (@second_singletons) {
1075         print OUT ",\n" if $i++ > 0;
1076         printf OUT " { %#06x, %#06x }", $record->[1], $record->[2];
1077     }
1078     print OUT "\n};\n";
1079
1080     $bytes_out += @second_singletons * 4;
1081
1082     # Output array of composition pairs
1083
1084     print OUT <<EOT;
1085 static gushort compose_array[$n_first][$n_second] = {
1086 EOT
1087
1088     for (my $i = 0; $i < $n_first; $i++) {
1089         print OUT ",\n" if $i;
1090         print OUT " { ";
1091         for (my $j = 0; $j < $n_second; $j++) {
1092             print OUT ", " if $j;
1093             if (exists $reverse{"$i|$j"}) {
1094                 printf OUT "%#06x", $reverse{"$i|$j"};
1095             } else {
1096                 print OUT "     0";
1097             }
1098         }
1099         print OUT " }";
1100     }
1101     print OUT "\n";
1102
1103     print OUT <<EOT;
1104 };
1105 EOT
1106
1107     $bytes_out += $n_first * $n_second * 2;
1108
1109     printf STDERR "Generated %d bytes in compose tables\n", $bytes_out;
1110 }
1111
1112 sub output_casefold_table
1113 {
1114     my $out = shift;
1115
1116     print $out <<EOT;
1117
1118 /* Table of casefolding cases that can't be derived by lowercasing
1119  */
1120 static struct {
1121   guint16 ch;
1122   gchar data[$casefoldlen];
1123 } casefold_table[] = {
1124 EOT
1125
1126    @casefold = sort { $a->[0] <=> $b->[0] } @casefold;
1127
1128    for $case (@casefold) {
1129        $code = $case->[0];
1130        $string = $case->[1];
1131        print $out sprintf(qq({ %#04x, "$string" },\n), $code);
1132
1133    }
1134
1135     print $out <<EOT;
1136 };
1137
1138 EOT
1139
1140    my $recordlen = (2+$casefoldlen+1) & ~1;
1141    printf "Generated %d bytes for casefold table\n", $recordlen * @casefold;
1142 }
1143
1144
1145