summaryrefslogtreecommitdiffstats
path: root/tools/uniParse.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/uniParse.tcl')
-rw-r--r--tools/uniParse.tcl369
1 files changed, 369 insertions, 0 deletions
diff --git a/tools/uniParse.tcl b/tools/uniParse.tcl
new file mode 100644
index 0000000..f92275f
--- /dev/null
+++ b/tools/uniParse.tcl
@@ -0,0 +1,369 @@
+namespace eval uni {
+ set shift 9 ;# number of bits of data within a page
+ variable pMap ;# map from page to page index, each entry is
+ # an index into the pages table, indexed by
+ # page number
+ variable pages ;# map from page index to page info, each
+ # entry is a list of indices into the groups
+ # table, the list is indexed by the offset
+ variable groups ;# list of character info values, indexed by
+ # group number, initialized with the
+ # unassigned character group
+
+ 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
+ } ;# Ordered list of character categories, must
+ # match the enumeration in the header file.
+
+ variable titleCount 0 ;# Count of the number of title case
+ # characters. This value is used in the
+ # regular expression code to allocate enough
+ # space for the title case variants.
+}
+
+proc uni::getValue {items index} {
+ variable categories
+ variable titleCount
+
+ # Extract character info
+
+ 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 {} ;# temporary page 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]]
+
+ # Since the input table omits unassigned characters, these will
+ # show up as gaps in the index sequence. There are a few special cases
+ # where the gaps correspond to a uniform block of assigned characters.
+ # These are indicated as such in the character name.
+
+ # Enter all unassigned characters up to the current character.
+ if {($index > $next) \
+ && ![regexp "Last>$" [lindex $items 1]]} {
+ for {} {$next < $index} {incr next} {
+ lappend info 0
+ if {($next & $mask) == $mask} {
+ addPage $info
+ set info {}
+ }
+ }
+ }
+
+ # Enter all assigned characters up to the current character
+ for {set i $next} {$i <= $index} {incr i} {
+ # Split character index into offset and page number
+ set offset [expr {$i & $mask}]
+ set page [expr {($i >> $shift)}]
+
+ # Add the group index to the info for the current page
+ lappend info $gIndex
+
+ # If this is the last entry in the page, add the page
+ 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 && $argc != 3} {
+ puts stderr "\nusage: $argv0 <datafile> <outdir> ?optimize?\n"
+ exit 1
+ }
+ set f [open [lindex $argv 0] r]
+ set data [read $f]
+ close $f
+
+ set shift 6
+ 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]
+ puts $f "/*
+ * tclUtfData.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 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 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] ,] {}
+
+ # Compute the case conversion type and delta
+
+ if {$totitle != ""} {
+ if {$totitle == $toupper} {
+ # subtract delta for title or upper
+ set case 4
+ set delta $toupper
+ } elseif {$toupper != ""} {
+ # subtract delta for upper, subtract 1 for title
+ set case 5
+ set delta $toupper
+ } else {
+ # add delta for lower, add 1 for title
+ set case 3
+ set delta $tolower
+ }
+ } elseif {$toupper != ""} {
+ # subtract delta for upper, add delta for lower
+ set case 6
+ set delta $toupper
+ } elseif {$tolower != ""} {
+ # add delta for lower
+ set case 2
+ set delta $tolower
+ } else {
+ # noop
+ 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
generated by cgit v0.12 at 2024-11-09 19:22:17 (GMT)