3 $UnicodeData = "UnicodeData-Latest.txt";
5 # Note: we try to keep filenames unique within first 8 chars. Using
6 # subdirectories for the following helps.
12 open(UNICODEDATA, $UnicodeData) || die "$0: $UnicodeData: $!\n";
14 while (<UNICODEDATA>) {
15 ($code, $name) = split /;/;
20 next unless $name =~ /^(.+? LETTER .+?) WITH .+( \w+ FORM)?$/;
22 push @base, [ $code, $1 ];
23 push @base, [ $code, $1.$2 ] if $2 ne '';
25 # Before this "diacritics stripping" phase (and for Arabic, also
26 # "form stripping" phase) all ligatures could be decomposed into
27 # their constituent letters.
29 # For example the ligature
30 # ARABIC LIGATURE YEH WITH HAMZA ABOVE WITH ALEF ISOLATED FORM
31 # would go first through ligature decomposition producing the two letters
32 # ARABIC LETTER YEH WITH HAMZA ABOVE ISOLATED FORM
33 # ARABIC LETTER ALEF WITH HAMZA ABOVE ISOLATED FORM
34 # and those with diacritics stripping
35 # ARABIC LETTER YEH ISOLATED FORM
36 # ARABIC LETTER ALEF ISOLATED FORM
37 # and those with the Arabic form stripping
39 # ARABIC LETTER ALEF ISOLATED FORM
41 # ARABIC LETTER ALEF ISOLATED FORM
43 # Similarly for ligatures from other scripts.
44 # Effectively this would mean that ligatures turn into categories
45 # (Unicodese for character classes).
48 foreach my $b (@base) {
50 next unless exists $code{$base};
51 push @{$unicode{$code{$base}}}, $code;
52 # print "$code: $name{$code} -> $base\n",
55 @unicode = sort keys %unicode;
58 if (open(EQ_UNICODE, ">Eq/Unicode")) {
59 foreach my $c (@unicode) {
60 print EQ_UNICODE "$c @{$unicode{$c}}\n";
64 die "$0: failed to open Eq/Unicode for writing: $!\n";
68 if (open(EQ_LATIN1, ">Eq/Latin1")) {
69 foreach my $c (@unicode) {
70 last if hex($c) > 255;
71 my @c = grep { hex($_) <= 255 } @{$unicode{$c}};
73 print EQ_LATIN1 "$c @c\n";
77 die "$0: failed to open Eq/Latin1 for writing: $!\n";
83 ['IsWord', '$cat =~ /^L[ulo]|^Nd/ or $code eq "005F"', ''],
84 ['IsAlnum', '$cat =~ /^L[ulo]|^Nd/', ''],
85 ['IsAlpha', '$cat =~ /^L[ulo]/', ''],
86 ['IsSpace', '$cat =~ /^Z/ or $code lt "0020" and chr(hex $code) =~ /^\s/', ''],
87 ['IsDigit', '$cat =~ /^Nd$/', ''],
88 ['IsUpper', '$cat =~ /^Lu$/', ''],
89 ['IsLower', '$cat =~ /^Ll$/', ''],
90 ['IsASCII', 'hex $code <= 127', ''],
91 ['IsCntrl', '$cat =~ /^C/', ''],
92 ['IsGraph', '$cat =~ /^[^C]/ and $code ne "0020"', ''],
93 ['IsPrint', '$cat =~ /^[^C]/', ''],
94 ['IsPunct', '$cat =~ /^P/', ''],
95 ['IsXDigit', '$code =~ /^00(3[0-9]|[46][1-6])$/', ''],
96 ['ToUpper', '$up', '$up'],
97 ['ToLower', '$down', '$down'],
98 ['ToTitle', '$title', '$title'],
99 ['ToDigit', '$dec ne ""', '$dec'],
103 ['Name', '$name', '$name'],
107 ['Category', '$cat', '$cat'],
111 ['IsM', '$cat =~ /^M/', ''], # Mark
112 ['IsMn', '$cat eq "Mn"', ''], # Mark, Non-Spacing
113 ['IsMc', '$cat eq "Mc"', ''], # Mark, Combining
115 ['IsN', '$cat =~ /^N/', ''], # Number
116 ['IsNd', '$cat eq "Nd"', ''], # Number, Decimal Digit
117 ['IsNo', '$cat eq "No"', ''], # Number, Other
119 ['IsZ', '$cat =~ /^Z/', ''], # Zeparator
120 ['IsZs', '$cat eq "Zs"', ''], # Separator, Space
121 ['IsZl', '$cat eq "Zl"', ''], # Separator, Line
122 ['IsZp', '$cat eq "Zp"', ''], # Separator, Paragraph
124 ['IsC', '$cat =~ /^C/', ''], # Crazy
125 ['IsCc', '$cat eq "Cc"', ''], # Other, Control or Format
126 ['IsCo', '$cat eq "Co"', ''], # Other, Private Use
127 ['IsCn', '$cat eq "Cn"', ''], # Other, Not Assigned
131 ['IsL', '$cat =~ /^L/', ''], # Letter
132 ['IsLu', '$cat eq "Lu"', ''], # Letter, Uppercase
133 ['IsLl', '$cat eq "Ll"', ''], # Letter, Lowercase
134 ['IsLt', '$cat eq "Lt"', ''], # Letter, Titlecase
135 ['IsLm', '$cat eq "Lm"', ''], # Letter, Modifier
136 ['IsLo', '$cat eq "Lo"', ''], # Letter, Other
138 ['IsP', '$cat =~ /^P/', ''], # Punctuation
139 ['IsPd', '$cat eq "Pd"', ''], # Punctuation, Dash
140 ['IsPs', '$cat eq "Ps"', ''], # Punctuation, Open
141 ['IsPe', '$cat eq "Pe"', ''], # Punctuation, Close
142 ['IsPo', '$cat eq "Po"', ''], # Punctuation, Other
144 ['IsS', '$cat =~ /^S/', ''], # Symbol
145 ['IsSm', '$cat eq "Sm"', ''], # Symbol, Math
146 ['IsSc', '$cat eq "Sc"', ''], # Symbol, Currency
147 ['IsSo', '$cat eq "So"', ''], # Symbol, Other
150 ['CombiningClass', '$comb', '$comb'],
152 # BIDIRECTIONAL PROPERTIES
154 ['Bidirectional', '$bid', '$bid'],
158 ['IsBidiL', '$bid eq "L"', ''], # Left-Right; Most alphabetic,
159 # syllabic, and logographic
160 # characters (e.g., CJK
162 ['IsBidiR', '$bid eq "R"', ''], # Right-Left; Arabic, Hebrew,
163 # and punctuation specific to
168 ['IsBidiEN','$bid eq "EN"', ''], # European Number
169 ['IsBidiES','$bid eq "ES"', ''], # European Number Separator
170 ['IsBidiET','$bid eq "ET"', ''], # European Number Terminator
171 ['IsBidiAN','$bid eq "AN"', ''], # Arabic Number
172 ['IsBidiCS','$bid eq "CS"', ''], # Common Number Separator
176 ['IsBidiB', '$bid eq "B"', ''], # Block Separator
177 ['IsBidiS', '$bid eq "S"', ''], # Segment Separator
181 ['IsBidiWS','$bid eq "WS"', ''], # Whitespace
182 ['IsBidiON','$bid eq "ON"', ''], # Other Neutrals ; All other
183 # characters: punctuation,
188 ['Decomposition', '$decomp', '$decomp'],
189 ['IsDecoCanon', '$decomp && $decomp !~ /^</', ''],
190 ['IsDecoCompat', '$decomp =~ /^</', ''],
191 ['IsDCfont', '$decomp =~ /^<font>/', ''],
192 ['IsDCnoBreak', '$decomp =~ /^<noBreak>/', ''],
193 ['IsDCinitial', '$decomp =~ /^<initial>/', ''],
194 ['IsDCinital', '$decomp =~ /^<medial>/', ''],
195 ['IsDCfinal', '$decomp =~ /^<final>/', ''],
196 ['IsDCisolated', '$decomp =~ /^<isolated>/', ''],
197 ['IsDCcircle', '$decomp =~ /^<circle>/', ''],
198 ['IsDCsuper', '$decomp =~ /^<super>/', ''],
199 ['IsDCsub', '$decomp =~ /^<sub>/', ''],
200 ['IsDCvertical', '$decomp =~ /^<vertical>/', ''],
201 ['IsDCwide', '$decomp =~ /^<wide>/', ''],
202 ['IsDCnarrow', '$decomp =~ /^<narrow>/', ''],
203 ['IsDCsmall', '$decomp =~ /^<small>/', ''],
204 ['IsDCsquare', '$decomp =~ /^<square>/', ''],
205 ['IsDCcompat', '$decomp =~ /^<compat>/', ''],
209 ['Number', '$num', '$num'],
213 ['IsMirrored', '$mir eq "Y"', ''],
217 ['ArabLink', '1', '$link'],
218 ['ArabLnkGrp', '1', '$linkgroup'],
222 ['JamoShort', '1', '$short'],
225 # This is not written for speed...
227 foreach $file (@todo) {
228 my ($table, $wanted, $val) = @$file;
229 next if @ARGV and not grep { $_ eq $table } @ARGV;
231 if ($table =~ /^(Is|In|To)(.*)/) {
232 open(OUT, ">$1/$2.pl") or die "Can't create $1/$2.pl: $!\n";
235 open(OUT, ">$table.pl") or die "Can't create $table.pl: $!\n";
240 print OUT proplist($table, $wanted, $val);
245 # Must treat blocks specially.
247 exit if @ARGV and not grep { $_ eq Block } @ARGV;
249 open(UD, 'blocks.txt') or die "Can't open blocks.txt: $!\n";
250 open(OUT, ">Block.pl") or die "Can't create $table.pl: $!\n";
259 ($code, $last, $name) = split(/; */);
261 print OUT "$code $last $name\n";
263 open(BLOCK, ">In/$name.pl");
264 print BLOCK <<"END2";
276 ##################################################
279 my ($table, $wanted, $val) = @_;
284 if ($table =~ /^Arab/) {
285 open(UD, "arabshp.txt") or warn "Can't open $table: $!";
287 $split = '($code, $name, $link, $linkgroup) = split(/; */);';
289 elsif ($table =~ /^Jamo/) {
290 open(UD, "jamo2.txt") or warn "Can't open $table: $!";
292 $split = '($code, $short, $name) = split(/; */); $code =~ s/^U\+//;';
295 open(UD, $UnicodeData) or warn "Can't open $UnicodeData: $!";
297 $split = '($code, $name, $cat, $comb, $bid, $decomp, $dec, $dig, $num, $mir, $uni1,
298 $comment, $up, $down, $title) = split(/;/);';
301 if ($table =~ /^(?:To|Is)[A-Z]/) {
309 push(\@wanted, [hex \$code, hex $val, \$name =~ /, First>\$/]);
316 $beg = shift @wanted;
318 while (@wanted and $wanted[0]->[0] == $last->[0] + 1 and
319 (not $val or $wanted[0]->[1] == $last->[1] + 1)) {
320 $last = shift @wanted;
322 $out .= sprintf "%04x", $beg->[0];
324 $last = shift @wanted;
330 $out .= sprintf "\t%04x", $last->[0];
332 $out .= sprintf "\t%04x", $beg->[1] if $val;
344 push(\@wanted, [hex \$code, $val, \$name =~ /, First>\$/]);
351 $beg = shift @wanted;
353 while (@wanted and $wanted[0]->[0] == $last->[0] + 1 and
354 ($wanted[0]->[1] eq $last->[1])) {
355 $last = shift @wanted;
357 $out .= sprintf "%04x", $beg->[0];
359 $last = shift @wanted;
365 $out .= sprintf "\t%04x", $last->[0];
367 $out .= sprintf "\t%s\n", $beg->[1];
373 # Create the equivalence mappings.