"======================================================================
|
|   CharacterArray Method Definitions
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"


"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by Steve Byrne.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
| 
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
| General Public License for more details.
| 
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"


ArrayedCollection variableWordSubclass: #CharacterArray
		  instanceVariableNames: ''
		  classVariableNames: ''
		  poolDictionaries: ''
		  category: 'Language-Data types'
!

CharacterArray comment: 
'My instances represent a generic textual (string) data type.  I provide
accessing and manipulation methods for strings.' !


!CharacterArray class methodsFor: 'basic'!

fromString: aCharacterArray
    "Make up an instance of the receiver containing the same characters
     as aCharacterArray, and answer it."
    ^(self new: aCharacterArray size)
	replaceFrom: 1
	to: aCharacterArray size
	with: aCharacterArray
	startingAt: 1;

	yourself
!

lineDelimiter
    "Answer a CharacterArray which one can use as a line delimiter."
    ^self with: Character nl
! !


!CharacterArray methodsFor: 'basic'!

basicAt: index
    "Answer the index-th character of the receiver. This is an exception
     to the `do not override' rule that allows storage optimization by
     storing the characters as values instead of as objects."
    ^super basicAt: index put: ((self valueAt: index) asCharacter)
!

basicAt: index put: anObject
    "Set the index-th character of the receiver to be anObject. This
     method must not be overridden; override at: instead. String overrides it so
     that it looks like it contains character objects even though it
     contains bytes"
    self valueAt: index put: anObject asInteger.
    ^anObject
! !



!CharacterArray methodsFor: 'comparing'!

< aCharacterArray
    "Return true if the receiver is less than aCharacterArray, ignoring case
    differences."
    | c1 c2 |
    1 to: (self size min: aCharacterArray size) do:
    	[ :i | c1 := (self at: i) asLowercaseValue.
	       c2 := (aCharacterArray at: i) asLowercaseValue.
	       c1 > c2 ifTrue: [ ^false ].
	       c1 < c2 ifTrue: [ ^true ] ].
    ^self size < aCharacterArray size
!

> aCharacterArray
    "Return true if the receiver is greater than aCharacterArray, ignoring case
    differences."
    | c1 c2 |
    " Scan self and aCharacterArray until a character is clearly greater or lesser
      (All preceding characters must have been equal).  If the end is reached,
      one of the CharacterArrays is a possibly improper initial substring of the other,
      and for the receiver to be less than aCharacterArray, it must be the initial
      substring."
    1 to: (self size min: aCharacterArray size) do:
    	[ :i | c1 := (self at: i) asLowercaseValue.
	       c2 := (aCharacterArray at: i) asLowercaseValue.
	       c1 > c2 ifTrue: [ ^true ].
	       c1 < c2 ifTrue: [ ^false ] ].
    ^self size > aCharacterArray size
!

<= aCharacterArray
    "Returns true if the receiver is less than or equal to aCharacterArray,
    ignoring case differences.  If is receiver is an initial substring of
    aCharacterArray, it is considered to be less than aCharacterArray."
    | c1 c2 |
    " Scan self and aCharacterArray until a character is clearly greater or lesser
      (All preceding characters must have been equal).  If the end is reached,
      one of the CharacterArrays is a possibly improper initial substring of the other,
      and for the receiver to be less than aCharacterArray, it must be the initial
      substring."
    1 to: (self size min: aCharacterArray size) do:
    	[ :i | c1 := (self at: i) asLowercaseValue.
	       c2 := (aCharacterArray at: i) asLowercaseValue.
	       c1 < c2 ifTrue: [ ^true ].
	       c1 > c2 ifTrue: [ ^false ] ].
    ^self size <= aCharacterArray size
!

>= aCharacterArray
    "Returns true if the receiver is greater than or equal to aCharacterArray,
    ignoring case differences.  If is aCharacterArray is an initial substring of
    the receiver, it is considered to be less than the receiver."
    | c1 c2 |
    1 to: (self size min: aCharacterArray size) do:
    	[ :i | c1 := (self at: i) asLowercaseValue.
	       c2 := (aCharacterArray at: i) asLowercaseValue.
	       c1 < c2 ifTrue: [ ^false ].
	       c1 > c2 ifTrue: [ ^true ] ].
    ^self size >= aCharacterArray size
!

sameAs: aCharacterArray
    "Returns true if the receiver is the same CharacterArray as aCharacterArray, ignoring
    case differences."
    self size ~= aCharacterArray size ifTrue: [ ^false ].
    1 to: self size do: [ :i |
	(self at: i) asLowercaseValue ~= (aCharacterArray at: i) asLowercaseValue
	    ifTrue: [ ^false ]
    ].
    ^true
!

match: aCharacterArray
    "Answer whether the receiver matches the aCharacterArray pattern. # in aCharacterArray
     means 'match any character', * in aCharacterArray means 'match any sequence of
     characters' "
    | result |
    result := self asLowercase
	matchSubstring: 1
	in: aCharacterArray asLowercase
	at: 1.

    ^result = aCharacterArray size
!

indexOf: aCharacterArray matchCase: aBoolean startingAt: anIndex
    "Answer an Interval of indices in the receiver which match the aCharacterArray
     pattern. # in aCharacterArray means 'match any character', * in aCharacterArray means
     'match any sequence of characters'. The first item of the returned in-
     terval is >= anIndex. If aBoolean is false, the search is case-insen-
     sitive, else it is case-sensitive.
     If no Interval matches the pattern, answer nil."

    | result |

    aBoolean ifFalse: [
	^self asLowercase
	   indexOf: aCharacterArray asLowercase
	   matchCase: true
	   startingAt: anIndex ].

    anIndex to: self size do: [ :i |
	result := aCharacterArray matchSubstring: 1 in: self at: i.
	result notNil ifTrue: [^i to: result]
    ].
    ^nil
! !


!CharacterArray methodsFor: 'string processing'!

contractTo: smallSize
    "Either return myself, or a copy shortened to smallSize characters
     by inserting an ellipsis (three dots: ...)"

    | leftSize |
    self size <= smallSize
	ifTrue: [ ^self ].
    smallSize < 5
	ifTrue: [ ^self copyFrom: 1 to: smallSize ].
    leftSize := smallSize - 2 // 2.
    ^self
	copyReplaceFrom: leftSize + 1		"First N/2 ... last N/2"
	to: self size - (smallSize - leftSize - 3)
	with: '...'
!

substrings
    "Answer an OrderedCollection of substrings of the receiver. A new substring
     start at the start of the receiver, or after every sequence of white space
     characters"
    | oc last |

    last := 1.
    oc := OrderedCollection new.
    1 to: self size do: [:i |
	(self at: i) isSeparator ifTrue: [
	    last = i ifFalse: [
		oc addLast: (self copyFrom: last to: i - 1)
	    ].
	    last := i + 1.
	]
    ].
    last <= self size ifTrue: [
	oc addLast: (self copyFrom: last to: self size)
    ].
    ^oc
!

substrings: aCharacter
    "Answer an OrderedCollection of substrings of the receiver. A new substring
     start at the start of the receiver, or after every sequence of characters
     matching aCharacter"
    | oc last |

    last := 1.
    oc := OrderedCollection new.
    1 to: self size do: [:i |
	(self at: i) == aCharacter ifTrue: [
	    last = i ifFalse: [
		oc addLast: (self copyFrom: last to: i - 1)
	    ].
	    last := i + 1.
	]
    ].
    last <= self size ifTrue: [
	oc addLast: (self copyFrom: last to: self size)
    ].
    ^oc
!

bindWith: s1
    "Answer the receiver with every %1 replaced by s1"
    ^self bindWithArguments: (Array with: s1)
!

bindWith: s1 with: s2
    "Answer the receiver with every %1 or %2 replaced by s1 or s2,
     respectively"
    ^self bindWithArguments: (Array with: s1 with: s2)
!

bindWith: s1 with: s2 with: s3
    "Answer the receiver with every %1, %2 or %3 replaced by s1, s2 or s3,
     respectively"

    ^self bindWithArguments: (Array with: s1 with: s2 with: s3)
!

bindWith: s1 with: s2 with: s3 with: s4
    "Answer the receiver with every %1, %2, %3 or %4 replaced by s1, s2, s3
     or s4, respectively"

    ^self bindWithArguments: (Array with: s1 with: s2 with: s3 with: s4)
!

bindWithArguments: anArray
    "Answer the receiver with every %n (1<=n<=9) replaced by the n-th element
     of anArray"

    | result wasPercent char |
    result := WriteStream on: (self copyEmpty: self size + 20).
    wasPercent := false.
    
    1 to: self size do: [:i |
	char := self at: i.
	wasPercent
	    ifTrue: [
		char = $%
		    ifTrue: [ result nextPut: char ]
		    ifFalse: [ result nextPutAll: (anArray at: char digitValue) ].
		wasPercent := false
	    ]
	    ifFalse: [
		(wasPercent := (char = $%))
		    ifFalse: [ result nextPut: char ]
	    ]
    ].

    ^result contents
! !


!CharacterArray methodsFor: 'converting'!

asNumber
    "Parse a Number from the receiver until the input character is invalid
     and answer the result at this point"

    ^Number readFrom: (ReadStream on: self)
!

asUppercase
    "Returns a copy of self as an uppercase CharacterArray"
    | newStr |
    newStr := self copyEmpty: self size.
    1 to: self size do:
    	[ :i | newStr at: i put: (self at: i) asUppercase ].
    ^newStr
!

asLowercase
    "Returns a copy of self as a lowercase CharacterArray"
    | newStr |
    newStr := self copyEmpty: self size.
    1 to: self size do:
    	[ :i | newStr at: i put: (self at: i) asLowercase ].
    ^newStr
!

asString
    "But I already am a String!  Really!"
    self subclassResponsibility
!

asGlobalKey
    "Return the receiver, ready to be put in the Smalltalk dictionary"
    ^self asSymbol
!

asPoolKey
    "Return the receiver, ready to be put in a pool dictionary"
    ^self asSymbol
!

asClassPoolKey
    "Return the receiver, ready to be put in a class pool dictionary"
    ^self asSymbol
!

asByteArray
    "Return the receiver, converted to a ByteArray of ASCII values"
    ^self asString asByteArray
!

asInteger
    "Parse an Integer number from the receiver until the input character
     is invalid and answer the result at this point"
    | result i sign |
    result := 0.
    self isEmpty ifTrue: [ ^result ].

    sign := (self at: 1) = $-
	ifTrue: [ i := 2. -1 ]
	ifFalse: [ i := 1. 1 ].
    self from: i to: self size do: 
	[ :ch | ch isDigit ifFalse: [ ^result ].
		result := result * 10 + (ch digitValue * sign) ].
    ^result
!


fileName
    "But I don't HAVE a file name!"
    ^nil
!

filePos
    "But I don't HAVE a file position!"
    ^nil
!

isNumeric
    "Answer whether the receiver denotes a number"

    | stream ch |
    stream := ReadStream on: self.
    [ stream atEnd ifTrue: [^true].
      (ch := stream next) isDigit ] whileTrue: [
    ].
    ch = $. ifFalse: [^false].

    [   ch := stream next.
	ch isDigit ifFalse: [ ^false ]
	stream atEnd] whileFalse.
    ^true
!

asSymbol
    "Returns the symbol corresponding to the CharacterArray"
    self subclassResponsibility
!

trimSeparators
    "Return a copy of the reciever without any spaces on front or back.
     The implementation is protected against the `all blanks' case."

    "This is not implemented as two while loops, but as two nested
     #to:do:'s, for speed"
    1 to: self size do: [ :start |
	(self at: start) isSeparator ifFalse: [
	    self size to: start by: -1 do: [ :stop |
		(self at: stop) isSeparator ifFalse: [
		    ^self copyFrom: start to: stop
		]
	    ]. "to:by:do:"
	]
    ]. "to:do:"
    ^''
