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