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