"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 1994 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 }"

UninterpretedBytes variableByteSubclass:#CharacterArray

	instanceVariableNames:''

	classVariableNames:'DecoderTables DecodingFailedSignal EncoderTables

		EncodingFailedSignal PreviousMatches UnicodeDenormalizationMap

		UnicodeNormalizationMap'

	poolDictionaries:''

	category:'Collections-Text'

!

!CharacterArray class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1994 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

"

    CharacterArray is a superclass for all kinds of Strings (i.e.

    (singleByte-)Strings, TwoByteStrings, UnicodeStrings

    and whatever may come in the future.

    This class is abstract, meaning that there are no instances of it;

    concrete subclasses define how the characters are stored (i.e. either as

    single byte, two-byte or four byte strings).

    All this class does is provide common protocol for concrete subclasses.

    Notice:

        internally, ST/X uses a unicode encoding for ALL characters - both

        for individual chatacter entities and for strings of characters.

        When reading/writing files in different encodings, the conversion is

        done at read/write time by use of a CharacterEncoder instance.

        These know how to convert to a wide range of encodings.

    Also notice:

        UTF8 and UTF16 are external encodings of a Unicode string; they are never

        used internally. When interacting with a UTF8 interface (OS-API or files),

        you should convert UTF8 into the internal full Unicode right at the interface.

        Do not keep UTF8 around internally as String instances.

        The reason is that UTF8 makes it harder to manipulate strings (for example

        to insert/extract substrings or to get its size. Of such operations would

        require a scan of the UTF8, which would complicate them).

        Of course, there may be rare exceptions to this, for example if a file's contents

        is treated as raw data, and the strings have to be copied/shuffled around only,

        without any real processing on it.

    [author:]

        Claus Gittinger

    [see also:]

        String TwoByteString Unicode16String Uniode32String

        StringCollection

"

! !

!CharacterArray class methodsFor:'initialization'!

initialize

    DecodingFailedSignal isNil ifTrue:[

        DecodingFailedSignal := DecodingError.

        DecodingFailedSignal notifierString:'error during decode'.

        EncodingFailedSignal :=EncodingError.

        EncodingFailedSignal notifierString:'error during encode'.

    ]

    "

     CharacterArray initialize

    "

    "Modified: 3.8.1997 / 18:15:59 / cg"

! !

!CharacterArray class methodsFor:'instance creation'!

basicNew

    "return a new empty string"

    ^ self basicNew:0

!

fromBytes:aByteCollection

    "return an instance of the receiver class,

     taking untranslated bytes from the argument, aByteCollection

     in most-significant first order.

     Only useful, when reading twoByteStrings from external sources."

    ^ self fromBytes:aByteCollection MSB:true

    "

     Unicode16String fromBytes:#[16r02 16r20]

     Unicode16String fromBytes:#[16r02 16r20] MSB:true

     Unicode16String fromBytes:#[16r02 16r20] MSB:false

    "

    "Modified: 30.6.1997 / 20:08:37 / cg"

!

fromBytes:aByteCollection MSB:msb

    "return an instance of the receiver class,

     taking untranslated bytes from the argument, aByteCollection

     in the given byte order.

     Only useful, when reading twoByteStrings from external sources."

    |mySize nBytes newString dstIdx|

    self assert:(self ~~ CharacterArray). "/ only works for concrete subclasses.

    "/ the following is a quite inefficient implementation.

    "/ consider rewriting, if heavily used.

    nBytes := aByteCollection size.

    mySize := self basicNew bitsPerCharacter.

    mySize == 16 ifTrue:[

        newString := self uninitializedNew:(nBytes // 2).

        dstIdx := 1.

        msb ifTrue:[

            aByteCollection pairWiseDo:[:hi :lo |

                newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).

                dstIdx := dstIdx + 1

            ].

        ] ifFalse:[

            aByteCollection pairWiseDo:[:lo :hi |

                newString at:dstIdx put:(Character value:(hi bitShift:8)+lo).

                dstIdx := dstIdx + 1

            ].

        ].

        ^ newString.

    ].

    ^ (self uninitializedNew:nBytes) replaceFrom:1 with:aByteCollection

    "

     Unicode16String fromBytes:#[16r02 16r20]

    "

    "Modified: 30.6.1997 / 20:08:37 / cg"

!

fromString:aString

    "return a copy of the argument, aString"

    |sz|

    sz := aString size.

    ^ (self uninitializedNew:sz) replaceFrom:1 to:sz with:aString startingAt:1

    "

        Unicode16String fromString:'hello'

    "

!

fromStringCollection:aCollectionOfStrings

    "return new string formed by concatenating a copy of the argument, aString"

    ^ self fromStringCollection:aCollectionOfStrings separatedBy:''

    "

     String fromStringCollection:#('hello' 'world' 'how' 'about' 'this')

    "

    "Created: 20.11.1995 / 15:26:59 / cg"

!

fromStringCollection:aCollectionOfStrings separatedBy:aSeparatorString

    "return new string formed by concatenating a copy of the argument, aString"

    |stream|

    aCollectionOfStrings do:[:eachString |

        stream isNil ifTrue:[

            stream := self writeStreamClass with:eachString.

        ] ifFalse:[

            stream

                nextPutAll:aSeparatorString;

                nextPutAll:eachString.

        ].

    ].

    stream isNil ifTrue:[^ ''].

    ^ stream contents

    "

     String fromStringCollection:#('hello' 'world' 'how' 'about' 'this') separatedBy:' '

     String fromStringCollection:#('hello' 'world' 'how' 'about' 'this') separatedBy:'Ƞ'

     Text fromStringCollection:{'hello'. 'world'. 'how' allBold. 'about'. 'this'. 'äöü'} separatedBy:'Ƞ'

    "

    "Created: 20.11.1995 / 15:32:17 / cg"

!

fromUTF8Bytes:aByteCollection

    "return a new string which represents the characters as decoded

     from the utf8 encoded bytes, aByteCollection.

     Returns either a normal String, or a TwoByteString instance.

     Only useful, when reading twoByteStrings from external sources.

     This only handles up-to 16bit characters"

    ^ self decodeFromUTF8:aByteCollection.

    "

     CharacterArray fromUTF8Bytes:#[ 16r41 16r42 ]

     CharacterArray fromUTF8Bytes:#[ 16rC1 16r02 ]

     CharacterArray fromUTF8Bytes:#[ 16rE0 16r81 16r02 ]

     CharacterArray fromUTF8Bytes:#[ 16rEF 16rBF 16rBF ]

   rfc2279 examples:

     CharacterArray fromUTF8Bytes:#[ 16r41 16rE2 16r89 16rA2 16rCE 16r91 16r2E ]

     CharacterArray fromUTF8Bytes:#[ 16rED 16r95 16r9C 16rEA 16rB5 16rAD 16rEC 16r96 16rB4 ]

     CharacterArray fromUTF8Bytes:#[ 16rE6 16r97 16rA5 16rE6 16r9C 16rAC 16rE8 16rAA 16r9E ]

   invalid:

     CharacterArray fromUTF8Bytes:#[ 16rC0 16r80 ]

     CharacterArray fromUTF8Bytes:#[ 16rE0 16r80 16r80 ]

    "

!

new

    "return a new empty string"

    ^ self basicNew:0

!

readSmalltalkStringFrom:aStreamOrString onError:exceptionBlock

    "read & return the next String from the (character-)stream aStream;

     skipping all whitespace first; return the value of exceptionBlock,

     if no string can be read. The sequence of characters as read from the

     stream must be one as stored via storeOn: or storeString."

    |str collected char|

    str := aStreamOrString readStream.

    "skip whiteSpace"

    str skipSeparators.

    (str peekOrNil == $') ifTrue:[

        str next.

        collected := self writeStream.

        [str atEnd] whileFalse:[

            char := str next.

            char == $' ifTrue:[

                "/ look for another quote

                str peekOrNil ~~ $' ifTrue:[

                    "end of string reached"

                    ^ collected contents.

                ].

                "eat doubled quote"

                str next.

            ].

            ((char ~~ Character return) or:[str peekOrNil ~~ Character lf]) ifTrue:[

                "compress CRLF to LF, but keep a single CR"

                collected nextPut:char.

            ].

        ].

        "if we come here, we reached the end without finding a closing $'"

    ].

    ^ exceptionBlock value

    "

     String readFrom:('''hello world''' readStream)

     String readFrom:('''hello '''' world''' readStream)

     String readFrom:('1 ''hello'' ' readStream)

     String readFrom:('1 ''hello'' ' readStream) onError:['foobar']

    "

    "Created: / 05-07-2006 / 16:41:04 / cg"

    "Modified: / 06-10-2006 / 14:05:32 / cg"

