"

 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.

"

ByteArray subclass:#CharacterArray

	instanceVariableNames:''

	classVariableNames:'PreviousMatch DecoderTables EncoderTables'

	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.

    As the name already implies, this class is abstract, meaning that there are

    no instances of it. All this class does is provide common protocol for 

    concrete subclasses.

"

! !

!CharacterArray class methodsFor:'instance creation'!

basicNew

    "return a new empty string"

    ^ self basicNew:0

!

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"

!

new

    "return a new empty string"

    ^ self basicNew:0

! !

!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:'code tables'!

decoderTableFor:encoding

    "return a table to decode from an alien encoding into

     the internal (iso8859, ansi) format.

     This is an experimental interface - unfinished"

    |table|

    DecoderTables notNil ifTrue:[

        table := DecoderTables at:encoding ifAbsent:nil.

        table notNil ifTrue:[^ table].

    ] ifFalse:[

        DecoderTables := IdentityDictionary new

    ].

    table := (0 to:255) asByteArray.

    "/

    "/ mac -> iso8859

    "/

    encoding == #mac ifTrue:[

        table at:8r232+1 put:246. "/ german umlaut o (mac: 154; 8859: 246)

        table at:8r212+1 put:228. "/ german umlaut a (mac: 138; 8859: 228)

        table at:8r237+1 put:252. "/ german umlaut u (mac: 159; 8859: 252)

        table at:8r206+1 put:220. "/ german umlaut U (mac: 134; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/

    "/ postscript -> iso8859

    "/

    encoding == #postscript ifTrue:[

        table at:8r224+1 put:246. "/ german umlaut o (ps: 148; 8859: 246)

        table at:8r204+1 put:228. "/ german umlaut a (ps: 132; 8859: 228)

        table at:8r201+1 put:252. "/ german umlaut u (ps: 129; 8859: 252)

        table at:8r231+1 put:214. "/ german umlaut O (ps: 153; 8859: 214)

        table at:8r216+1 put:196. "/ german umlaut A (ps: 142; 8859: 196)

        table at:8r232+1 put:220. "/ german umlaut U (ps: 154; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/

    "/ msdos -> iso8859

    "/

    encoding == #msdos ifTrue:[

        table at:16r82+1 put:16re9. "/ french e degu    (dos: 82; 8859: e9)

        table at:16r8a+1 put:16re8. "/ french e graph   (dos: 8a; 8859: e8)

        table at:16r88+1 put:16rea. "/ french e circ.   (dos: 88; 8859: ea)

        table at:16r8c+1 put:16ree. "/ french u circ.   (dos: 8c; 8859: ee)

        table at:16r87+1 put:16re7. "/ french c cedille (dos: 87; 8859: e7)

        table at:16r85+1 put:16re0. "/ french a degu    (dos: 85; 8859: e0)

"/        table at:8r224+1 put:246. "/ german umlaut o (ps: 148; 8859: 246)

"/        table at:8r204+1 put:228. "/ german umlaut a (ps: 132; 8859: 228)

"/        table at:8r201+1 put:252. "/ german umlaut u (ps: 129; 8859: 252)

"/        table at:8r231+1 put:214. "/ german umlaut O (ps: 153; 8859: 214)

"/        table at:8r216+1 put:196. "/ german umlaut A (ps: 142; 8859: 196)

"/        table at:8r232+1 put:220. "/ german umlaut U (ps: 154; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/ more encodings needed here ....

    DecoderTables at:encoding put:table.

    ^ table

    "

     DecoderTables := nil

    "

    "Created: 20.10.1995 / 23:04:43 / cg"

    "Modified: 22.2.1996 / 17:19:38 / cg"

!

encoderTableFor:encoding

    "return a table to encode from the internal (iso8859, ansi) format

     into an alien encoding.

     This is an experimental interface - unfinished"

    |table|

    EncoderTables notNil ifTrue:[

        table := EncoderTables at:encoding ifAbsent:nil.

        table notNil ifTrue:[^ table].

    ] ifFalse:[

        EncoderTables := IdentityDictionary new

    ].

    table := (0 to:255) asByteArray.

    "/

    "/ iso8859 -> mac

    "/

    encoding == #mac ifTrue:[

        table at:246+1 put:8r232. "/ german umlaut o (mac: 154; 8859: 246)

        table at:228+1 put:8r212. "/ german umlaut a (mac: 138; 8859: 228)

        table at:252+1 put:8r237. "/ german umlaut u (mac: 159; 8859: 252)

        table at:220+1 put:8r206. "/ german umlaut U (mac: 134; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/

    "/ iso8859 -> msdos

    "/

    encoding == #msdos ifTrue:[

        table at:233+1 put:8r202. "/ french e accent degu  (dos: 130; 8859: 233)

        table at:232+1 put:8r212. "/ french e accent graph (dos: 138; 8859: 232)

        table at:234+1 put:8r210. "/ french e accent circ. (dos: 136; 8859: 234)

        table at:238+1 put:8r214. "/ french u accent circ. (dos: 140; 8859: 238)

        table at:231+1 put:8r207. "/ french c cedille      (dos: 135; 8859: 231)

        table at:16re9+1 put:16r82. "/ french e degu    (dos: 82; 8859: e9)

        table at:16re8+1 put:16r8a. "/ french e graph   (dos: 8a; 8859: e8)

        table at:16rea+1 put:16r88. "/ french e circ.   (dos: 88; 8859: ea)

        table at:16ree+1 put:16r8c. "/ french u circ.   (dos: 8c; 8859: ee)

        table at:16re7+1 put:16r87. "/ french c cedille (dos: 87; 8859: e7)

        table at:16re0+1 put:16r85. "/ french a degu    (dos: 85; 8859: e0)

        "/ more needed here - need info to do it ....

    ].

    "/ more encodings needed here ....

    EncoderTables at:encoding put:table.

    ^ table

    "

     EncoderTables := nil

    "

    "Created: 22.2.1996 / 16:17:58 / cg"

    "Modified: 22.2.1996 / 17:21:13 / cg"

