"

 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' }"

UninterpretedBytes subclass:#CharacterArray

	instanceVariableNames:''

	classVariableNames:'PreviousMatch DecoderTables EncoderTables DecodingFailedSignal

		EncodingFailedSignal'

	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 and whatever comes in the future.

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

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

    [author:]

	Claus Gittinger

    [see also:]

	String TwoByteString

	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.

     Only useful, when reading twoByteStrings from external sources."

    |mySize nBytes newString dstIdx|

    nBytes := aByteCollection size.

    mySize := self basicNew bitsPerCharacter.

    mySize == 16 ifTrue:[

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

	dstIdx := 1.

	aByteCollection pairWiseDo:[:hi :lo |

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

	    dstIdx := dstIdx + 1

	].

	^ newString.

    ].

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

    "

     TwoByteString fromBytes:#[16r21 16r21]

    "

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

!

fromString:aString

    "return a copy of the argument, aString"

    ^ (self basicNew:(aString size)) replaceFrom:1 with:aString

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

    |newString first|

    newString := ''.

    first := true.

    aCollectionOfStrings do:[:s |

	first ifFalse:[

	    newString := newString , aSeparatorString

	] ifTrue:[

	    first := false

	].

	newString := newString , s

    ].

    ^ newString

    "

     String fromStringCollection:#('hello' 'world' 'how' '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"

    ^ 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

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

    ^ CharacterEncoderImplementations::ISO10646_to_UTF8 decodeString:aStringOrByteCollection

    "

     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 ]

    "

! !

!CharacterArray class methodsFor:'pattern matching'!

matchEscapeCharacter

    "return the character used to escape a matchCharacter

     (i.e. make it a regular character in a matchPattern)"

    ^ $\

!

matchScan:matchScanArray from:matchStart to:matchStop with:aString from:start to:stop ignoreCase:ignoreCase

    "helper for match; return true if the characters from start to stop in

     aString are matching the scan in matchScan from matchStart to matchStop.

     The matchScan is as created by asMatchScanArray.

     This algorithm is not at all the most efficient;

     for heavy duty pattern matching, an interface (primitive) to the regex

     pattern matching package should be added."

    |matchEntry

     mStart "{ Class: SmallInteger }"

     mStop  "{ Class: SmallInteger }"

     sStart "{ Class: SmallInteger }"

     sStop  "{ Class: SmallInteger }"

     mSize  "{ Class: SmallInteger }"

     sSize  "{ Class: SmallInteger }"

     index  "{ Class: SmallInteger }"

     quickCheck matchLast nextMatchEntry

     checkChar included|

    mStart := matchStart.

    mStop := matchStop.

    sStart := start.

    sStop := stop.

    [true] whileTrue:[

"/ Transcript showCR:('match: ''' , (aString copyFrom:sStart to:sStop) ,

"/                    ''' against:' , (matchScanArray copyFrom:mStart to:mStop) printString).

	mSize := mStop - mStart + 1.

	sSize := sStop - sStart + 1.

	"empty strings match"

	(mSize == 0) ifTrue:[^ (sSize == 0)].

	matchEntry := matchScanArray at:mStart.

	"/ the most common case first:

	(sSize ~~ 0

	and:[(checkChar := (aString at:sStart)) = matchEntry]) ifTrue:[

	    "advance by one and continue"

	    mStart := mStart + 1.

	    sStart := sStart + 1

	] ifFalse:[

	    (matchEntry == #any) ifTrue:[

		"restString empty -> no match"

		(sSize == 0) ifTrue:[^ false].

		"# matches single character"

		((sSize == 1) and:[mSize == 1]) ifTrue:[^ true].

		"advance by one and continue"

		mStart := mStart + 1.

		sStart := sStart + 1

	    ] ifFalse:[

		(matchEntry == #anyString) ifTrue:[

		    "* alone matches anything"

		    (mSize == 1) ifTrue:[^ true].

		    "restString empty & matchString not empty -> no match"

		    (sSize == 0) ifTrue:[^ false].

		    "

		     try to avoid some of the recursion by checking last

		     character and continue with shortened strings if possible

		    "

		    quickCheck := false.

		    (mStop >= mStart) ifTrue:[

			matchLast := matchScanArray at:mStop.

			(matchLast ~~ #anyString) ifTrue:[

			    (matchLast == #any) ifTrue:[

				quickCheck := true

			    ] ifFalse:[

				matchLast == (aString at:sStop) ifTrue:[

				    quickCheck := true

				] ifFalse:[

				    matchLast isString ifTrue:[

					quickCheck := matchLast includes:(aString at:sStop)

				    ]

				]

			    ]

			]

		    ].

		    quickCheck ifTrue:[

			"

			 quickCheck ok, advance from the right

			"

			mStop := mStop - 1.

			sStop := sStop - 1

		    ] ifFalse:[

			"/ no quick check;

			"/ look for the next character(s)

			"/ and try matching there

			"/ (to avoid recursion)

			mStart < mStop ifTrue:[

			    nextMatchEntry := matchScanArray at:mStart+1.

			    nextMatchEntry isCharacter ifTrue:[

				sStart <= sStop ifTrue:[

				    [true] whileTrue:[

					ignoreCase ifFalse:[

					    index := aString indexOf:nextMatchEntry startingAt:sStart

					] ifTrue:[

					    index := aString findFirst:[:c | c asLowercase = nextMatchEntry asLowercase]

							   startingAt:sStart.

					].

					(index == 0 or:[index > sStop]) ifTrue:[

					    ^ false

					].

					(self matchScan:matchScanArray

					      from:(mStart + 1)

					      to:mStop

					      with:aString

					      from:index

					      to:sStop

					      ignoreCase:ignoreCase

					) ifTrue:[

					    ^ true

					].

					sStart := index + 1.

				    ]

				]

			    ]

			].

			"

			 no quick check possible;

			 loop over all possible substrings

			"

			index := sStart.

			[index <= sStop] whileTrue:[

			    (self matchScan:matchScanArray

				  from:(mStart + 1)

				  to:mStop

				  with:aString

				  from:index

				  to:sStop

				  ignoreCase:ignoreCase

			    ) ifTrue:[

				^ true

			    ].

			    index := index + 1

			].

			^ false

		    ].

		] ifFalse:[

		    (matchEntry isString) ifTrue:[

			"testString empty -> no match"

			(sSize == 0) ifTrue:[^ false].

			included := false.

			"/ checkChar := aString at:sStart.

			included := matchEntry includes:checkChar.

			included ifFalse:[

			    ignoreCase ifTrue:[

				checkChar isUppercase ifTrue:[