glib/gen-unicode-tables.pl

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