"

 COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libbasic' }"

"{ NameSpace: Smalltalk }"

Magnitude subclass:#Character

	instanceVariableNames:'asciivalue'

	classVariableNames:'CharacterTable Separators'

	poolDictionaries:''

	category:'Magnitude-General'

!

!Character class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This class represents characters.

    Notice, that actual character objects are not used when characters

    are stored in strings, symbols etc.

    These only store a character's asciiValue/codePoint for a more compact representation.

    The word 'asciiValue' is a historic leftover - actually, any integer

    code is allowed and actually used (i.e. characters are not limited to 8bit).

    Also, the encoding is actually Unicode, of which ascii is a subset and the same encoding value

    for the first 128 characters (codePoint 0 to 127 are the same in ascii).

    Some heavily used Characters are kept as singletons; i.e. for every asciiValue (0..N),

    there exists exactly one instance of Character, which is shared.

    Character value:xxx checks for this, and returns a reference to an existing instance.

    For N<=255, this is guaranteed; i.e. in all Smalltalks, the single byte characters are always

    handled like this, and you can therefore safely compare them using == (identity compare).

    Other characters (i.e. codepoint > N) are not guaranteed to be shared;

    i.e. these my or may not be created as required.

    Actually, do NOT depend on which characters are and which are not shared.

    Always compare using #= if there is any chance of a non-ascii character being involved.

    Once again (because beginners sometimes make this mistake):

	This means: you may compare characters using #== ONLY IFF you are certain,

	that the characters ranges is 0..255.

	Otherwise, you HAVE TO compare using #=. (if in doubt, always compare using #=).

	Sorry for this inconvenience, but it is (practically) impossible to keep

	the possible maximum of 2^32 characters (Unicode) around, for that convenience alone.

    In ST/X, N is (currently) 1024. This means that all the latin characters and some others are

    kept as singleton in the CharacterTable class variable (which is also used by the VM when characters

    are instanciated).

    Methods marked as (JS) come from the manchester Character goody

    (CharacterComparing) by Jan Steinman, which allow Characters to be used as

    Interval elements (i.e. ($a to:$z) do:[...] );

    They are not a big deal, but convenient add-ons.

    Some of these have been modified a bit.

    WARNING: characters are known by compiler and runtime system -

	     do not change the instance layout.

    Also, although you can create subclasses of Character, the compiler always

    creates instances of Character for literals ...

    ... and other classes are hard-wired to always return instances of characters

    in some cases (i.e. String>>at:, Symbol>>at: etc.).

    Therefore, it may not make sense to create a character-subclass.

    Case Mapping in Unicode:

	There are a number of complications to case mappings that occur once the repertoire

	of characters is expanded beyond ASCII.

	* Because of the inclusion of certain composite characters for compatibility,

	  such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,

	  which is used where the first letter of a word is to be capitalized

	  (e.g. Titlecase, vs. UPPERCASE, or lowercase).

	  For example, the title case of the example character is U+01F2 'Dz' capital d with small z.

	* Case mappings may produce strings of different length than the original.

	  For example, the German character U+00DF small letter sharp s expands when uppercased to

	  the sequence of two characters 'SS'.

	  This also occurs where there is no precomposed character corresponding to a case mapping.

	  *** This is not yet implemented (in 5.2) ***

	* Characters may also have different case mappings, depending on the context.

	  For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed

	  by another letter, but lowercases to 03C2 small final sigma if it is.

	  *** This is not yet implemented (in 5.2) ***

	* Characters may have case mappings that depend on the locale.

	  For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.

	  *** This is not yet implemented (in 5.2) ***

	* Case mappings are not, in general, reversible.

	  For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,

	  the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.

    Collation Sequence:

	*** This is not yet implemented (in 5.2) ***

    [author:]

	Claus Gittinger

    [see also:]

	String TwoByteString Unicode16String Unicode32String

	StringCollection Text

"

! !

!Character class methodsFor:'instance creation'!

basicNew

    "catch new - Characters cannot be created with new"

    ^ self error:'Characters cannot be created with new'

!

codePoint:anInteger

    "return a character with codePoint anInteger"

