lib/gen-unicode-tables.pl

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