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