%{  /* NOCONTEXT */

#ifdef __SCHTEAM__

    {

	char ch = (char)(context.stArg(0).intValue("[codePoint:]"));

	return context._RETURN(STCharacter._new(ch));

    }

    /* NOTREACHED */

#else

    INT __codePoint;

    if (__isSmallInteger(anInteger)) {

	__codePoint = __smallIntegerVal(anInteger);

	if ((unsigned INT)(__codePoint) <= MAX_IMMEDIATE_CHARACTER /* (__codePoint >= 0) && (__codePoint <= 255) */) {

	    RETURN ( __MKCHARACTER(__codePoint) );

	} else {

	    RETURN ( __MKUCHARACTER(__codePoint) );

	}

    }

#endif

%}.

    (anInteger between:0 and:(CharacterTable size - 1)) ifTrue:[

	^ CharacterTable at:(anInteger + 1)

    ].

    (anInteger between:16r100 and:16r3FFFFFFF) ifTrue:[

	^ super basicNew setCodePoint:anInteger

    ].

    "

     a characters codePoint must be 0..16r3FFFFFFF.

     (i.e. only characters with up-to 30 bits are allowed.)

    "

    RangeError raiseWith:anInteger errorString:'invalid codePoint for character'

    "

      self codePoint:16r34.

      self codePoint:16r3455.

      self codePoint:16rFFFFFFFFFFFFFFFFFFF.

    "

!

digitValue:anInteger

    "return a character that corresponds to anInteger.

     0-9 map to $0-$9, 10-35 map to $A-$Z"

    |val "{ Class: SmallInteger }" |

    val := anInteger.

    (val between:0 and:9) ifTrue:[

	^ Character codePoint:(val + ($0 codePoint))

    ].

    (val between:10 and:35) ifTrue:[

	^ Character codePoint:(val + ($A codePoint - 10))

    ].

    ^ self error:'value not in range 0 to 35'

!

utf8DecodeFrom:aStream

    "read and return a single unicode character from an UTF8 encoded stream"

    |fetchNext c1 c2 c3 c4 c5 codePoint|

    c1 := aStream next.

    codePoint := c1 codePoint.

    codePoint <= 16r7F ifTrue:[

	"/ 0xxxxxxx - 7 bits

	^ c1.

    ].

    (codePoint bitAnd:2r11000000) == 2r10000000 ifTrue:[

	"/ out of sync (got an intermediate character)

	InvalidEncodingError raiseRequestWith:codePoint errorString:' - out of sync'.

	^ c1.

    ].

    fetchNext := [  |ch|

		    ch := aStream next.

		    (ch codePoint bitAnd:2r11000000) == 2r10000000 ifFalse:[

			"/ followup chars must have 2r10 in high bits

			InvalidEncodingError raiseRequestWith:ch codePoint.

			^ c1.

		    ].

		    ch

		 ].

    (codePoint bitAnd:2r11100000) == 2r11000000 ifTrue:[

	"/ 110xxxxx 10xxxxxx - 11 bits

	c2 := fetchNext value.

	codePoint := c1 codePoint bitAnd:16r1F.

	codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).

	codePoint <= 16r7F ifTrue:[

	    InvalidEncodingError raiseRequestWith:codePoint.

	].

	^ Character codePoint:codePoint

    ].

    (codePoint bitAnd:2r11110000) == 2r11100000 ifTrue:[

	"/ 1110xxxx 10xxxxxx 10xxxxxx - 16 bits

	c2 := fetchNext value.

	c3 := fetchNext value.

	codePoint := c1 codePoint bitAnd:16r0F.

	codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).

	codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).

	codePoint <= 16r7FF ifTrue:[

	    InvalidEncodingError raiseRequestWith:codePoint.

	].

	^ Character codePoint:codePoint

    ].

    "/ notice: currently, characters can only have 16bit encoding;

    "/ therefore the following will raise a runtime exception,

    (codePoint bitAnd:2r11111000) == 2r11110000 ifTrue:[

	"/ 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - 21 bits

	c2 := fetchNext value.

	c3 := fetchNext value.

	c4 := fetchNext value.

	codePoint := c1 codePoint bitAnd:16r07.

	codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).

	codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).

	codePoint := (codePoint bitShift:6) bitOr:(c4 codePoint bitAnd:16r3F).

	codePoint <= 16rFFFF ifTrue:[

	    InvalidEncodingError raiseRequestWith:codePoint.

	].

	^ Character codePoint:codePoint

    ].

    (codePoint bitAnd:2r11111100) == 2r11111000 ifTrue:[

	"/ 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - 26 bits

	c2 := fetchNext value.

	c3 := fetchNext value.

	c4 := fetchNext value.

	c5 := fetchNext value.

	codePoint := c1 codePoint bitAnd:16r03.

	codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).

	codePoint := (codePoint bitShift:6) bitOr:(c3 codePoint bitAnd:16r3F).

	codePoint := (codePoint bitShift:6) bitOr:(c4 codePoint bitAnd:16r3F).

	codePoint := (codePoint bitShift:6) bitOr:(c5 codePoint bitAnd:16r3F).

	codePoint <= 16r1FFFFF ifTrue:[

	    InvalidEncodingError raiseRequestWith:codePoint.

	].

	^ Character codePoint:codePoint

    ].

    (codePoint bitAnd:2r11111110) == 2r11111100 ifTrue:[

	"/ 1111110x ... 10xxxxxx - any number of bits

	codePoint := c1 codePoint bitAnd:16r01.

	c2 := aStream peek.

	[c2 notNil and:[(c2 codePoint bitAnd:2r11000000) == 2r10000000]] whileTrue:[

	    codePoint := (codePoint bitShift:6) bitOr:(c2 codePoint bitAnd:16r3F).

	    aStream next.

	    c2 := aStream peek.

	].

	codePoint <= 16r3FFFFFF ifTrue:[

	    InvalidEncodingError raiseRequestWith:codePoint.

	].

	^ Character codePoint:codePoint

    ].

    InvalidEncodingError raiseRequestWith:codePoint.

    ^ c1

    "

      Character utf8DecodeFrom:'a' readStream

      Character utf8DecodeFrom:#[195 188] asString readStream

    "

    "test:

      |utf8Encoding original readBack|

      1 to:16rFFFF do:[:codePoint |

	original := Character value:codePoint.

	utf8Encoding := original asString utf8Encoded.

	readBack := Character utf8DecodeFrom:(utf8Encoding readStream).

	readBack codePoint = codePoint ifFalse:[

	    self halt

	]

      ]

    "