!

writeStreamClass

    "the class used by writeStream.

     Here, we return CharacterWriteStream, which automatically changes

     the underlying collection to a multiByte string (i.e. UnicodeString).

     So you can stream wide characters into it."

    ^ CharacterWriteStream

    "

     String writeStream

    "

    "Created: / 09-01-2011 / 10:37:57 / cg"

! !

!CharacterArray class methodsFor:'Compatibility-VW'!

fromIntegerArray: anArray

    "Answer a new instance of the receiver that is created from the argument, anArray."

    | new |

    new := self new: anArray size.

    1 to: anArray size do:[:index |

        new at: index put: (anArray at: index) asCharacter

    ].

    ^new

    "

     String fromIntegerArray: #[8 127]

    "

! !

!CharacterArray class methodsFor:'Signal constants'!

decodingFailedSignal

    "return the signal, raised when decoding of a string is not possible

     due to invalid characters contained in the source.

     This may happen for example, if a non EUC coded 8-bit string

     is attempted to be decoded into a JIS string."

    ^ DecodingFailedSignal

    "Created: 28.6.1997 / 20:09:55 / cg"

    "Modified: 3.8.1997 / 18:16:47 / cg"

!

encodingFailedSignal

    "return the (query-) signal, raised when encoding of a string is not possible

     due to invalid characters contained in the source."

    ^ EncodingFailedSignal

    "Modified: 28.6.1997 / 20:09:35 / cg"

    "Created: 3.8.1997 / 18:16:40 / cg"

