1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tools/uniClass.tcl	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,103 @@
     1.4 +#!/bin/sh
     1.5 +# The next line is executed by /bin/sh, but not tcl \
     1.6 +exec tclsh "$0" ${1+"$@"}
     1.7 +
     1.8 +#
     1.9 +# uniClass.tcl --
    1.10 +#
    1.11 +#	Generates the character ranges and singletons that are used in
    1.12 +#	generic/regc_locale.c for translation of character classes.
    1.13 +#	This file must be generated using a tclsh that contains the
    1.14 +#	correct corresponding tclUniData.c file (generated by uniParse.tcl)
    1.15 +#	in order for the class ranges to match.
    1.16 +#
    1.17 +
    1.18 +proc emitRange {first last} {
    1.19 +    global ranges numranges chars numchars
    1.20 +
    1.21 +    if {$first < ($last-1)} {
    1.22 +	append ranges [format "{0x%04x, 0x%04x}, " \
    1.23 +		$first $last]
    1.24 +	if {[incr numranges] % 4 == 0} {
    1.25 +	    append ranges "\n    "
    1.26 +	}
    1.27 +    } else {
    1.28 +	append chars [format "0x%04x, " $first]
    1.29 +	incr numchars
    1.30 +	if {$numchars % 9 == 0} {
    1.31 +	    append chars "\n    "
    1.32 +	}
    1.33 +	if {$first != $last} {
    1.34 +	    append chars [format "0x%04x, " $last]
    1.35 +	    incr numchars
    1.36 +	    if {$numchars % 9 == 0} {
    1.37 +		append chars "\n    "
    1.38 +	    }
    1.39 +	}
    1.40 +    }
    1.41 +}
    1.42 +
    1.43 +proc genTable {type} {
    1.44 +    global first last ranges numranges chars numchars
    1.45 +    set first -2
    1.46 +    set last -2
    1.47 +
    1.48 +    set ranges "    "
    1.49 +    set numranges 0
    1.50 +    set chars "    "
    1.51 +    set numchars 0
    1.52 +
    1.53 +    for {set i 0} {$i <= 0xFFFF} {incr i} {
    1.54 +	if {[string is $type [format %c $i]]} {
    1.55 +	    if {$i == ($last + 1)} {
    1.56 +		set last $i
    1.57 +	    } else {
    1.58 +		if {$first > 0} {
    1.59 +		    emitRange $first $last
    1.60 +		}
    1.61 +		set first $i
    1.62 +		set last $i
    1.63 +	    }
    1.64 +	}
    1.65 +    }
    1.66 +    emitRange $first $last
    1.67 +
    1.68 +    set ranges [string trimright $ranges "\t\n ,"]
    1.69 +    set chars  [string trimright $chars "\t\n ,"]
    1.70 +    if {$ranges != ""} {
    1.71 +	puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
    1.72 +	puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
    1.73 +    } else {
    1.74 +	puts "/* no contiguous ranges of $type characters */\n"
    1.75 +    }
    1.76 +    if {$chars != ""} {
    1.77 +	puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
    1.78 +	puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
    1.79 +    } else {
    1.80 +	puts "/* no singletons of $type characters */\n"
    1.81 +    }
    1.82 +}
    1.83 +
    1.84 +puts "/*
    1.85 + *	Declarations of Unicode character ranges.  This code
    1.86 + *	is automatically generated by the tools/uniClass.tcl script
    1.87 + *	and used in generic/regc_locale.c.  Do not modify by hand.
    1.88 + */
    1.89 +"
    1.90 +
    1.91 +foreach {type desc} {
    1.92 +    alpha "alphabetic characters"
    1.93 +    digit "decimal digit characters"
    1.94 +    punct "punctuation characters"
    1.95 +    space "white space characters"
    1.96 +    lower "lowercase characters"
    1.97 +    upper "uppercase characters"
    1.98 +    graph "unicode print characters excluding space"
    1.99 +} {
   1.100 +    puts "/* Unicode: $desc */\n"
   1.101 +    genTable $type
   1.102 +}
   1.103 +
   1.104 +puts "/*
   1.105 + *	End of auto-generated Unicode character ranges declarations.
   1.106 + */"