!

value:anInteger

    "return a character with codePoint anInteger - backward compatibility"

    ^ self codePoint:anInteger

! !

!Character class methodsFor:'accessing untypeable characters'!

controlCharacter:char

    "Answer the Character representing ctrl-char.

     ctrl-a -> 1; ctrl-@ -> 0"

    char == $@ ifTrue:[^ self codePoint:0].

    self assert:char isLetter.

    ^ self codePoint:(char asLowercase - $a + 1)

    "

     self controlCharacter:$@

     self controlCharacter:$d

    "

!

endOfInput

    "Answer the Character representing ctrl-d (Unix-EOF)."

    ^ self codePoint:4

!

leftParenthesis

    "Answer the Character representing a left parenthesis."

    ^ self codePoint:40

!

period

    "Answer the Character representing a carriage period."

    ^ self codePoint:46

!

poundSign

    "Answer the Character representing a pound sign (hash)."

    ^ self codePoint:35

!

rightParenthesis

    "Answer the Character representing a right parenthesis."

    ^ self codePoint:41

! !

!Character class methodsFor:'constants'!

backspace

    "return the backspace character"

    ^ Character codePoint:8

!

bell

    "return the bell character"

    ^ Character codePoint:7

!

cr

    "return the lineEnd character

     - actually (in unix) this is a newline character"

    ^ Character codePoint:10

!

del

    "return the delete character"

    ^ Character codePoint:16r7F

!

doubleQuote

    "return the double-quote character"

    ^ Character codePoint:34

!

esc

    "return the escape character"

    ^ Character codePoint:27

!

etx

    "return the end-of-text character"

    ^ Character codePoint:3

!

euro

    "The Euro currency sign (notice: not all fonts support it).

     The Unicode encoding is U+20AC"

    ^ Character codePoint:16r20AC

    "

     Transcript font:(Font family:'courier' size:12 encoding:'iso10646-1').

     Transcript showCR:Character euro

    "

    "

     0 to:255 do:[:i |

	Transcript

	    show:'| '; show:((i printStringRadix:16) leftPaddedTo:2);

	    show:' | '; show:(i printStringPaddedTo:3);

	    show:' | '; show:(Character value:i);

	    cr.

     ]

    "

!

excla

    "return the exclamation-mark character"

    ^ $!!

!

ff

    "return the form-feed character"

    ^ Character codePoint:12

!

lf

    "return the newline/linefeed character"

    ^ Character codePoint:10

!

linefeed

    "squeak compatibility: return the newline/linefeed character"

    ^ Character codePoint:10

!

maxImmediateCodePoint

    "return the maximum codePoint until which the characters are shared"

%{ /* NOCONTEXT */

    RETURN(__mkSmallInteger(MAX_IMMEDIATE_CHARACTER));

%}.

    "

      self maxImmediateCodePoint

    "

!

maxValue

    "return the maximum codePoint a character may have"

    ^ 16r3FFFFFFF

!

newPage

    "return the form-feed character"

    ^ Character codePoint:12

!

nl

    "return the newline character"