"{ 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.

    [about hashing:]

        the ST/X VM uses the fnv1 hash (*) to quickly retrieve symbols,

        This has only 1 collision in my current systm with 66k symbols.

        To try, evaluate:

            ((Symbol allInstances collect:#hash_fnv1a as:Bag)

                valuesAndCountsSelect:[:h :cnt | cnt > 1]) size

        in contrast, java hash is much worse (18 collisions):

            ((Symbol allInstances collect:#hash_java as:Bag)

                valuesAndCountsSelect:[:h :cnt | cnt > 1]) size

        and hash_sdbm hash is even better (0 collisions),

        but slightly slower:

            ((Symbol allInstances collect:#hash_sdbm as:Bag)

                valuesAndCountsSelect:[:h :cnt | cnt > 1]) size

        we could use CRC32 (also with 0 collisions), 

        but that is slower on machines without CRC instruction:

            ((Symbol allInstances collect:[:s | CRC32Stream hashValueOf:s] as:Bag)

                valuesAndCountsSelect:[:h :cnt | cnt > 1]) size

        (*) slightly modified to return a 31bit positive number, eg. a SmallInt in 32bit systems.

    [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: / 03-08-1997 / 18:15:59 / cg"

    "Modified (format): / 16-01-2018 / 18:57:10 / stefan"

! !

!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'

        String fromString:'hello' asUnicode16String

        Unicode16String fromString:'hello' asUnicode16String

    "

!

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

    <resource: #obsolete>

    "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.

    "Modified (comment): / 07-02-2017 / 17:32:38 / stefan"

!

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 type of stream used in 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

     - the following delivers a Unicode16String:

     String streamContents:[:s |

         s nextPut:(Character value:16r3f30).

         s nextPutAll:'hello'.

         s cr.

     ] 

    "

    "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."

    ^ DecodingError

    "Created: / 28-06-1997 / 20:09:55 / cg"

    "Modified: / 03-08-1997 / 18:16:47 / cg"

    "Modified: / 16-01-2018 / 18:58:10 / stefan"

!

encodingFailedSignal

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

     due to invalid characters contained in the source."

    ^ EncodingError

    "Modified: / 28-06-1997 / 20:09:35 / cg"

    "Created: / 03-08-1997 / 18:16:40 / cg"

    "Modified: / 16-01-2018 / 18:59:04 / stefan"

! !

!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."

    |decodedSize nBitsRequired

     codepoint "{ Class: SmallInteger }"

     byte  "{ Class: SmallInteger }"

     encodedSize  "{ Class: SmallInteger }"

     srcIdx  "{ Class: SmallInteger }"

     idx  "{ Class: SmallInteger }"

     nFollowBytes  "{ Class: SmallInteger }"

     minValue "{ Class: SmallInteger }"

     newString|

    encodedSize := aStringOrByteCollection size.

    decodedSize := aStringOrByteCollection utf8DecodedSize.

    encodedSize == decodedSize ifTrue:[

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

        ^ aStringOrByteCollection asSingleByteStringIfPossible

    ].

    nBitsRequired := 8.

    srcIdx := 1.

    "this loop is only used to find the largest character"

    [srcIdx <= encodedSize] whileTrue:[

        byte := aStringOrByteCollection byteAt:srcIdx. 

        srcIdx := srcIdx + 1.

        byte > 16r7F ifTrue:[

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

                "/ 80 .. 7FF

                nBitsRequired < 16 ifTrue:[

                    codepoint := ((byte bitAnd:2r00011111) bitShift:6)

                               + ((aStringOrByteCollection byteAt:srcIdx) bitAnd:2r00111111).

                    codepoint > 16rFF ifTrue:[

                        nBitsRequired := 16.

                    ].

                ].

                srcIdx := srcIdx + 1.

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

                "/ 800 .. FFFF

                srcIdx := srcIdx + 2.

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

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

                "/ 10000 .. 1FFFFF

                srcIdx := srcIdx + 3.

                nBitsRequired := 32.

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

                "5 byte sequences do not result in valid unicode"

                "/ 200000 .. 3FFFFFF

                srcIdx := srcIdx + 4.

                nBitsRequired := 32.

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

                "6 byte sequences do not result in valid unicode"

                "/ 4000000 .. 7FFFFFFF

                (byte bitAnd:2r00000001) ~~ 0 ifTrue:[

                    "/ ST/X can only represent up to 30 bit characters.

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

                    ^ DecodingError newException

                           defaultValue:aStringOrByteCollection;

                           raiseRequestWith:aStringOrByteCollection 

                           errorString:('unicode character out of range at: %1' bindWith:srcIdx).

                ].

                srcIdx := srcIdx + 5.

                nBitsRequired := 32.

            ] ifFalse:[

                ^ DecodingError newException

                       defaultValue:aStringOrByteCollection;

                       raiseRequestWith:aStringOrByteCollection errorString:'invalid utf8 encoding'.

            ]]]]].

        ].

    ].

    nBitsRequired == 8 ifTrue:[

        newString := String uninitializedNew:decodedSize

    ] ifFalse:[nBitsRequired == 16 ifTrue:[

        newString := Unicode16String new:decodedSize

    ] ifFalse:[

        newString := Unicode32String new:decodedSize

    ]].

    idx := srcIdx := 1.

    "now fill the string"

    [srcIdx <= encodedSize] whileTrue:[

        byte := codepoint := aStringOrByteCollection byteAt:srcIdx.

        srcIdx := srcIdx + 1.

        byte > 16r7F ifTrue:[

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

                codepoint := byte bitAnd:2r00011111.

                nFollowBytes := 1.