!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: eucstring.gs,v 1.8 2008-01-09 22:50:10 stever Exp $
!
! Superclass Hierarchy:
!   EUCString, JapaneseString, CharacterCollection, SequenceableCollection,
!   Collection, Object.
!
!=========================================================================

removeallmethods EUCString
removeallclassmethods EUCString

category: 'For Documentation Installation only'
classmethod: EUCString
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'This class represents Japanese strings in Extended Unix Code format.'.
doc documentClassWith: txt.

self description: doc.
%

category: 'Accessing'
method: EUCString
at: anIndex

"Returns the JISCharacter at the specified index."

<primitive: 244>

(anIndex _isSmallInteger)
ifTrue:[ ^ self _errorIndexOutOfRange: anIndex]
ifFalse:[^ self _errorNonIntegerIndex: anIndex].

self _primitiveFailed: #at: .
self _uncontinuableError
%

category: 'Accessing'
method: EUCString
size

"Returns the number of JISCharacters in the receiver."

<primitive: 76>

self _primitiveFailed: #size .
self _uncontinuableError
%

category: 'Updating'
method: EUCString
at: anIndex put: aCharacter

"Stores aCharacter at the specified location."

<primitive: 243>
| charClass |
charClass := aCharacter class .
(charClass == JISCharacter _or:[ charClass == Character]) ifFalse:[
  ^ self at: anIndex put: aCharacter asJISCharacter .
  ].
(anIndex _isSmallInteger)
ifTrue:[ ^ self _errorIndexOutOfRange: anIndex]
ifFalse:[^ self _errorNonIntegerIndex: anIndex].

self _primitiveFailed: #at:put: .
self _uncontinuableError
%

category: 'Updating'
method: EUCString
size: anInteger

"Changes the size of the receiver to anInteger.

 If anInteger is less than the current size of the receiver, the receiver is
 shrunk accordingly.  If anInteger is greater than the current size of the
 receiver, the receiver is extended and new elements are initialized to nil."

<primitive: 245>

(anInteger _isSmallInteger)
ifTrue:[^ self _errorIndexOutOfRange: anInteger]
ifFalse:[^ self _errorNonIntegerIndex: anInteger].

self _primitiveFailed: #size: .
self _uncontinuableError
%

category: 'Formatting'
method: EUCString
asEUCString

"Returns the receiver."

"This reimplementation of from JapaneseString is crucial !."

^self
%

! category: 'Formatting'
! method: EUCString
! describe
! 
! "If the receiver is less than half a megabyte, quote it.
!  Otherwise, return the receiver."
! 
! self _basicSize > 500000
!   ifTrue: [ ^self ]
!   ifFalse: [ ^self quoted ]
! %

category: 'Converting'
method: EUCString
asSymbolKind

"Returns a copy of the receiver as an instance of Symbol."

^ self asSymbol
%

category: 'Comparing'
method: EUCString
= aCharCollection

"Returns true if all of the corresponding Characters in the receiver and
 argument are equal.  Returns false otherwise."

<primitive: 77>

^ super = aCharCollection
%

category: 'Comparing'
method: EUCString
< aCharCollection

"Returns true if the receiver collates before the argument.  Returns false
 otherwise."

((aCharCollection isKindOf: EUCString) _or: [ aCharCollection isKindOf: String])
  ifTrue: [ ^(self _EUCcompare: aCharCollection) == -1]
  ifFalse: [ ^super < aCharCollection ]
%

category: 'Comparing'
method: EUCString
<= aCharCollection

"Returns true if the receiver collates before the argument or if all of the
 corresponding Characters in the receiver and argument are equal.  Returns
 false otherwise."

((aCharCollection isKindOf: EUCString) _or: [ aCharCollection isKindOf: String])
  ifTrue: [ ^(self _EUCcompare: aCharCollection) <= 0]
  ifFalse: [ ^super <= aCharCollection ]
%

category: 'Comparing'
method: EUCString
> aCharCollection

"Returns true if the receiver collates after the argument.  Returns false
 otherwise."

((aCharCollection isKindOf: EUCString) _or: [ aCharCollection isKindOf: String])
  ifTrue: [ ^(self _EUCcompare: aCharCollection) == 1]
  ifFalse: [ ^super > aCharCollection ]
%

category: 'Comparing'
method: EUCString
>= aCharCollection

"Returns true if the receiver collates after the argument or if all of the
 corresponding Characters in the receiver and arguments are equal.  Returns
 false otherwise."

((aCharCollection isKindOf: EUCString) _or: [ aCharCollection isKindOf: String])
  ifTrue: [ ^(self _EUCcompare: aCharCollection) >= 0]
  ifFalse: [ ^super >= aCharCollection ]
%

category: 'Comparing'
method: EUCString
_EUCcompare: aCharCollection

"Returns -1 if self < aCharCollection, returns 0 if self = aCharCollection,
 and returns 1 if self > aCharCollection."

<primitive: 78>

^ self _primitiveFailed: #_EUCcompare:
%

! _hashCaseSensitive: deleted

category: 'Copying'
method: EUCString
copyFrom: index1 to: index2 into: aSeqColl startingAt: destIndex

"Copies the elements of the receiver between index1 and index2, inclusive, into
 aSeqColl starting at destIndex, overwriting the previous contents.  If aSeqColl
 is the same object as the receiver, the source and destination blocks may
 overlap."

