sl@0: #!/bin/sh
sl@0: # The next line is executed by /bin/sh, but not tcl \
sl@0: exec tclsh "$0" ${1+"$@"}
sl@0: 
sl@0: #
sl@0: # uniClass.tcl --
sl@0: #
sl@0: #	Generates the character ranges and singletons that are used in
sl@0: #	generic/regc_locale.c for translation of character classes.
sl@0: #	This file must be generated using a tclsh that contains the
sl@0: #	correct corresponding tclUniData.c file (generated by uniParse.tcl)
sl@0: #	in order for the class ranges to match.
sl@0: #
sl@0: 
sl@0: proc emitRange {first last} {
sl@0:     global ranges numranges chars numchars
sl@0: 
sl@0:     if {$first < ($last-1)} {
sl@0: 	append ranges [format "{0x%04x, 0x%04x}, " \
sl@0: 		$first $last]
sl@0: 	if {[incr numranges] % 4 == 0} {
sl@0: 	    append ranges "\n    "
sl@0: 	}
sl@0:     } else {
sl@0: 	append chars [format "0x%04x, " $first]
sl@0: 	incr numchars
sl@0: 	if {$numchars % 9 == 0} {
sl@0: 	    append chars "\n    "
sl@0: 	}
sl@0: 	if {$first != $last} {
sl@0: 	    append chars [format "0x%04x, " $last]
sl@0: 	    incr numchars
sl@0: 	    if {$numchars % 9 == 0} {
sl@0: 		append chars "\n    "
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: proc genTable {type} {
sl@0:     global first last ranges numranges chars numchars
sl@0:     set first -2
sl@0:     set last -2
sl@0: 
sl@0:     set ranges "    "
sl@0:     set numranges 0
sl@0:     set chars "    "
sl@0:     set numchars 0
sl@0: 
sl@0:     for {set i 0} {$i <= 0xFFFF} {incr i} {
sl@0: 	if {[string is $type [format %c $i]]} {
sl@0: 	    if {$i == ($last + 1)} {
sl@0: 		set last $i
sl@0: 	    } else {
sl@0: 		if {$first > 0} {
sl@0: 		    emitRange $first $last
sl@0: 		}
sl@0: 		set first $i
sl@0: 		set last $i
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0:     emitRange $first $last
sl@0: 
sl@0:     set ranges [string trimright $ranges "\t\n ,"]
sl@0:     set chars  [string trimright $chars "\t\n ,"]
sl@0:     if {$ranges != ""} {
sl@0: 	puts "static crange ${type}RangeTable\[\] = {\n$ranges\n};\n"
sl@0: 	puts "#define NUM_[string toupper $type]_RANGE (sizeof(${type}RangeTable)/sizeof(crange))\n"
sl@0:     } else {
sl@0: 	puts "/* no contiguous ranges of $type characters */\n"
sl@0:     }
sl@0:     if {$chars != ""} {
sl@0: 	puts "static chr ${type}CharTable\[\] = {\n$chars\n};\n"
sl@0: 	puts "#define NUM_[string toupper $type]_CHAR (sizeof(${type}CharTable)/sizeof(chr))\n"
sl@0:     } else {
sl@0: 	puts "/* no singletons of $type characters */\n"
sl@0:     }
sl@0: }
sl@0: 
sl@0: puts "/*
sl@0:  *	Declarations of Unicode character ranges.  This code
sl@0:  *	is automatically generated by the tools/uniClass.tcl script
sl@0:  *	and used in generic/regc_locale.c.  Do not modify by hand.
sl@0:  */
sl@0: "
sl@0: 
sl@0: foreach {type desc} {
sl@0:     alpha "alphabetic characters"
sl@0:     digit "decimal digit characters"
sl@0:     punct "punctuation characters"
sl@0:     space "white space characters"
sl@0:     lower "lowercase characters"
sl@0:     upper "uppercase characters"
sl@0:     graph "unicode print characters excluding space"
sl@0: } {
sl@0:     puts "/* Unicode: $desc */\n"
sl@0:     genTable $type
sl@0: }
sl@0: 
sl@0: puts "/*
sl@0:  *	End of auto-generated Unicode character ranges declarations.
sl@0:  */"