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