! !

!CharacterArray class methodsFor:'cleanup'!

lowSpaceCleanup

    "cleanup in low-memory situations"

    DecoderTables := EncoderTables := nil

    "

     CharacterArray lowSpaceCleanup

    "

    "Created: 22.2.1996 / 16:30:30 / cg"

    "Modified: 22.2.1996 / 17:58:05 / cg"

! !

!CharacterArray class methodsFor:'encoding & decoding'!

decodeFromUTF8:aStringOrByteCollection

    "given a string in UTF8 encoding,

     return a new string containing the same characters, in Unicode encoding.

     Returns either a normal String, a Unicode16String or a Unicode32String instance.

     This is only useful, when reading from external sources or communicating with

     other systems 

     (ST/X never uses utf8 internally, but always uses strings of fully decoded unicode characters).

     This only handles up-to 30bit characters."

    |sz anyAbove7BitAscii nBitsRequired

     ascii "{ Class: SmallInteger }"

     byte  "{ Class: SmallInteger }"

     lastIdx  "{ Class: SmallInteger }"

     srcIdx  "{ Class: SmallInteger }"

     idx  "{ Class: SmallInteger }"

     nFollowBytes  "{ Class: SmallInteger }"

     minValue "{ Class: SmallInteger }"

     newString|

    "/ fast track, also avoid creation of new strings if aStringOrByteCollection is already a 7-bit string

    aStringOrByteCollection containsNon7BitAscii ifFalse:[

        ^ aStringOrByteCollection asSingleByteString

    ].

    nBitsRequired := 8.

    anyAbove7BitAscii := false.

    sz := 0.

    lastIdx := aStringOrByteCollection size.

    srcIdx := 1.

    "first determine the string size and max element size.

     Check for UTF-8 confomance on the fly."

    [srcIdx <= lastIdx] whileTrue:[

        byte := ascii := aStringOrByteCollection byteAt:srcIdx. 

        srcIdx := srcIdx + 1.

        (byte bitAnd:16r80) ~~ 0 ifTrue:[

            anyAbove7BitAscii := true.

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

                "/ 80 .. 7FF

                ascii := byte bitAnd:2r00011111.

                nFollowBytes := 1.

                minValue := 16r80.

            ] ifFalse:[(byte bitAnd:2r11110000) == 2r11100000 ifTrue:[

                "/ 800 .. FFFF

                ascii := byte bitAnd:2r00001111.

                nFollowBytes := 2.

                minValue := 16r800.

            ] ifFalse:[(byte bitAnd:2r11111000) == 2r11110000 ifTrue:[

                "/ 10000 .. 1FFFFF

                ascii := byte bitAnd:2r00000111.

                nFollowBytes := 3.

                minValue := 16r10000.

            ] ifFalse:[(byte bitAnd:2r11111100) == 2r11111000 ifTrue:[

                "/ 200000 .. 3FFFFFF

                ascii := byte bitAnd:2r00000011.

                nFollowBytes := 4.

                minValue := 16r200000.

            ] ifFalse:[(byte bitAnd:2r11111110) == 2r11111100 ifTrue:[

                "/ 4000000 .. 7FFFFFFF

                ascii := byte bitAnd:2r00000001.

                ascii ~~ 0 ifTrue:[

                    "/ ST/X can only represent 30 bit unicode characters.

                    "/ but the max unicode character is defined as 16r10 FFFF anyway

                    ^ DecodingError newException

                           defaultValue:aStringOrByteCollection;

                           raiseRequestWith:aStringOrByteCollection errorString:'unicode character out of range'.

                ].

                nFollowBytes := 5.

                minValue := 16r4000000.

            ] ifFalse:[

                ^ DecodingError newException

                       defaultValue:aStringOrByteCollection;

                       raiseRequestWith:aStringOrByteCollection errorString:'invalid utf8 encoding'.

            ]]]]].

            nFollowBytes timesRepeat:[

                byte := aStringOrByteCollection byteAt:srcIdx.

                srcIdx := srcIdx + 1.

                (byte bitAnd:2r11000000) ~~ 2r10000000 ifTrue:[

                    ^ DecodingError newException

                           defaultValue:aStringOrByteCollection;

                           raiseRequestWith:aStringOrByteCollection errorString:'illegal followbyte'.

                ].

                ascii := (ascii bitShift:6) bitOr:(byte bitAnd:2r00111111). 

            ]. 

            ascii > 16rFFFF ifTrue:[

                nBitsRequired < 32 ifTrue:[nBitsRequired := 32].

            ] ifFalse:[ascii > 16rFF ifTrue:[

                nBitsRequired < 16 ifTrue:[nBitsRequired := 16].

            ]].

            ascii < minValue ifTrue:[

                "encoding a value in a longer utf8-sequence than required is not allowed

                 and imposes a security risk"

                ^ DecodingError newException

                       defaultValue:aStringOrByteCollection;

                       raiseRequestWith:aStringOrByteCollection errorString:'overlong utf8 sequence'.

            ].

        ].

        sz := sz + 1.

    ].

    nBitsRequired == 8 ifTrue:[

        anyAbove7BitAscii ifFalse:[

            "/ can return the original string

            ^ aStringOrByteCollection asSingleByteString.

        ].

        newString := String uninitializedNew:sz

    ] ifFalse:[nBitsRequired <= 16 ifTrue:[

        newString := Unicode16String new:sz

    ] ifFalse:[

        newString := Unicode32String new:sz

    ]].

    idx := srcIdx := 1.

    "now fill the string"

    [srcIdx <= lastIdx] whileTrue:[

        byte := ascii := aStringOrByteCollection byteAt:srcIdx.

        srcIdx := srcIdx + 1.