glib/gen-unicode-tables.pl

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