"

 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"

!

romanJISDecoderTable

    "return a table to decode from roman ascii to 16 bit JIS.

     This is an experimental interface - unfinished"

    ^ #(

                  16r212a 16r2149 16r2174 16r2170 16r2173 16r2175 16r2147 

          16r214a 16r214b 16r2176 16r215c 16r2124 16r215d 16r2125 16r213f 

          16r2330 16r2331 16r2332 16r2333 16r2334 16r2335 16r2336 16r2337 

          16r2338 16r2339 16r2127 16r2128 16r2163 16r2161 16r2164 16r2129 

          16r2177 16r2341 16r2342 16r2343 16r2344 16r2345 16r2346 16r2347 

          16r2348 16r2349 16r234a 16r234b 16r234c 16r234d 16r234e 16r234f 

          16r2350 16r2351 16r2352 16r2353 16r2354 16r2355 16r2356 16r2357 

          16r2358 16r2359 16r235a 16r214e 16r2140 16r214f 16r2130 16r2132 

          16r2146 16r2361 16r2362 16r2363 16r2364 16r2365 16r2366 16r2367 

          16r2368 16r2369 16r236a 16r236b 16r236c 16r236d 16r236e 16r236f 

          16r2370 16r2371 16r2372 16r2373 16r2374 16r2375 16r2376 16r2377 

          16r2378 16r2379 16r237a 16r2150 16r2143 16r2151 16r2141 16r2121 

          16r2121 16r2123 16r2156 16r2157 16r2122 16r2126 16r2572 16r2521 

          16r2523 16r2525 16r2527 16r2529 16r2563 16r2565 16r2567 16r2543 

          16r213c 16r2522 16r2524 16r2526 16r2528 16r252a 16r252b 16r252d 

          16r252f 16r2531 16r2533 16r2535 16r2537 16r2539 16r253b 16r253d 

          16r253f 16r2541 16r2544 16r2546 16r2548 16r254a 16r254b 16r254c 

          16r254d 16r254e 16r254f 16r2552 16r2555 16r2558 16r255b 16r255e 

          16r255f 16r2560 16r2561 16r2562 16r2564 16r2566 16r2568 16r2569 

          16r256a 16r256b 16r256c 16r256d 16r256f 16r2573 16r212b 16r212c ).

    "Created: 23.2.1996 / 15:57:50 / 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