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