|
sl@0
|
1 |
#!/bin/sh
|
|
sl@0
|
2 |
# The next line is executed by /bin/sh, but not tcl \
|
|
sl@0
|
3 |
exec tclsh "$0" ${1+"$@"}
|
|
sl@0
|
4 |
|
|
sl@0
|
5 |
#
|
|
sl@0
|
6 |
# uniClass.tcl --
|
|
sl@0
|
7 |
#
|
|
sl@0
|
8 |
# Generates the character ranges and singletons that are used in
|
|
sl@0
|
9 |
# generic/regc_locale.c for translation of character classes.
|
|
sl@0
|
10 |
# This file must be generated using a tclsh that contains the
|
|
sl@0
|
11 |
# correct corresponding tclUniData.c file (generated by uniParse.tcl)
|
|
sl@0
|
12 |
# in order for the class ranges to match.
|
|
sl@0
|
13 |
#
|
|
sl@0
|
14 |
|
|
sl@0
|
15 |
proc emitRange {first last} {
|
|
sl@0
|
16 |
global ranges numranges chars numchars
|
|
sl@0
|
17 |
|
|
sl@0
|
18 |
if {$first < ($last-1)} {
|
|
sl@0
|
19 |
append ranges [format "{0x%04x, 0x%04x}, " \
|
|
sl@0
|
20 |
$first $last]
|
|
sl@0
|
21 |
if {[incr numranges] % 4 == 0} {
|
|
sl@0
|
22 |
append ranges "\n "
|
|
sl@0
|
23 |
}
|
|
sl@0
|
24 |
} else {
|
|
sl@0
|
25 |
append chars [format "0x%04x, " $first]
|
|
sl@0
|
26 |
incr numchars
|
|
sl@0
|
27 |
if {$numchars % 9 == 0} {
|
|
sl@0
|
28 |
append chars "\n "
|
|
sl@0
|
29 |
}
|
|
sl@0
|
30 |
if {$first != $last} {
|
|
sl@0
|
31 |
append chars [format "0x%04x, " $last]
|
|
sl@0
|
32 |
incr numchars
|
|
sl@0
|
33 |
if {$numchars % 9 == 0} {
|
|
sl@0
|
34 |
append chars "\n "
|
|
sl@0
|
35 |
}
|
|
sl@0
|
36 |
}
|
|
sl@0
|
37 |
}
|
|
sl@0
|
38 |
}
|
|
sl@0
|
39 |
|
|
sl@0
|
40 |
proc genTable {type} {
|
|
sl@0
|
41 |
global first last ranges numranges chars numchars
|
|
sl@0
|
42 |
set first -2
|
|
sl@0
|
43 |
set last -2
|
|
sl@0
|
44 |
|
|
sl@0
|
45 |
set ranges " "
|
|
sl@0
|
46 |
set numranges 0
|
|
sl@0
|
47 |
set chars " "
|
|
sl@0
|
48 |
set numchars 0
|
|
sl@0
|
49 |
|
|
sl@0
|
50 |
for {set i 0} {$i <= 0xFFFF} {incr i} {
|
|
sl@0
|
51 |
if {[string is $type [format %c $i]]} {
|
|
sl@0
|
52 |
if {$i == ($last + 1)} {
|
|
sl@0
|
53 |
set last $i
|
|
sl@0
|
54 |
} else {
|
|
sl@0
|
55 |
if {$first > 0} {
|
|
sl@0
|
56 |
emitRange $first $last
|
|
sl@0
|
57 |
}
|
|
sl@0
|
58 |
set first $i
|
|
sl@0
|
59 |
set last $i
|
|
sl@0
|
60 |
}
|
|
sl@0
|
61 |
}
|
|
sl@0
|
62 |
}
|
|
sl@0
|
63 |
emitRange $first $last
|
|
sl@0
|
64 |
|
|
sl@0
|
65 |
set ranges [string trimright $ranges "\t\n ,"]
|
|
sl@0
|
66 |
set chars [string trimright $chars "\t\n ,"]
|
|
sl@0
|
67 |
if {$ranges != ""} {
|
|
sl@0
|
68 |
puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
|
|
sl@0
|
69 |
puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
|
|
sl@0
|
70 |
} else {
|
|
sl@0
|
71 |
puts "/* no contiguous ranges of $type characters */\n"
|
|
sl@0
|
72 |
}
|
|
sl@0
|
73 |
if {$chars != ""} {
|
|
sl@0
|
74 |
puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
|
|
sl@0
|
75 |
puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
|
|
sl@0
|
76 |
} else {
|
|
sl@0
|
77 |
puts "/* no singletons of $type characters */\n"
|
|
sl@0
|
78 |
}
|
|
sl@0
|
79 |
}
|
|
sl@0
|
80 |
|
|
sl@0
|
81 |
puts "/*
|
|
sl@0
|
82 |
* Declarations of Unicode character ranges. This code
|
|
sl@0
|
83 |
* is automatically generated by the tools/uniClass.tcl script
|
|
sl@0
|
84 |
* and used in generic/regc_locale.c. Do not modify by hand.
|
|
sl@0
|
85 |
*/
|
|
sl@0
|
86 |
"
|
|
sl@0
|
87 |
|
|
sl@0
|
88 |
foreach {type desc} {
|
|
sl@0
|
89 |
alpha "alphabetic characters"
|
|
sl@0
|
90 |
digit "decimal digit characters"
|
|
sl@0
|
91 |
punct "punctuation characters"
|
|
sl@0
|
92 |
space "white space characters"
|
|
sl@0
|
93 |
lower "lowercase characters"
|
|
sl@0
|
94 |
upper "uppercase characters"
|
|
sl@0
|
95 |
graph "unicode print characters excluding space"
|
|
sl@0
|
96 |
} {
|
|
sl@0
|
97 |
puts "/* Unicode: $desc */\n"
|
|
sl@0
|
98 |
genTable $type
|
|
sl@0
|
99 |
}
|
|
sl@0
|
100 |
|
|
sl@0
|
101 |
puts "/*
|
|
sl@0
|
102 |
* End of auto-generated Unicode character ranges declarations.
|
|
sl@0
|
103 |
*/"
|