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