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