!

supportedEncodings

    ^ #( ('DOS' 'MAC')

         (msdos mac)

       )

    "Created: 22.2.1996 / 16:19:20 / cg"

! !

!CharacterArray class methodsFor:'pattern matching'!

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

     checkChar included|

    mStart := matchStart.

    mStop := matchStop.

    sStart := start.

    sStop := stop.

    [true] whileTrue:[

	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 ifFalse:[

			"

			 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:stop 

				  ignoreCase:ignoreCase) ifTrue:[

				^ true

			    ].

			    index := index + 1

			].

			^ false

		    ].

		    "

		     quickCheck ok, advance from the right

		    "

		    mStop := mStop - 1.

		    sStop := sStop - 1

		] 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:[

				    included := matchEntry includes:checkChar asLowercase.

				] ifFalse:[

				    included := matchEntry includes:checkChar asUppercase.

				]

			    ].

			].

			mStart := mStart + 1.

			mSize := mSize - 1.

			included ifFalse:[^ false].

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

			"cut off 1st char and continue"

			sStart := sStart + 1

		    ] ifFalse:[

			"/ must be single character

			"testString empty ?"

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

			"first characters equal ?"

			"/ checkChar := aString at:sStart.

			ignoreCase ifFalse:[^ false].

			(checkChar asUppercase ~~ matchEntry asUppercase) ifTrue:[^ false].

			"advance and continue"

			mStart := mStart + 1.

			sStart := sStart + 1

		    ]

		]

	    ]

	]

    ]

!

matchScanArrayFrom:aString

    "scan a pattern string and decompose it into a scanArray.

     This is processed faster (especially with character ranges), and

     can also be reused later. (if the same pattern is to be searched again)"

    |coll 

     idx "{ Class: SmallInteger }"

     end c1 c2 matchSet previous|

    coll := OrderedCollection new.

    idx := 1. end := aString size.

    [idx <= end] whileTrue:[

	|char this|

	char := aString at:idx.

	char == $* ifTrue:[

	    previous ~~ #anyString ifTrue:[

		this := #anyString

	    ]

	] ifFalse:[

	    char == $# ifTrue:[

		previous ~~ #anyString ifTrue:[

		    this := #any

		]

	    ] ifFalse:[

		char == $[ ifTrue:[

		    matchSet := IdentitySet new.

		    idx := idx + 1.

		    idx > end ifTrue:[^ nil].

		    char := aString at:idx.

		    c1 := nil.

		    [char ~~ $]] whileTrue:[

			((char == $-) and:[c1 notNil]) ifTrue:[

			    idx := idx + 1.

			    idx > end ifTrue:[^ nil].

			    c2 := aString at:idx.

			    c1 to:c2 do:[:c | matchSet add:c].

			    c1 := nil.

			    idx := idx + 1.

			] ifFalse:[

			    (char ~~ $]) ifTrue:[

				matchSet add:char.

				c1 := char.

				idx := idx + 1

			    ]

			].

			idx > end ifTrue:[^ nil].

			char := aString at:idx

		    ].

		    this := matchSet asString

		] ifFalse:[

		    this := char

		]

	    ]

	].

	this notNil ifTrue:[coll add:this. previous := this].

	idx := idx + 1

    ].

    ^ coll asArray

    "

     String matchScanArrayFrom:'*ute*'  

     String matchScanArrayFrom:'**ute**'  

     String matchScanArrayFrom:'*uter'   

     String matchScanArrayFrom:'[cC]#mpute[rR]'  

     String matchScanArrayFrom:'[abcd]*'      

     String matchScanArrayFrom:'[a-k]*'      

     String matchScanArrayFrom:'*some*compl*ern*' 

     String matchScanArrayFrom:'[a-'  

     String matchScanArrayFrom:'[a-zA-Z]'  

     String matchScanArrayFrom:'[a-z01234A-Z]'  

    "

! !

!CharacterArray methodsFor:'Compatibility - ST/V'!

byteAt:index put:aByte

    "store a byte at given index.

     This is an ST/V compatibility method."

    (aByte == 0) ifTrue:[

	"store a space instead"

	^ super basicAt:index put:(Character space)

    ].

    ^ super at:index put:(Character value:aByte)

!

replChar:oldChar with:newChar