namespace eval uni {
set shift 5;
variable pMap; variable pages; variable groups;
variable categories {
Cn Lu Ll Lt Lm Lo Mn Me Mc Nd Nl No Zs Zl Zp
Cc Cf Co Cs Pc Pd Ps Pe Pi Pf Po Sm Sc Sk So
};
variable titleCount 0; }
proc uni::getValue {items index} {
variable categories
variable titleCount
set category [lindex $items 2]
if {[scan [lindex $items 12] %4x toupper] == 1} {
set toupper [expr {$index - $toupper}]
} else {
set toupper {}
}
if {[scan [lindex $items 13] %4x tolower] == 1} {
set tolower [expr {$tolower - $index}]
} else {
set tolower {}
}
if {[scan [lindex $items 14] %4x totitle] == 1} {
set totitle [expr {$index - $totitle}]
} else {
set totitle {}
}
set categoryIndex [lsearch -exact $categories $category]
if {$categoryIndex < 0} {
puts "Unexpected character category: $index($category)"
set categoryIndex 0
} elseif {$category == "Lt"} {
incr titleCount
}
return "$categoryIndex,$toupper,$tolower,$totitle"
}
proc uni::getGroup {value} {
variable groups
set gIndex [lsearch -exact $groups $value]
if {$gIndex == -1} {
set gIndex [llength $groups]
lappend groups $value
}
return $gIndex
}
proc uni::addPage {info} {
variable pMap
variable pages
set pIndex [lsearch -exact $pages $info]
if {$pIndex == -1} {
set pIndex [llength $pages]
lappend pages $info
}
lappend pMap $pIndex
return
}
proc uni::buildTables {data} {
variable shift
variable pMap {}
variable pages {}
variable groups {{0,,,}}
set info {} ;
set mask [expr {(1 << $shift) - 1}]
set next 0
foreach line [split $data \n] {
if {$line == ""} {
set line "FFFF;;Cn;0;ON;;;;;N;;;;;\n"
}
set items [split $line \;]
scan [lindex $items 0] %4x index
set index [format 0x%0.4x $index]
set gIndex [getGroup [getValue $items $index]]
if {($index > $next) \
&& ![regexp "Last>$" [lindex $items 1]]} {
for {} {$next < $index} {incr next} {
lappend info 0
if {($next & $mask) == $mask} {
addPage $info
set info {}
}
}
}
for {set i $next} {$i <= $index} {incr i} {
set offset [expr {$i & $mask}]
set page [expr {($i >> $shift)}]
lappend info $gIndex
if {$offset == $mask} {
addPage $info
set info {}
}
}
set next [expr {$index + 1}]
}
return
}
proc uni::main {} {
global argc argv0 argv
variable pMap
variable pages
variable groups
variable shift
variable titleCount
if {$argc != 2} {
puts stderr "\nusage: $argv0 <datafile> <outdir>\n"
exit 1
}
set f [open [lindex $argv 0] r]
set data [read $f]
close $f
buildTables $data
puts "X = [llength $pMap] Y= [llength $pages] A= [llength $groups]"
set size [expr {[llength $pMap] + [llength $pages]*(1<<$shift)}]
puts "shift = 6, space = $size"
puts "title case count = $titleCount"
set f [open [file join [lindex $argv 1] tclUniData.c] w]
fconfigure $f -translation lf
puts $f "/*
* tclUniData.c --
*
* Declarations of Unicode character information tables. This file is
* automatically generated by the tools/uniParse.tcl script. Do not
* modify this file by hand.
*
* Copyright (c) 1998 by Scriptics Corporation.
* All rights reserved.
*
* RCS: @(#) \$Id\$
*/
/*
* A 16-bit Unicode character is split into two parts in order to index
* into the following tables. The lower OFFSET_BITS comprise an offset
* into a page of characters. The upper bits comprise the page number.
*/
#define OFFSET_BITS $shift
/*
* The pageMap is indexed by page number and returns an alternate page number
* that identifies a unique page of characters. Many Unicode characters map
* to the same alternate page number.
*/
static unsigned char pageMap\[\] = {"
set line " "
set last [expr {[llength $pMap] - 1}]
for {set i 0} {$i <= $last} {incr i} {
append line [lindex $pMap $i]
if {$i != $last} {
append line ", "
}
if {[string length $line] > 70} {
puts $f $line
set line " "
}
}
puts $f $line
puts $f "};
/*
* The groupMap is indexed by combining the alternate page number with
* the page offset and returns a group number that identifies a unique
* set of character attributes.
*/
static unsigned char groupMap\[\] = {"
set line " "
set lasti [expr {[llength $pages] - 1}]
for {set i 0} {$i <= $lasti} {incr i} {
set page [lindex $pages $i]
set lastj [expr {[llength $page] - 1}]
for {set j 0} {$j <= $lastj} {incr j} {
append line [lindex $page $j]
if {$j != $lastj || $i != $lasti} {
append line ", "
}
if {[string length $line] > 70} {
puts $f $line
set line " "
}
}
}
puts $f $line
puts $f "};
/*
* Each group represents a unique set of character attributes. The attributes
* are encoded into a 32-bit value as follows:
*
* Bits 0-4 Character category: see the constants listed below.
*
* Bits 5-7 Case delta type: 000 = identity
* 010 = add delta for lower
* 011 = add delta for lower, add 1 for title
* 100 = sutract delta for title/upper
* 101 = sub delta for upper, sub 1 for title
* 110 = sub delta for upper, add delta for lower
*
* Bits 8-21 Reserved for future use.
*
* Bits 22-31 Case delta: delta for case conversions. This should be the
* highest field so we can easily sign extend.
*/
static int groups\[\] = {"
set line " "
set last [expr {[llength $groups] - 1}]
for {set i 0} {$i <= $last} {incr i} {
foreach {type toupper tolower totitle} [split [lindex $groups $i] ,] {}
if {$totitle != ""} {
if {$totitle == $toupper} {
set case 4
set delta $toupper
} elseif {$toupper != ""} {
set case 5
set delta $toupper
} else {
set case 3
set delta $tolower
}
} elseif {$toupper != ""} {
set case 6
set delta $toupper
} elseif {$tolower != ""} {
set case 2
set delta $tolower
} else {
set case 0
set delta 0
}
set val [expr {($delta << 22) | ($case << 5) | $type}]
append line [format "%d" $val]
if {$i != $last} {
append line ", "
}
if {[string length $line] > 65} {
puts $f $line
set line " "
}
}
puts $f $line
puts $f "};
/*
* The following constants are used to determine the category of a
* Unicode character.
*/
#define UNICODE_CATEGORY_MASK 0X1F
enum {
UNASSIGNED,
UPPERCASE_LETTER,
LOWERCASE_LETTER,
TITLECASE_LETTER,
MODIFIER_LETTER,
OTHER_LETTER,
NON_SPACING_MARK,
ENCLOSING_MARK,
COMBINING_SPACING_MARK,
DECIMAL_DIGIT_NUMBER,
LETTER_NUMBER,
OTHER_NUMBER,
SPACE_SEPARATOR,
LINE_SEPARATOR,
PARAGRAPH_SEPARATOR,
CONTROL,
FORMAT,
PRIVATE_USE,
SURROGATE,
CONNECTOR_PUNCTUATION,
DASH_PUNCTUATION,
OPEN_PUNCTUATION,
CLOSE_PUNCTUATION,
INITIAL_QUOTE_PUNCTUATION,
FINAL_QUOTE_PUNCTUATION,
OTHER_PUNCTUATION,
MATH_SYMBOL,
CURRENCY_SYMBOL,
MODIFIER_SYMBOL,
OTHER_SYMBOL
};
/*
* The following macros extract the fields of the character info. The
* GetDelta() macro is complicated because we can't rely on the C compiler
* to do sign extension on right shifts.
*/
#define GetCaseType(info) (((info) & 0xE0) >> 5)
#define GetCategory(info) ((info) & 0x1F)
#define GetDelta(info) (((info) > 0) ? ((info) >> 22) : (~(~((info)) >> 22)))
/*
* This macro extracts the information about a character from the
* Unicode character tables.
*/
#define GetUniCharInfo(ch) (groups\[groupMap\[(pageMap\[(((int)(ch)) & 0xffff) >> OFFSET_BITS\] << OFFSET_BITS) | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
"
close $f
}
uni::main
return