<primitive: 246>

(index1 < 1) ifTrue:[ ^ self _errorIndexOutOfRange: index1].
(index2 < 1) ifTrue:[ ^ self _errorIndexOutOfRange: index2].
(destIndex < 1) ifTrue:[ ^ aSeqColl _errorIndexOutOfRange: destIndex].

^ super copyFrom: index1 to: index2 into: aSeqColl startingAt: destIndex
%

category: 'Searching'
method: EUCString
indexOf: aCharacter startingAt: startIndex

"Returns the index of the first occurrence of aCharacter in the receiver,
 not preceding startIndex.  If the receiver does not contain aCharacter,
 this returns zero."

<primitive: 79>

^super indexOf: aCharacter startingAt: startIndex
%

category: 'Adding'
method: EUCString
add: aCharOrCharCollection

"Appends aCharOrCharCollection to the receiver.  The argument
 aCharOrCharCollection must be a CharacterCollection or a kind of
 AbstractCharacter."

<primitive: 242>

^ super add: aCharOrCharCollection
%

category: 'Adding'
method: EUCString
addAll: aCharOrCharCollection

"Equivalent to add: aCharOrCharCollection."

<primitive: 242>

^ super addAll: aCharOrCharCollection
%

category: 'Adding'
method: EUCString
addLast: aCharOrCharCollection

"Equivalent to add: aCharOrCharCollection."

<primitive: 242>

^ super addLast: aCharOrCharCollection
%

category: 'Adding'
method: EUCString
insertAll: aCharOrCharCollection at: anIndex

"Inserts aCharOrCharCollection at the specified index."

<primitive: 241>

anIndex _validateClass: SmallInteger.
(anIndex > (self size + 1))
ifTrue:[ ^ self _errorIndexOutOfRange: anIndex]
ifFalse:[ ^ super insertAll: aCharOrCharCollection at: anIndex]
%

category: 'Converting'
method: EUCString
asSymbol

"Returns a Symbol that contains the same bytes as the receiver."

^ (DoubleByteString withAll: self) asSymbol
%

category: 'Formatting'
method: EUCString
printString

"Returns an EUCString whose contents are a displayable representation of the
 receiver."

| ws str |

str := EUCString new.
ws := PrintStream printingOn: str.
self printOn: ws.
^str
%

! added trapping of error 2281 so we can get consistent error reports
!  in methtst, etc .
category: 'Formatting'
method: EUCString
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

| subStr idx lastIdx sz strmClass |

Exception category: GemStoneError number: 2281"RT_ERR_BAD_EUC_FORMAT" do:
  [ :ex :categ :errnum :args |
    aStream nextPutAll:'(corrupt EUCString with oop ' ;
        nextPutAll: (self asOop asString) ; nextPut: $) .
    ^ self
  ] .
strmClass := aStream _collection class .
(strmClass == String _or:[strmClass == ISOLatin]) ifTrue:[ 
  aStream _convertToEUC
  ].
self size > 1000 ifTrue:[
  ^ aStream nextPutAll: self .
  ]. 
aStream nextPut: $' .
idx := self indexOf: $' startingAt: 1 .
idx == 0 ifTrue:[
  aStream nextPutAll: self .
  ]
ifFalse:[
  subStr := EUCString new . 
  lastIdx := 1.
  [ idx == 0 ] whileFalse: [
    self copyFrom: lastIdx to: idx into: subStr startingAt: 1 .
    aStream nextPutAll: subStr .
    subStr size: 0 .
    aStream nextPut: $' .
    lastIdx := idx + 1 .
    idx := self indexOf: $' startingAt: lastIdx .
    ].
  sz := self size .
  lastIdx <= sz ifTrue: [
    self copyFrom: lastIdx to: sz into: subStr startingAt: 1 .
    aStream nextPutAll: subStr .
    subStr size: 0 .
    ].
  ].
aStream nextPut: $' 
%

category: 'Converting'
method: EUCString
asArrayOfPathTerms

"Returns an Array of path substrings held by the receiver.  The receiver
 is assumed to be a period-separated list of substrings.  These substrings
 are extracted and collected in an Array.  If the receiver contains no
 periods, the Array will hold a copy of the receiver. The backslash character
 is no longer recongnized as an escape character. 

 Raises an error if an element is not a valid path term."

| nextName result period |

result := Array new.
nextName := self class new.
period := JISCharacter withValue: ($.  asciiValue).
self do: [:c |
  (c == period) ifTrue: [
    nextName _isValidPathTermName
      ifFalse: [
        ^ self _error: #rtErrInvalidIndexPathExpression
               args: #[ nextName asSymbol ]
    ].
    result add: nextName asSymbol .
    nextName := self class new.
  ]
  ifFalse: [
    nextName add: c
  ].
].
nextName size > 0 ifTrue: [
  nextName _isValidPathTermName
    ifFalse: [
      ^ self _error: #rtErrInvalidIndexPathExpression
             args: #[ nextName asSymbol ]
  ].
  result add: nextName asSymbol
]
ifFalse: [
  result size == 0 ifTrue: [result add: nextName asSymbol ]
].
^result
%

category: 'Indexing Support'
method: EUCString
_isValidPathTermName

"Returns true if the receiver is a valid term in a path expression."

^ (String withAll: self) _isValidPathTermName
%