! !



!CharacterArray methodsFor: 'copying'!

shallowCopy
    "Returns a shallow copy of the receiver"
    | newStr |
    newStr := self copyEmpty: self size.
    newStr replaceFrom: 1 to: self size with: self startingAt: 1.
    ^newStr
!

deepCopy
    "Returns a deep copy of the receiver. This is the same thing as a
     shallow copy for CharacterArrays"
    ^self shallowCopy
! !




!CharacterArray methodsFor: 'printing'!

displayString
    "Answer a String representing the receiver. For most objects
     this is simply its #printString, but for CharacterArrays and characters,
     superfluous dollars or extra pair of quotes are stripped."
    ^self
!

displayOn: aStream
    "Print a representation of the receiver on aStream. Unlike
     #printOn:, this method strips extra quotes."
    aStream nextPutAll: self
!

printOn: aStream
    "Print a representation of the receiver on aStream"
    aStream nextPut: $'.
    self do:
    	[ :char | char == $' ifTrue: [ aStream nextPut: char ].
	    	  aStream nextPut: char ].
    aStream nextPut: $'
! !



!CharacterArray methodsFor: 'storing'!

storeOn: aStream
    "Print Smalltalk code compiling to the receiver on aStream"
    
    aStream
	nextPut: $(;
	print: self class;
	nextPut: ' fromString: ';
	store: self asString;
	nextPut: $)
! !



!CharacterArray methodsFor: 'private'!

matchSubstring: pp in: aCharacterArray at: i
    "Private - Match the pattern from the pp-th character of the receiver
     to the characters from the i-th in aCharacterArray. Answer nil if they
     don't match, else answer the last character making up the pattern"

    | result s |
    s := i.
    self from: pp to: self size doWithIndex: [ :pc :p |

	pc = $*
	    ifTrue: [
		(aCharacterArray size + 1) to: s by: -1 do: [:ss |
		    result := self matchSubstring: p + 1
			in: aCharacterArray
			at: ss.

		    result notNil ifTrue: [ ^result ].
		].
		^nil ].

	s > aCharacterArray size ifTrue: [ ^nil ].

	pc = $# ifFalse: [
	    pc = (aCharacterArray at: s) ifFalse: [ ^nil ]
	].
	s := s + 1
    ].
    ^s - 1
! !


!CharacterArray methodsFor: 'testing functionality'!

isCharacterArray
    ^true
! !

