[Pkg] The Inbox: Collections-ul.163.mcz

9 Oct 2009


      A new version of Collections was added to project The Inbox:
http://source.squeak.org/inbox/Collections-ul.163.mcz
==================== Summary ====================
Name: Collections-ul.163
Author: ul
Time: 9 October 2009, 2:36:21 am
UUID: 0b0ed95e-4b15-ae44-9f7f-639cc85b4256
Ancestors: Collections-nice.162
- faster shuffle
==================== Snapshot ====================
SystemOrganization addCategory: #'Collections-Abstract'!
SystemOrganization addCategory: #'Collections-Arrayed'!
SystemOrganization addCategory: #'Collections-Sequenceable'!
SystemOrganization addCategory: #'Collections-Stack'!
SystemOrganization addCategory: #'Collections-Streams'!
SystemOrganization addCategory: #'Collections-Strings'!
SystemOrganization addCategory: #'Collections-Support'!
SystemOrganization addCategory: #'Collections-Text'!
SystemOrganization addCategory: #'Collections-Unordered'!
SystemOrganization addCategory: #'Collections-Weak'!
Magnitude subclass: #Character
    instanceVariableNames: 'value'
    classVariableNames: 'CharacterTable ClassificationTable LetterBits LowercaseBit UppercaseBit'
    poolDictionaries: ''
    category: 'Collections-Strings'!
!Character commentStamp: 'ar 4/9/2005 22:35' prior: 0!
I represent a character by storing its associated Unicode. The first 256 characters are created uniquely, so that all instances of latin1 characters ($R, for example) are identical.
The code point is based on Unicode.  Since Unicode is 21-bit wide character set, we have several bits available for other information.  As the Unicode Standard  states, a Unicode code point doesn't carry the language information.  This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean.  Or often CJKV including Vietnamese).  Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools.  To utilize the extra available bits, we use them for identifying the languages.  Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.
The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.
I represent a character by storing its associated ASCII code (extended to 256 codes). My instances are created uniquely, so that all instances of a character ($R, for example) are identical.!
----- Method: Character class>>allByteCharacters (in category 'instance creation') -----
allByteCharacters
    "Answer all the characters that can be encoded in a byte"
    ^ (0 to: 255) collect: [:v | Character value: v]
!
----- Method: Character class>>allCharacters (in category 'instance creation') -----
allCharacters
    "This name is obsolete since only the characters that will fit in a byte can be queried"
    ^self allByteCharacters
    
!
----- Method: Character class>>alphabet (in category 'constants') -----
alphabet
    "($a to: $z) as: String"
^ 'abcdefghijklmnopqrstuvwxyz' copy!
----- Method: Character class>>arrowDown (in category 'accessing untypeable characters') -----
arrowDown
    ^ self value: 31!
----- Method: Character class>>arrowLeft (in category 'accessing untypeable characters') -----
arrowLeft
    ^ self value: 28!
----- Method: Character class>>arrowRight (in category 'accessing untypeable characters') -----
arrowRight
    ^ self value: 29!
----- Method: Character class>>arrowUp (in category 'accessing untypeable characters') -----
arrowUp
    ^ self value: 30!
----- Method: Character class>>backspace (in category 'accessing untypeable characters') -----
backspace
    "Answer the Character representing a backspace."
^self value: 8!
----- Method: Character class>>characterTable (in category 'constants') -----
characterTable
    "Answer the class variable in which unique Characters are stored."
^CharacterTable!
----- Method: Character class>>codePoint: (in category 'instance creation') -----
codePoint: integer 
    "Return a character whose encoding value is integer.
    For ansi compability."
    ^self value: integer!
----- Method: Character class>>constantNameFor: (in category 'private') -----
constantNameFor: aCharacter
    ^ self constantNames
    	detect: [ :each | (self perform: each) = aCharacter ]
    	ifNone: [ nil ].!
----- Method: Character class>>constantNames (in category 'private') -----
constantNames
    ^ #( backspace cr delete escape lf newPage space tab ).!
----- Method: Character class>>cr (in category 'accessing untypeable characters') -----
cr
    "Answer the Character representing a carriage return."
^self value: 13!
----- Method: Character class>>delete (in category 'accessing untypeable characters') -----
delete
    ^ self value: 127!
----- Method: Character class>>digitValue: (in category 'instance creation') -----
digitValue: x 
    "Answer the Character whose digit value is x. For example, answer $9 for 
    x=9, $0 for x=0, $A for x=10, $Z for x=35."
| index |
    index := x asInteger.
    ^CharacterTable at: 
    	(index < 10
    		ifTrue: [48 + index]
    		ifFalse: [55 + index])
    	+ 1!
----- Method: Character class>>end (in category 'accessing untypeable characters') -----
end
    ^ self value: 4!
----- Method: Character class>>enter (in category 'accessing untypeable characters') -----
enter
    "Answer the Character representing enter."
^self value: 3!
----- Method: Character class>>escape (in category 'accessing untypeable characters') -----
escape
    "Answer the ASCII ESC character"
^self value: 27!
----- Method: Character class>>euro (in category 'accessing untypeable characters') -----
euro
    "The Euro currency sign, that E with two dashes. The key code is a wild guess"
^ Character value: 219!
----- Method: Character class>>home (in category 'accessing untypeable characters') -----
home
    ^ self value: 1!
----- Method: Character class>>initialize (in category 'class initialization') -----
initialize
    "Create the table of unique Characters."
"	self initializeClassificationTable"!
----- Method: Character class>>initializeClassificationTable (in category 'class initialization') -----
initializeClassificationTable
    "
    Initialize the classification table. The classification table is a
    compact encoding of upper and lower cases of characters with
- bits 0-7: The lower case value of this character.
    	- bits 8-15: The upper case value of this character.
    	- bit 16: lowercase bit (e.g., isLowercase == true)
    	- bit 17: uppercase bit (e.g., isUppercase == true)
"
    | ch1 ch2 |
LowercaseBit := 1 bitShift: 16.
    UppercaseBit := 1 bitShift: 17.
"Initialize the letter bits (e.g., isLetter == true)"
    LetterBits := LowercaseBit bitOr: UppercaseBit.
ClassificationTable := Array new: 256.
    "Initialize the defaults (neither lower nor upper case)"
    0 to: 255 do:[:i|
    	ClassificationTable at: i+1 put: (i bitShift: 8) + i.
    ].
"Initialize character pairs (upper-lower case)"
    #(
    	"Basic roman"
    	($A $a) 	($B $b) 	($C $c) 	($D $d) 
    	($E $e) 	($F $f) 	($G $g) 	($H $h) 
    	($I $i) 		($J $j) 		($K $k) 	($L $l) 
    	($M $m)	($N $n)	($O $o)	($P $p) 
    	($Q $q) 	($R $r) 	($S $s) 	($T $t) 
    	($U $u)	($V $v)	($W $w)	($X $x)
    	($Y $y)	($Z $z)
    	"International"
    	($Ä $ä)	($Å $å)	($Ç $ç)	($É $é)
    	($Ñ $ñ)	($Ö $ö)	($Ü $ü)	($À $à)
    	($Ã $ã)	($Õ $õ)	($ $)	($Æ $æ)
    	"International - Spanish"
    	($Á $á)	($Í $í)		($Ó $ó)	($Ú $ú)
    	"International - PLEASE CHECK"
    	($È $è)	($Ì $ì)		($Ò $ò)	($Ù $ù)
    	($Ë $ë)	($Ï $ï)
    	($Â $â)	($Ê $ê)	($Î $î)	($Ô $ô)	($Û $û)
    ) do:[:pair|
    	ch1 := pair first asciiValue.
    	ch2 := pair last asciiValue.
    	ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch2 + UppercaseBit.
    	ClassificationTable at: ch2+1 put: (ch1 bitShift: 8) + ch2 + LowercaseBit.
    ].
"Initialize a few others for which we only have lower case versions."
    #($ß $Ø $ø $ÿ) do:[:char|
    	ch1 := char asciiValue.
    	ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch1 + LowercaseBit.
    ].
!
----- Method: Character class>>insert (in category 'accessing untypeable characters') -----
insert
    ^ self value: 5!
----- Method: Character class>>leadingChar:code: (in category 'instance creation') -----
leadingChar: leadChar code: code
code >= 16r400000 ifTrue: [
    	self error: 'code is out of range'.
    ].
    leadChar >= 256 ifTrue: [
    	self error: 'lead is out of range'.
    ].
^self value: (leadChar bitShift: 22) + code.!
----- Method: Character class>>lf (in category 'accessing untypeable characters') -----
lf
    "Answer the Character representing a linefeed."
^self value: 10!
----- Method: Character class>>linefeed (in category 'accessing untypeable characters') -----
linefeed
    "Answer the Character representing a linefeed."
^self value: 10!
----- Method: Character class>>nbsp (in category 'accessing untypeable characters') -----
nbsp
    "non-breakable space. Latin1 encoding common usage."
^ Character value: 160!
----- Method: Character class>>new (in category 'instance creation') -----
new
    "Creating new characters is not allowed."
self error: 'cannot create new characters'!
----- Method: Character class>>newPage (in category 'accessing untypeable characters') -----
newPage
    "Answer the Character representing a form feed."
^self value: 12!
----- Method: Character class>>pageDown (in category 'accessing untypeable characters') -----
pageDown
    ^ self value: 12!
----- Method: Character class>>pageUp (in category 'accessing untypeable characters') -----
pageUp
    ^ self value: 11!
----- Method: Character class>>separators (in category 'instance creation') -----
separators
    ^ #(32 "space"
    	13 "cr"
    	9 "tab"
    	10 "line feed"
    	12 "form feed")
    	collect: [:v | Character value: v]
!
----- Method: Character class>>space (in category 'accessing untypeable characters') -----
space
    "Answer the Character representing a space."
^self value: 32!
----- Method: Character class>>tab (in category 'accessing untypeable characters') -----
tab
    "Answer the Character representing a tab."
^self value: 9!
----- Method: Character class>>value: (in category 'instance creation') -----
value: anInteger 
    "Answer the Character whose value is anInteger."
anInteger > 255 ifTrue: [^self basicNew setValue: anInteger].
    ^ CharacterTable at: anInteger + 1.
!
----- Method: Character>>< (in category 'comparing') -----
< aCharacter 
    "Answer true if the receiver's value < aCharacter's value."
^self asciiValue < aCharacter asciiValue!
----- Method: Character>>= (in category 'comparing') -----
= aCharacter 
    "Primitive. Answer true if the receiver and the argument are the same
    object (have the same object pointer) and false otherwise. Optional. See
    Object documentation whatIsAPrimitive."
^ self == aCharacter or:[
    	aCharacter isCharacter and: [self asciiValue = aCharacter asciiValue]]!
----- Method: Character>>> (in category 'comparing') -----
...
aCharacter
"Answer true if the receiver's value > aCharacter's value."
^self asciiValue > aCharacter asciiValue!
----- Method: Character>>asCharacter (in category 'converting') -----
asCharacter
    "Answer the receiver itself."
^self!
----- Method: Character>>asIRCLowercase (in category 'converting') -----
asIRCLowercase
    "convert to lowercase, using IRC's rules"
self == $[ ifTrue: [ ^ ${ ].
    self == $] ifTrue: [ ^ $} ].
    self == $\ ifTrue: [ ^ $| ].
^self asLowercase!
----- Method: Character>>asInteger (in category 'converting') -----
asInteger
    "Answer the value of the receiver."
^value!
----- Method: Character>>asLowercase (in category 'converting') -----
asLowercase
    "If the receiver is uppercase, answer its matching lowercase Character."
    "A tentative implementation.  Eventually this should consult the Unicode table."
| v |
    v := self charCode.
    (((8r101 <= v and: [v <= 8r132]) or: [16rC0 <= v and: [v <= 16rD6]]) or: [16rD8 <= v and: [v <= 16rDE]])
    	ifTrue: [^ Character value: value + 8r40]
    	ifFalse: [^ self]!
----- Method: Character>>asString (in category 'converting') -----
asString
    ^ String with: self!
----- Method: Character>>asSymbol (in category 'converting') -----
asSymbol 
    "Answer a Symbol consisting of the receiver as the only element."
^Symbol internCharacter: self!
----- Method: Character>>asText (in category 'converting') -----
asText
    ^ self asString asText!
----- Method: Character>>asUnicode (in category 'converting') -----
asUnicode
| table charset v |
    self leadingChar = 0 ifTrue: [^ value].
    charset := EncodedCharSet charsetAt: self leadingChar.
    charset isCharset ifFalse: [^ self charCode].
    table := charset ucsTable.
    table isNil ifTrue: [^ 16rFFFD].
v := table at: self charCode + 1.
    v = -1 ifTrue: [^ 16rFFFD].
^ v.
!
----- Method: Character>>asUppercase (in category 'converting') -----
asUppercase
    "If the receiver is lowercase, answer its matching uppercase Character."
    "A tentative implementation.  Eventually this should consult the Unicode table."
| v |
    v := self charCode.
    (((8r141 <= v and: [v <= 8r172]) or: [16rE0 <= v and: [v <= 16rF6]]) or: [16rF8 <= v and: [v <= 16rFE]])
    	ifTrue: [^ Character value: value - 8r40]
    	ifFalse: [^ self]
!
----- Method: Character>>asciiValue (in category 'accessing') -----
asciiValue
    "Answer the value of the receiver that represents its ascii encoding."
^value!
----- Method: Character>>basicSqueakToIso (in category 'converting') -----
basicSqueakToIso
    | asciiValue |
value < 128 ifTrue: [^ self].
    value > 255 ifTrue: [^ self].
    asciiValue := #(196 197 199 201 209 214 220 225 224 226 228 227 229 231 233 232 234 235 237 236 238 239 241 243 242 244 246 245 250 249 251 252 134 176 162 163 167 149 182 223 174 169 153 180 168 128 198 216 129 177 138 141 165 181 142 143 144 154 157 170 186 158 230 248 191 161 172 166 131 173 178 171 187 133 160 192 195 213 140 156 150 151 147 148 145 146 247 179 253 159 185 164 139 155 188 189 135 183 130 132 137 194 202 193 203 200 205 206 207 204 211 212 190 210 218 219 217 208 136 152 175 215 221 222 184 240 254 255 256 ) at: self asciiValue - 127.
    ^ Character value: asciiValue.
!
----- Method: Character>>canBeGlobalVarInitial (in category 'testing') -----
canBeGlobalVarInitial
^ (EncodedCharSet charsetAt: self leadingChar) canBeGlobalVarInitial: self.
!
----- Method: Character>>canBeNonGlobalVarInitial (in category 'testing') -----
canBeNonGlobalVarInitial
^ (EncodedCharSet charsetAt: self leadingChar) canBeNonGlobalVarInitial: self.
!
----- Method: Character>>charCode (in category 'accessing') -----
charCode
^ (value bitAnd: 16r3FFFFF).
!
----- Method: Character>>clone (in category 'copying') -----
clone
    "Answer with the receiver, because Characters are unique."!
----- Method: Character>>codePoint (in category 'accessing') -----
codePoint
    "Return the encoding value of the receiver."
    #Fundmntl.
    ^ self asciiValue!
----- Method: Character>>comeFullyUpOnReload: (in category 'object fileIn') -----
comeFullyUpOnReload: smartRefStream
    "Use existing an Character.  Don't use the new copy."
^ self class value: value!
----- Method: Character>>copy (in category 'copying') -----
copy
    "Answer with the receiver because Characters are unique."!
----- Method: Character>>deepCopy (in category 'copying') -----
deepCopy
    "Answer with the receiver because Characters are unique."!
----- Method: Character>>digitValue (in category 'accessing') -----
digitValue
    "Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 
    otherwise. This is used to parse literal numbers of radix 2-36."
    | value |
    
    value := ('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ' indexOf: self) - 1.
    value >= 0 ifTrue: [^value].
    ^ (EncodedCharSet charsetAt: self leadingChar) digitValue: self.
!
----- Method: Character>>hash (in category 'comparing') -----
hash
    "Hash is reimplemented because = is implemented."
^value!
----- Method: Character>>hex (in category 'printing') -----
hex
    ^value hex!
----- Method: Character>>isAlphaNumeric (in category 'testing') -----
isAlphaNumeric
    "Answer whether the receiver is a letter or a digit."
^self isLetter or: [self isDigit]!
----- Method: Character>>isCharacter (in category 'testing') -----
isCharacter
^ true.
!
----- Method: Character>>isDigit (in category 'testing') -----
isDigit
^ (EncodedCharSet charsetAt: self leadingChar) isDigit: self.
!
----- Method: Character>>isLetter (in category 'testing') -----
isLetter
^ (EncodedCharSet charsetAt: self leadingChar) isLetter: self.
!
----- Method: Character>>isLiteral (in category 'printing') -----
isLiteral
^true!
----- Method: Character>>isLowercase (in category 'testing') -----
isLowercase
^ (EncodedCharSet charsetAt: self leadingChar) isLowercase: self.
!
----- Method: Character>>isOctetCharacter (in category 'testing') -----
isOctetCharacter
^ value < 256.
!
----- Method: Character>>isSafeForHTTP (in category 'testing') -----
isSafeForHTTP
    "whether a character is 'safe', or needs to be escaped when used, eg, in a URL"
    "[GG]  See http://www.faqs.org/rfcs/rfc1738.html. ~ is unsafe and has been removed"
    ^ self charCode < 128
    	and: [self isAlphaNumeric
    			or: ['.-_' includes: (Character value: self charCode)]]!
----- Method: Character>>isSeparator (in category 'testing') -----
isSeparator
    "Answer whether the receiver is one of the separator characters--space, 
    cr, tab, line feed, or form feed."
value = 32 ifTrue: [^true].	"space"
    value = 13 ifTrue: [^true].	"cr"
    value = 9 ifTrue: [^true].	"tab"
    value = 10 ifTrue: [^true].	"line feed"
    value = 12 ifTrue: [^true].	"form feed"
    ^false!
----- Method: Character>>isSpecial (in category 'testing') -----
isSpecial
    "Answer whether the receiver is one of the special characters"
^'+-/*~<>=@,%|&?!!' includes: self!
----- Method: Character>>isTraditionalDomestic (in category 'testing') -----
isTraditionalDomestic
    "Yoshiki's note about #isUnicode says:
    	[This method] is for the backward compatibility when we had domestic
    	traditional encodings for CJK languages.  To support loading the
    	projects in traditional domestic encodings (From Nihongo4), and load
    	some changesets.  Once we decided to get rid of classes like JISX0208
    	from the EncodedCharSet table, the need for isUnicode will not be
    	necessary.
    I (Andreas) decided to change the name from isUnicode to #isTraditionalDomestic
    since I found isUnicode to be horribly confusing (how could the character *not*
    be Unicode after all?). But still, we should remove this method in due time."
    ^ ((EncodedCharSet charsetAt: self leadingChar) isKindOf: LanguageEnvironment class) not!
----- Method: Character>>isUppercase (in category 'testing') -----
isUppercase
^ (EncodedCharSet charsetAt: self leadingChar) isUppercase: self.
!
----- Method: Character>>isVowel (in category 'testing') -----
isVowel
    "Answer whether the receiver is one of the vowels, AEIOU, in upper or 
    lower case."
^'AEIOU' includes: self asUppercase!
----- Method: Character>>isoToSqueak (in category 'converting') -----
isoToSqueak 
    ^self "no longer needed"!
----- Method: Character>>leadingChar (in category 'accessing') -----
leadingChar
^ (value bitAnd: (16r3FC00000)) bitShift: -22.
!
----- Method: Character>>macToSqueak (in category 'converting') -----
macToSqueak
    "Convert the receiver from MacRoman to Squeak encoding"
    | asciiValue |
    value < 128 ifTrue: [^ self].
    value > 255 ifTrue: [^ self].
    asciiValue := #(196 197 199 201 209 214 220 225 224 226 228 227 229 231 233 232 234 235 237 236 238 239 241 243 242 244 246 245 250 249 251 252 134 176 162 163 167 149 182 223 174 169 153 180 168 128 198 216 129 177 138 141 165 181 142 143 144 154 157 170 186 158 230 248 191 161 172 166 131 173 178 171 187 133 160 192 195 213 140 156 150 151 147 148 145 146 247 179 255 159 185 164 139 155 188 189 135 183 130 132 137 194 202 193 203 200 205 206 207 204 211 212 190 210 218 219 217 208 136 152 175 215 221 222 184 240 253 254 ) at: self asciiValue - 127.
    ^ Character value: asciiValue.
!
----- Method: Character>>objectForDataStream: (in category 'object fileIn') -----
objectForDataStream: refStrm
    "I am being collected for inclusion in a segment.  Do not include Characters!!  Let them be in outPointers."
refStrm insideASegment
    	ifFalse: ["Normal use" ^ self]
    	ifTrue: ["recording objects to go into an ImageSegment"			
    		"remove it from references.  Do not trace."
    		refStrm references removeKey: self ifAbsent: [].
    		^ nil]
!
----- Method: Character>>printOn: (in category 'printing') -----
printOn: aStream
    | name |
    value > 32
    	ifTrue: [ aStream nextPut: $$; nextPut: self ]
    	ifFalse: [
    		name := self class constantNameFor: self.
    		name notNil
    			ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ]
    			ifFalse: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: value ] ].!
----- Method: Character>>printOnStream: (in category 'printing') -----
printOnStream: aStream
aStream print:'$', (String with:self).!
----- Method: Character>>sameAs: (in category 'comparing') -----
sameAs: aCharacter 
    "Answer whether the receiver is equal to aCharacter, ignoring case"
    ^ (self asLowercase = aCharacter asLowercase)	!
----- Method: Character>>setValue: (in category 'private') -----
setValue: newValue
    value ifNotNil:[^self error:'Characters are immutable'].
    value := newValue.!
----- Method: Character>>squeakToIso (in category 'converting') -----
squeakToIso
    ^self "no longer needed"!
----- Method: Character>>squeakToMac (in category 'converting') -----
squeakToMac
    "Convert the receiver from Squeak to MacRoman encoding."
    value < 128 ifTrue: [^ self].
    value > 255 ifTrue: [^ self].
    ^ Character value: (#(
    	173 176 226 196 227 201 160 224 246 228 178 220 206 179 182 183	"80-8F"
    	184 212 213 210 211 165 208 209 247 170 185 221 207 186 189 217	"90-9F"
    	202 193 162 163 219 180 195 164 172 169 187 199 194 197 168 248	"A0-AF"
    	161 177 198 215 171 181 166 225 252 218 188 200 222 223 240 192 	"B0-BF"
    	203 231 229 204 128 129 174 130 233 131 230 232 237 234 235 236 	"C0-CF"
    	245 132 241 238 239 205 133 249 175 244 242 243 134 250 251 167	"D0-DF"
    	136 135 137 139 138 140 190 141 143 142 144 145 147 146 148 149	"E0-EF"
    	253 150 152 151 153 155 154 214 191 157 156 158 159 254 255 216	"F0-FF"
    ) at: value - 127)
!
----- Method: Character>>storeBinaryOn: (in category 'printing') -----
storeBinaryOn: aStream
    "Store the receiver on a binary (file) stream"
    value < 256 
    	ifTrue:[aStream basicNextPut: self]
    	ifFalse:[Stream nextInt32Put: value].!
----- Method: Character>>storeOn: (in category 'printing') -----
storeOn: aStream
    "Common character literals are preceded by '$', however special need to be encoded differently: for some this might be done by using one of the shortcut constructor methods for the rest we have to create them by ascii-value."
| name |
    (value between: 33 and: 255)
    	ifTrue: [ aStream nextPut: $$; nextPut: self ]
    	ifFalse: [
    		name := self class constantNameFor: self.
    		name notNil
    			ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ]
    			ifFalse: [
    				aStream 
    					nextPut: $(; nextPutAll: self class name; 
    					nextPutAll: ' value: '; print: value; nextPut: $) ] ].!
----- Method: Character>>to: (in category 'converting') -----
to: other
    "Answer with a collection in ascii order -- $a to: $z"
    ^ (self asciiValue to: other asciiValue) collect:
    			[:ascii | Character value: ascii]!
----- Method: Character>>tokenish (in category 'testing') -----
tokenish
    "Answer whether the receiver is a valid token-character--letter, digit, or 
    colon."
^self isLetter or: [self isDigit or: [self = $:]]!
----- Method: Character>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
    "Return self.  I can't be copied."!
Magnitude subclass: #LookupKey
    instanceVariableNames: 'key'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!LookupKey commentStamp: '<historical>' prior: 0!
I represent a key for looking up entries in a data structure. Subclasses of me, such as Association, typically represent dictionary entries.!
LookupKey subclass: #Association
    instanceVariableNames: 'value'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!Association commentStamp: '<historical>' prior: 0!
I represent a pair of associated objects--a key and a value. My instances can serve as entries in a dictionary.!
----- Method: Association class>>key:value: (in category 'instance creation') -----
key: newKey value: newValue
    "Answer an instance of me with the arguments as the key and value of 
    the association."
^(super key: newKey) value: newValue!
----- Method: Association>>= (in category 'comparing') -----
= anAssociation
^ super = anAssociation and: [value = anAssociation value]!
----- Method: Association>>byteEncode: (in category 'filter streaming') -----
byteEncode: aStream
    aStream writeAssocation:self.!
----- Method: Association>>hash (in category 'comparing') -----
hash
    "Hash is reimplemented because = is implemented."
    
    ^key hash bitXor: value hash.!
----- Method: Association>>isSelfEvaluating (in category 'self evaluating') -----
isSelfEvaluating
    ^ self class == Association!
----- Method: Association>>isSpecialWriteBinding (in category 'testing') -----
isSpecialWriteBinding
    "Return true if this variable binding is write protected, e.g., should not be accessed primitively but rather by sending #value: messages"
    ^false!
----- Method: Association>>isVariableBinding (in category 'testing') -----
isVariableBinding
    "Return true if I represent a literal variable binding"
    ^true!
----- Method: Association>>key:value: (in category 'accessing') -----
key: aKey value: anObject 
    "Store the arguments as the variables of the receiver."
key := aKey.
    value := anObject!
----- Method: Association>>objectForDataStream: (in category 'objects from disk') -----
objectForDataStream: refStrm
    | dp |
    "I am about to be written on an object file.  If I am a known global, write a proxy that will hook up with the same resource in the destination system."
^ (Smalltalk associationAt: key ifAbsent: [nil]) == self 
    	ifTrue: [dp := DiskProxy global: #Smalltalk selector: #associationOrUndeclaredAt: 
    						args: (Array with: key).
    		refStrm replace: self with: dp.
    		dp]
    	ifFalse: [self]!
----- Method: Association>>printOn: (in category 'printing') -----
printOn: aStream
super printOn: aStream.
    aStream nextPutAll: '->'.
    value printOn: aStream!
----- Method: Association>>propertyListOn: (in category 'printing') -----
propertyListOn: aStream
    aStream write:key; print:'='; write:value.
!
----- Method: Association>>storeOn: (in category 'printing') -----
storeOn: aStream
    "Store in the format (key->value)"
    aStream nextPut: $(.
    key storeOn: aStream.
    aStream nextPutAll: '->'.
    value storeOn: aStream.
    aStream nextPut: $)!
----- Method: Association>>value (in category 'accessing') -----
value
    "Answer the value of the receiver."
^value!
----- Method: Association>>value: (in category 'accessing') -----
value: anObject 
    "Store the argument, anObject, as the value of the receiver."
value := anObject!
Association subclass: #WeakKeyAssociation
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!WeakKeyAssociation commentStamp: '<historical>' prior: 0!
I am an association holding only weakly on my key.!
----- Method: WeakKeyAssociation>>< (in category 'comparing') -----
< aLookupKey 
    "Refer to the comment in Magnitude|<."
^self key < aLookupKey key!
----- Method: WeakKeyAssociation>>= (in category 'comparing') -----
= aLookupKey
self species = aLookupKey species
    	ifTrue: [^self key = aLookupKey key]
    	ifFalse: [^false]!
----- Method: WeakKeyAssociation>>hash (in category 'comparing') -----
hash
    "Hash is reimplemented because = is implemented."
^self key hash!
----- Method: WeakKeyAssociation>>hashMappedBy: (in category 'comparing') -----
hashMappedBy: map
    "Answer what my hash would be if oops changed according to map."
^self key hashMappedBy: map!
----- Method: WeakKeyAssociation>>identityHashMappedBy: (in category 'comparing') -----
identityHashMappedBy: map
    "Answer what my hash would be if oops changed according to map."
^ self key identityHashMappedBy: map!
----- Method: WeakKeyAssociation>>key (in category 'accessing') -----
key
    ^key isNil
    	ifTrue:[nil]
    	ifFalse:[key at: 1]!
----- Method: WeakKeyAssociation>>key: (in category 'accessing') -----
key: aKey
    key := WeakArray with: aKey!
----- Method: WeakKeyAssociation>>key:value: (in category 'accessing') -----
key: aKey value: anObject
    key := WeakArray with: aKey.
    value := anObject.!
----- Method: WeakKeyAssociation>>printOn: (in category 'printing') -----
printOn: aStream
    self key printOn: aStream.
    aStream nextPutAll: '->'.
    self value printOn: aStream!
----- Method: WeakKeyAssociation>>storeOn: (in category 'printing') -----
storeOn: aStream
    aStream 
    	nextPut: $(;
    	nextPutAll: self class name;
    	nextPutAll:' key: '.
    self key storeOn: aStream.
    aStream nextPutAll: ' value: '.
    self value storeOn: aStream.
    aStream nextPut: $)!
----- Method: LookupKey class>>key: (in category 'instance creation') -----
key: aKey 
    "Answer an instance of me with the argument as the lookup up."
^self basicNew key: aKey!
----- Method: LookupKey>>< (in category 'comparing') -----
< aLookupKey 
    "Refer to the comment in Magnitude|<."
^key < aLookupKey key!
----- Method: LookupKey>>= (in category 'comparing') -----
= aLookupKey
self species = aLookupKey species
    	ifTrue: [^key = aLookupKey key]
    	ifFalse: [^false]!
----- Method: LookupKey>>beBindingOfType:announcing: (in category 'bindings') -----
beBindingOfType: aClass announcing: aBool
    "Make the receiver a global binding of the given type"
    | old new |
    (Smalltalk associationAt: self key) == self
    	ifFalse:[^self error:'Not a global variable binding'].
    self class == aClass ifTrue:[^self].
    old := self.
    new := aClass key: self key value: self value.
    old become: new.
    "NOTE: Now self == read-only (e.g., the new binding)"
    ^self recompileBindingsAnnouncing: aBool!
----- Method: LookupKey>>beReadOnlyBinding (in category 'bindings') -----
beReadOnlyBinding
    "Make the receiver (a global read-write binding) be a read-only binding"
    ^self beReadOnlyBindingAnnouncing: true!
----- Method: LookupKey>>beReadOnlyBindingAnnouncing: (in category 'bindings') -----
beReadOnlyBindingAnnouncing: aBool
    "Make the receiver (a global read-write binding) be a read-only binding"
    ^self beBindingOfType: ReadOnlyVariableBinding announcing: aBool!
----- Method: LookupKey>>beReadWriteBinding (in category 'bindings') -----
beReadWriteBinding
    "Make the receiver (a global read-only binding) be a read-write binding"
    ^self beReadWriteBindingAnnouncing: true!
----- Method: LookupKey>>beReadWriteBindingAnnouncing: (in category 'bindings') -----
beReadWriteBindingAnnouncing: aBool
    "Make the receiver (a global read-write binding) be a read-write binding"
    ^self beBindingOfType: Association announcing: aBool!
----- Method: LookupKey>>canAssign (in category 'accessing') -----
canAssign
^ true!
----- Method: LookupKey>>hash (in category 'comparing') -----
hash
    "Hash is reimplemented because = is implemented."
^key hash!
----- Method: LookupKey>>hashMappedBy: (in category 'comparing') -----
hashMappedBy: map
    "Answer what my hash would be if oops changed according to map."
^key hashMappedBy: map!
----- Method: LookupKey>>identityHashMappedBy: (in category 'comparing') -----
identityHashMappedBy: map
    "Answer what my hash would be if oops changed according to map."
^ key identityHashMappedBy: map!
----- Method: LookupKey>>isSpecialReadBinding (in category 'testing') -----
isSpecialReadBinding
    "Return true if this variable binding is read protected, e.g., should not be accessed primitively but rather by sending #value messages"
    ^false!
----- Method: LookupKey>>isVariableBinding (in category 'testing') -----
isVariableBinding
    "Return true if I represent a literal variable binding"
    ^true!
----- Method: LookupKey>>key (in category 'accessing') -----
key
    "Answer the lookup key of the receiver."
^key!
----- Method: LookupKey>>key: (in category 'accessing') -----
key: anObject 
    "Store the argument, anObject, as the lookup key of the receiver."
key := anObject!
----- Method: LookupKey>>name (in category 'accessing') -----
name
^ self key isString
    	ifTrue: [self key]
    	ifFalse: [self key printString]!
----- Method: LookupKey>>printOn: (in category 'printing') -----
printOn: aStream
key printOn: aStream!
----- Method: LookupKey>>recompileBindingsAnnouncing: (in category 'bindings') -----
recompileBindingsAnnouncing: aBool 
    "Make the receiver (a global read-write binding) be a read-only binding"
aBool 
    	ifTrue: 
    		[Utilities informUserDuring: 
    				[:bar | 
    				(self systemNavigation allCallsOn: self) do: 
    						[:mref | 
    						bar value: 'Recompiling ' , mref asStringOrText.
    						mref actualClass recompile: mref methodSymbol]]]
    	ifFalse: 
    		[(self systemNavigation allCallsOn: self) 
    			do: [:mref | mref actualClass recompile: mref methodSymbol]]!
----- Method: LookupKey>>writeOnFilterStream: (in category 'filter streaming') -----
writeOnFilterStream: aStream
aStream write:key.!
LookupKey subclass: #ReadOnlyVariableBinding
    instanceVariableNames: 'value'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
----- Method: ReadOnlyVariableBinding class>>key:value: (in category 'instance creation') -----
key: key value: aValue
    ^self new privateSetKey: key value: aValue!
----- Method: ReadOnlyVariableBinding>>canAssign (in category 'accessing') -----
canAssign
^ false!
----- Method: ReadOnlyVariableBinding>>isSpecialWriteBinding (in category 'testing') -----
isSpecialWriteBinding
    "Return true if this variable binding is write protected, e.g., should not be accessed primitively but rather by sending #value: messages"
    ^true!
----- Method: ReadOnlyVariableBinding>>privateSetKey:value: (in category 'private') -----
privateSetKey: aKey value: aValue
    key := aKey.
    value := aValue!
----- Method: ReadOnlyVariableBinding>>value (in category 'accessing') -----
value
    ^value!
----- Method: ReadOnlyVariableBinding>>value: (in category 'accessing') -----
value: aValue
    (AttemptToWriteReadOnlyGlobal signal: 'Cannot store into read-only bindings') == true ifTrue:[
    	value := aValue.
    ].!
LookupKey weakSubclass: #WeakValueAssociation
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!WeakValueAssociation commentStamp: '<historical>' prior: 0!
I am a lookup key (acting like an association but) holding only weakly on my value.!
----- Method: WeakValueAssociation class>>key:value: (in category 'instance creation') -----
key: anObject value: bObject
    ^ self new key: anObject value: bObject!
----- Method: WeakValueAssociation class>>new (in category 'as yet unclassified') -----
new
    ^ self new: 1!
----- Method: WeakValueAssociation>>key:value: (in category 'accessing') -----
key: aKey value: anObject 
    "Store the arguments as the variables of the receiver."
key := aKey.
    self value: anObject!
----- Method: WeakValueAssociation>>value (in category 'accessing') -----
value
    ^self at: 1!
----- Method: WeakValueAssociation>>value: (in category 'accessing') -----
value: anObject 
    "Store the argument, anObject, as the value of the receiver."
self at: 1 put: anObject!
Object subclass: #Collection
    instanceVariableNames: ''
    classVariableNames: 'MutexForPicking RandomForPicking'
    poolDictionaries: ''
    category: 'Collections-Abstract'!
!Collection commentStamp: '<historical>' prior: 0!
I am the abstract superclass of all classes that represent a group of elements.!
Collection subclass: #Bag
    instanceVariableNames: 'contents'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!Bag commentStamp: '<historical>' prior: 0!
I represent an unordered collection of possibly duplicate elements.
    
I store these elements in a dictionary, tallying up occurrences of equal objects. Because I store an occurrence only once, my clients should beware that objects they store will not necessarily be retrieved such that == is true. If the client cares, a subclass of me should be created.!
----- Method: Bag class>>contentsClass (in category 'instance creation') -----
contentsClass
    ^Dictionary!
----- Method: Bag class>>new (in category 'instance creation') -----
new
    ^ self new: 4!
----- Method: Bag class>>new: (in category 'instance creation') -----
new: nElements
    ^ super new setContents: (self contentsClass new: nElements)!
----- Method: Bag class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
^ self withAll: aCollection
"Examples:
    Bag newFrom: {1. 2. 3. 3}
    {1. 2. 3. 3} as: Bag
"!
----- Method: Bag>>= (in category 'comparing') -----
= aBag
    "Two bags are equal if
     (a) they are the same 'kind' of thing.
     (b) they have the same size.
     (c) each element occurs the same number of times in both of them"
(aBag isKindOf: Bag) ifFalse: [^false].
    self size = aBag size ifFalse: [^false].
    contents associationsDo: [:assoc|
    	(aBag occurrencesOf: assoc key) = assoc value
    		ifFalse: [^false]].
    ^true
!
----- Method: Bag>>add: (in category 'adding') -----
add: newObject 
    "Include newObject as one of the receiver's elements. Answer newObject."
^ self add: newObject withOccurrences: 1!
----- Method: Bag>>add:withOccurrences: (in category 'adding') -----
add: newObject withOccurrences: anInteger 
    "Add newObject anInteger times to the receiver. Answer newObject."
contents at: newObject put: (contents at: newObject ifAbsent: [0]) + anInteger.
    ^ newObject!
----- Method: Bag>>asBag (in category 'converting') -----
asBag
    ^ self!
----- Method: Bag>>asSet (in category 'converting') -----
asSet
    "Answer a set with the elements of the receiver."
^ contents keys!
----- Method: Bag>>at: (in category 'accessing') -----
at: index 
    self errorNotKeyed!
----- Method: Bag>>at:put: (in category 'accessing') -----
at: index put: anObject 
    self errorNotKeyed!
----- Method: Bag>>cumulativeCounts (in category 'accessing') -----
cumulativeCounts
    "Answer with a collection of cumulative percents covered by elements so far."
    | s n |
    s := self size / 100.0. n := 0.
    ^ self sortedCounts asArray collect:
    	[:a | n := n + a key. (n / s roundTo: 0.1) -> a value]!
----- Method: Bag>>do: (in category 'enumerating') -----
do: aBlock 
    "Refer to the comment in Collection|do:."
contents associationsDo: [:assoc | assoc value timesRepeat: [aBlock value: assoc key]]!
----- Method: Bag>>includes: (in category 'testing') -----
includes: anObject 
    "Refer to the comment in Collection|includes:."
^contents includesKey: anObject!
----- Method: Bag>>occurrencesOf: (in category 'testing') -----
occurrencesOf: anObject 
    "Refer to the comment in Collection|occurrencesOf:."
(self includes: anObject)
    	ifTrue: [^contents at: anObject]
    	ifFalse: [^0]!
----- Method: Bag>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    contents := contents copy!
----- Method: Bag>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: exceptionBlock 
    "Refer to the comment in Collection|remove:ifAbsent:."
| count |
    count := contents at: oldObject ifAbsent: [^ exceptionBlock value].
    count = 1
    	ifTrue: [contents removeKey: oldObject]
    	ifFalse: [contents at: oldObject put: count - 1].
    ^ oldObject!
----- Method: Bag>>removeAll (in category 'removing') -----
removeAll
    "Implementation Note: as contents will be overwritten, a shallowCopy of self would be modified.
    An alternative implementation preserving capacity would be to create a new contents:
    self setContents: (self class contentsClass new: contents size)."
    
    contents removeAll!
----- Method: Bag>>setContents: (in category 'private') -----
setContents: aDictionary
    contents := aDictionary!
----- Method: Bag>>size (in category 'accessing') -----
size
    "Answer how many elements the receiver contains."
| tally |
    tally := 0.
    contents do: [:each | tally := tally + each].
    ^ tally!
----- Method: Bag>>sortedCounts (in category 'accessing') -----
sortedCounts
    "Answer with a collection of counts with elements, sorted by decreasing
    count."
^(Array new: contents size streamContents: [ :stream |
    	contents associationsDo: [ :each |
    		stream nextPut: each value -> each key ] ])
    	sort: [:x :y | x >= y ];
    	yourself!
----- Method: Bag>>sortedElements (in category 'accessing') -----
sortedElements
    "Answer with a collection of elements with counts, sorted by element."
^contents associations
    	sort;
    	yourself!
----- Method: Bag>>valuesAndCounts (in category 'accessing') -----
valuesAndCounts
^ contents!
Bag subclass: #IdentityBag
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!IdentityBag commentStamp: '<historical>' prior: 0!
Like a Bag, except that items are compared with #== instead of #= .
See the comment of IdentitySet for more information.
!
----- Method: IdentityBag class>>contentsClass (in category 'instance creation') -----
contentsClass
    ^IdentityDictionary!
Collection subclass: #CharacterSet
    instanceVariableNames: 'map'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!CharacterSet commentStamp: '<historical>' prior: 0!
A set of characters.  Lookups for inclusion are very fast.!
----- Method: CharacterSet class>>allCharacters (in category 'instance creation') -----
allCharacters
    "return a set containing all characters"
| set |
    set := self empty.
    0 to: 255 do: [ :ascii | set add: (Character value: ascii) ].
    ^set!
----- Method: CharacterSet class>>empty (in category 'instance creation') -----
empty
    "return an empty set of characters"
    ^self new!
----- Method: CharacterSet class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection
    | newCollection |
    newCollection := self new.
    newCollection addAll: aCollection.
    ^newCollection!
----- Method: CharacterSet class>>nonSeparators (in category 'instance creation') -----
nonSeparators
    "return a set containing everything but the whitespace characters"
^self separators complement!
----- Method: CharacterSet class>>separators (in category 'instance creation') -----
separators
    "return a set containing just the whitespace characters"
| set |
    set := self empty.
    set addAll: Character separators.
    ^set!
----- Method: CharacterSet>>= (in category 'comparison') -----
= anObject
    ^self species == anObject species and: [
    	self byteArrayMap = anObject byteArrayMap ]!
----- Method: CharacterSet>>add: (in category 'collection ops') -----
add: aCharacter
    "I automatically become a WideCharacterSet if you add a wide character to myself"
    
    aCharacter asciiValue >= 256
    	ifTrue: [| wide |
    		wide := WideCharacterSet new.
    		wide addAll: self.
    		wide add: aCharacter.
    		self become: wide.
    		^aCharacter].
    map at: aCharacter asciiValue + 1 put: 1.
    ^aCharacter!
----- Method: CharacterSet>>byteArrayMap (in category 'private') -----
byteArrayMap
    "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't.  Intended for use by primitives only"
    ^map!
----- Method: CharacterSet>>byteComplement (in category 'conversion') -----
byteComplement
    "return a character set containing precisely the single byte characters the receiver does not"
    
    | set |
    set := CharacterSet allCharacters.
    self do: [ :c | set remove: c ].
    ^set!
----- Method: CharacterSet>>complement (in category 'conversion') -----
complement
    "return a character set containing precisely the characters the receiver does not"
    
    ^CharacterSetComplement of: self copy!
----- Method: CharacterSet>>do: (in category 'collection ops') -----
do: aBlock
    "evaluate aBlock with each character in the set"
Character allByteCharacters do: [ :c |
    	(self includes: c) ifTrue: [ aBlock value: c ] ]
!
----- Method: CharacterSet>>hasWideCharacters (in category 'testing') -----
hasWideCharacters
    ^false!
----- Method: CharacterSet>>hash (in category 'comparison') -----
hash
    ^self byteArrayMap hash!
----- Method: CharacterSet>>includes: (in category 'collection ops') -----
includes: aCharacter
    aCharacter asciiValue >= 256
    	ifTrue: ["Guard against wide characters"
    		^false].
    ^(map at: aCharacter asciiValue + 1) > 0!
----- Method: CharacterSet>>initialize (in category 'private') -----
initialize
    map := ByteArray new: 256 withAll: 0.!
----- Method: CharacterSet>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    map := map copy!
----- Method: CharacterSet>>remove: (in category 'collection ops') -----
remove: aCharacter
    aCharacter asciiValue >= 256
    	ifFalse: ["Guard against wide characters"
    		map at: aCharacter asciiValue + 1 put: 0].
    ^aCharacter!
----- Method: CharacterSet>>removeAll (in category 'removing') -----
removeAll
map atAllPut: 0!
----- Method: CharacterSet>>size (in category 'collection ops') -----
size
    ^map sum!
----- Method: CharacterSet>>species (in category 'comparison') -----
species
    ^CharacterSet!
----- Method: CharacterSet>>wideCharacterMap (in category 'private') -----
wideCharacterMap
    "used for comparing with WideCharacterSet"
    
    | wide |
    wide := WideCharacterSet new.
    wide addAll: self.
    ^wide wideCharacterMap!
Collection subclass: #CharacterSetComplement
    instanceVariableNames: 'absent byteArrayMapCache'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!CharacterSetComplement commentStamp: 'nice 8/31/2008 14:53' prior: 0!
CharacterSetComplement is a space efficient implementation of (CharacterSet complement) taking care of WideCharacter (code > 255)
However, it will maintain a byteArrayMap for character <= 255 in a cache keeping
instance variables:
    absent <CharacterSet> contains character that are not in the set (i.e. my complement)
    byteArrayMapCache <ByteArray | nil> cache this information because it has to be used in tight loops where efficiency matters!
----- Method: CharacterSetComplement class>>of: (in category 'instance creation') -----
of: aCharacterSet
    "answer the complement of aCharacterSet"
    
    ^ super new complement: aCharacterSet!
----- Method: CharacterSetComplement>>= (in category 'comparing') -----
= anObject
    "Implementation note: we do not test if equal to a WideCharacterSet,
    because it is unlikely that WideCharacterSet is as complete as self"
    
    ^self class == anObject class and: [
    	absent = anObject complement ]!
----- Method: CharacterSetComplement>>add: (in category 'collection ops') -----
add: aCharacter 
    "a character is present if not absent, so adding a character is removing it from the absent"
    
    (absent includes: aCharacter)
    	ifTrue:
    		[byteArrayMapCache := nil.
    		absent remove: aCharacter].
    ^ aCharacter!
----- Method: CharacterSetComplement>>byteArrayMap (in category 'private') -----
byteArrayMap
    "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't.  Intended for use by primitives only"
^byteArrayMapCache ifNil: [byteArrayMapCache := absent byteArrayMap collect: [:i | 1 - i]]!
----- Method: CharacterSetComplement>>complement (in category 'converting') -----
complement
    "return a character set containing precisely the characters the receiver does not"
    
    ^absent copy!
----- Method: CharacterSetComplement>>complement: (in category 'initialize-release') -----
complement: aCharacterSet
    "initialize with the complement"
    
    byteArrayMapCache := nil.
    absent := aCharacterSet.
    !
----- Method: CharacterSetComplement>>do: (in category 'collection ops') -----
do: aBlock
    "evaluate aBlock with each character in the set.
    don't do it, there are too many..."
self shouldNotImplement!
----- Method: CharacterSetComplement>>hasWideCharacters (in category 'testing') -----
hasWideCharacters
    "This is a guess that absent is not holding each and every possible wideCharacter..."
    
    ^true!
----- Method: CharacterSetComplement>>hash (in category 'comparing') -----
hash
    ^ absent hash bitXor: self class hash!
----- Method: CharacterSetComplement>>includes: (in category 'collection ops') -----
includes: aCharacter
    ^(absent includes: aCharacter) not!
----- Method: CharacterSetComplement>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    absent := absent copy!
----- Method: CharacterSetComplement>>printOn: (in category 'printing') -----
printOn: aStream
    "Print a description of the complement rather than self.
    Rationale: self would be too long to print."
    
    aStream nextPut: $(.
    absent printOn: aStream.
    aStream nextPut: $); space; nextPutAll: #complement.!
----- Method: CharacterSetComplement>>reject: (in category 'collection ops') -----
reject: aBlock
    "Implementation note: rejecting present is selecting absent"
    
    ^(absent select: aBlock) complement!
----- Method: CharacterSetComplement>>remove: (in category 'collection ops') -----
remove: aCharacter
    "This means aCharacter is now absent from myself.
    It must be added to my absent."
    
    byteArrayMapCache := nil.
    ^absent add: aCharacter!
----- Method: CharacterSetComplement>>removeAll (in category 'collection ops') -----
removeAll
    | newSet |
    newSet := CharacterSet new.
    self become: newSet!
----- Method: CharacterSetComplement>>select: (in category 'collection ops') -----
select: aBlock
    "Implementation note: selecting present is rejecting absent"
    
    ^(absent reject: aBlock) complement!
----- Method: CharacterSetComplement>>size (in category 'collection ops') -----
size
    "Is this 2**32-absent size ?"
    
    ^self shouldNotImplement!
----- Method: CharacterSetComplement>>storeOn: (in category 'printing') -----
storeOn: aStream
    "Store a description of the elements of the complement rather than self."
    
    aStream nextPut: $(.
    absent storeOn: aStream.
    aStream nextPut: $); space; nextPutAll: #complement.!
----- Method: Collection class>>initialize (in category 'private') -----
initialize
    "Set up a Random number generator to be used by atRandom when the 
    user does not feel like creating his own Random generator."
RandomForPicking := Random new.
    MutexForPicking := Semaphore forMutualExclusion!
----- Method: Collection class>>mutexForPicking (in category 'private') -----
mutexForPicking
    ^ MutexForPicking!
----- Method: Collection class>>ofSize: (in category 'instance creation') -----
ofSize: n
    "Create a new collection of size n with nil as its elements.
    This method exists because OrderedCollection new: n creates an
    empty collection,  not one of size n."
    ^ self new: n!
----- Method: Collection class>>randomForPicking (in category 'private') -----
randomForPicking
    ^ RandomForPicking!
----- Method: Collection class>>with: (in category 'instance creation') -----
with: anObject 
    "Answer an instance of me containing anObject."
^ self new
    	add: anObject;
    	yourself!
----- Method: Collection class>>with:with: (in category 'instance creation') -----
with: firstObject with: secondObject 
    "Answer an instance of me containing the two arguments as elements."
^ self new
    	add: firstObject;
    	add: secondObject;
    	yourself!
----- Method: Collection class>>with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject 
    "Answer an instance of me containing the three arguments as elements."
^ self new
    	add: firstObject;
    	add: secondObject;
    	add: thirdObject;
    	yourself!
----- Method: Collection class>>with:with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject with: fourthObject 
    "Answer an instance of me, containing the four arguments as the elements."
^ self new
    	add: firstObject;
    	add: secondObject;
    	add: thirdObject;
    	add: fourthObject;
    	yourself!
----- Method: Collection class>>with:with:with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
    "Answer an instance of me, containing the five arguments as the elements."
^ self new
    	add: firstObject;
    	add: secondObject;
    	add: thirdObject;
    	add: fourthObject;
    	add: fifthObject;
    	yourself!
----- Method: Collection class>>with:with:with:with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
    "Answer an instance of me, containing the six arguments as the elements."
^ self new
    	add: firstObject;
    	add: secondObject;
    	add: thirdObject;
    	add: fourthObject;
    	add: fifthObject;
    	add: sixthObject;
    	yourself!
----- Method: Collection class>>withAll: (in category 'instance creation') -----
withAll: aCollection
    "Create a new collection containing all the elements from aCollection."
^ (self new: aCollection size)
    	addAll: aCollection;
    	yourself!
----- Method: Collection>>* (in category 'arithmetic') -----
* arg
^ arg adaptToCollection: self andSend: #*!
----- Method: Collection>>+ (in category 'arithmetic') -----
+ arg
^ arg adaptToCollection: self andSend: #+!
----- Method: Collection>>, (in category 'copying') -----
, aCollection
    ^self copy addAll: aCollection; yourself!
----- Method: Collection>>- (in category 'arithmetic') -----
- arg
^ arg adaptToCollection: self andSend: #-!
----- Method: Collection>>/ (in category 'arithmetic') -----
/ arg
^ arg adaptToCollection: self andSend: #/!
----- Method: Collection>>// (in category 'arithmetic') -----
// arg
^ arg adaptToCollection: self andSend: #//!
----- Method: Collection>>\ (in category 'arithmetic') -----
\ arg
^ arg adaptToCollection: self andSend: #\!
----- Method: Collection>>abs (in category 'math functions') -----
abs
    "Absolute value of all elements in the collection"
    ^ self collect: [:a | a abs]!
----- Method: Collection>>adaptToCollection:andSend: (in category 'adapting') -----
adaptToCollection: rcvr andSend: selector
    "If I am involved in arithmetic with another Collection, return a Collection of
    the results of each element combined with the scalar in that expression."
rcvr isSequenceable & self isSequenceable ifFalse:
    	[self error: 'Only sequenceable collections may be combined arithmetically'].
    ^ rcvr with: self collect:
    	[:rcvrElement :myElement | rcvrElement perform: selector with: myElement]!
----- Method: Collection>>adaptToComplex:andSend: (in category 'adapting') -----
adaptToComplex: rcvr andSend: selector
    "If I am involved in arithmetic with a scalar, return a Collection of
    the results of each element combined with the scalar in that expression."
^ self collect: [:element | rcvr perform: selector with: element]!
----- Method: Collection>>adaptToNumber:andSend: (in category 'adapting') -----
adaptToNumber: rcvr andSend: selector
    "If I am involved in arithmetic with a scalar, return a Collection of
    the results of each element combined with the scalar in that expression."
^ self collect: [:element | rcvr perform: selector with: element]!
----- Method: Collection>>adaptToPoint:andSend: (in category 'adapting') -----
adaptToPoint: rcvr andSend: selector
    "If I am involved in arithmetic with a scalar, return a Collection of
    the results of each element combined with the scalar in that expression."
^ self collect: [:element | rcvr perform: selector with: element]!
----- Method: Collection>>adaptToString:andSend: (in category 'adapting') -----
adaptToString: rcvr andSend: selector
    "If I am involved in arithmetic with a String, convert it to a Number."
    ^ rcvr asNumber perform: selector with: self!
----- Method: Collection>>add: (in category 'adding') -----
add: newObject 
    "Include newObject as one of the receiver's elements. Answer newObject. 
    ArrayedCollections cannot respond to this message."
self subclassResponsibility!
----- Method: Collection>>add:withOccurrences: (in category 'adding') -----
add: newObject withOccurrences: anInteger
    "Add newObject anInteger times to the receiver. Answer newObject."
anInteger timesRepeat: [self add: newObject].
    ^ newObject!
----- Method: Collection>>addAll: (in category 'adding') -----
addAll: aCollection 
    "Include all the elements of aCollection as the receiver's elements. Answer 
    aCollection. Actually, any object responding to #do: can be used as argument."
aCollection do: [:each | self add: each].
    ^ aCollection!
----- Method: Collection>>addIfNotPresent: (in category 'adding') -----
addIfNotPresent: anObject
    "Include anObject as one of the receiver's elements, but only if there
    is no such element already. Anwser anObject."
(self includes: anObject) ifFalse: [self add: anObject].
    ^ anObject!
----- Method: Collection>>allSatisfy: (in category 'enumerating') -----
allSatisfy: aBlock
    "Evaluate aBlock with the elements of the receiver.
    If aBlock returns false for any element return false.
    Otherwise return true."
self do: [:each | (aBlock value: each) ifFalse: [^ false]].
    ^ true!
----- Method: Collection>>anyOne (in category 'accessing') -----
anyOne
    "Answer a representative sample of the receiver. This method can
    be helpful when needing to preinfer the nature of the contents of 
    semi-homogeneous collections."
self emptyCheck.
    self do: [:each | ^ each]!
----- Method: Collection>>anySatisfy: (in category 'enumerating') -----
anySatisfy: aBlock
    "Evaluate aBlock with the elements of the receiver.
    If aBlock returns true for any element return true.
    Otherwise return false."
self do: [:each | (aBlock value: each) ifTrue: [^ true]].
    ^ false!
----- Method: Collection>>arcCos (in category 'math functions') -----
arcCos
    ^self collect: [:each | each arcCos]!
----- Method: Collection>>arcSin (in category 'math functions') -----
arcSin
    ^self collect: [:each | each arcSin]!
----- Method: Collection>>arcTan (in category 'math functions') -----
arcTan
    ^self collect: [:each | each arcTan]!
----- Method: Collection>>asArray (in category 'converting') -----
asArray
    "Answer an Array whose elements are the elements of the receiver.
    Implementation note: Cannot use ''Array withAll: self'' as that only
    works for SequenceableCollections which support the replacement 
    primitive."
| array index |
    array := Array new: self size.
    index := 0.
    self do: [:each | array at: (index := index + 1) put: each].
    ^ array!
----- Method: Collection>>asBag (in category 'converting') -----
asBag
    "Answer a Bag whose elements are the elements of the receiver."
^ Bag withAll: self!
----- Method: Collection>>asByteArray (in category 'converting') -----
asByteArray
    "Answer a ByteArray whose elements are the elements of the receiver.
    Implementation note: Cannot use ''ByteArray withAll: self'' as that only
    works for SequenceableCollections which support the replacement 
    primitive."
| array index |
    array := ByteArray new: self size.
    index := 0.
    self do: [:each | array at: (index := index + 1) put: each].
    ^ array!
----- Method: Collection>>asCharacterSet (in category 'converting') -----
asCharacterSet
    "Answer a CharacterSet whose elements are the unique elements of the receiver.
    The reciever should only contain characters."
^ CharacterSet newFrom: self!
----- Method: Collection>>asCommaString (in category 'printing') -----
asCommaString
    "Return collection printed as 'a, b, c' "
^String streamContents: [:s | self asStringOn: s delimiter: ', ']
    	!
----- Method: Collection>>asCommaStringAnd (in category 'printing') -----
asCommaStringAnd
    "Return collection printed as 'a, b and c' "
^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ' and ']
    	!
----- Method: Collection>>asIdentitySet (in category 'converting') -----
asIdentitySet
    ^(IdentitySet new: self size) addAll: self; yourself!
----- Method: Collection>>asOrderedCollection (in category 'converting') -----
asOrderedCollection
    "Answer an OrderedCollection whose elements are the elements of the
    receiver. The order in which elements are added depends on the order
    in which the receiver enumerates its elements. In the case of unordered
    collections, the ordering is not necessarily the same for multiple 
    requests for the conversion."
^ self as: OrderedCollection!
----- Method: Collection>>asSet (in category 'converting') -----
asSet
    "Answer a Set whose elements are the unique elements of the receiver."
^ Set withAll: self!
----- Method: Collection>>asSortedArray (in category 'converting') -----
asSortedArray
    "Return a copy of the receiver in sorted order, as an Array.  6/10/96 sw"
^ self asSortedCollection asArray!
----- Method: Collection>>asSortedCollection (in category 'converting') -----
asSortedCollection
    "Answer a SortedCollection whose elements are the elements of the 
    receiver. The sort order is the default less than or equal."
^ self as: SortedCollection!
----- Method: Collection>>asSortedCollection: (in category 'converting') -----
asSortedCollection: aSortBlock 
    "Answer a SortedCollection whose elements are the elements of the 
    receiver. The sort order is defined by the argument, aSortBlock."
| aSortedCollection |
    aSortedCollection := SortedCollection new: self size.
    aSortedCollection sortBlock: aSortBlock.
    aSortedCollection addAll: self.
    ^ aSortedCollection!
----- Method: Collection>>asStringOn:delimiter: (in category 'printing') -----
asStringOn: aStream delimiter: delimString
    "Print elements on a stream separated
    with a delimiter String like: 'a, b, c'
    Uses #asString instead of #print:."
self do: [:elem | aStream nextPutAll: elem asString]
    	separatedBy: [aStream nextPutAll: delimString]!
----- Method: Collection>>asStringOn:delimiter:last: (in category 'printing') -----
asStringOn: aStream delimiter: delimString last: lastDelimString
    "Print elements on a stream separated
    with a delimiter between all the elements and with
    a special one before the last like: 'a, b and c'.
    Uses #asString instead of #print:
Note: Feel free to improve the code to detect the last element."
| n sz |
    n := 1.
    sz := self size.
    self do: [:elem |
    	n := n + 1.
    	aStream nextPutAll: elem asString]
    separatedBy: [
    	aStream nextPutAll: (n = sz ifTrue: [lastDelimString] ifFalse: [delimString])]!
----- Method: Collection>>associationsDo: (in category 'enumerating') -----
associationsDo: aBlock
    "Evaluate aBlock for each of the receiver's elements (key/value 
    associations).  If any non-association is within, the error is not caught now,
    but later, when a key or value message is sent to it."
self do: aBlock!
----- Method: Collection>>atRandom (in category 'accessing') -----
atRandom
    "Answer a random element of the receiver.  Uses a shared random 
    number generator owned by class Collection.  If you use this a lot, 
    define your own instance of Random and use #atRandom:.  Causes 
    an error if self has no elements."
^ self class mutexForPicking critical: [
    	self atRandom: self class randomForPicking ]
"Examples:
    #('one' 'or' 'the' 'other') atRandom
    (1 to: 10) atRandom
    'Just pick one of these letters at random' atRandom
    #(3 7 4 9 21) asSet atRandom		(just to show it also works for Sets)
"!
----- Method: Collection>>average (in category 'math functions') -----
average
    ^ self sum / self size!
----- Method: Collection>>capacity (in category 'accessing') -----
capacity
    "Answer the current capacity of the receiver."
^ self size!
----- Method: Collection>>ceiling (in category 'math functions') -----
ceiling
    ^ self collect: [:a | a ceiling]!
----- Method: Collection>>collect: (in category 'enumerating') -----
collect: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument.  
    Collect the resulting values into a collection like the receiver. Answer  
    the new collection."
| newCollection |
    newCollection := self species new.
    self do: [:each | newCollection add: (aBlock value: each)].
    ^ newCollection!
----- Method: Collection>>collect:thenDo: (in category 'enumerating') -----
collect: collectBlock thenDo: doBlock 
    "Utility method to improve readability."
    ^ (self collect: collectBlock) do: doBlock!
----- Method: Collection>>collect:thenSelect: (in category 'enumerating') -----
collect: collectBlock thenSelect: selectBlock
    "Utility method to improve readability."
^ (self collect: collectBlock) select: selectBlock!
----- Method: Collection>>contains: (in category 'testing') -----
contains: aBlock
    "VW compatibility"
    ^self anySatisfy: aBlock!
----- Method: Collection>>contents (in category 'filter streaming') -----
contents
    ^ self!
----- Method: Collection>>copyWith: (in category 'copying') -----
copyWith: newElement
    "Answer a new collection with newElement added (as last
    element if sequenceable)."
^ self copy
    	add: newElement;
    	yourself!
----- Method: Collection>>copyWithDependent: (in category 'copying') -----
copyWithDependent: newElement
    "Answer a new collection with newElement added (as last
    element if sequenceable)."
    ^self copyWith: newElement!
----- Method: Collection>>copyWithout: (in category 'copying') -----
copyWithout: oldElement 
    "Answer a copy of the receiver that does not contain any
    elements equal to oldElement."
^ self reject: [:each | each = oldElement]
"Examples:
    'fred the bear' copyWithout: $e
    #(2 3 4 5 5 6) copyWithout: 5
"!
----- Method: Collection>>copyWithoutAll: (in category 'copying') -----
copyWithoutAll: aCollection
    "Answer a copy of the receiver that does not contain any elements 
    equal to those in aCollection."
^ self reject: [:each | aCollection includes: each]!
----- Method: Collection>>cos (in category 'math functions') -----
cos
    ^self collect: [:each | each cos]!
----- Method: Collection>>count: (in category 'enumerating') -----
count: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument.  
    Answer the number of elements that answered true."
| sum |
    sum := 0.
    self do: [:each | (aBlock value: each) ifTrue: [sum := sum + 1]].
    ^ sum!
----- Method: Collection>>degreeCos (in category 'math functions') -----
degreeCos
    ^self collect: [:each | each degreeCos]!
----- Method: Collection>>degreeSin (in category 'math functions') -----
degreeSin
    ^self collect: [:each | each degreeSin]!
----- Method: Collection>>detect: (in category 'enumerating') -----
detect: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument. 
    Answer the first element for which aBlock evaluates to true."
^ self detect: aBlock ifNone: [self errorNotFound: aBlock]!
----- Method: Collection>>detect:ifNone: (in category 'enumerating') -----
detect: aBlock ifNone: exceptionBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument.  
    Answer the first element for which aBlock evaluates to true. If none  
    evaluate to true, then evaluate the argument, exceptionBlock."
self do: [:each | (aBlock value: each) ifTrue: [^ each]].
    ^ exceptionBlock value!
----- Method: Collection>>detectMax: (in category 'enumerating') -----
detectMax: aBlock
    "Evaluate aBlock with each of the receiver's elements as the argument. 
    Answer the element for which aBlock evaluates to the highest magnitude.
    If collection empty, return nil.  This method might also be called elect:."
| maxElement maxValue val |
    self do: [:each | 
    	maxValue == nil
    		ifFalse: [
    			(val := aBlock value: each) > maxValue ifTrue: [
    				maxElement := each.
    				maxValue := val]]
    		ifTrue: ["first element"
    			maxElement := each.
    			maxValue := aBlock value: each].
    			"Note that there is no way to get the first element that works 
    			for all kinds of Collections.  Must test every one."].
    ^ maxElement!
----- Method: Collection>>detectMin: (in category 'enumerating') -----
detectMin: aBlock
    "Evaluate aBlock with each of the receiver's elements as the argument. 
    Answer the element for which aBlock evaluates to the lowest number.
    If collection empty, return nil."
| minElement minValue val |
    self do: [:each | 
    	minValue == nil
    		ifFalse: [
    			(val := aBlock value: each) < minValue ifTrue: [
    				minElement := each.
    				minValue := val]]
    		ifTrue: ["first element"
    			minElement := each.
    			minValue := aBlock value: each].
    			"Note that there is no way to get the first element that works 
    			for all kinds of Collections.  Must test every one."].
    ^ minElement!
----- Method: Collection>>detectSum: (in category 'enumerating') -----
detectSum: aBlock
    "Evaluate aBlock with each of the receiver's elements as the argument. 
    Return the sum of the answers."
    | sum |
    sum := 0.
    self do: [:each | 
    	sum := (aBlock value: each) + sum].  
    ^ sum!
----- Method: Collection>>difference: (in category 'enumerating') -----
difference: aCollection
    "Answer the set theoretic difference of two collections."
^ self reject: [:each | aCollection includes: each]!
----- Method: Collection>>do: (in category 'enumerating') -----
do: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument."
self subclassResponsibility!
----- Method: Collection>>do:displayingProgress: (in category 'enumerating') -----
do: aBlock displayingProgress: aString
aString
    	displayProgressAt: Sensor cursorPoint
    	from: 0 to: self size
    	during:
    		[:bar |
    		self inject: 1 into:
    			[:index :each |
    			bar value: index.
    			aBlock value: each.
    			index + 1]]!
----- Method: Collection>>do:separatedBy: (in category 'enumerating') -----
do: elementBlock separatedBy: separatorBlock
    "Evaluate the elementBlock for all elements in the receiver,
    and evaluate the separatorBlock between."
| beforeFirst | 
    beforeFirst := true.
    self do:
    	[:each |
    	beforeFirst
    		ifTrue: [beforeFirst := false]
    		ifFalse: [separatorBlock value].
    	elementBlock value: each]!
----- Method: Collection>>do:without: (in category 'enumerating') -----
do: aBlock without: anItem 
    "Enumerate all elements in the receiver. 
    Execute aBlock for those elements that are not equal to the given item"
^ self do: [:each | anItem = each ifFalse: [aBlock value: each]]!
----- Method: Collection>>emptyCheck (in category 'private') -----
emptyCheck
self isEmpty ifTrue: [self errorEmptyCollection]!
----- Method: Collection>>errorEmptyCollection (in category 'private') -----
errorEmptyCollection
self error: 'this collection is empty'!
----- Method: Collection>>errorNoMatch (in category 'private') -----
errorNoMatch
self error: 'collection sizes do not match'!
----- Method: Collection>>errorNotFound: (in category 'private') -----
errorNotFound: anObject
    "Actually, this should raise a special Exception not just an error."
self error: 'Object is not in the collection.'!
----- Method: Collection>>errorNotKeyed (in category 'private') -----
errorNotKeyed
self error: ('Instances of {1} do not respond to keyed accessing messages.' translated format: {self class name})
!
----- Method: Collection>>exp (in category 'math functions') -----
exp
    ^self collect: [:each | each exp]!
----- Method: Collection>>flattenOnStream: (in category 'filter streaming') -----
flattenOnStream: aStream 
    ^ aStream writeCollection: self!
----- Method: Collection>>floor (in category 'math functions') -----
floor
    ^ self collect: [:a | a floor]!
----- Method: Collection>>groupBy:having: (in category 'enumerating') -----
groupBy: keyBlock having: selectBlock 
    "Like in SQL operation - Split the recievers contents into collections of 
    elements for which keyBlock returns the same results, and return those 
    collections allowed by selectBlock. keyBlock should return an Integer."
    | result key |
    result := PluggableDictionary integerDictionary.
    self do: 
    	[:e | 
    	key := keyBlock value: e.
    	(result includesKey: key)
    		ifFalse: [result at: key put: OrderedCollection new].
    	(result at: key)
    		add: e].
    ^ result := result select: selectBlock!
----- Method: Collection>>hash (in category 'comparing') -----
hash
    "Answer an integer hash value for the receiver such that,
      -- the hash value of an unchanged object is constant over time, and
      -- two equal objects have equal hash values"
| hash |
hash := self species hash.
    self size <= 10 ifTrue:
    	[self do: [:elem | hash := hash bitXor: elem hash]].
    ^hash bitXor: self size hash!
----- Method: Collection>>identityIncludes: (in category 'testing') -----
identityIncludes: anObject 
    "Answer whether anObject is one of the receiver's elements."
self do: [:each | anObject == each ifTrue: [^true]].
    ^false!
----- Method: Collection>>ifEmpty: (in category 'testing') -----
ifEmpty: aBlock
    "Evaluate the block if I'm empty"
^ self isEmpty ifTrue: aBlock!
----- Method: Collection>>ifEmpty:ifNotEmpty: (in category 'testing') -----
ifEmpty: emptyBlock ifNotEmpty: notEmptyBlock
    "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise"
    " If the notEmptyBlock has an argument, eval with the receiver as its argument"
^ self isEmpty ifTrue: emptyBlock ifFalse: [notEmptyBlock valueWithPossibleArgument: self]!
----- Method: Collection>>ifEmpty:ifNotEmptyDo: (in category 'testing') -----
ifEmpty: emptyBlock ifNotEmptyDo: notEmptyBlock
    "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise"
    "Evaluate the notEmptyBlock with the receiver as its argument"
^ self isEmpty ifTrue: emptyBlock ifFalse: [notEmptyBlock value: self]!
----- Method: Collection>>ifNotEmpty: (in category 'testing') -----
ifNotEmpty: aBlock
    "Evaluate the given block unless the receiver is empty.
If the block has an argument, eval with the receiver as its argument,
      but it might be better to use ifNotEmptyDo: to make the code easier to
      understand"
^self isEmpty ifFalse: [aBlock valueWithPossibleArgument: self].
!
----- Method: Collection>>ifNotEmpty:ifEmpty: (in category 'testing') -----
ifNotEmpty: notEmptyBlock ifEmpty: emptyBlock
    "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise
     If the notEmptyBlock has an argument, eval with the receiver as its argument"
^ self isEmpty ifFalse: [notEmptyBlock valueWithPossibleArgument: self] ifTrue: emptyBlock!
----- Method: Collection>>ifNotEmptyDo: (in category 'testing') -----
ifNotEmptyDo: aBlock
    "Evaluate the given block with the receiver as its argument."
^self isEmpty ifFalse: [aBlock value: self].
!
----- Method: Collection>>ifNotEmptyDo:ifEmpty: (in category 'testing') -----
ifNotEmptyDo: notEmptyBlock ifEmpty: emptyBlock
    "Evaluate emptyBlock if I'm empty, notEmptyBlock otherwise
    Evaluate the notEmptyBlock with the receiver as its argument"
^ self isEmpty ifFalse: [notEmptyBlock value: self] ifTrue: emptyBlock!
----- Method: Collection>>includes: (in category 'testing') -----
includes: anObject 
    "Answer whether anObject is one of the receiver's elements."
^ self anySatisfy: [:each | each = anObject]!
----- Method: Collection>>includesAllOf: (in category 'testing') -----
includesAllOf: aCollection 
    "Answer whether all the elements of aCollection are in the receiver."
    aCollection do: [:elem | (self includes: elem) ifFalse: [^ false]].
    ^ true!
----- Method: Collection>>includesAnyOf: (in category 'testing') -----
includesAnyOf: aCollection 
    "Answer whether any element of aCollection is one of the receiver's elements."
    aCollection do: [:elem | (self includes: elem) ifTrue: [^ true]].
    ^ false!
----- Method: Collection>>includesSubstringAnywhere: (in category 'testing') -----
includesSubstringAnywhere: testString
    "Answer whether the receiver includes, anywhere in its nested structure, a string that has testString as a substring"
    self do:
    	[:element |
    		(element isString)
    			ifTrue:
    				[(element includesSubString: testString) ifTrue: [^ true]].
    		(element isCollection)
    			ifTrue:
    				[(element includesSubstringAnywhere: testString) ifTrue: [^ true]]].
    ^ false
"#(first (second third) ((allSentMessages ('Elvis' includes:)))) includesSubstringAnywhere:  'lvi'"!
----- Method: Collection>>inject:into: (in category 'enumerating') -----
inject: thisValue into: binaryBlock 
    "Accumulate a running value associated with evaluating the argument, 
    binaryBlock, with the current value of the argument, thisValue, and the 
    receiver as block arguments. For instance, to sum the numeric elements 
    of a collection, aCollection inject: 0 into: [:subTotal :next | subTotal + 
    next]."
| nextValue |
    nextValue := thisValue.
    self do: [:each | nextValue := binaryBlock value: nextValue value: each].
    ^nextValue!
----- Method: Collection>>intersection: (in category 'enumerating') -----
intersection: aCollection
    "Answer the set theoretic intersection of two collections."
^ self select: [:each | aCollection includes: each]!
----- Method: Collection>>isCollection (in category 'testing') -----
isCollection
    "Return true if the receiver is some sort of Collection and responds to basic collection messages such as #size and #do:"
    ^true!
----- Method: Collection>>isEmpty (in category 'testing') -----
isEmpty
    "Answer whether the receiver contains any elements."
^self size = 0!
----- Method: Collection>>isEmptyOrNil (in category 'testing') -----
isEmptyOrNil
    "Answer whether the receiver contains any elements, or is nil.  Useful in numerous situations where one wishes the same reaction to an empty collection or to nil"
^ self isEmpty!
----- Method: Collection>>isSequenceable (in category 'testing') -----
isSequenceable
    ^ false!
----- Method: Collection>>isZero (in category 'testing') -----
isZero
    "Answer whether the receiver is zero"
    ^ false!
----- Method: Collection>>ln (in category 'math functions') -----
ln
    ^self collect: [:each | each ln]!
----- Method: Collection>>log (in category 'math functions') -----
log
    ^ self collect: [:each | each log]!
----- Method: Collection>>max (in category 'math functions') -----
max
    ^ self inject: self anyOne into: [:max :each | max max: each]!
----- Method: Collection>>median (in category 'math functions') -----
median
    ^ self asSortedCollection median!
----- Method: Collection>>min (in category 'math functions') -----
min
    ^ self inject: self anyOne into: [:min :each | min min: each]!
----- Method: Collection>>negated (in category 'math functions') -----
negated
    "Negated value of all elements in the collection"
    ^ self collect: [:a | a negated]!
----- Method: Collection>>noneSatisfy: (in category 'enumerating') -----
noneSatisfy: aBlock
    "Evaluate aBlock with the elements of the receiver.
    If aBlock returns false for all elements return true.
    Otherwise return false"
self do: [:item | (aBlock value: item) ifTrue: [^ false]].
    ^ true!
----- Method: Collection>>notEmpty (in category 'testing') -----
notEmpty
    "Answer whether the receiver contains any elements."
^ self isEmpty not!
----- Method: Collection>>occurrencesOf: (in category 'testing') -----
occurrencesOf: anObject 
    "Answer how many of the receiver's elements are equal to anObject."
| tally |
    tally := 0.
    self do: [:each | anObject = each ifTrue: [tally := tally + 1]].
    ^tally!
----- Method: Collection>>printElementsOn: (in category 'printing') -----
printElementsOn: aStream
    "The original code used #skip:, but some streams do not support that,
     and we don't really need it."
aStream nextPut: $(.
    self do: [:element | aStream print: element] separatedBy: [aStream space].
    aStream nextPut: $)!
----- Method: Collection>>printNameOn: (in category 'printing') -----
printNameOn: aStream
    super printOn: aStream!
----- Method: Collection>>printOn: (in category 'printing') -----
printOn: aStream 
    "Append a sequence of characters that identify the receiver to aStream."
self printNameOn: aStream.
    self printElementsOn: aStream!
----- Method: Collection>>printOn:delimiter: (in category 'printing') -----
printOn: aStream delimiter: delimString
    "Print elements on a stream separated
    with a delimiter String like: 'a, b, c' "
self do: [:elem | aStream print: elem] separatedBy: [aStream print: delimString]
    	!
----- Method: Collection>>printOn:delimiter:last: (in category 'printing') -----
printOn: aStream delimiter: delimString last: lastDelimString
    "Print elements on a stream separated
    with a delimiter between all the elements and with
    a special one before the last like: 'a, b and c'
Note: Feel free to improve the code to detect the last element."
| n sz |
    n := 1.
    sz := self size.
    self do: [:elem |
    	n := n + 1.
    	aStream print: elem]
    separatedBy: [
    	n = sz
    		ifTrue: [aStream print: lastDelimString]
    		ifFalse: [aStream print: delimString]]!
----- Method: Collection>>raisedTo: (in category 'arithmetic') -----
raisedTo: arg
^ arg adaptToCollection: self andSend: #raisedTo:!
----- Method: Collection>>range (in category 'math functions') -----
range
    ^ self max - self min!
----- Method: Collection>>reciprocal (in category 'math functions') -----
reciprocal
    "Return the reciever full of reciprocated elements"
    ^ self collect: [:a | a reciprocal]!
----- Method: Collection>>reject: (in category 'enumerating') -----
reject: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument. 
    Collect into a new collection like the receiver only those elements for 
    which aBlock evaluates to false. Answer the new collection."
^self select: [:element | (aBlock value: element) == false]!
----- Method: Collection>>reject:thenDo: (in category 'enumerating') -----
reject: rejectBlock thenDo: doBlock 
    "Utility method to improve readability."
    ^ (self reject: rejectBlock) do: doBlock!
----- Method: Collection>>remove: (in category 'removing') -----
remove: oldObject 
    "Remove oldObject from the receiver's elements. Answer oldObject 
    unless no element is equal to oldObject, in which case, raise an error.
    ArrayedCollections cannot respond to this message."
^ self remove: oldObject ifAbsent: [self errorNotFound: oldObject]!
----- Method: Collection>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: anExceptionBlock 
    "Remove oldObject from the receiver's elements. If several of the 
    elements are equal to oldObject, only one is removed. If no element is 
    equal to oldObject, answer the result of evaluating anExceptionBlock. 
    Otherwise, answer the argument, oldObject. ArrayedCollections cannot 
    respond to this message."
self subclassResponsibility!
----- Method: Collection>>removeAll (in category 'removing') -----
removeAll
    "Remove each element from the receiver and leave it empty.
    ArrayedCollections cannot respond to this message.
    There are two good reasons why a subclass should override this message:
    1) the subclass does not support being modified while being iterated
    2) the subclass provides a much faster way than iterating through each element"
self do: [:each | self remove: each].!
----- Method: Collection>>removeAll: (in category 'removing') -----
removeAll: aCollection 
    "Remove each element of aCollection from the receiver. If successful for 
    each, answer aCollection. Otherwise create an error notification.
    ArrayedCollections cannot respond to this message."
aCollection == self ifTrue: [^self removeAll].
    aCollection do: [:each | self remove: each].
    ^ aCollection!
----- Method: Collection>>removeAllFoundIn: (in category 'removing') -----
removeAllFoundIn: aCollection 
    "Remove each element of aCollection which is present in the receiver 
    from the receiver. Answer aCollection. No error is raised if an element
    isn't found. ArrayedCollections cannot respond to this message."
aCollection do: [:each | self remove: each ifAbsent: []].
    ^ aCollection!
----- Method: Collection>>removeAllSuchThat: (in category 'removing') -----
removeAllSuchThat: aBlock 
    "Evaluate aBlock for each element and remove all that elements from
    the receiver for that aBlock evaluates to true.  Use a copy to enumerate 
    collections whose order changes when an element is removed (i.e. Sets)."
self copy do: [:each | (aBlock value: each) ifTrue: [self remove: each]]!
----- Method: Collection>>roundTo: (in category 'math functions') -----
roundTo: quantum
    ^self collect: [ :ea | ea roundTo: quantum ]!
----- Method: Collection>>rounded (in category 'math functions') -----
rounded
    ^ self collect: [:a | a rounded]!
----- Method: Collection>>select: (in category 'enumerating') -----
select: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument. 
    Collect into a new collection like the receiver, only those elements for 
    which aBlock evaluates to true. Answer the new collection."
| newCollection |
    newCollection := self species new.
    self do: [:each | (aBlock value: each) ifTrue: [newCollection add: each]].
    ^newCollection!
----- Method: Collection>>select:thenCollect: (in category 'enumerating') -----
select: selectBlock thenCollect: collectBlock
    "Utility method to improve readability."
^ (self select: selectBlock) collect: collectBlock!
----- Method: Collection>>select:thenDo: (in category 'enumerating') -----
select: selectBlock thenDo: doBlock 
    "Utility method to improve readability."
    ^ (self select: selectBlock) do: doBlock!
----- Method: Collection>>sign (in category 'math functions') -----
sign
    ^self collect: [:each | each sign]!
----- Method: Collection>>sin (in category 'math functions') -----
sin
    ^self collect: [:each | each sin]!
----- Method: Collection>>size (in category 'accessing') -----
size
    "Answer how many elements the receiver contains."
| tally |
    tally := 0.
    self do: [:each | tally := tally + 1].
    ^ tally!
----- Method: Collection>>sqrt (in category 'math functions') -----
sqrt
    ^ self collect: [:each | each sqrt]!
----- Method: Collection>>squared (in category 'math functions') -----
squared
    ^ self collect: [:each | each * each]!
----- Method: Collection>>storeOn: (in category 'printing') -----
storeOn: aStream 
    "Refer to the comment in Object|storeOn:."
| noneYet |
    aStream nextPutAll: '(('.
    aStream nextPutAll: self class name.
    aStream nextPutAll: ' new)'.
    noneYet := true.
    self do: 
    	[:each | 
    	noneYet
    		ifTrue: [noneYet := false]
    		ifFalse: [aStream nextPut: $;].
    	aStream nextPutAll: ' add: '.
    	aStream store: each].
    noneYet ifFalse: [aStream nextPutAll: '; yourself'].
    aStream nextPut: $)!
----- Method: Collection>>sum (in category 'math functions') -----
sum
    "This is implemented using a variant of the normal inject:into: pattern. 
    The reason for this is that it is not known whether we're in the normal 
    number line, i.e. whether 0 is a good initial value for the sum. 
    Consider a collection of measurement objects, 0 would be the unitless 
    value and would not be appropriate to add with the unit-ed objects."
    | sum sample |
    sample := self anyOne.
    sum := self inject: sample into: [:accum :each | accum + each].
    ^ sum - sample!
----- Method: Collection>>tan (in category 'math functions') -----
tan
    ^self collect: [:each | each tan]!
----- Method: Collection>>toBraceStack: (in category 'private') -----
toBraceStack: itsSize 
    "Push receiver's elements onto the stack of thisContext sender.  Error if receiver does
     not have itsSize elements or if receiver is unordered.
     Do not call directly: this is called by {a. b} := ... constructs."
self size ~= itsSize ifTrue:
    	[self error: 'Trying to store ', self size printString,
    				' values into ', itsSize printString, ' variables.'].
    thisContext sender push: itsSize fromIndexable: self!
----- Method: Collection>>topologicallySortedUsing: (in category 'converting') -----
topologicallySortedUsing: aSortBlock 
    "Answer a SortedCollection whose elements are the elements of the 
    receiver, but topologically sorted. The topological order is defined 
    by the argument, aSortBlock."
| aSortedCollection |
    aSortedCollection := SortedCollection new: self size.
    aSortedCollection sortBlock: aSortBlock.
    self do: [:each | aSortedCollection addLast: each].	"avoids sorting"
    ^ aSortedCollection sortTopologically
!
----- Method: Collection>>truncated (in category 'math functions') -----
truncated
    ^ self collect: [:a | a truncated]!
----- Method: Collection>>union: (in category 'enumerating') -----
union: aCollection
    "Answer the set theoretic union of two collections."
^ self asSet addAll: aCollection; yourself!
----- Method: Collection>>write: (in category 'filter streaming') -----
write: anObject 
    ^ self add: anObject!
Collection subclass: #Matrix
    instanceVariableNames: 'nrows ncols contents'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!Matrix commentStamp: '<historical>' prior: 0!
I represent a two-dimensional array, rather like Array2D.
There are three main differences between me and Array2D:
(1) Array2D inherits from ArrayedCollection, but isn't one.  A lot of things that should work
    do not work in consequence of this.
(2) Array2D uses "at: column at: row" index order, which means that nothing you write using
    it is likely to work either.  I use the almost universal "at: row at: column" order, so it is
    much easier to adapt code from other languages without going doolally.
(3) Array2D lets you specify the class of the underlying collection, I don't.
Structure:
  nrows : a non-negative integer saying how many rows there are.
  ncols : a non-negative integer saying how many columns there are.
  contents : an Array holding the elements in row-major order.  That is, for a 2x3 array
    the contents are (11 12 13 21 22 23).  Array2D uses column major order.
You can specify the class of 'contents' when you create a new Array2D,
    but Matrix always gives you an Array.
There is a reason for this.  In strongly typed languages like Haskell and Clean,
    'unboxed arrays' save you both space AND time.  But in Squeak, while
    WordArray and FloatArray and so on do save space, it costs time to use them.
    A LOT of time.  I've measured aFloatArray sum running nearly twice as slow as
    anArray sum.  The reason is that whenever you fetch an element from an Array,
    that's all that happens, but when you fetch an element from aFloatArray, a whole
    new Float gets allocated to hold the value.  This takes time and churns memory.
    So the paradox is that if you want fast numerical stuff, DON'T use unboxed arrays!!
Another reason for always insisting on an Array is that letting it be something
    else would make things like #, and #,, rather more complicated.  Always using Array
    is the simplest thing that could possibly work, and it works rather well.
I was trying to patch Array2D to make more things work, but just couldn't get my head
around the subscript order.  That's why I made Matrix.
Element-wise matrix arithmetic works; you can freely mix matrices and numbers but
don't try to mix matrices and arrays (yet).
Matrix multiplication, using the symbol +* (derived from APL's +.x), works between
(Matrix or Array) +* (Matrix or Array).  Don't try to use a number as an argument of +*.
Matrix * Number and Number * Matrix work fine, so you don't need +* with numbers.
Still to come: oodles of stuff.  Gaussian elimination maybe, other stuff probably not.
!
----- Method: Matrix class>>column: (in category 'instance creation') -----
column: aCollection
    "Should this be called #fromColumn:?"
^self rows: aCollection size columns: 1 contents: aCollection asArray shallowCopy!
----- Method: Matrix class>>diagonal: (in category 'instance creation') -----
diagonal: aCollection
    |r i|
    r := self zeros: aCollection size.
    i := 0.
    aCollection do: [:each | i := i+1. r at: i at: i put: each].
    ^r!
----- Method: Matrix class>>identity: (in category 'instance creation') -----
identity: n
    |r|
r := self zeros: n.
    1 to: n do: [:i | r at: i at: i put: 1].
    ^r!
----- Method: Matrix class>>new: (in category 'instance creation') -----
new: dim
    "Answer a dim*dim matrix.  Is this an abuse of #new:?  The argument is NOT a size."
    ^self rows: dim columns: dim!
----- Method: Matrix class>>new:element: (in category 'instance creation') -----
new: dim element: element
    "Answer a dim*dim matrix with all elements set to element.
     Is this an abuse of #new:?  The argument is NOT a size."
^self rows: dim columns: dim element: element!
----- Method: Matrix class>>new:tabulate: (in category 'instance creation') -----
new: dim tabulate: aBlock
    "Answer a dim*dim matrix where it at: i at: j is aBlock value: i value: j."
    ^self rows: dim columns: dim tabulate: aBlock!
----- Method: Matrix class>>ones: (in category 'instance creation') -----
ones: n
    ^self new: n element: 1
!
----- Method: Matrix class>>row: (in category 'instance creation') -----
row: aCollection
    "Should this be called #fromRow:?"
^self rows: 1 columns: aCollection size contents: aCollection asArray shallowCopy!
----- Method: Matrix class>>rows:columns: (in category 'instance creation') -----
rows: rows columns: columns
    ^self rows: rows columns: columns contents: (Array new: rows*columns)!
----- Method: Matrix class>>rows:columns:contents: (in category 'private') -----
rows: rows columns: columns contents: contents
    ^self new rows: rows columns: columns contents: contents!
----- Method: Matrix class>>rows:columns:element: (in category 'instance creation') -----
rows: rows columns: columns element: element
    ^self rows: rows columns: columns
    	contents: ((Array new: rows*columns) atAllPut: element; yourself)!
----- Method: Matrix class>>rows:columns:tabulate: (in category 'instance creation') -----
rows: rows columns: columns tabulate: aBlock
    "Answer a new Matrix of the given dimensions where
     result at: i at: j     is   aBlock value: i value: j"
    |a i|
a := Array new: rows*columns.
    i := 0.
    1 to: rows do: [:row |
    	1 to: columns do: [:column |
    		a at: (i := i+1) put: (aBlock value: row value: column)]].
    ^self rows: rows columns: columns contents: a
!
----- Method: Matrix class>>zeros: (in category 'instance creation') -----
zeros: n
    ^self new: n element: 0!
----- Method: Matrix>>+* (in category 'arithmetic') -----
+* aCollection
    "Premultiply aCollection by self.  aCollection should be an Array or Matrix.
     The name of this method is APL's +.x squished into Smalltalk syntax."
^aCollection preMultiplyByMatrix: self
!
----- Method: Matrix>>, (in category 'copying') -----
, aMatrix
    "Answer a new matrix having the same number of rows as the receiver and aMatrix,
     its columns being the columns of the receiver followed by the columns of aMatrix."
    |newCont newCols anArray oldCols a b c|
self assert: [nrows = aMatrix rowCount].
    newCont := Array new: self size + aMatrix size.
    anArray := aMatrix privateContents.
    oldCols := aMatrix columnCount.
    newCols := ncols + oldCols.
    a := b := c := 1.
    1 to: nrows do: [:r |
    	newCont replaceFrom: a to: a+ncols-1 with: contents startingAt: b.
    	newCont replaceFrom: a+ncols to: a+newCols-1 with: anArray startingAt: c.
    	a := a + newCols.
    	b := b + ncols.
    	c := c + oldCols].
    ^self class rows: nrows columns: newCols contents: newCont
    	
!
----- Method: Matrix>>,, (in category 'copying') -----
,, aMatrix
    "Answer a new matrix having the same number of columns as the receiver and aMatrix,
     its rows being the rows of the receiver followed by the rows of aMatrix."
self assert: [ncols = aMatrix columnCount].
    ^self class rows: nrows + aMatrix rowCount columns: ncols
    	contents: contents , aMatrix privateContents
!
----- Method: Matrix>>= (in category 'comparing') -----
= aMatrix
    ^aMatrix class == self class and: [
     aMatrix rowCount = nrows and: [
     aMatrix columnCount = ncols and: [
     aMatrix privateContents = contents]]]!
----- Method: Matrix>>add: (in category 'adding') -----
add: newObject
    self shouldNotImplement!
----- Method: Matrix>>anyOne (in category 'accessing') -----
anyOne
    ^contents anyOne!
----- Method: Matrix>>asArray (in category 'converting') -----
asArray
    ^contents shallowCopy!
----- Method: Matrix>>asBag (in category 'converting') -----
asBag
    ^contents asBag!
----- Method: Matrix>>asByteArray (in category 'converting') -----
asByteArray
    ^contents asByteArray!
----- Method: Matrix>>asCharacterSet (in category 'converting') -----
asCharacterSet
    ^contents asCharacterSet!
----- Method: Matrix>>asFloatArray (in category 'converting') -----
asFloatArray
    ^contents asFloatArray!
----- Method: Matrix>>asIdentitySet (in category 'converting') -----
asIdentitySet
    ^contents asIdentitySet!
----- Method: Matrix>>asIntegerArray (in category 'converting') -----
asIntegerArray
    ^contents asIntegerArray!
----- Method: Matrix>>asOrderedCollection (in category 'converting') -----
asOrderedCollection
    ^contents asOrderedCollection!
----- Method: Matrix>>asSet (in category 'converting') -----
asSet
    ^contents asSet!
----- Method: Matrix>>asSortedArray (in category 'converting') -----
asSortedArray
    ^contents asSortedArray!
----- Method: Matrix>>asSortedCollection (in category 'converting') -----
asSortedCollection
    ^contents asSortedCollection!
----- Method: Matrix>>asSortedCollection: (in category 'converting') -----
asSortedCollection: aBlock
    ^contents asSortedCollection: aBlock!
----- Method: Matrix>>asWordArray (in category 'converting') -----
asWordArray
    ^contents asWordArray!
----- Method: Matrix>>at:at: (in category 'accessing') -----
at: row at: column
    ^contents at: (self indexForRow: row andColumn: column)!
----- Method: Matrix>>at:at:ifInvalid: (in category 'accessing') -----
at: r at: c ifInvalid: v
    "If r,c is a valid index for this matrix, answer the corresponding element.
     Otherwise, answer v."
(r between: 1 and: nrows) ifFalse: [^v].
    (c between: 1 and: ncols) ifFalse: [^v].
    ^contents at: (r-1)*ncols + c
!
----- Method: Matrix>>at:at:incrementBy: (in category 'accessing') -----
at: row at: column incrementBy: value
    "Array2D>>at:at:add: was the origin of this method, but in Smalltalk add:
     generally suggests adding an element to a collection, not doing a sum.
     This method, and SequenceableCollection>>at:incrementBy: that supports
     it, have been renamed to reveal their intention more clearly."
^contents at: (self indexForRow: row andColumn: column) incrementBy: value!
----- Method: Matrix>>at:at:put: (in category 'accessing') -----
at: row at: column put: value
    ^contents at: (self indexForRow: row andColumn: column) put: value!
----- Method: Matrix>>atAllPut: (in category 'accessing') -----
atAllPut: value
    contents atAllPut: value!
----- Method: Matrix>>atColumn: (in category 'accessing rows/columns') -----
atColumn: column
    |p|
p := (self indexForRow: 1 andColumn: column)-ncols.
    ^(1 to: nrows) collect: [:row | contents at: (p := p+ncols)]
!
----- Method: Matrix>>atColumn:put: (in category 'accessing rows/columns') -----
atColumn: column put: aCollection
    |p|
aCollection size = nrows ifFalse: [self error: 'wrong column size'].
    p := (self indexForRow: 1 andColumn: column)-ncols.
    aCollection do: [:each | contents at: (p := p+ncols) put: each].
    ^aCollection
!
----- Method: Matrix>>atRandom (in category 'accessing') -----
atRandom
    ^contents atRandom
!
----- Method: Matrix>>atRandom: (in category 'accessing') -----
atRandom: aGenerator
    ^contents atRandom: aGenerator!
----- Method: Matrix>>atRow: (in category 'accessing rows/columns') -----
atRow: row
    (row between: 1 and: nrows)
    	ifFalse: [self error: '1st subscript out of range'].
    ^contents copyFrom: (row-1)*ncols+1 to: row*ncols!
----- Method: Matrix>>atRow:put: (in category 'accessing rows/columns') -----
atRow: row put: aCollection
    |p|
aCollection size = ncols ifFalse: [self error: 'wrong row size'].
    p := (self indexForRow: row andColumn: 1)-1.
    aCollection do: [:each | contents at: (p := p+1) put: each].
    ^aCollection!
----- Method: Matrix>>atRows:columns: (in category 'accessing submatrices') -----
atRows: rs columns: cs
    "Answer a Matrix obtained by slicing the receiver.
     rs and cs should be sequenceable collections of positive integers."
^self class rows: rs size columns: cs size tabulate: [:r :c |
    	self at: (rs at: r) at: (cs at: c)]!
----- Method: Matrix>>atRows:to:columns:to: (in category 'accessing submatrices') -----
atRows: r1 to: r2 columns: c1 to: c2
    "Answer a submatrix [r1..r2][c1..c2] of the receiver."
    |rd cd|
rd := r1 - 1.
    cd := c1 - 1.
    ^self class rows: r2-rd columns: c2-cd tabulate: [:r :c| self at: r+rd at: c+cd]
!
----- Method: Matrix>>atRows:to:columns:to:ifInvalid: (in category 'accessing submatrices') -----
atRows: r1 to: r2 columns: c1 to: c2 ifInvalid: element
    "Answer a submatrix [r1..r2][c1..c2] of the receiver.
     Portions of the result outside the bounds of the original matrix
     are filled in with element."
    |rd cd|
rd := r1 - 1.
    cd := c1 - 1.
    ^self class rows: r2-rd columns: c2-cd tabulate: [:r :c| self at: r+rd at: c+cd ifInvalid: element]
!
----- Method: Matrix>>atRows:to:columns:to:put: (in category 'accessing submatrices') -----
atRows: r1 to: r2 columns: c1 to: c2 put: aMatrix
    "Set the [r1..r2][c1..c2] submatrix of the receiver
     from the [1..r2-r1+1][1..c2-c1+1] submatrix of aMatrix.
     As long as aMatrix responds to at:at: and accepts arguments in the range shown,
     we don't care if it is bigger or even if it is a Matrix at all."
    |rd cd|
rd := r1 - 1.
    cd := c1 - 1.
    r1 to: r2 do: [:r |
    	c1 to: c2 do: [:c |
    		self at: r at: c put: (aMatrix at: r-rd at: c-cd)]].
    ^aMatrix
!
----- Method: Matrix>>collect: (in category 'enumerating') -----
collect: aBlock
    "Answer a new matrix with transformed elements; transformations should be independent."
^self class rows: nrows columns: ncols contents: (contents collect: aBlock)!
----- Method: Matrix>>columnCount (in category 'accessing') -----
columnCount
    ^ncols!
----- Method: Matrix>>diagonal (in category 'accessing rows/columns') -----
diagonal
    "Answer (1 to: (nrows min: ncols)) collect: [:i | self at: i at: i]"
    |i|
i := ncols negated.
    ^(1 to: (nrows min: ncols)) collect: [:j | contents at: (i := i + ncols + 1)]!
----- Method: Matrix>>difference: (in category 'enumerating') -----
difference: aCollection
    "Union is in because the result is always a Set.
     Difference and intersection are out because the result is like the receiver,
     and with irregular seleection that cannot be."
    self shouldNotImplement!
----- Method: Matrix>>do: (in category 'enumerating') -----
do: aBlock
    "Pass elements to aBlock one at a time in row-major order."
    contents do: aBlock!
----- Method: Matrix>>hash (in category 'comparing') -----
hash
    "I'm really not sure what would be a good hash function here.
     The essential thing is that it must be compatible with #=, and
     this satisfies that requirement."
^contents hash!
----- Method: Matrix>>identityIncludes: (in category 'testing') -----
identityIncludes: anObject
    ^contents identityIncludes: anObject!
----- Method: Matrix>>identityIndexOf: (in category 'accessing') -----
identityIndexOf: anElement
    ^self identityIndexOf: anElement ifAbsent: [0@0]
!
----- Method: Matrix>>identityIndexOf:ifAbsent: (in category 'accessing') -----
identityIndexOf: anElement ifAbsent: anExceptionBlock
    ^self rowAndColumnForIndex:
    	 (contents identityIndexOf: anElement ifAbsent: [^anExceptionBlock value])
!
----- Method: Matrix>>includes: (in category 'testing') -----
includes: anObject
    ^contents includes: anObject!
----- Method: Matrix>>includesAllOf: (in category 'testing') -----
includesAllOf: aCollection
    ^contents includesAllOf: aCollection!
----- Method: Matrix>>includesAnyOf: (in category 'testing') -----
includesAnyOf: aCollection
    ^contents includesAnyOf: aCollection!
----- Method: Matrix>>indexForRow:andColumn: (in category 'private') -----
indexForRow: row andColumn: column
    (row between: 1 and: nrows)
    	ifFalse: [self error: '1st subscript out of range'].
    (column between: 1 and: ncols)
    	ifFalse: [self error: '2nd subscript out of range'].
    ^(row-1) * ncols + column!
----- Method: Matrix>>indexOf: (in category 'accessing') -----
indexOf: anElement
    "If there are integers r, c such that (self at: r at: c) = anElement,
     answer some such r@c, otherwise answer 0@0.  This kind of perverse
     result is provided by analogy with SequenceableCollection>>indexOf:.
     The order in which the receiver are searched is UNSPECIFIED except
     that it is the same as the order used by #indexOf:ifAbsent: and #readStream."
^self indexOf: anElement ifAbsent: [0@0]
!
----- Method: Matrix>>indexOf:ifAbsent: (in category 'accessing') -----
indexOf: anElement ifAbsent: anExceptionBlock
    "If there are integers r, c such that (self at: r at: c) = anElement,
     answer some such r@c, otherwise answer the result of anExceptionBlock."
^self rowAndColumnForIndex:
    	 (contents indexOf: anElement ifAbsent: [^anExceptionBlock value])
!
----- Method: Matrix>>indicesCollect: (in category 'enumerating') -----
indicesCollect: aBlock
    |r i|
r := Array new: nrows * ncols.
    i := 0.
    1 to: nrows do: [:row |
    	1 to: ncols do: [:column |
    		r at: (i := i+1) put: (aBlock value: row value: column)]].
    ^self class rows: nrows columns: ncols contents: r!
----- Method: Matrix>>indicesDo: (in category 'enumerating') -----
indicesDo: aBlock
    1 to: nrows do: [:row |
    	1 to: ncols do: [:column |
    		aBlock value: row value: column]].!
----- Method: Matrix>>indicesInject:into: (in category 'enumerating') -----
indicesInject: start into: aBlock
    |current|
current := start.
    1 to: nrows do: [:row |
    	1 to: ncols do: [:column |
    		current := aBlock value: current value: row value: column]].
    ^current!
----- Method: Matrix>>intersection: (in category 'enumerating') -----
intersection: aCollection
    "Union is in because the result is always a Set.
     Difference and intersection are out because the result is like the receiver,
     and with irregular seleection that cannot be."
    self shouldNotImplement!
----- Method: Matrix>>isSequenceable (in category 'testing') -----
isSequenceable
    "LIE so that arithmetic on matrices will work.
     What matters for arithmetic is not that there should be random indexing
     but that the structure should be stable and independent of the values of
     the elements.  #isSequenceable is simply the wrong question to ask."
    ^true!
----- Method: Matrix>>occurrencesOf: (in category 'testing') -----
occurrencesOf: anObject
    ^contents occurrencesOf: anObject!
----- Method: Matrix>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    contents := contents copy!
----- Method: Matrix>>preMultiplyByArray: (in category 'arithmetic') -----
preMultiplyByArray: a
    "Answer a +* self where a is an Array."
nrows = 1 ifFalse: [self error: 'dimensions do not conform'].
    ^Matrix rows: a size columns: ncols tabulate: [:row :col |
    	(a at: row) * (contents at: col)]
!
----- Method: Matrix>>preMultiplyByMatrix: (in category 'arithmetic') -----
preMultiplyByMatrix: m
    "Answer m +* self where m is a Matrix."
    |s|
nrows = m columnCount ifFalse: [self error: 'dimensions do not conform'].
    ^Matrix rows: m rowCount columns: ncols tabulate: [:row :col |
    	s := 0.
    	1 to: nrows do: [:k | s := (m at: row at: k) * (self at: k at: col) + s].
    	s]!
----- Method: Matrix>>privateContents (in category 'private') -----
privateContents
    "Only used in #, #,, and #= so far.
     It used to be called #contents, but that clashes with Collection>>contents."
^contents!
----- Method: Matrix>>readStream (in category 'converting') -----
readStream
    "Answer a ReadStream that returns all the elements of the receiver
     in some UNSPECIFIED order."
^ReadStream on: contents!
----- Method: Matrix>>reject: (in category 'enumerating') -----
reject: aBlock
    self shouldNotImplement!
----- Method: Matrix>>remove:ifAbsent: (in category 'removing') -----
remove: anObject ifAbsent: anExceptionBlock
    self shouldNotImplement!
----- Method: Matrix>>removeAll (in category 'removing') -----
removeAll
self shouldNotImplement!
----- Method: Matrix>>replaceAll:with: (in category 'accessing') -----
replaceAll: oldObject with: newObject
    contents replaceAll: oldObject with: newObject!
----- Method: Matrix>>rowAndColumnForIndex: (in category 'private') -----
rowAndColumnForIndex: index
    |t|
t := index - 1.
    ^(t // ncols + 1)@(t \ ncols + 1)!
----- Method: Matrix>>rowCount (in category 'accessing') -----
rowCount
    ^nrows!
----- Method: Matrix>>rows:columns:contents: (in category 'private') -----
rows: rows columns: columns contents: anArray
    self assert: [rows isInteger and: [rows >= 0]].
    self assert: [columns isInteger and: [columns >= 0]].
    self assert: [rows * columns = anArray size].
    nrows := rows.
    ncols := columns.
    contents := anArray.
    ^self!
----- Method: Matrix>>select: (in category 'enumerating') -----
select: aBlock
    self shouldNotImplement!
----- Method: Matrix>>shallowCopy (in category 'copying') -----
shallowCopy
    ^self class rows: nrows columns: ncols contents: contents shallowCopy!
----- Method: Matrix>>shuffled (in category 'copying') -----
shuffled
    ^self class rows: nrows columns: ncols contents: (contents shuffled)!
----- Method: Matrix>>shuffledBy: (in category 'copying') -----
shuffledBy: aRandom
    ^self class rows: nrows columns: ncols contents: (contents shuffledBy: aRandom)!
----- Method: Matrix>>size (in category 'accessing') -----
size
    ^contents size!
----- Method: Matrix>>storeOn: (in category 'printing') -----
storeOn: aStream
    aStream nextPut: $(; nextPutAll: self class name;
    	nextPutAll: ' rows: '; store: nrows;
    	nextPutAll: ' columns: '; store: ncols;
    	nextPutAll: ' contents: '; store: contents;
    	nextPut: $)!
----- Method: Matrix>>swap:at:with:at: (in category 'accessing') -----
swap: r1 at: c1 with: r2 at: c2
    contents swap: (self indexForRow: r1 andColumn: c1)
    		 with: (self indexForRow: r2 andColumn: c2)!
----- Method: Matrix>>swapColumn:withColumn: (in category 'accessing rows/columns') -----
swapColumn: anIndex withColumn: anotherIndex
    |a b|
a := self indexForRow: 1 andColumn: anIndex.
    b := self indexForRow: 1 andColumn: anotherIndex.
    nrows timesRepeat: [
    	contents swap: a with: b.
    	a := a + ncols.
    	b := b + ncols].
!
----- Method: Matrix>>swapRow:withRow: (in category 'accessing rows/columns') -----
swapRow: anIndex withRow: anotherIndex
    |a b|
a := self indexForRow: anIndex andColumn: 1.
    b := self indexForRow: anotherIndex andColumn: 1.
    ncols timesRepeat: [
    	contents swap: a with: b.
    	a := a + 1.
    	b := b + 1].
!
----- Method: Matrix>>transposed (in category 'accessing rows/columns') -----
transposed
    self assert: [nrows = ncols].
    ^self indicesCollect: [:row :column | self at: column at: row]!
----- Method: Matrix>>with:collect: (in category 'enumerating') -----
with: aCollection collect: aBlock
    "aCollection must support #at:at: and be at least as large as the receiver."
^self withIndicesCollect: [:each :row :column |
    	aBlock value: each value: (aCollection at: row at: column)]
!
----- Method: Matrix>>with:do: (in category 'enumerating') -----
with: aCollection do: aBlock
    "aCollection must support #at:at: and be at least as large as the receiver."
self withIndicesDo: [:each :row :column |
    	aBlock value: each value: (aCollection at: row at: column)].
!
----- Method: Matrix>>with:inject:into: (in category 'enumerating') -----
with: aCollection inject: startingValue into: aBlock
    "aCollection must support #at:at: and be at least as large as the receiver."
^self withIndicesInject: startingValue into: [:value :each :row :column |
    	aBlock value: value value: each value: (aCollection at: row at: column)]!
----- Method: Matrix>>withIndicesCollect: (in category 'enumerating') -----
withIndicesCollect: aBlock
    |i r|
i := 0.
    r := contents shallowCopy.
    1 to: nrows do: [:row |
    	1 to: ncols do: [:column |
    		i := i+1.
    		r at: i put: (aBlock value: (r at: i) value: row value: column)]].
    ^self class rows: nrows columns: ncols contents: r
!
----- Method: Matrix>>withIndicesDo: (in category 'enumerating') -----
withIndicesDo: aBlock
    |i|
i := 0.
    1 to: nrows do: [:row |
    	1 to: ncols do: [:column |
    		aBlock value: (contents at: (i := i+1)) value: row value: column]].
!
----- Method: Matrix>>withIndicesInject:into: (in category 'enumerating') -----
withIndicesInject: start into: aBlock
    |i current|
i := 0.
    current := start.
    1 to: nrows do: [:row |
    	1 to: ncols do: [:column |
    		current := aBlock value: current value: (contents at: (i := i+1)) 
    						  value: row value: column]].
    ^current!
Collection subclass: #SequenceableCollection
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Abstract'!
!SequenceableCollection commentStamp: '<historical>' prior: 0!
I am an abstract superclass for collections that have a well-defined order associated with their elements. Thus each element is externally-named by integers referred to as indices.!
SequenceableCollection subclass: #ArrayedCollection
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Abstract'!
!ArrayedCollection commentStamp: '<historical>' prior: 0!
I am an abstract collection of elements with a fixed range of integers (from 1 to n>=0) as external keys.!
ArrayedCollection variableSubclass: #Array
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!Array commentStamp: '<historical>' prior: 0!
I present an ArrayedCollection whose elements are objects.!
----- Method: Array class>>braceStream: (in category 'brace support') -----
braceStream: nElements
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
^ WriteStream basicNew braceArray: (self new: nElements)
!
----- Method: Array class>>braceWith: (in category 'brace support') -----
braceWith: a
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
| array |
    array := self new: 1.
    array at: 1 put: a.
    ^ array!
----- Method: Array class>>braceWith:with: (in category 'brace support') -----
braceWith: a with: b 
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
| array |
    array := self new: 2.
    array at: 1 put: a.
    array at: 2 put: b.
    ^ array!
----- Method: Array class>>braceWith:with:with: (in category 'brace support') -----
braceWith: a with: b with: c 
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
| array |
    array := self new: 3.
    array at: 1 put: a.
    array at: 2 put: b.
    array at: 3 put: c.
    ^ array!
----- Method: Array class>>braceWith:with:with:with: (in category 'brace support') -----
braceWith: a with: b with: c with: d
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
| array |
    array := self new: 4.
    array at: 1 put: a.
    array at: 2 put: b.
    array at: 3 put: c.
    array at: 4 put: d.
    ^ array!
----- Method: Array class>>braceWithNone (in category 'brace support') -----
braceWithNone
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
^ self new: 0!
----- Method: Array class>>new: (in category 'instance creation') -----
new: sizeRequested 
    "Answer an instance of this class with the number of indexable
    variables specified by the argument, sizeRequested.
    
    This is a shortcut (direct call of primitive, no #initialize, for performance"
<primitive: 71>  "This method runs primitively if successful"
    ^ self basicNew: sizeRequested  "Exceptional conditions will be handled in basicNew:"
!
----- Method: Array>>+* (in category 'arithmetic') -----
+* aCollection
    "Premultiply aCollection by self.  aCollection should be an Array or Matrix.
     The name of this method is APL's +.x squished into Smalltalk syntax."
^aCollection preMultiplyByArray: self
!
----- Method: Array>>asArray (in category 'converting') -----
asArray
    "Answer with the receiver itself."
^ self!
----- Method: Array>>atWrap: (in category 'accessing') -----
atWrap: index 
    "Optimized to go through the primitive if possible"
    <primitive: 60>
    ^ self at: index - 1 \ self size + 1!
----- Method: Array>>atWrap:put: (in category 'accessing') -----
atWrap: index put: anObject
    "Optimized to go through the primitive if possible"
    <primitive: 61>
    ^ self at: index - 1 \ self size + 1 put: anObject!
----- Method: Array>>byteEncode: (in category 'filter streaming') -----
byteEncode:aStream
    aStream writeArray:self.
!
----- Method: Array>>copyWithDependent: (in category 'copying') -----
copyWithDependent: newElement
    self size = 0 ifTrue:[^DependentsArray with: newElement].
    ^self copyWith: newElement!
----- Method: Array>>elementsExchangeIdentityWith: (in category 'converting') -----
elementsExchangeIdentityWith: otherArray
    "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  At the same time, all pointers to the elements of otherArray are replaced by pointers to the corresponding elements of this array.  The identityHashes remain with the pointers rather than with the objects so that objects in hashed structures should still be properly indexed after the mutation."
<primitive: 128>
    otherArray class == Array ifFalse: [^ self error: 'arg must be array'].
    self size = otherArray size ifFalse: [^ self error: 'arrays must be same size'].
    (self anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers'].
    (otherArray anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers'].
    self with: otherArray do:[:a :b| a == b ifTrue:[^self error:'can''t become yourself']].
"Must have failed because not enough space in forwarding table (see ObjectMemory-prepareForwardingTableForBecoming:with:twoWay:).  Do GC and try again only once"
    (Smalltalk bytesLeft: true) = Smalltalk primitiveGarbageCollect
    	ifTrue: [^ self primitiveFailed].
    ^ self elementsExchangeIdentityWith: otherArray!
----- Method: Array>>elementsForwardIdentityTo: (in category 'converting') -----
elementsForwardIdentityTo: otherArray
    "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation."
    <primitive: 72>
    self primitiveFailed!
----- Method: Array>>elementsForwardIdentityTo:copyHash: (in category 'converting') -----
elementsForwardIdentityTo: otherArray copyHash: copyHash
    "This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation."
    <primitive: 249>
    self primitiveFailed!
----- Method: Array>>evalStrings (in category 'converting') -----
evalStrings
       "Allows you to construct literal arrays.
    #(true false nil '5@6' 'Set new' '''text string''') evalStrings
    gives an array with true, false, nil, a Point, a Set, and a String
    instead of just a bunch of Symbols"
    | it |
^ self collect: [:each |
        it := each.
        each == #true ifTrue: [it := true].
    	      each == #false ifTrue: [it := false].
        each == #nil ifTrue: [it := nil].
        (each isString and:[each isSymbol not]) ifTrue: [
    		it := Compiler evaluate: each].
        each class == Array ifTrue: [it := it evalStrings].
        it]!
----- Method: Array>>hasLiteral: (in category 'private') -----
hasLiteral: literal
    "Answer true if literal is identical to any literal in this array, even 
    if imbedded in further array structure. This method is only intended 
    for private use by CompiledMethod hasLiteralSymbol:"
| lit |
    1 to: self size do: 
    	[:index | 
    	(lit := self at: index) == literal ifTrue: [^ true].
    	(lit class == Array and: [lit hasLiteral: literal]) ifTrue: [^ true]].
    ^ false!
----- Method: Array>>hasLiteralSuchThat: (in category 'private') -----
hasLiteralSuchThat: testBlock
    "Answer true if testBlock returns true for any literal in this array, even if imbedded in 	further Arrays or CompiledMethods.  This method is only intended for private use by 	CompiledMethod 	hasLiteralSuchThat:"
    | lit |
    1 to: self size do: [:index |
    	(testBlock value: (lit := self at: index)) ifTrue: [^ true].
    	(lit hasLiteralSuchThat: testBlock) ifTrue: [^ true]].
    ^ false!
----- Method: Array>>hasLiteralThorough: (in category 'private') -----
hasLiteralThorough: literal
    "Answer true if literal is identical to any literal in this array, even if imbedded in further array structures or closure methods"
| lit |
    1 to: self size do: [:index |
    	(lit := self at: index) == literal ifTrue: [^ true].
    	(lit hasLiteralThorough: literal) ifTrue: [^ true]].
    ^ false!
----- Method: Array>>hashMappedBy: (in category 'comparing') -----
hashMappedBy: map
    "Answer what my hash would be if oops changed according to map."
self size = 0 ifTrue: [^self hash].
    ^(self first hashMappedBy: map) + (self last hashMappedBy: map)!
----- Method: Array>>isArray (in category 'testing') -----
isArray
    ^true!
----- Method: Array>>isLiteral (in category 'testing') -----
isLiteral
    ^ self allSatisfy: [:each | each isLiteral]!
----- Method: Array>>isSelfEvaluating (in category 'self evaluating') -----
isSelfEvaluating
    ^ (self allSatisfy: [:each | each isSelfEvaluating]) and: [self class == Array]!
----- Method: Array>>literalEqual: (in category 'comparing') -----
literalEqual: other
self class == other class ifFalse: [^ false].
    self size = other size ifFalse: [^ false].
    self with: other do: [:e1 :e2 |
    	(e1 literalEqual: e2) ifFalse: [^ false]].
    ^ true!
----- Method: Array>>objectForDataStream: (in category 'file in/out') -----
objectForDataStream: refStrm
    | dp |
    "I am about to be written on an object file.  If I am one of two shared global arrays, write a proxy instead."
self == (TextConstants at: #DefaultTabsArray) ifTrue: [
    dp := DiskProxy global: #TextConstants selector: #at: args: #(DefaultTabsArray).
    refStrm replace: self with: dp.
    ^ dp].
self == (TextConstants at: #DefaultMarginTabsArray) ifTrue: [
    dp := DiskProxy global: #TextConstants selector: #at: args: #(DefaultMarginTabsArray).
    refStrm replace: self with: dp.
    ^ dp].
^ super objectForDataStream: refStrm!
----- Method: Array>>preMultiplyByArray: (in category 'arithmetic') -----
preMultiplyByArray: a
    "Answer a+*self where a is an Array.  Arrays are always understood as column vectors,
     so an n element Array is an n*1 Array.  This multiplication is legal iff self size = 1."
self size = 1 ifFalse: [self error: 'dimensions do not conform'].
    ^a * self first!
----- Method: Array>>preMultiplyByMatrix: (in category 'arithmetic') -----
preMultiplyByMatrix: m
    "Answer m+*self where m is a Matrix."
    |s|
m columnCount = self size ifFalse: [self error: 'dimensions do not conform'].
    ^(1 to: m rowCount) collect: [:row |
    	s := 0.
    	1 to: self size do: [:k | s := (m at: row at: k) * (self at: k) + s].
    	s]!
----- Method: Array>>printAsLiteralFormOn: (in category 'self evaluating') -----
printAsLiteralFormOn: aStream
    aStream nextPut: $#.
    self printElementsOn: aStream
!
----- Method: Array>>printAsSelfEvaluatingFormOn: (in category 'self evaluating') -----
printAsSelfEvaluatingFormOn: aStream
aStream nextPut: ${.
    self do: [:el | aStream print: el] separatedBy: [ aStream nextPutAll: ' . '].
    aStream nextPut: $}!
----- Method: Array>>printOn: (in category 'printing') -----
printOn: aStream
    self isLiteral ifTrue: [self printAsLiteralFormOn: aStream. ^ self].
    self isSelfEvaluating ifTrue: [self printAsSelfEvaluatingFormOn: aStream. ^ self].
super printOn: aStream!
----- Method: Array>>replaceFrom:to:with:startingAt: (in category 'private') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
    <primitive: 105>
    super replaceFrom: start to: stop with: replacement startingAt: repStart!
----- Method: Array>>storeOn: (in category 'printing') -----
storeOn: aStream 
    "Use the literal form if possible."
self isLiteral
    	ifTrue: 
    		[aStream nextPut: $#; nextPut: $(.
    		self do: 
    			[:element | 
    			element printOn: aStream.
    			aStream space].
    		aStream nextPut: $)]
    	ifFalse: [super storeOn: aStream]!
----- Method: Array>>storeOnStream: (in category 'filter streaming') -----
storeOnStream:aStream
    self isLiteral ifTrue: [super storeOnStream:aStream] ifFalse:[aStream writeCollection:self].
!
Array weakSubclass: #WeakArray
    instanceVariableNames: ''
    classVariableNames: 'FinalizationDependents FinalizationLock FinalizationProcess FinalizationSemaphore IsFinalizationSupported'
    poolDictionaries: ''
    category: 'Collections-Weak'!
!WeakArray commentStamp: '<historical>' prior: 0!
WeakArray is an array which holds only weakly on its elements. This means whenever an object is only referenced by instances of WeakArray it will be garbage collected.!
----- Method: WeakArray class>>addWeakDependent: (in category 'accessing') -----
addWeakDependent: anObject
    | finished index weakDependent |
    self isFinalizationSupported ifFalse:[^self].
    FinalizationLock critical:[
    	finished := false.
    	index := 0.
    	[index := index + 1.
    	finished not and:[index <= FinalizationDependents size]] whileTrue:[
    		weakDependent := FinalizationDependents at: index.
    		weakDependent isNil ifTrue:[
    			FinalizationDependents at: index put: anObject.
    			finished := true.
    		].
    	].
    	finished ifFalse:[
    		"Grow linearly"
    		FinalizationDependents := FinalizationDependents, (WeakArray new: 10).
    		FinalizationDependents at: index put: anObject.
    	].
    ] ifError:[:msg :rcvr| rcvr error: msg].!
----- Method: WeakArray class>>finalizationProcess (in category 'private') -----
finalizationProcess
[true] whileTrue:
    	[FinalizationSemaphore wait.
    	FinalizationLock critical:
    		[FinalizationDependents do:
    			[:weakDependent |
    			weakDependent ifNotNil:
    				[weakDependent finalizeValues.
    				"***Following statement is required to keep weakDependent
    				from holding onto its value as garbage.***"
    				weakDependent := nil]]]
    		ifError:
    		[:msg :rcvr | rcvr error: msg].
    	].
!
----- Method: WeakArray class>>initialize (in category 'class initialization') -----
initialize
    "WeakArray initialize"
"Do we need to initialize specialObjectsArray?"
    Smalltalk specialObjectsArray size < 42 
    	ifTrue:[Smalltalk recreateSpecialObjectsArray].
Smalltalk addToStartUpList: self.
    self restartFinalizationProcess.!
----- Method: WeakArray class>>isFinalizationSupported (in category 'accessing') -----
isFinalizationSupported
    "Check if this VM supports the finalization mechanism"
    | tempObject |
    IsFinalizationSupported ifNotNil:[^IsFinalizationSupported].
    tempObject := WeakArray new: 1.
    "Check if the class format 4 is correctly understood by the VM.
    If the weak class support is not installed then the VM will report
    any weak class as containing 32bit words - not pointers"
    (tempObject at: 1) = nil 
    	ifFalse:[^IsFinalizationSupported :=false].
    "Check if objects are correctly freed"
    self pvtCreateTemporaryObjectIn: tempObject.
    Smalltalk garbageCollect.
    ^IsFinalizationSupported := (tempObject at: 1) == nil!
----- Method: WeakArray class>>pvtCreateTemporaryObjectIn: (in category 'private') -----
pvtCreateTemporaryObjectIn: tempObject
    "We have to create the temporary object in a separate stack frame"
    tempObject at: 1 put: Object new!
----- Method: WeakArray class>>removeWeakDependent: (in category 'accessing') -----
removeWeakDependent: anObject
    self isFinalizationSupported ifFalse:[^self].
    FinalizationLock critical:[
    	1 to: FinalizationDependents size do:[:i|
    		((FinalizationDependents at: i) == anObject) ifTrue:[
    			FinalizationDependents at: i put: nil.
    		].
    	].
    ] ifError:[:msg :rcvr| rcvr error: msg].!
----- Method: WeakArray class>>restartFinalizationProcess (in category 'private') -----
restartFinalizationProcess
    "kill any old process, just in case"
    FinalizationProcess
    	ifNotNil: [FinalizationProcess terminate.
    		FinalizationProcess := nil].
"Check if Finalization is supported by this VM"
    IsFinalizationSupported := nil.
    self isFinalizationSupported
    	ifFalse: [^ self].
FinalizationSemaphore := Smalltalk specialObjectsArray at: 42.
    FinalizationDependents ifNil: [FinalizationDependents := WeakArray new: 10].
    FinalizationLock := Semaphore forMutualExclusion.
    FinalizationProcess := [self finalizationProcess]
    	forkAt: Processor userInterruptPriority!
----- Method: WeakArray class>>runningFinalizationProcess (in category 'accessing') -----
runningFinalizationProcess
    "Answer the FinalizationProcess I am running, if any"
    ^FinalizationProcess!
----- Method: WeakArray class>>startUp: (in category 'system startup') -----
startUp: resuming
    resuming ifFalse: [ ^self ].
    self restartFinalizationProcess.!
----- Method: ArrayedCollection class>>new (in category 'instance creation') -----
new
    "Answer a new instance of me, with size = 0."
^self new: 0!
----- Method: ArrayedCollection class>>new:withAll: (in category 'instance creation') -----
new: size withAll: value 
    "Answer an instance of me, with number of elements equal to size, each 
    of which refers to the argument, value."
^(self new: size) atAllPut: value!
----- Method: ArrayedCollection class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
    | newArray |
    newArray := self new: aCollection size.
    1 to: aCollection size do: [:i | newArray at: i put: (aCollection at: i)].
    ^ newArray
"	Array newFrom: {1. 2. 3}
    {1. 2. 3} as: Array
    {1. 2. 3} as: ByteArray
    {$c. $h. $r} as: String
    {$c. $h. $r} as: Text
"!
----- Method: ArrayedCollection class>>newFromStream: (in category 'instance creation') -----
newFromStream: s
    "Only meant for my subclasses that are raw bits and word-like.  For quick unpack form the disk."
    | len |
self isPointers | self isWords not ifTrue: [^ super newFromStream: s].
    	"super may cause an error, but will not be called."
s next = 16r80 ifTrue:
    	["A compressed format.  Could copy what BitMap does, or use a 
    	special sound compression format.  Callers normally compress their own way."
    	^ self error: 'not implemented'].
    s skip: -1.
    len := s nextInt32.
    ^ s nextWordsInto: (self basicNew: len)!
----- Method: ArrayedCollection class>>with: (in category 'instance creation') -----
with: anObject 
    "Answer a new instance of me, containing only anObject."
| newCollection |
    newCollection := self new: 1.
    newCollection at: 1 put: anObject.
    ^newCollection!
----- Method: ArrayedCollection class>>with:with: (in category 'instance creation') -----
with: firstObject with: secondObject 
    "Answer a new instance of me, containing firstObject and secondObject."
| newCollection |
    newCollection := self new: 2.
    newCollection at: 1 put: firstObject.
    newCollection at: 2 put: secondObject.
    ^newCollection!
----- Method: ArrayedCollection class>>with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject 
    "Answer a new instance of me, containing only the three arguments as
    elements."
| newCollection |
    newCollection := self new: 3.
    newCollection at: 1 put: firstObject.
    newCollection at: 2 put: secondObject.
    newCollection at: 3 put: thirdObject.
    ^newCollection!
----- Method: ArrayedCollection class>>with:with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject with: fourthObject 
    "Answer a new instance of me, containing only the three arguments as
    elements."
| newCollection |
    newCollection := self new: 4.
    newCollection at: 1 put: firstObject.
    newCollection at: 2 put: secondObject.
    newCollection at: 3 put: thirdObject.
    newCollection at: 4 put: fourthObject.
    ^newCollection!
----- Method: ArrayedCollection class>>with:with:with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject
    "Answer a new instance of me, containing only the five arguments as
    elements."
| newCollection |
    newCollection := self new: 5.
    newCollection at: 1 put: firstObject.
    newCollection at: 2 put: secondObject.
    newCollection at: 3 put: thirdObject.
    newCollection at: 4 put: fourthObject.
    newCollection at: 5 put: fifthObject.
    ^newCollection!
----- Method: ArrayedCollection class>>with:with:with:with:with:with: (in category 'instance creation') -----
with: firstObject with: secondObject with: thirdObject with: fourthObject with: fifthObject with: sixthObject
    "Answer a new instance of me, containing only the 6 arguments as elements."
| newCollection |
    newCollection := self new: 6.
    newCollection at: 1 put: firstObject.
    newCollection at: 2 put: secondObject.
    newCollection at: 3 put: thirdObject.
    newCollection at: 4 put: fourthObject.
    newCollection at: 5 put: fifthObject.
    newCollection at: 6 put: sixthObject.
    ^ newCollection!
----- Method: ArrayedCollection class>>withAll: (in category 'instance creation') -----
withAll: aCollection
    "Create a new collection containing all the elements from aCollection."
^ (self new: aCollection size) replaceFrom: 1 to: aCollection size with: aCollection!
----- Method: ArrayedCollection>>add: (in category 'adding') -----
add: newObject
    self shouldNotImplement!
----- Method: ArrayedCollection>>asSortedArray (in category 'sorting') -----
asSortedArray
    self isSorted ifTrue: [^ self asArray].
    ^ super asSortedArray!
----- Method: ArrayedCollection>>byteSize (in category 'objects from disk') -----
byteSize
    ^self basicSize * self bytesPerBasicElement
!
----- Method: ArrayedCollection>>bytesPerBasicElement (in category 'objects from disk') -----
bytesPerBasicElement
    "Answer the number of bytes that each of my basic elements requires.
    In other words:
    	self basicSize * self bytesPerBasicElement
    should equal the space required on disk by my variable sized representation."
    ^self class isBytes ifTrue: [ 1 ] ifFalse: [ 4 ]!
----- Method: ArrayedCollection>>bytesPerElement (in category 'objects from disk') -----
bytesPerElement
    ^self class isBytes ifTrue: [ 1 ] ifFalse: [ 4 ].
!
----- Method: ArrayedCollection>>defaultElement (in category 'private') -----
defaultElement
^nil!
----- Method: ArrayedCollection>>flattenOnStream: (in category 'filter streaming') -----
flattenOnStream: aStream 
    aStream writeArrayedCollection: self!
----- Method: ArrayedCollection>>isSorted (in category 'sorting') -----
isSorted
    "Return true if the receiver is sorted by the given criterion.
    Optimization for isSortedBy: [:a :b | a <= b]."
| lastElm elm |
    self isEmpty ifTrue: [^ true].
    lastElm := self first.
    2 to: self size do: 
    	[:index | 
    	elm := self at: index.
    	lastElm <= elm ifFalse: [^ false].
    	lastElm := elm].
    ^ true!
----- Method: ArrayedCollection>>isSortedBy: (in category 'sorting') -----
isSortedBy: aBlock
    "Return true if the receiver is sorted by the given criterion."
| lastElm elm |
    self isEmpty ifTrue: [^ true].
    lastElm := self first.
    2 to: self size do: 
    	[:index | 
    	elm := self at: index.
    	(aBlock value: lastElm value: elm) ifFalse: [^ false].
    	lastElm := elm].
    ^ true!
----- Method: ArrayedCollection>>mergeFirst:middle:last:into:by: (in category 'sorting') -----
mergeFirst: first middle: middle last: last into: dst by: aBlock
    "Private. Merge the sorted ranges [first..middle] and [middle+1..last] 
    of the receiver into the range [first..last] of dst."
| i1 i2 val1 val2 out |
    i1 := first.
    i2 := middle + 1.
    val1 := self at: i1.
    val2 := self at: i2.
    out := first - 1.  "will be pre-incremented"
"select 'lower' half of the elements based on comparator"
    [(i1 <= middle) and: [i2 <= last]] whileTrue:
    	[(aBlock value: val1 value: val2)
    		ifTrue: [dst at: (out := out + 1) put: val1.
    				val1 := self at: (i1 := i1 + 1)]
    		ifFalse: [dst at: (out := out + 1) put: val2.
    				i2 := i2 + 1.
    				i2 <= last ifTrue: [val2 := self at: i2]]].
"copy the remaining elements"
    i1 <= middle
    	ifTrue: [dst replaceFrom: out + 1 to: last with: self startingAt: i1]
    	ifFalse: [dst replaceFrom: out + 1 to: last with: self startingAt: i2]!
----- Method: ArrayedCollection>>mergeSortFrom:to:by: (in category 'sorting') -----
mergeSortFrom: startIndex to: stopIndex by: aBlock
    "Sort the given range of indices using the mergesort algorithm.
    Mergesort is a worst-case O(N log N) sorting algorithm that usually
    does only half as many comparisons as heapsort or quicksort."
"Details: recursively split the range to be sorted into two halves,
    mergesort each half, then merge the two halves together. An extra 
    copy of the data is used as temporary storage and successive merge 
    phases copy data back and forth between the receiver and this copy.
    The recursion is set up so that the final merge is performed into the
    receiver, resulting in the receiver being completely sorted."
self size <= 1 ifTrue: [^ self].  "nothing to do"
    startIndex = stopIndex ifTrue: [^ self].
    self assert: [startIndex >= 1 and: [startIndex < stopIndex]]. "bad start index"
    self assert: [stopIndex <= self size]. "bad stop index"
    self
    	mergeSortFrom: startIndex
    	to: stopIndex 
    	src: self clone 
    	dst: self 
    	by: aBlock!
----- Method: ArrayedCollection>>mergeSortFrom:to:src:dst:by: (in category 'sorting') -----
mergeSortFrom: first to: last src: src dst: dst by: aBlock
    "Private. Split the range to be sorted in half, sort each half, and 
    merge the two half-ranges into dst."
| middle |
    first = last ifTrue: [^ self].
    middle := (first + last) // 2.
    self mergeSortFrom: first to: middle src: dst dst: src by: aBlock.
    self mergeSortFrom: middle + 1 to: last src: dst dst: src by: aBlock.
    src mergeFirst: first middle: middle last: last into: dst by: aBlock!
----- Method: ArrayedCollection>>removeAll (in category 'removing') -----
removeAll
self shouldNotImplement!
----- Method: ArrayedCollection>>restoreEndianness (in category 'objects from disk') -----
restoreEndianness
    "This word object was just read in from a stream.  It was stored in Big Endian (Mac) format.  Reverse the byte order if the current machine is Little Endian.
    We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
self class isPointers | self class isWords not ifTrue: [^self].
    SmalltalkImage current  isLittleEndian 
    	ifTrue: 
    		[Bitmap 
    			swapBytesIn: self
    			from: 1
    			to: self basicSize]!
----- Method: ArrayedCollection>>size (in category 'accessing') -----
size
    "Answer how many elements the receiver contains."
<primitive: 62>
    ^ self basicSize!
----- Method: ArrayedCollection>>sort (in category 'sorting') -----
sort
    "Sort this array into ascending order using the '<=' operator."
self sort: [:a :b | a <= b]!
----- Method: ArrayedCollection>>sort: (in category 'sorting') -----
sort: aSortBlock 
    "Sort this array using aSortBlock. The block should take two arguments
    and return true if the first element should preceed the second one."
self
    	mergeSortFrom: 1
    	to: self size
    	by: aSortBlock!
----- Method: ArrayedCollection>>storeElementsFrom:to:on: (in category 'private') -----
storeElementsFrom: firstIndex to: lastIndex on: aStream
| noneYet defaultElement arrayElement |
    noneYet := true.
    defaultElement := self defaultElement.
    firstIndex to: lastIndex do: 
    	[:index | 
    	arrayElement := self at: index.
    	arrayElement = defaultElement
    		ifFalse: 
    			[noneYet
    				ifTrue: [noneYet := false]
    				ifFalse: [aStream nextPut: $;].
    			aStream nextPutAll: ' at: '.
    			aStream store: index.
    			aStream nextPutAll: ' put: '.
    			aStream store: arrayElement]].
    ^noneYet!
----- Method: ArrayedCollection>>storeOn: (in category 'printing') -----
storeOn: aStream
aStream nextPutAll: '(('.
    aStream nextPutAll: self class name.
    aStream nextPutAll: ' new: '.
    aStream store: self size.
    aStream nextPut: $).
    (self storeElementsFrom: 1 to: self size on: aStream)
    	ifFalse: [aStream nextPutAll: '; yourself'].
    aStream nextPut: $)!
----- Method: ArrayedCollection>>swapHalves (in category 'objects from disk') -----
swapHalves
    	"A normal switch in endianness (byte order in words) reverses the order of 4 bytes.  That is not correct for SoundBuffers, which use 2-bytes units.  If a normal switch has be done, this method corrects it further by swapping the two halves of the long word.
    This method is only used for 16-bit quanities in SoundBuffer, ShortIntegerArray, etc."
| hack blt |
    "The implementation is a hack, but fast for large ranges"
    hack := Form new hackBits: self.
    blt := (BitBlt toForm: hack) sourceForm: hack.
    blt combinationRule: Form reverse.  "XOR"
    blt sourceY: 0; destY: 0; height: self size; width: 2.
    blt sourceX: 0; destX: 2; copyBits.  "Exchange bytes 0&1 with 2&3"
    blt sourceX: 2; destX: 0; copyBits.
    blt sourceX: 0; destX: 2; copyBits.!
----- Method: ArrayedCollection>>writeOn: (in category 'objects from disk') -----
writeOn: aStream 
    "Store the array of bits onto the argument, aStream.  (leading byte ~= 16r80) identifies this as raw bits (uncompressed).  Always store in Big Endian (Mac) byte order.  Do the writing at BitBlt speeds. We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
    self class isPointers | self class isWords not ifTrue: [^ super writeOn: aStream].
    			"super may cause an error, but will not be called."
    aStream nextInt32Put: self basicSize.
    aStream nextWordsPutAll: self.!
----- Method: ArrayedCollection>>writeOnGZIPByteStream: (in category 'objects from disk') -----
writeOnGZIPByteStream: aStream 
    "We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
self class isPointers | self class isWords not ifTrue: [^ super writeOnGZIPByteStream: aStream].
    	"super may cause an error, but will not be called."
    
    aStream nextPutAllWordArray: self!
ArrayedCollection variableByteSubclass: #ByteArray
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!ByteArray commentStamp: '<historical>' prior: 0!
I represent an ArrayedCollection whose elements are integers between 0 and 255.
!
----- Method: ByteArray class>>hashBytes:startingWith: (in category 'byte based hash') -----
hashBytes: aByteArray startingWith: speciesHash
    "Answer the hash of a byte-indexed collection,
    using speciesHash as the initial value.
    See SmallInteger>>hashMultiply.
The primitive should be renamed at a
    suitable point in the future"
| byteArraySize hash low |
    <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'>
self var: #aHash declareC: 'int speciesHash'.
    self var: #aByteArray declareC: 'unsigned char *aByteArray'.
byteArraySize := aByteArray size.
    hash := speciesHash bitAnd: 16rFFFFFFF.
    1 to: byteArraySize do: [:pos |
    	hash := hash + (aByteArray basicAt: pos).
    	"Begin hashMultiply"
    	low := hash bitAnd: 16383.
    	hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
    ].
    ^ hash!
----- Method: ByteArray>>asByteArray (in category 'converting') -----
asByteArray
    ^ self!
----- Method: ByteArray>>asByteArrayPointer (in category 'private') -----
asByteArrayPointer
    "Return a ByteArray describing a pointer to the contents of the receiver."
    ^self shouldNotImplement!
----- Method: ByteArray>>asString (in category 'converting') -----
asString
    "Convert to a String with Characters for each byte.
    Fast code uses primitive that avoids character conversion"
^ (String new: self size) replaceFrom: 1 to: self size with: self!
----- Method: ByteArray>>asWideString (in category 'accessing') -----
asWideString
^ WideString fromByteArray: self.
!
----- Method: ByteArray>>atAllPut: (in category 'accessing') -----
atAllPut: value
    "Fill the receiver with the given value"
<primitive: 145>
    super atAllPut: value!
----- Method: ByteArray>>base64Encoded (in category 'converting') -----
base64Encoded
    "Encode the receiver as base64"
    "'Hello World' asByteArray base64Encoded"
    ^(Base64MimeConverter mimeEncode: self readStream) contents!
----- Method: ByteArray>>byteAt: (in category 'accessing') -----
byteAt: index
    <primitive: 60>
    ^self at: index!
----- Method: ByteArray>>byteAt:put: (in category 'accessing') -----
byteAt: index put: value
    <primitive: 61>
    ^self at: index put: value!
----- Method: ByteArray>>byteSize (in category 'accessing') -----
byteSize
    ^self size!
----- Method: ByteArray>>bytesPerElement (in category 'accessing') -----
bytesPerElement
    "Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
    ^ 1!
----- Method: ByteArray>>defaultElement (in category 'private') -----
defaultElement
^0!
----- Method: ByteArray>>doubleAt:bigEndian: (in category 'platform independent access') -----
doubleAt: index bigEndian: bool 
    "Return a 64 bit float starting from the given byte index"
    | w1 w2 dbl |
    w1 := self unsignedLongAt: index bigEndian: bool.
    w2 := self unsignedLongAt: index + 4 bigEndian: bool.
    dbl := Float new: 2. 
    bool
    	ifTrue: [dbl basicAt: 1 put: w1.
    		dbl basicAt: 2 put: w2]
    	ifFalse: [dbl basicAt: 1 put: w2.
    		dbl basicAt: 2 put: w1].
    ^ dbl!
----- Method: ByteArray>>doubleAt:put:bigEndian: (in category 'platform independent access') -----
doubleAt: index put: value bigEndian: bool 
    "Store a 64 bit float starting from the given byte index"
    | w1 w2 |
    bool
    	ifTrue: [w1 := value basicAt: 1.
    		w2 := value basicAt: 2]
    	ifFalse: [w1 := value basicAt: 2.
    		w2 := value basicAt: 1]. 
    self unsignedLongAt: index put: w1 bigEndian: bool.
    self unsignedLongAt: index + 4 put: w2 bigEndian: bool.
    ^ value!
----- Method: ByteArray>>hash (in category 'comparing') -----
hash
    "#hash is implemented, because #= is implemented"
^self class
    	hashBytes: self
    	startingWith: self species hash!
----- Method: ByteArray>>lastIndexOfPKSignature: (in category 'zip archive') -----
lastIndexOfPKSignature: aSignature
    "Answer the last index in me where aSignature (4 bytes long) occurs, or 0 if not found"
    | a b c d |
    a := aSignature first.
    b := aSignature second.
    c := aSignature third.
    d := aSignature fourth.
    (self size - 3) to: 1 by: -1 do: [ :i |
    	(((self at: i) = a)
    		and: [ ((self at: i + 1) = b)
    			and: [ ((self at: i + 2) = c)
    				and: [ ((self at: i + 3) = d) ]]])
    					ifTrue: [ ^i ]
    ].
    ^0!
----- Method: ByteArray>>longAt:bigEndian: (in category 'platform independent access') -----
longAt: index bigEndian: aBool
    "Return a 32bit integer quantity starting from the given byte index"
    | b0 b1 b2 w h |
    aBool ifTrue:[
    	b0 := self at: index.
    	b1 := self at: index+1.
    	b2 := self at: index+2.
    	w := self at: index+3.
    ] ifFalse:[
    	w := self at: index.
    	b2 := self at: index+1.
    	b1 := self at: index+2.
    	b0 := self at: index+3.
    ].
    "Minimize LargeInteger arithmetic"
    h := ((b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80) bitShift: 8) + b1.
    b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w].
    h = 0 ifFalse:[w := (h bitShift: 16) + w].
    ^w!
----- Method: ByteArray>>longAt:put:bigEndian: (in category 'platform independent access') -----
longAt: index put: value bigEndian: aBool
    "Return a 32bit integer quantity starting from the given byte index"
    | b0 b1 b2 b3 |
    b0 := value bitShift: -24.
    b0 := (b0 bitAnd: 16r7F) - (b0 bitAnd: 16r80).
    b0 < 0 ifTrue:[b0 := 256 + b0].
    b1 := (value bitShift: -16) bitAnd: 255.
    b2 := (value bitShift: -8) bitAnd: 255.
    b3 := value bitAnd: 255.
    aBool ifTrue:[
    	self at: index put: b0.
    	self at: index+1 put: b1.
    	self at: index+2 put: b2.
    	self at: index+3 put: b3.
    ] ifFalse:[
    	self at: index put: b3.
    	self at: index+1 put: b2.
    	self at: index+2 put: b1.
    	self at: index+3 put: b0.
    ].
    ^value!
----- Method: ByteArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
    <primitive: 105>
    super replaceFrom: start to: stop with: replacement startingAt: repStart!
----- Method: ByteArray>>shortAt:bigEndian: (in category 'platform independent access') -----
shortAt: index bigEndian: aBool
    "Return a 16 bit integer quantity starting from the given byte index"
    | uShort |
    uShort := self unsignedShortAt: index bigEndian: aBool.
    ^(uShort bitAnd: 16r7FFF) - (uShort bitAnd: 16r8000)!
----- Method: ByteArray>>shortAt:put:bigEndian: (in category 'platform independent access') -----
shortAt: index put: value bigEndian: aBool
    "Store a 16 bit integer quantity starting from the given byte index"
    self unsignedShortAt: index put: (value bitAnd: 16r7FFF) - (value bitAnd: -16r8000) bigEndian: aBool.
    ^value!
----- Method: ByteArray>>unsignedLongAt:bigEndian: (in category 'platform independent access') -----
unsignedLongAt: index bigEndian: aBool
    "Return a 32bit unsigned integer quantity starting from the given byte index"
    | b0 b1 b2 w |
    aBool ifTrue:[
    	b0 := self at: index.
    	b1 := self at: index+1.
    	b2 := self at: index+2.
    	w := self at: index+3.
    ] ifFalse:[
    	w := self at: index.
    	b2 := self at: index+1.
    	b1 := self at: index+2.
    	b0 := self at: index+3.
    ].
    "Minimize LargeInteger arithmetic"
    b2 = 0 ifFalse:[w := (b2 bitShift: 8) + w].
    b1 = 0 ifFalse:[w := (b1 bitShift: 16) + w].
    b0 = 0 ifFalse:[w := (b0 bitShift: 24) + w].
    ^w!
----- Method: ByteArray>>unsignedLongAt:put:bigEndian: (in category 'platform independent access') -----
unsignedLongAt: index put: value bigEndian: aBool
    "Store a 32bit unsigned integer quantity starting from the given byte index"
    | b0 b1 b2 b3 |
    b0 := value bitShift: -24.
    b1 := (value bitShift: -16) bitAnd: 255.
    b2 := (value bitShift: -8) bitAnd: 255.
    b3 := value bitAnd: 255.
    aBool ifTrue:[
    	self at: index put: b0.
    	self at: index+1 put: b1.
    	self at: index+2 put: b2.
    	self at: index+3 put: b3.
    ] ifFalse:[
    	self at: index put: b3.
    	self at: index+1 put: b2.
    	self at: index+2 put: b1.
    	self at: index+3 put: b0.
    ].
    ^value!
----- Method: ByteArray>>unsignedShortAt:bigEndian: (in category 'platform independent access') -----
unsignedShortAt: index bigEndian: aBool
    "Return a 16 bit unsigned integer quantity starting from the given byte index"
    ^aBool 
    	ifTrue:[((self at: index) bitShift: 8) + (self at: index+1)]
    	ifFalse:[((self at: index+1) bitShift: 8) + (self at: index)].!
----- Method: ByteArray>>unsignedShortAt:put:bigEndian: (in category 'platform independent access') -----
unsignedShortAt: index put: value bigEndian: aBool
    "Store a 16 bit unsigned integer quantity starting from the given byte index"
    aBool ifTrue:[
    	self at: index put: (value bitShift: -8).
    	self at: index+1 put: (value bitAnd: 255).
    ] ifFalse:[
    	self at: index+1 put: (value bitShift: -8).
    	self at: index put: (value bitAnd: 255).
    ].
    ^value!
ArrayedCollection variableWordSubclass: #ColorArray
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
----- Method: ColorArray>>asColorArray (in category 'converting') -----
asColorArray
    ^self!
----- Method: ColorArray>>at: (in category 'accessing') -----
at: index
    ^(super at: index) asColorOfDepth: 32!
----- Method: ColorArray>>at:put: (in category 'accessing') -----
at: index put: aColor
    ^super at: index put: (aColor pixelWordForDepth: 32).!
----- Method: ColorArray>>bytesPerElement (in category 'converting') -----
bytesPerElement
^4!
ArrayedCollection variableWordSubclass: #FloatArray
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!FloatArray commentStamp: '<historical>' prior: 0!
FloatArrays store 32bit IEEE floating point numbers.!
----- Method: FloatArray>>* (in category 'arithmetic') -----
* anObject
    ^self clone *= anObject!
----- Method: FloatArray>>*= (in category 'arithmetic') -----
*= anObject
    ^anObject isNumber
    	ifTrue:[self primMulScalar: anObject asFloat]
    	ifFalse:[self primMulArray: anObject]!
----- Method: FloatArray>>+ (in category 'arithmetic') -----
+ anObject
    ^self clone += anObject!
----- Method: FloatArray>>+= (in category 'arithmetic') -----
+= anObject
    ^anObject isNumber
    	ifTrue:[self primAddScalar: anObject asFloat]
    	ifFalse:[self primAddArray: anObject]!
----- Method: FloatArray>>- (in category 'arithmetic') -----
- anObject
    ^self clone -= anObject!
----- Method: FloatArray>>-= (in category 'arithmetic') -----
-= anObject
    ^anObject isNumber
    	ifTrue:[self primSubScalar: anObject asFloat]
    	ifFalse:[self primSubArray: anObject]!
----- Method: FloatArray>>/ (in category 'arithmetic') -----
/ anObject
    ^self clone /= anObject!
----- Method: FloatArray>>/= (in category 'arithmetic') -----
/= anObject
    ^anObject isNumber
    	ifTrue:[self primDivScalar: anObject asFloat]
    	ifFalse:[self primDivArray: anObject]!
----- Method: FloatArray>>= (in category 'comparing') -----
= aFloatArray 
    | length |
    <primitive: 'primitiveEqual' module: 'FloatArrayPlugin'>
    aFloatArray class = self class ifFalse: [^ false].
    length := self size.
    length = aFloatArray size ifFalse: [^ false].
    1 to: self size do: [:i | (self at: i)
    		= (aFloatArray at: i) ifFalse: [^ false]].
    ^ true!
----- Method: FloatArray>>\= (in category 'arithmetic') -----
\= other
other isNumber ifTrue: [
    	1 to: self size do: [:i |
    		self at: i put: (self at: i) \ other
    	].
    	^ self.
    ].
    1 to: (self size min: other size) do: [:i |
    	self at: i put: (self at: i) \ (other at: i).
    ].
!
----- Method: FloatArray>>adaptToNumber:andSend: (in category 'arithmetic') -----
adaptToNumber: rcvr andSend: selector
    "If I am involved in arithmetic with a Number. If possible,
    convert it to a float and perform the (more efficient) primitive operation."
    selector == #+ ifTrue:[^self + rcvr].
    selector == #* ifTrue:[^self * rcvr].
    selector == #- ifTrue:[^self negated += rcvr].
    selector == #/ ifTrue:[
    	"DO NOT USE TRIVIAL CODE
    		^self reciprocal * rcvr
    	BECAUSE OF GRADUAL UNDERFLOW
    	self should: (1.0e-39 / (FloatArray with: 1.0e-39)) first < 2."
    		^(self class new: self size withAll: rcvr) / self
    	].
    ^super adaptToNumber: rcvr andSend: selector!
----- Method: FloatArray>>asFloatArray (in category 'converting') -----
asFloatArray
    ^self!
----- Method: FloatArray>>at: (in category 'accessing') -----
at: index
    <primitive: 'primitiveAt' module: 'FloatArrayPlugin'>
    ^Float fromIEEE32Bit: (self basicAt: index)!
----- Method: FloatArray>>at:put: (in category 'accessing') -----
at: index put: value
    <primitive: 'primitiveAtPut' module: 'FloatArrayPlugin'>
    value isFloat 
    	ifTrue:[self basicAt: index put: value asIEEE32BitWord]
    	ifFalse:[self at: index put: value asFloat].
    ^value!
----- Method: FloatArray>>defaultElement (in category 'accessing') -----
defaultElement
    "Return the default element of the receiver"
    ^0.0!
----- Method: FloatArray>>dot: (in category 'arithmetic') -----
dot: aFloatVector
    "Primitive. Return the dot product of the receiver and the argument.
    Fail if the argument is not of the same size as the receiver."
    | result |
    "primitive:'primitiveFloatArrayDotProduct'"
    self size = aFloatVector size ifFalse:[^self error:'Must be equal size'].
    result := 0.0.
    1 to: self size do:[:i|
    	result := result + ((self at: i) * (aFloatVector at: i)).
    ].
    ^result!
----- Method: FloatArray>>hash (in category 'comparing') -----
hash
    | result |
    <primitive:'primitiveHashArray' module: 'FloatArrayPlugin'>
    result := 0.
    1 to: self size do:[:i| result := result + (self basicAt: i) ].
    ^result bitAnd: 16r1FFFFFFF!
----- Method: FloatArray>>length (in category 'accessing') -----
length
    "Return the length of the receiver"
    ^self squaredLength sqrt!
----- Method: FloatArray>>negated (in category 'arithmetic') -----
negated
    ^self clone *= -1!
----- Method: FloatArray>>primAddArray: (in category 'primitives-plugin') -----
primAddArray: floatArray
<primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].!
----- Method: FloatArray>>primAddScalar: (in category 'primitives-plugin') -----
primAddScalar: scalarValue
<primitive: 'primitiveAddScalar' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].!
----- Method: FloatArray>>primDivArray: (in category 'primitives-plugin') -----
primDivArray: floatArray
<primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].!
----- Method: FloatArray>>primDivScalar: (in category 'primitives-plugin') -----
primDivScalar: scalarValue
<primitive: 'primitiveDivScalar' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].!
----- Method: FloatArray>>primMulArray: (in category 'primitives-plugin') -----
primMulArray: floatArray
<primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].!
----- Method: FloatArray>>primMulScalar: (in category 'primitives-plugin') -----
primMulScalar: scalarValue
<primitive: 'primitiveMulScalar' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].!
----- Method: FloatArray>>primSubArray: (in category 'primitives-plugin') -----
primSubArray: floatArray
<primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].!
----- Method: FloatArray>>primSubScalar: (in category 'primitives-plugin') -----
primSubScalar: scalarValue
<primitive: 'primitiveSubScalar' module: 'FloatArrayPlugin'>
    1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].!
----- Method: FloatArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
    <primitive: 105>
    super replaceFrom: start to: stop with: replacement startingAt: repStart!
----- Method: FloatArray>>squaredLength (in category 'accessing') -----
squaredLength
    "Return the squared length of the receiver"
    ^self dot: self!
----- Method: FloatArray>>sum (in category 'primitives-plugin') -----
sum
<primitive: 'primitiveSum' module: 'FloatArrayPlugin'>
    ^ super sum!
ArrayedCollection variableWordSubclass: #IntegerArray
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!IntegerArray commentStamp: '<historical>' prior: 0!
IntegerArrays store 32bit signed Integer values.
Negative values are stored as 2's complement.!
----- Method: IntegerArray>>asIntegerArray (in category 'converting') -----
asIntegerArray
    ^self!
----- Method: IntegerArray>>at: (in category 'accessing') -----
at: index
    | word |
    <primitive: 165>
    word := self basicAt: index.
    word < 16r3FFFFFFF ifTrue:[^word]. "Avoid LargeInteger computations"
    ^word >= 16r80000000	"Negative?!!"
    	ifTrue:["word - 16r100000000"
    			(word bitInvert32 + 1) negated]
    	ifFalse:[word]!
----- Method: IntegerArray>>at:put: (in category 'accessing') -----
at: index put: anInteger
    | word |
    <primitive: 166>
    anInteger < 0
    	ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range'].
    			"word _ 16r100000000 + anInteger"
    			word := (anInteger + 1) negated bitInvert32]
    	ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range'].
    			word := anInteger].
    self  basicAt: index put: word.
    ^anInteger!
----- Method: IntegerArray>>atAllPut: (in category 'accessing') -----
atAllPut: anInteger
    | word |
    anInteger < 0
    	ifTrue:[anInteger < -16r80000000 ifTrue: [self error: anInteger asString , ' out of range'].
    			"word _ 16r100000000 + anInteger"
    			word := (anInteger + 1) negated bitInvert32]
    	ifFalse:[anInteger > 16r7FFFFFFF ifTrue: [self error: anInteger asString , ' out of range'].
    			word := anInteger].
    self primFill: word.!
----- Method: IntegerArray>>defaultElement (in category 'accessing') -----
defaultElement
    "Return the default element of the receiver"
    ^0!
----- Method: IntegerArray>>primFill: (in category 'private') -----
primFill: aPositiveInteger
    "Fill the receiver, an indexable bytes or words object, with the given positive integer. The range of possible fill values is [0..255] for byte arrays and [0..(2^32 - 1)] for word arrays."
<primitive: 145>
    self errorImproperStore.!
ArrayedCollection subclass: #RunArray
    instanceVariableNames: 'runs values lastIndex lastRun lastOffset'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!RunArray commentStamp: '<historical>' prior: 0!
My instances provide space-efficient storage of data which tends to be constant over long runs of the possible indices. Essentially repeated values are stored singly and then associated with a "run" length that denotes the number of consecutive occurrences of the value.
My two important variables are
    runs	An array of how many elements are in each run
    values	An array of what the value is over those elements
The variables lastIndex, lastRun and lastOffset cache the last access
so that streaming through RunArrays is not an N-squared process.
Many complexities of access can be bypassed by using the method
    RunArray withStartStopAndValueDo:!
----- Method: RunArray class>>new (in category 'instance creation') -----
new
^self runs: Array new values: Array new!
----- Method: RunArray class>>new: (in category 'instance creation') -----
new: aSize
    ^ self new: aSize withAll: nil!
----- Method: RunArray class>>new:withAll: (in category 'instance creation') -----
new: size withAll: value 
    "Answer a new instance of me, whose every element is equal to the
    argument, value."
size = 0 ifTrue: [^self new].
    ^self runs: (Array with: size) values: (Array with: value)!
----- Method: RunArray class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
| newCollection |
    newCollection := self new.
    aCollection do: [:x | newCollection addLast: x].
    ^newCollection
"	RunArray newFrom: {1. 2. 2. 3}
    {1. $a. $a. 3} as: RunArray
    ({1. $a. $a. 3} as: RunArray) values
"!
----- Method: RunArray class>>readFrom: (in category 'instance creation') -----
readFrom: aStream
    "Answer an instance of me as described on the stream, aStream."
| size runs values |
    size := aStream nextWord.
    runs := Array new: size.
    values := Array new: size.
    1 to: size do:
    	[:x |
    	runs at: x put: aStream nextWord.
    	values at: x put: aStream nextWord].
    ^ self runs: runs values: values!
----- Method: RunArray class>>runs:values: (in category 'instance creation') -----
runs: newRuns values: newValues 
    "Answer an instance of me with runs and values specified by the 
    arguments."
| instance |
    instance := self basicNew.
    instance setRuns: newRuns setValues: newValues.
    ^instance!
----- Method: RunArray class>>scanFrom: (in category 'instance creation') -----
scanFrom: strm
    "Read the style section of a fileOut or sources file.  nextChunk has already been done.  We need to return a RunArray of TextAttributes of various kinds.  These are written by the implementors of writeScanOn:"
    | rr vv aa this |
    (strm peekFor: $( ) ifFalse: [^ nil].
    rr := OrderedCollection new.
    [strm skipSeparators.
     strm peekFor: $)] whileFalse: 
    	[rr add: (Number readFrom: strm)].
    vv := OrderedCollection new.	"Value array"
    aa := OrderedCollection new.	"Attributes list"
    [(this := strm next) == nil] whileFalse: [
    	this == $, ifTrue: [vv add: aa asArray.  aa := OrderedCollection new].
    	this == $a ifTrue: [aa add: 
    		(TextAlignment new alignment: (Integer readFrom: strm))].
    	this == $f ifTrue: [aa add: 
    		(TextFontChange new fontNumber: (Integer readFrom: strm))].
    	this == $F ifTrue: [aa add: (TextFontReference toFont: 
    		(StrikeFont familyName: (strm upTo: $#) size: (Integer readFrom: strm)))].
    	this == $b ifTrue: [aa add: (TextEmphasis bold)].
    	this == $i ifTrue: [aa add: (TextEmphasis italic)].
    	this == $u ifTrue: [aa add: (TextEmphasis underlined)].
    	this == $= ifTrue: [aa add: (TextEmphasis struckOut)].
    	this == $n ifTrue: [aa add: (TextEmphasis normal)].
    	this == $- ifTrue: [aa add: (TextKern kern: -1)].
    	this == $+ ifTrue: [aa add: (TextKern kern: 1)].
    	this == $c ifTrue: [aa add: (TextColor scanFrom: strm)]. "color"
    	this == $L ifTrue: [aa add: (TextLink scanFrom: strm)].	"L not look like 1"
    	this == $R ifTrue: [aa add: (TextURL scanFrom: strm)].
    			"R capitalized so it can follow a number"
    	this == $q ifTrue: [aa add: (TextSqkPageLink scanFrom: strm)].
    	this == $p ifTrue: [aa add: (TextSqkProjectLink scanFrom: strm)].
    	this == $P ifTrue: [aa add: (TextPrintIt scanFrom: strm)].
    	this == $d ifTrue: [aa add: (TextDoIt scanFrom: strm)].
    	"space, cr do nothing"
    	].
    aa size > 0 ifTrue: [vv add: aa asArray].
    ^ self runs: rr asArray values: vv asArray
"
RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i')
"!
----- Method: RunArray>>, (in category 'copying') -----
, aRunArray 
    "Answer a new RunArray that is a concatenation of the receiver and
    aRunArray."
| new newRuns |
    (aRunArray isMemberOf: RunArray)
    	ifFalse: 
    		[new := self copy.
    		"attempt to be sociable"
    		aRunArray do: [:each | new addLast: each].
    		^new].
    runs size = 0 ifTrue: [^aRunArray copy].
    aRunArray runs size = 0 ifTrue: [^self copy].
    (values at: values size) ~= (aRunArray values at: 1)
    	ifTrue: [^RunArray
    				runs: runs , aRunArray runs
    				values: values , aRunArray values].
    newRuns := runs
    				copyReplaceFrom: runs size
    				to: runs size
    				with: aRunArray runs.
    newRuns at: runs size put: (runs at: runs size) + (aRunArray runs at: 1).
    ^RunArray
    	runs: newRuns
    	values: 
    		(values
    			copyReplaceFrom: values size
    			to: values size
    			with: aRunArray values)!
----- Method: RunArray>>= (in category 'accessing') -----
= otherArray 
    "Test if all my elements are equal to those of otherArray"
(otherArray isMemberOf: RunArray) ifFalse: [^ self hasEqualElements: otherArray].
"Faster test between two RunArrays"
    ^ (runs hasEqualElements: otherArray runs)
    	and: [values hasEqualElements: otherArray values]!
----- Method: RunArray>>addFirst: (in category 'adding') -----
addFirst: value
    "Add value as the first element of the receiver."
    lastIndex := nil.  "flush access cache"
    (runs size=0 or: [values first ~= value])
      ifTrue:
    	[runs := {1}, runs.
    	values := {value}, values]
      ifFalse:
    	[runs at: 1 put: runs first+1]!
----- Method: RunArray>>addLast: (in category 'adding') -----
addLast: value
    "Add value as the last element of the receiver."
    lastIndex := nil.  "flush access cache"
    (runs size=0 or: [values last ~= value])
      ifTrue:
    	[runs := runs copyWith: 1.
    	values := values copyWith: value]
      ifFalse:
    	[runs at: runs size put: runs last+1]!
----- Method: RunArray>>addLast:times: (in category 'adding') -----
addLast: value  times: times
    "Add value as the last element of the receiver, the given number of times"
    times = 0 ifTrue: [ ^self ].
    lastIndex := nil.  "flush access cache"
    (runs size=0 or: [values last ~= value])
      ifTrue:
    	[runs := runs copyWith: times.
    	values := values copyWith: value]
      ifFalse:
    	[runs at: runs size put: runs last+times]!
----- Method: RunArray>>at: (in category 'accessing') -----
at: index
self at: index setRunOffsetAndValue: [:run :offset :value | ^value]!
----- Method: RunArray>>at:put: (in category 'accessing') -----
at: index put: aValue 
    "Set an element of the RunArray"
    | runIndex offsetInRun lastValue runLength runReplacement valueReplacement iStart iStop |
    index isInteger
    	ifFalse: [self errorNonIntegerIndex].
    (index >= 1
    		and: [index <= self size])
    	ifFalse: [self errorSubscriptBounds: index].
    self
    	at: index
    	setRunOffsetAndValue: [:run :offset :value | 
    		runIndex := run.
    		offsetInRun := offset.
    		lastValue := value].
    aValue = lastValue
    	ifTrue: [^ aValue].
    runLength := runs at: runIndex.
    runReplacement := Array
    			with: offsetInRun
    			with: 1
    			with: runLength - offsetInRun - 1.
    valueReplacement := Array
    			with: lastValue
    			with: aValue
    			with: lastValue.
    iStart := offsetInRun = 0
    			ifTrue: [2]
    			ifFalse: [1].
    iStop := offsetInRun = (runLength - 1)
    			ifTrue: [2]
    			ifFalse: [3].
    self
    	setRuns: (runs copyReplaceFrom: runIndex to: runIndex with: (runReplacement copyFrom: iStart to: iStop))
    	setValues: (values copyReplaceFrom: runIndex to: runIndex with: (valueReplacement copyFrom: iStart to: iStop)).
    self coalesce.
    ^ aValue!
----- Method: RunArray>>at:setRunOffsetAndValue: (in category 'private') -----
at: index setRunOffsetAndValue: aBlock 
    "Supply all run information to aBlock."
    "Tolerates index=0 and index=size+1 for copyReplace: "
    | run limit offset |
    limit := runs size.
    (lastIndex == nil or: [index < lastIndex])
    	ifTrue:  "cache not loaded, or beyond index - start over"
    		[run := 1.
    		offset := index-1]
    	ifFalse:  "cache loaded and before index - start at cache"
    		[run := lastRun.
    		offset := lastOffset + (index-lastIndex)].
    [run <= limit and: [offset >= (runs at: run)]]
    	whileTrue: 
    		[offset := offset - (runs at: run).
    		run := run + 1].
    lastIndex := index.  "Load cache for next access"
    lastRun := run.
    lastOffset := offset.
    run > limit
    	ifTrue: 
    		["adjustment for size+1"
    		run := run - 1.
    		offset := offset + (runs at: run)].
    ^aBlock
    	value: run	"an index into runs and values"
    	value: offset	"zero-based offset from beginning of this run"
    	value: (values at: run)	"value for this run"!
----- Method: RunArray>>coalesce (in category 'adding') -----
coalesce
    "Try to combine adjacent runs"
    | ind |
    ind := 2.
    [ind > values size] whileFalse: [
    	(values at: ind-1) = (values at: ind) 
    		ifFalse: [ind := ind + 1]
    		ifTrue: ["two are the same, combine them"
    			values := values copyReplaceFrom: ind to: ind with: #().
    			runs at: ind-1 put: (runs at: ind-1) + (runs at: ind).
    			runs := runs copyReplaceFrom: ind to: ind with: #().
    			"self error: 'needed to combine runs' "]].
    		!
----- Method: RunArray>>copyFrom:to: (in category 'copying') -----
copyFrom: start to: stop
    | newRuns run1 run2 offset1 offset2 | 
    stop < start ifTrue: [^RunArray new].
    self at: start setRunOffsetAndValue: [:r :o :value1 | run1 := r. offset1
:= o.  value1].
    self at: stop setRunOffsetAndValue: [:r :o :value2 | run2 := r. offset2
:= o. value2].
    run1 = run2
    	ifTrue: 
    		[newRuns := Array with: offset2 - offset1 + 1]
    	ifFalse: 
    		[newRuns := runs copyFrom: run1 to: run2.
    		newRuns at: 1 put: (newRuns at: 1) - offset1.
    		newRuns at: newRuns size put: offset2 + 1].
    ^RunArray runs: newRuns values: (values copyFrom: run1 to: run2)!
----- Method: RunArray>>copyReplaceFrom:to:with: (in category 'copying') -----
copyReplaceFrom: start to: stop with: replacement
^(self copyFrom: 1 to: start - 1)
    	, replacement 
    	, (self copyFrom: stop + 1 to: self size)!
----- Method: RunArray>>first (in category 'accessing') -----
first
    ^values at: 1!
----- Method: RunArray>>isSelfEvaluating (in category 'self evaluating') -----
isSelfEvaluating
    ^ self class == RunArray!
----- Method: RunArray>>last (in category 'accessing') -----
last
    ^values at: values size!
----- Method: RunArray>>mapValues: (in category 'private') -----
mapValues: mapBlock
    "NOTE: only meaningful to an entire set of runs"
    values := values collect: [:val | mapBlock value: val]!
----- Method: RunArray>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    runs := runs copy.
    values := values copy!
----- Method: RunArray>>printOn: (in category 'printing') -----
printOn: aStream
    self printNameOn: aStream.
    aStream
    	nextPutAll: ' runs: ';
    	print: runs;
    	nextPutAll: ' values: ';
    	print: values!
----- Method: RunArray>>rangeOf:startingAt: (in category 'adding') -----
rangeOf: attr startingAt: startPos
    "Answer an interval that gives the range of attr at index position  startPos. An empty interval with start value startPos is returned when the attribute attr is not present at position startPos.  self size > 0 is assumed, it is the responsibility of the caller to test for emptiness of self.
Note that an attribute may span several adjancent runs. "
self at: startPos 
    	setRunOffsetAndValue: 
            [:run :offset :value | 
               ^(value includes: attr)
                  ifFalse: [startPos to: startPos - 1]
                  ifTrue:
                    [ | firstRelevantPosition lastRelevantPosition idxOfCandidateRun |
                     lastRelevantPosition := startPos - offset + (runs at: run) - 1.
                     firstRelevantPosition := startPos - offset.
                     idxOfCandidateRun := run + 1.
                     [idxOfCandidateRun <= runs size 
                             and: [(values at: idxOfCandidateRun) includes: attr]]
                        whileTrue:
                          [lastRelevantPosition := lastRelevantPosition + (runs at: idxOfCandidateRun).
                           idxOfCandidateRun := idxOfCandidateRun + 1]. 
                     idxOfCandidateRun := run - 1.
                     [idxOfCandidateRun >= 1 
                             and: [(values at: idxOfCandidateRun) includes: attr]]
                        whileTrue:
                          [firstRelevantPosition := firstRelevantPosition - (runs at: idxOfCandidateRun).
                           idxOfCandidateRun := idxOfCandidateRun - 1].
firstRelevantPosition to: lastRelevantPosition]
    	  ]!
----- Method: RunArray>>repeatLast:ifEmpty: (in category 'adding') -----
repeatLast: times  ifEmpty: defaultBlock
    "add the last value back again, the given number of times.  If we are empty, add (defaultBlock value)"
    times = 0 ifTrue: [^self ].
    lastIndex := nil.  "flush access cache"
    (runs size=0)
      ifTrue:
    	[runs := runs copyWith: times.
    	values := values copyWith: defaultBlock value]
      ifFalse:
    	[runs at: runs size put: runs last+times] !
----- Method: RunArray>>repeatLastIfEmpty: (in category 'adding') -----
repeatLastIfEmpty: defaultBlock
    "add the last value back again.  If we are empty, add (defaultBlock value)"
    lastIndex := nil.  "flush access cache"
    (runs size=0)
      ifTrue:[
    	 runs := runs copyWith: 1.
    	values := values copyWith: defaultBlock value]
      ifFalse:
    	[runs at: runs size put: runs last+1]!
----- Method: RunArray>>reversed (in category 'converting') -----
reversed
^self class runs: runs reversed values: values reversed!
----- Method: RunArray>>runLengthAt: (in category 'accessing') -----
runLengthAt: index 
    "Answer the length remaining in run beginning at index."
self at: index 
    	setRunOffsetAndValue: [:run :offset :value | ^(runs at: run) - offset]!
----- Method: RunArray>>runs (in category 'private') -----
runs
^runs!
----- Method: RunArray>>runsAndValuesDo: (in category 'enumerating') -----
runsAndValuesDo: aBlock
    "Evaluate aBlock with run lengths and values from the receiver"
    ^runs with: values do: aBlock.!
----- Method: RunArray>>runsFrom:to:do: (in category 'enumerating') -----
runsFrom: start to: stop do: aBlock
    "Evaluate aBlock with all existing runs in the range from start to stop"
    | run value index |
    start > stop ifTrue:[^self].
    self at: start setRunOffsetAndValue:[:firstRun :offset :firstValue|
    	run := firstRun.
    	value := firstValue.
    	index := start + (runs at: run) - offset.
    	[aBlock value: value.
    	index <= stop] whileTrue:[
    		run := run + 1.
    		value := values at: run.
    		index := index + (runs at: run)]].
!
----- Method: RunArray>>setRuns:setValues: (in category 'private') -----
setRuns: newRuns setValues: newValues
    lastIndex := nil.  "flush access cache"
    runs := newRuns asArray.
    values := newValues asArray.!
----- Method: RunArray>>size (in category 'accessing') -----
size
    | size |
    size := 0.
    1 to: runs size do: [:i | size := size + (runs at: i)].
    ^size!
----- Method: RunArray>>storeOn: (in category 'printing') -----
storeOn: aStream
aStream nextPut: $(.
    aStream nextPutAll: self class name.
    aStream nextPutAll: ' runs: '.
    runs storeOn: aStream.
    aStream nextPutAll: ' values: '.
    values storeOn: aStream.
    aStream nextPut: $)!
----- Method: RunArray>>values (in category 'private') -----
values
    "Answer the values in the receiver."
^values!
----- Method: RunArray>>withStartStopAndValueDo: (in category 'accessing') -----
withStartStopAndValueDo: aBlock
    | start stop |
    start := 1.
    runs with: values do:
    	[:len : val | stop := start + len - 1.
    	aBlock value: start value: stop value: val.
    	start := stop + 1]
    	!
----- Method: RunArray>>writeOn: (in category 'printing') -----
writeOn: aStream
aStream nextWordPut: runs size.
    1 to: runs size do:
    	[:x |
    	aStream nextWordPut: (runs at: x).
    	aStream nextWordPut: (values at: x)]!
----- Method: RunArray>>writeScanOn: (in category 'printing') -----
writeScanOn: strm
    "Write out the format used for text runs in source files. (14 50 312)f1,f1b,f1LInteger +;i"
strm nextPut: $(.
    runs do: [:rr | rr printOn: strm.  strm space].
    strm skip: -1; nextPut: $).
    values do: [:vv |
    	vv do: [:att | att writeScanOn: strm].
    	strm nextPut: $,].
    strm skip: -1.  "trailing comma"!
ArrayedCollection variableSubclass: #SparseLargeTable
    instanceVariableNames: 'base size chunkSize defaultValue'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!SparseLargeTable commentStamp: '<historical>' prior: 0!
Derivated from Stephan Pair's LargeArray, but to hold a sparse table, in which most of the entries are the same default value, it uses some tricks.!
----- Method: SparseLargeTable class>>defaultChunkSize (in category 'accessing') -----
defaultChunkSize
^100!
----- Method: SparseLargeTable class>>defaultChunkSizeForFiles (in category 'accessing') -----
defaultChunkSizeForFiles
^8000!
----- Method: SparseLargeTable class>>new: (in category 'instance creation') -----
new: size
^self new: size chunkSize: self defaultChunkSize
!
----- Method: SparseLargeTable class>>new:chunkSize: (in category 'instance creation') -----
new: size chunkSize: chunkSize
^self new: size chunkSize: chunkSize arrayClass: Array
!
----- Method: SparseLargeTable class>>new:chunkSize:arrayClass: (in category 'instance creation') -----
new: size chunkSize: chunkSize arrayClass: aClass
^self new: size chunkSize: chunkSize arrayClass: Array base: 1.
!
----- Method: SparseLargeTable class>>new:chunkSize:arrayClass:base: (in category 'instance creation') -----
new: size chunkSize: chunkSize arrayClass: aClass base: b
^self new: size chunkSize: chunkSize arrayClass: Array base: 1 defaultValue: nil.
!
----- Method: SparseLargeTable class>>new:chunkSize:arrayClass:base:defaultValue: (in category 'instance creation') -----
new: size chunkSize: chunkSize arrayClass: aClass base: b defaultValue: d
| basicSize |
    (basicSize := ((size - 1) // chunkSize) + 1) = 0
    	ifTrue: [basicSize := 1].
    ^(self basicNew: basicSize)
    	initChunkSize: chunkSize size: size arrayClass: aClass base: b defaultValue: d;
    	yourself
!
----- Method: SparseLargeTable>>allDefaultValueSubtableAt: (in category 'private') -----
allDefaultValueSubtableAt: index
| t |
    t := self basicAt: index.
    t ifNil: [^ true].
    t do: [:e |
    	e ~= defaultValue ifTrue: [^ false].
    ].
    ^ true.
!
----- Method: SparseLargeTable>>analyzeSpaceSaving (in category 'private') -----
analyzeSpaceSaving
| total elems tablesTotal nonNilTables |
    total := size - base + 1.
    elems := 0.
    base to: size do: [:i | (self at: i) ~= defaultValue ifTrue: [elems := elems + 1]].
    tablesTotal := self basicSize.
    nonNilTables := 0.
    1 to: self basicSize do: [:i | (self basicAt: i) ifNotNil: [nonNilTables := nonNilTables + 1]].
^ String streamContents: [:strm |
    	strm nextPutAll: 'total: '.
    	strm nextPutAll: total printString.
    	strm nextPutAll: ' elements: '.
    	strm nextPutAll: elems printString.
    	strm nextPutAll: ' tables: '.
    	strm nextPutAll: tablesTotal printString.
    	strm nextPutAll: ' non-nil: '.
    	strm nextPutAll: nonNilTables printString.
    ].
!
----- Method: SparseLargeTable>>arrayClass (in category 'accessing') -----
arrayClass
^(self basicAt: 1) class
!
----- Method: SparseLargeTable>>at: (in category 'accessing') -----
at: index
self pvtCheckIndex: index.
    ^self noCheckAt: index.
!
----- Method: SparseLargeTable>>at:put: (in category 'accessing') -----
at: index put: value
    
    self pvtCheckIndex: index.
    ^self noCheckAt: index put: value
!
----- Method: SparseLargeTable>>base (in category 'accessing') -----
base
^ base.
!
----- Method: SparseLargeTable>>chunkSize (in category 'accessing') -----
chunkSize
^chunkSize
!
----- Method: SparseLargeTable>>copyEmpty (in category 'private') -----
copyEmpty
    "Answer a copy of the receiver that contains no elements."
    ^self speciesNew: 0
!
----- Method: SparseLargeTable>>findLastNonNilSubTable (in category 'private') -----
findLastNonNilSubTable
(self basicAt: self basicSize) ifNotNil: [^ self basicSize].
self basicSize - 1 to: 1 by: -1 do: [:lastIndex |
    	(self basicAt: lastIndex) ifNotNil: [^ lastIndex].
    ].
    ^ 0.
!
----- Method: SparseLargeTable>>initChunkSize:size:arrayClass:base:defaultValue: (in category 'initialization') -----
initChunkSize: aChunkSize size: aSize arrayClass: aClass base: b defaultValue: d
| lastChunkSize |
    chunkSize := aChunkSize.
    size := aSize.
    base := b.
    defaultValue := d.
    1 to: (self basicSize - 1) do: [ :in | self basicAt: in put: (aClass new: chunkSize withAll: defaultValue) ].
    lastChunkSize := size \ chunkSize.
    lastChunkSize = 0 ifTrue: [lastChunkSize := chunkSize].
    size = 0 
    	ifTrue: [self basicAt: 1 put: (aClass new: 0)]
    	ifFalse: [self basicAt: self basicSize put: (aClass new: lastChunkSize withAll: defaultValue)].
!
----- Method: SparseLargeTable>>noCheckAt: (in category 'accessing') -----
noCheckAt: index
    | chunkIndex t |
chunkIndex := index - base // chunkSize + 1.
    (chunkIndex > self basicSize or: [chunkIndex < 1]) ifTrue: [^ defaultValue].
    t := self basicAt: chunkIndex.
    t ifNil: [^ defaultValue].
    ^ t at: (index - base + 1 - (chunkIndex - 1 * chunkSize))
!
----- Method: SparseLargeTable>>noCheckAt:put: (in category 'accessing') -----
noCheckAt: index put: value
    | chunkIndex t |
chunkIndex := index - base // chunkSize + 1.
    chunkIndex > self basicSize ifTrue: [^ value].
    t :=  self basicAt: chunkIndex.
    t ifNil: [^ value].
    ^ t at: (index - base + 1 - (chunkIndex - 1 * chunkSize)) put: value
!
----- Method: SparseLargeTable>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    1 to: self basicSize do: [:i | self basicAt: i put: (self basicAt: i) copy]!
----- Method: SparseLargeTable>>printElementsOn: (in category 'printing') -----
printElementsOn: aStream
    | element |
    aStream nextPut: $(.
    base to: size do: [:index | element := self at: index. aStream print: element; space].
    self isEmpty ifFalse: [aStream skip: -1].
    aStream nextPut: $)
!
----- Method: SparseLargeTable>>printOn: (in category 'printing') -----
printOn: aStream
(#(String) includes: self arrayClass name) 
    	ifTrue: [^self storeOn: aStream].
    ^super printOn: aStream
!
----- Method: SparseLargeTable>>privateSize: (in category 'private') -----
privateSize: s
size := s.
!
----- Method: SparseLargeTable>>pvtCheckIndex: (in category 'private') -----
pvtCheckIndex: index
index isInteger ifFalse: [self errorNonIntegerIndex].
    index < 1 ifTrue: [self errorSubscriptBounds: index].
    index > size ifTrue: [self errorSubscriptBounds: index].
!
----- Method: SparseLargeTable>>similarInstance (in category 'private') -----
similarInstance
^self class
    	new: self size 
    	chunkSize: self chunkSize 
    	arrayClass: self arrayClass
!
----- Method: SparseLargeTable>>similarInstance: (in category 'private') -----
similarInstance: newSize
^self class
    	new: newSize 
    	chunkSize: self chunkSize 
    	arrayClass: self arrayClass
!
----- Method: SparseLargeTable>>similarSpeciesInstance (in category 'private') -----
similarSpeciesInstance
^self similarInstance
!
----- Method: SparseLargeTable>>similarSpeciesInstance: (in category 'private') -----
similarSpeciesInstance: newSize
^self similarInstance: newSize
!
----- Method: SparseLargeTable>>size (in category 'accessing') -----
size
^size
!
----- Method: SparseLargeTable>>speciesNew (in category 'private') -----
speciesNew
^self species
    	new: self size 
    	chunkSize: self chunkSize 
    	arrayClass: self arrayClass
!
----- Method: SparseLargeTable>>speciesNew: (in category 'private') -----
speciesNew: newSize
^self species
    	new: newSize 
    	chunkSize: self chunkSize 
    	arrayClass: self arrayClass
!
----- Method: SparseLargeTable>>storeOn: (in category 'printing') -----
storeOn: aStream
| x |
    (#(String) includes: self arrayClass name) ifTrue: 
    	[aStream nextPut: $'.
    	1 to: self size do:
    		[:i |
    		aStream nextPut: (x := self at: i).
    		x == $' ifTrue: [aStream nextPut: x]].
    	aStream nextPutAll: ''' asLargeArrayChunkSize: '.
    	aStream nextPutAll: self chunkSize asString.
    	^self].
    ^super storeOn: aStream
!
----- Method: SparseLargeTable>>zapDefaultOnlyEntries (in category 'accessing') -----
zapDefaultOnlyEntries
| lastIndex newInst |
    1 to: self basicSize do: [:i |
    	(self allDefaultValueSubtableAt: i) ifTrue: [self basicAt: i put: nil].
    ].
lastIndex := self findLastNonNilSubTable.
    lastIndex = 0 ifTrue: [^ self].
    
    newInst := self class new: lastIndex*chunkSize chunkSize: chunkSize arrayClass: (self basicAt: lastIndex) class base: base defaultValue: defaultValue.
    newInst privateSize: self size.
    base to: newInst size do: [:i | newInst at: i put: (self at: i)].
    1 to: newInst basicSize do: [:i |
    	(newInst allDefaultValueSubtableAt: i) ifTrue: [newInst basicAt: i put: nil].
    ].
" this is not allowed in production: self becomeForward: newInst. "
    ^ newInst.
!
ArrayedCollection subclass: #String
    instanceVariableNames: ''
    classVariableNames: 'AsciiOrder CSLineEnders CSNonSeparators CSSeparators CaseInsensitiveOrder CaseSensitiveOrder HtmlEntities LowercasingTable Tokenish UppercasingTable'
    poolDictionaries: ''
    category: 'Collections-Strings'!
!String commentStamp: '<historical>' prior: 0!
A String is an indexed collection of Characters. Class String provides the abstract super class for ByteString (that represents an array of 8-bit Characters) and WideString (that represents an array of  32-bit characters).  In the similar manner of LargeInteger and SmallInteger, those subclasses are chosen accordingly for a string; namely as long as the system can figure out so, the String is used to represent the given string.
Strings support a vast array of useful methods, which can best be learned by browsing and trying out examples as you find them in the code.
Here are a few useful methods to look at...
    String match:
    String contractTo:
String also inherits many useful methods from its hierarchy, such as
    SequenceableCollection ,
    SequenceableCollection copyReplaceAll:with:
!
String variableByteSubclass: #ByteString
    instanceVariableNames: ''
    classVariableNames: 'Latin1ToUtf8Encodings Latin1ToUtf8Map'
    poolDictionaries: ''
    category: 'Collections-Strings'!
!ByteString commentStamp: '<historical>' prior: 0!
This class represents the array of 8 bit wide characters.
!
----- Method: ByteString class>>compare:with:collated: (in category 'primitives') -----
compare: string1 with: string2 collated: order
    "Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array."
| len1 len2 c1 c2 |
    <primitive: 'primitiveCompareString' module: 'MiscPrimitivePlugin'>
    self var: #string1 declareC: 'unsigned char *string1'.
    self var: #string2 declareC: 'unsigned char *string2'.
    self var: #order declareC: 'unsigned char *order'.
len1 := string1 size.
    len2 := string2 size.
    1 to: (len1 min: len2) do:
    	[:i |
    	c1 := order at: (string1 basicAt: i) + 1.
    	c2 := order at: (string2 basicAt: i) + 1.
    	c1 = c2 ifFalse: 
    		[c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]]].
    len1 = len2 ifTrue: [^ 2].
    len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
!
----- Method: ByteString class>>findFirstInString:inSet:startingAt: (in category 'primitives') -----
findFirstInString: aString  inSet: inclusionMap  startingAt: start
    | i stringSize |
    <primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'>
    self var: #aString declareC: 'unsigned char *aString'.
    self var: #inclusionMap  declareC: 'char *inclusionMap'.
inclusionMap size ~= 256 ifTrue: [ ^0 ].
i := start.
    stringSize := aString size.
    [ i <= stringSize and: [ (inclusionMap at: (aString at: i) asciiValue+1) = 0 ] ] whileTrue: [ 
    	i := i + 1 ].
i > stringSize ifTrue: [ ^0 ].
    ^i!
----- Method: ByteString class>>indexOfAscii:inString:startingAt: (in category 'primitives') -----
indexOfAscii: anInteger inString: aString startingAt: start
| stringSize |
    <primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'>
self var: #aCharacter declareC: 'int anInteger'.
    self var: #aString declareC: 'unsigned char *aString'.
stringSize := aString size.
    start to: stringSize do: [:pos |
    	(aString at: pos) asciiValue = anInteger ifTrue: [^ pos]].
^ 0
!
----- Method: ByteString class>>initialize (in category 'initialization') -----
initialize
    "ByteString initialize"
    | latin1 utf8 |
    Latin1ToUtf8Map := ByteArray new: 256.
    Latin1ToUtf8Encodings := Array new: 256.
    0 to: 255 do:[:i|
    	latin1 := String with: (Character value: i).
    	utf8 := latin1 convertToWithConverter: UTF8TextConverter new.
    	latin1 = utf8 ifTrue:[
    		Latin1ToUtf8Map at: i+1 put: 0. "no translation needed"
    	] ifFalse:[
    		Latin1ToUtf8Map at: i+1 put: 1. "no translation needed"
    		Latin1ToUtf8Encodings at: i+1 put: utf8.
    	].
    ].!
----- Method: ByteString class>>stringHash:initialHash: (in category 'primitives') -----
stringHash: aString initialHash: speciesHash
| stringSize hash low |
    <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'>
self var: #aHash declareC: 'int speciesHash'.
    self var: #aString declareC: 'unsigned char *aString'.
stringSize := aString size.
    hash := speciesHash bitAnd: 16rFFFFFFF.
    1 to: stringSize do: [:pos |
    	hash := hash + (aString at: pos) asciiValue.
    	"Begin hashMultiply"
    	low := hash bitAnd: 16383.
    	hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
    ].
    ^ hash!
----- Method: ByteString class>>translate:from:to:table: (in category 'primitives') -----
translate: aString from: start  to: stop  table: table
    "translate the characters in the string by the given table, in place"
    <primitive: 'primitiveTranslateStringWithTable' module: 'MiscPrimitivePlugin'>
    self var: #table  declareC: 'unsigned char *table'.
    self var: #aString  declareC: 'unsigned char *aString'.
start to: stop do: [ :i |
    	aString at: i put: (table at: (aString at: i) asciiValue+1) ]!
----- Method: ByteString>>asByteArray (in category 'converting') -----
asByteArray
    | ba sz |
    sz := self byteSize.
    ba := ByteArray new: sz.
    ba replaceFrom: 1 to: sz with: self startingAt: 1.
    ^ba!
----- Method: ByteString>>asOctetString (in category 'converting') -----
asOctetString
^ self.
!
----- Method: ByteString>>at: (in category 'accessing') -----
at: index 
    "Primitive. Answer the Character stored in the field of the receiver
    indexed by the argument. Fail if the index argument is not an Integer or
    is out of bounds. Essential. See Object documentation whatIsAPrimitive."
<primitive: 63>
    ^ Character value: (super at: index)!
----- Method: ByteString>>at:put: (in category 'accessing') -----
at: index put: aCharacter
    "Primitive. Store the Character in the field of the receiver indicated by
    the index. Fail if the index is not an Integer or is out of bounds, or if
    the argument is not a Character. Essential. See Object documentation
    whatIsAPrimitive."
<primitive: 64>
    aCharacter isCharacter 
    	ifFalse:[^self errorImproperStore].
    aCharacter isOctetCharacter ifFalse:[
    	"Convert to WideString"
    	self becomeForward: (WideString from: self).
    	^self at: index put: aCharacter.
    ].
    index isInteger
    	ifTrue: [self errorSubscriptBounds: index]
    	ifFalse: [self errorNonIntegerIndex]!
----- Method: ByteString>>beginsWith: (in category 'comparing') -----
beginsWith: prefix
    "Answer whether the receiver begins with the given prefix string.
    The comparison is case-sensitive."
"IMPLEMENTATION NOTE:
    following algorithm is optimized in primitive only in case self and prefix are bytes like.
    Otherwise, if self is wide, then super outperforms,
    Otherwise, if prefix is wide, primitive is not correct"
    
    prefix class isBytes ifFalse: [^super beginsWith: prefix].
    
    self size < prefix size ifTrue: [^ false].
    ^ (self findSubstring: prefix in: self startingAt: 1
    		matchTable: CaseSensitiveOrder) = 1
!
----- Method: ByteString>>byteAt: (in category 'accessing') -----
byteAt: index
    <primitive: 60>
    ^(self at: index) asciiValue!
----- Method: ByteString>>byteAt:put: (in category 'accessing') -----
byteAt: index put: value
    <primitive: 61>
    self at: index put: value asCharacter.
    ^value!
----- Method: ByteString>>byteSize (in category 'accessing') -----
byteSize
    ^self size!
----- Method: ByteString>>convertFromCompoundText (in category 'converting') -----
convertFromCompoundText
| readStream writeStream converter |
    readStream := self readStream.
    writeStream := String new writeStream.
    converter := CompoundTextConverter new.
    converter ifNil: [^ self].
    [readStream atEnd] whileFalse: [
    	writeStream nextPut: (converter nextFromStream: readStream)].
    ^ writeStream contents
!
----- Method: ByteString>>convertFromSystemString (in category 'converting') -----
convertFromSystemString
| readStream writeStream converter |
    readStream := self readStream.
    writeStream := String new writeStream.
    converter := LanguageEnvironment defaultSystemConverter.
    converter ifNil: [^ self].
    [readStream atEnd] whileFalse: [
    	writeStream nextPut: (converter nextFromStream: readStream)].
    ^ writeStream contents
!
----- Method: ByteString>>findSubstring:in:startingAt:matchTable: (in category 'comparing') -----
findSubstring: key in: body startingAt: start matchTable: matchTable
    "Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned.
The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
    | index |
    <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
    self var: #key declareC: 'unsigned char *key'.
    self var: #body declareC: 'unsigned char *body'.
    self var: #matchTable declareC: 'unsigned char *matchTable'.
key size = 0 ifTrue: [^ 0].
    start to: body size - key size + 1 do:
    	[:startIndex |
    	index := 1.
    		[(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
    			= (matchTable at: (key at: index) asciiValue + 1)]
    			whileTrue:
    			[index = key size ifTrue: [^ startIndex].
    			index := index+1]].
    ^ 0
"
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
"!
----- Method: ByteString>>isByteString (in category 'testing') -----
isByteString
    "Answer whether the receiver is a ByteString"
    ^true!
----- Method: ByteString>>isOctetString (in category 'testing') -----
isOctetString
    "Answer whether the receiver can be represented as a byte string. 
    This is different from asking whether the receiver *is* a ByteString 
    (i.e., #isByteString)"
    ^ true.
!
----- Method: ByteString>>replaceFrom:to:with:startingAt: (in category 'accessing') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
    <primitive: 105>
    replacement class == WideString ifTrue: [
    	self becomeForward: (WideString from: self).
    ].
super replaceFrom: start to: stop with: replacement startingAt: repStart.
!
----- Method: ByteString>>squeakToUtf8 (in category 'converting') -----
squeakToUtf8
    "Convert the given string from UTF-8 using the fast path if converting to Latin-1"
    | outStream lastIndex nextIndex |
    Latin1ToUtf8Map ifNil:[^super squeakToUtf8]. "installation guard"
    lastIndex := 1.
    nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex.
    nextIndex = 0 ifTrue:[^self].
    outStream := (String new: self size * 2) writeStream.
    [outStream next: nextIndex-lastIndex putAll: self startingAt: lastIndex.
    outStream nextPutAll: (Latin1ToUtf8Encodings at: (self byteAt: nextIndex)+1).
    lastIndex := nextIndex + 1.
    nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex.
    nextIndex = 0] whileFalse.
    outStream next: self size-lastIndex+1 putAll: self startingAt: lastIndex.
    ^outStream contents
!
----- Method: ByteString>>substrings (in category 'converting') -----
substrings
    "Answer an array of the substrings that compose the receiver."
    | result end beginning |
    result := WriteStream on: (Array new: 10).
    end := 0.
    "find one substring each time through this loop"
    [ "find the beginning of the next substring"
    beginning := self indexOfAnyOf: CSNonSeparators 
    						startingAt: end+1 ifAbsent: [ nil ].
    beginning ~~ nil ] whileTrue: [
    	"find the end"
    	end := self indexOfAnyOf: CSSeparators 
    				startingAt: beginning ifAbsent: [ self size + 1 ].
    	end := end - 1.
    	result nextPut: (self copyFrom: beginning to: end).
    ].
    ^result contents!
----- Method: ByteString>>utf8ToSqueak (in category 'converting') -----
utf8ToSqueak
    "Convert the given string from UTF-8 using the fast path if converting to Latin-1"
    | outStream lastIndex nextIndex byte1 byte2 byte3 byte4 unicode |
    Latin1ToUtf8Map ifNil:[^super utf8ToSqueak]. "installation guard"
    lastIndex := 1.
    nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex.
    nextIndex = 0 ifTrue:[^self].
    outStream := (String new: self size) writeStream.
    [outStream next: nextIndex-lastIndex putAll: self startingAt: lastIndex.
    byte1 := self byteAt: nextIndex.
    (byte1 bitAnd: 16rE0) = 192 ifTrue: [ "two bytes"
    	byte2 := self byteAt: (nextIndex := nextIndex+1).
    	(byte2 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1"
    	unicode := ((byte1 bitAnd: 31) bitShift: 6) + (byte2 bitAnd: 63)].
    (byte1 bitAnd: 16rF0) = 224 ifTrue: [ "three bytes"
    	byte2 := self byteAt: (nextIndex := nextIndex+1).
    	(byte2 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1"
    	byte3 := self byteAt: (nextIndex := nextIndex+1).
    	(byte3 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1"
    	unicode := ((byte1 bitAnd: 15) bitShift: 12) + ((byte2 bitAnd: 63) bitShift: 6)
    		+ (byte3 bitAnd: 63)].
    (byte1 bitAnd: 16rF8) = 240 ifTrue: [ "four bytes"
    	byte2 := self byteAt: (nextIndex := nextIndex+1).
    	(byte2 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1"
    	byte3 := self byteAt: (nextIndex := nextIndex+1).
    	(byte3 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1"
    	byte4 := self byteAt: (nextIndex := nextIndex+1).
    	(byte4 bitAnd: 16rC0) = 16r80 ifFalse:[^self]. "invalid UTF-8; presume Latin-1"
    	unicode := ((byte1 bitAnd: 16r7) bitShift: 18) +
    					((byte2 bitAnd: 63) bitShift: 12) + 
    					((byte3 bitAnd: 63) bitShift: 6) +
    					(byte4 bitAnd: 63)].
    unicode ifNil:[^self]. "invalid UTF-8; presume Latin-1"
    outStream nextPut: (Character value: unicode).
    lastIndex := nextIndex + 1.
    nextIndex := ByteString findFirstInString: self inSet: Latin1ToUtf8Map startingAt: lastIndex.
    nextIndex = 0] whileFalse.
    outStream next: self size-lastIndex+1 putAll: self startingAt: lastIndex.
    ^outStream contents
!
----- Method: String class>>compare:with:collated: (in category 'primitives') -----
compare: string1 with: string2 collated: order
    "Return 1, 2 or 3, if string1 is <, =, or > string2, with the collating order of characters given by the order array."
| len1 len2 c1 c2 |
    order == nil ifTrue: [
    	len1 := string1 size.
    	len2 := string2 size.
    	1 to: (len1 min: len2) do:[:i |
    		c1 := (string1 at: i) asInteger.
    		c2 := (string2 at: i) asInteger.
    		c1 = c2 ifFalse: [c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]].
    	].
    	len1 = len2 ifTrue: [^ 2].
    	len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
    ].
    len1 := string1 size.
    len2 := string2 size.
    1 to: (len1 min: len2) do:[:i |
    	c1 := (string1 at: i) asInteger.
    	c2 := (string2 at: i) asInteger.
    	c1 < 256 ifTrue: [c1 := order at: c1 + 1].
    	c2 < 256 ifTrue: [c2 := order at: c2 + 1].
    	c1 = c2 ifFalse:[c1 < c2 ifTrue: [^ 1] ifFalse: [^ 3]].
    ].
    len1 = len2 ifTrue: [^ 2].
    len1 < len2 ifTrue: [^ 1] ifFalse: [^ 3].
!
----- Method: String class>>cr (in category 'instance creation') -----
cr
    "Answer a string containing a single carriage return character."
^ self with: Character cr
!
----- Method: String class>>crlf (in category 'instance creation') -----
crlf
    "Answer a string containing a carriage return and a linefeed."
^ self with: Character cr with: Character lf
!
----- Method: String class>>crlfcrlf (in category 'instance creation') -----
crlfcrlf
    ^self crlf , self crlf.
!
----- Method: String class>>example (in category 'examples') -----
example
    "To see the string displayed at the cursor point, execute this expression
    and select a point by pressing a mouse button."
'this is some text' displayOn: Display at: Sensor waitButton!
----- Method: String class>>expandMacro:argument:withExpansions: (in category 'formatting') -----
expandMacro: macroType argument: argument withExpansions: expansions 
    macroType = $s ifTrue: [^expansions at: argument].
    macroType = $p ifTrue: [^(expansions at: argument) printString].
    macroType = $n ifTrue: [^String cr].
    macroType = $t ifTrue: [^String tab].
    self error: 'unknown expansion type'!
----- Method: String class>>findFirstInString:inCharacterSet:startingAt: (in category 'primitives') -----
findFirstInString: aString inCharacterSet: aCharacterSet startingAt: start 
    "Trivial, non-primitive version"
    
    start
    	to: aString size
    	do: [:i | (aCharacterSet
    				includes: (aString at: i))
    			ifTrue: [^ i]].
    ^ 0!
----- Method: String class>>findFirstInString:inSet:startingAt: (in category 'primitives') -----
findFirstInString: aString inSet: inclusionMap startingAt: start
    "Trivial, non-primitive version"
    
    | i stringSize ascii more |
    inclusionMap size ~= 256 ifTrue: [^ 0].
    stringSize := aString size.
    more := true.
    i := start - 1.
    [more and: [(i := i + 1) <= stringSize]] whileTrue: [
    	ascii := (aString at: i) asciiValue.
    	more := ascii < 256 ifTrue: [(inclusionMap at: ascii + 1) = 0] ifFalse: [true].
    ].
i > stringSize ifTrue: [^ 0].
    ^ i!
----- Method: String class>>fromByteArray: (in category 'instance creation') -----
fromByteArray: aByteArray
^ aByteArray asString
!
----- Method: String class>>fromPacked: (in category 'instance creation') -----
fromPacked: aLong
    "Convert from a longinteger to a String of length 4."
| s |
    s := self new: 4.
    s at: 1 put: (aLong digitAt: 4) asCharacter.
    s at: 2 put: (aLong digitAt: 3) asCharacter.
    s at: 3 put: (aLong digitAt: 2) asCharacter.
    s at: 4 put: (aLong digitAt: 1) asCharacter.
    ^s
"String fromPacked: 'TEXT' asPacked"
!
----- Method: String class>>fromString: (in category 'instance creation') -----
fromString: aString 
    "Answer an instance of me that is a copy of the argument, aString."
    
    ^ aString copyFrom: 1 to: aString size!
----- Method: String class>>indexOfAscii:inString:startingAt: (in category 'primitives') -----
indexOfAscii: anInteger inString: aString startingAt: start
    "Trivial, non-primitive version"
    | stringSize |
    stringSize := aString size.
    start to: stringSize do: [:pos |
    	(aString at: pos) asInteger = anInteger ifTrue: [^ pos]].
    ^ 0
!
----- Method: String class>>initialize (in category 'initialization') -----
initialize   "self initialize"
| order |
    AsciiOrder := (0 to: 255) as: ByteArray.
CaseInsensitiveOrder := AsciiOrder copy.
    ($a to: $z) do:
    	[:c | CaseInsensitiveOrder at: c asciiValue + 1
    			put: (CaseInsensitiveOrder at: c asUppercase asciiValue +1)].
"Case-sensitive compare sorts space, digits, letters, all the rest..."
    CaseSensitiveOrder := ByteArray new: 256 withAll: 255.
    order := -1.
    ' 0123456789' do:  "0..10"
    	[:c | CaseSensitiveOrder at: c asciiValue + 1 put: (order := order+1)].
    ($a to: $z) do:     "11-64"
    	[:c | CaseSensitiveOrder at: c asUppercase asciiValue + 1 put: (order := order+1).
    	CaseSensitiveOrder at: c asciiValue + 1 put: (order := order+1)].
    1 to: CaseSensitiveOrder size do:
    	[:i | (CaseSensitiveOrder at: i) = 255 ifTrue:
    		[CaseSensitiveOrder at: i put: (order := order+1)]].
    order = 255 ifFalse: [self error: 'order problem'].
"a table for translating to lower case"
    LowercasingTable := String withAll: (Character allByteCharacters collect: [:c | c asLowercase]).
"a table for translating to upper case"
    UppercasingTable := String withAll: (Character allByteCharacters collect: [:c | c asUppercase]).
"a table for testing tokenish (for fast numArgs)"
    Tokenish := String withAll: (Character allByteCharacters collect:
    								[:c | c tokenish ifTrue: [c] ifFalse: [$~]]).
"CR and LF--characters that terminate a line"
    CSLineEnders := CharacterSet empty.
    CSLineEnders add: Character cr.
    CSLineEnders add: Character lf.
"separators and non-separators"
    CSSeparators := CharacterSet separators.
    CSNonSeparators := CSSeparators complement.!
----- Method: String class>>initializeHtmlEntities (in category 'initialization') -----
initializeHtmlEntities
    "self initializeHtmlEntities"
HtmlEntities := (Dictionary new: 128)
    	at: 'amp'	put: $&;
    	at: 'lt'		put: $<;
    	at: 'gt'		put: $>;
    	at: 'quot'	put: $";
    	at: 'euro'	put: Character euro;
    	yourself.
    #('nbsp' 'iexcl' 'cent' 'pound' 'curren' 'yen' 'brvbar' 'sect' 'uml' 'copy' 'ordf' 'laquo' 'not' 'shy' 'reg' 'hibar' 'deg' 'plusmn' 'sup2' 'sup3' 'acute' 'micro' 'para' 'middot' 'cedil' 'sup1' 'ordm' 'raquo' 'frac14' 'frac12' 'frac34' 'iquest' 'Agrave' 'Aacute' 'Acirc' 'Atilde' 'Auml' 'Aring' 'AElig' 'Ccedil' 'Egrave' 'Eacute' 'Ecirc' 'Euml' 'Igrave' 'Iacute' 'Icirc' 'Iuml' 'ETH' 'Ntilde' 'Ograve' 'Oacute' 'Ocirc' 'Otilde' 'Ouml' 'times' 'Oslash' 'Ugrave' 'Uacute' 'Ucirc' 'Uuml' 'Yacute' 'THORN' 'szlig' 'agrave' 'aacute' 'acirc' 'atilde' 'auml' 'aring' 'aelig' 'ccedil' 'egrave' 'eacute' 'ecirc' 'euml' 'igrave' 'iacute' 'icirc' 'iuml' 'eth' 'ntilde' 'ograve' 'oacute' 'ocirc' 'otilde' 'ouml' 'divide' 'oslash' 'ugrave' 'uacute' 'ucirc' 'uuml' 'yacute' 'thorn' 'yuml' ) withIndexDo: [:each :index | HtmlEntities at: each put: (index + 159) asCharacter]!
----- Method: String class>>lf (in category 'instance creation') -----
lf
    "Answer a string containing a single carriage return character."
^ self with: Character lf!
----- Method: String class>>new: (in category 'instance creation') -----
new: sizeRequested 
    "Answer an instance of this class with the number of indexable
    variables specified by the argument, sizeRequested."
    self == String 
    	ifTrue:[^ByteString new: sizeRequested]
    	ifFalse:[^self basicNew: sizeRequested].!
----- Method: String class>>noSeparatorMap (in category 'accessing') -----
noSeparatorMap
    ^CSNonSeparators byteArrayMap!
----- Method: String class>>readFrom: (in category 'instance creation') -----
readFrom: inStream
    "Answer an instance of me that is determined by reading the stream, 
    inStream. Embedded double quotes become the quote Character."
| outStream char done |
    outStream := WriteStream on: (self new: 16).
    "go to first quote"
    inStream skipTo: $'.
    done := false.
    [done or: [inStream atEnd]]
    	whileFalse: 
    		[char := inStream next.
    		char = $'
    			ifTrue: 
    				[char := inStream next.
    				char = $'
    					ifTrue: [outStream nextPut: char]
    					ifFalse: [done := true]]
    			ifFalse: [outStream nextPut: char]].
    ^outStream contents!
----- Method: String class>>separatorMap (in category 'accessing') -----
separatorMap
    ^CSSeparators byteArrayMap!
----- Method: String class>>space (in category 'instance creation') -----
space
    "Answer a string containing a single space character."
^ self with: Character space
!
----- Method: String class>>stringHash:initialHash: (in category 'primitives') -----
stringHash: aString initialHash: speciesHash
    | stringSize hash low |
    stringSize := aString size.
    hash := speciesHash bitAnd: 16rFFFFFFF.
    1 to: stringSize do: [:pos |
    	hash := hash + (aString at: pos) asInteger.
    	"Begin hashMultiply"
    	low := hash bitAnd: 16383.
    	hash := (16r260D * low + ((16r260D * (hash bitShift: -14) + (16r0065 * low) bitAnd: 16383) * 16384)) bitAnd: 16r0FFFFFFF.
    ].
    ^ hash.
!
----- Method: String class>>tab (in category 'instance creation') -----
tab
    "Answer a string containing a single tab character."
^ self with: Character tab
!
----- Method: String class>>translate:from:to:table: (in category 'primitives') -----
translate: aString from: start  to: stop  table: table
    "Trivial, non-primitive version"
    | char |
    start to: stop do: [:i |
    	char := (aString at: i) asInteger.
    	char < 256 ifTrue: [aString at: i put: (table at: char+1)].
    ].
!
----- Method: String class>>value: (in category 'instance creation') -----
value: anInteger
^ self with: (Character value: anInteger).
!
----- Method: String class>>with: (in category 'instance creation') -----
with: aCharacter
    | newCollection |
    aCharacter asInteger < 256
    	ifTrue:[newCollection := ByteString new: 1]
    	ifFalse:[newCollection := WideString new: 1].
    newCollection at: 1 put: aCharacter.
    ^newCollection!
----- Method: String>>* (in category 'arithmetic') -----
* arg
^ arg adaptToString: self andSend: #*!
----- Method: String>>+ (in category 'arithmetic') -----
+ arg
^ arg adaptToString: self andSend: #+!
----- Method: String>>- (in category 'arithmetic') -----
- arg
^ arg adaptToString: self andSend: #-!
----- Method: String>>/ (in category 'arithmetic') -----
/ arg
^ arg adaptToString: self andSend: #/!
----- Method: String>>// (in category 'arithmetic') -----
// arg
^ arg adaptToString: self andSend: #//!
----- Method: String>>< (in category 'comparing') -----
< aString 
    "Answer whether the receiver sorts before aString.
    The collation order is simple ascii (with case differences)."
^ (self compare: self with: aString collated: AsciiOrder) = 1!
----- Method: String>><= (in category 'comparing') -----
<= aString 
    "Answer whether the receiver sorts before or equal to aString.
    The collation order is simple ascii (with case differences)."
    
    ^ (self compare: self with: aString collated: AsciiOrder) <= 2!
----- Method: String>>= (in category 'comparing') -----
= aString 
    "Answer whether the receiver sorts equally as aString.
    The collation order is simple ascii (with case differences)."
    
    aString isString ifFalse: [ ^ false ].
    ^ (self compare: self with: aString collated: AsciiOrder) = 2!
----- Method: String>>> (in category 'comparing') -----
...
aString
"Answer whether the receiver sorts after aString.
    The collation order is simple ascii (with case differences)."
^ (self compare: self with: aString collated: AsciiOrder) = 3!
----- Method: String>>>= (in category 'comparing') -----
...
= aString
"Answer whether the receiver sorts after or equal to aString.
    The collation order is simple ascii (with case differences)."
^ (self compare: self with: aString collated: AsciiOrder) >= 2!
----- Method: String>>\ (in category 'arithmetic') -----
\ arg
^ arg adaptToString: self andSend: #\!
----- Method: String>>adaptToCollection:andSend: (in category 'converting') -----
adaptToCollection: rcvr andSend: selector
    "If I am involved in arithmetic with a collection, convert me to a number."
^ rcvr perform: selector with: self asNumber!
----- Method: String>>adaptToNumber:andSend: (in category 'converting') -----
adaptToNumber: rcvr andSend: selector
    "If I am involved in arithmetic with a number, convert me to a number."
^ rcvr perform: selector with: self asNumber!
----- Method: String>>adaptToPoint:andSend: (in category 'converting') -----
adaptToPoint: rcvr andSend: selector
    "If I am involved in arithmetic with a point, convert me to a number."
^ rcvr perform: selector with: self asNumber!
----- Method: String>>adaptToString:andSend: (in category 'converting') -----
adaptToString: rcvr andSend: selector
    "If I am involved in arithmetic with a string, convert us both to
    numbers, and return the printString of the result."
^ (rcvr asNumber perform: selector with: self asNumber) printString!
----- Method: String>>alike: (in category 'comparing') -----
alike: aString 
    "Answer some indication of how alike the receiver is to the argument,  0 is no match, twice aString size is best score.  Case is ignored."
| i j k minSize bonus |
    minSize := (j := self size) min: (k := aString size).
    bonus := (j - k) abs < 2 ifTrue: [ 1 ] ifFalse: [ 0 ].
    i := 1.
    [(i <= minSize) and: [((super at: i) bitAnd: 16rDF)  = ((aString at: i) asciiValue bitAnd: 16rDF)]]
    	whileTrue: [ i := i + 1 ].
    [(j > 0) and: [(k > 0) and:
    	[((super at: j) bitAnd: 16rDF) = ((aString at: k) asciiValue bitAnd: 16rDF)]]]
    		whileTrue: [ j := j - 1.  k := k - 1. ].
    ^ i - 1 + self size - j + bonus. !
----- Method: String>>asAlphaNumeric:extraChars:mergeUID: (in category 'converting') -----
asAlphaNumeric: totalSize extraChars: additionallyAllowed mergeUID: minimalSizeOfRandomPart
    "Generates a String with unique identifier ( UID ) qualities, the difference to a
     UUID is that its beginning is derived from the receiver, so that it has a meaning
     for a human reader.
Answers a String of totalSize, which consists of 3 parts
     1.part: the beginning of the receiver only consisting of
    	a-z, A-Z, 0-9 and extraChars in Collection additionallyAllowed ( which can be nil )
     2.part: a single _
     3.part: a ( random ) UID of size >= minimalSizeOfRandomPart consisting of
    	a-z, A-Z, 0-9
Starting letters are capitalized. 
     TotalSize must be at least 1.
     Exactly 1 occurrence of $_ is guaranteed ( unless additionallyAllowed includes $_ ).
     The random part has even for small sizes good UID qualitites for many practical purposes.
     If only lower- or uppercase letters are demanded, simply convert the answer with
     say #asLowercase. The probability of a duplicate will rise only moderately ( see below ).
Example: 
    	size of random part = 10
    	in n generated UIDs the chance p of having non-unique UIDs is
    		n = 10000 ->  p < 1e-10		if answer is reduced to lowerCase: p < 1.4 e-8
    		n = 100000 -> p < 1e-8
    	at the bottom is a snippet for your own calculations  
    	Note: the calculated propabilites are theoretical,
    		for the actually used random generator they may be much worse"
| stream out sizeOfFirstPart index ascii ch skip array random |
    totalSize > minimalSizeOfRandomPart 
    	ifFalse: [ self errorOutOfBounds ].
    stream := ReadStream on: self.
    out := WriteStream on: ( String new: totalSize ).
    index := 0.
    skip := true.
    sizeOfFirstPart := totalSize - minimalSizeOfRandomPart - 1.
    [ stream atEnd or: [ index >= sizeOfFirstPart ]]
    whileFalse: [
    	((( ascii := ( ch := stream next ) asciiValue ) >= 65 and: [ ascii <= 90 ]) or: [
    		( ascii >= 97 and: [ ascii <= 122 ]) or: [			 
    		ch isDigit or: [
    		additionallyAllowed notNil and: [ additionallyAllowed includes: ch ]]]])
    	ifTrue: [
    		skip
    			ifTrue: [ out nextPut: ch asUppercase ]
    			ifFalse: [ out nextPut: ch ].
    		index := index + 1.
    		skip := false ]
    	ifFalse: [ skip := true ]].
    out nextPut: $_.
    array := Array new: 62.
    1 to: 26 do: [ :i |
    	array at: i put: ( i + 64 ) asCharacter.
    	array at: i + 26 put: ( i + 96 ) asCharacter ].
    53 to: 62 do: [ :i |
    	array at: i put: ( i - 5 ) asCharacter ].
    random := UUIDGenerator default randomGenerator. 
    totalSize - index - 1 timesRepeat: [
    	out nextPut: ( array atRandom: random )].
    ^out contents
"	calculation of probability p for failure of uniqueness in n UIDs
    	Note: if answer will be converted to upper or lower case replace 62 with 36
    | n i p all |
    all := 62 raisedTo: sizeOfRandomPart.
    i := 1.
    p := 0.0 .
    n := 10000.
    [ i <= n ]
    whileTrue: [
    	p := p + (( i - 1 ) / all ).
    	i := i + 1 ].
    p
approximation formula: n squared / ( 62.0 raisedTo: sizeOfRandomPart ) / 2 
    "
"'Crop SketchMorphs and Grab Screen Rect to JPG' 
    		asAlphaNumeric: 31 extraChars: nil mergeUID: 10  
     			'CropSketchMorphsAndG_iOw94jquN6'
     'Monticello' 
    		asAlphaNumeric: 31 extraChars: nil mergeUID: 10    
    			'Monticello_kp6aV2l0IZK9uBULGOeG' 
     'version-', ( '1.1.2' replaceAll: $. with: $- )
    		asAlphaNumeric: 31 extraChars: #( $- ) mergeUID: 10    
    			'Version-1-1-2_kuz2tMg2xX9iRLDVR'"
    	!
----- Method: String>>asByteArray (in category 'converting') -----
asByteArray
    "Convert to a ByteArray with the ascii values of the string."
    | b |
    b := ByteArray new: self byteSize.
    1 to: self size * 4 do: [:i |
    	b at: i put: (self byteAt: i).
    ].
    ^ b.
!
----- Method: String>>asByteString (in category 'converting') -----
asByteString
    "Convert the receiver into a ByteString"
    ^self asOctetString!
----- Method: String>>asCharacter (in category 'converting') -----
asCharacter
    "Answer the receiver's first character, or '*' if none.  Idiosyncratic, provisional."
^ self size > 0 ifTrue: [self first] ifFalse:[$·]!
----- Method: String>>asDate (in category 'converting') -----
asDate
    "Many allowed forms, see Date>>#readFrom:"
^ Date fromString: self!
----- Method: String>>asDateAndTime (in category 'converting') -----
asDateAndTime
"Convert from UTC format" 	^ DateAndTime fromString: self!
----- Method: String>>asDecomposedUnicode (in category 'converting') -----
asDecomposedUnicode
    "Convert the receiver into a decomposed Unicode representation.
    Optimized for the common case that no decomposition needs to take place."
    | lastIndex nextIndex out decomposed |
    lastIndex := 1.
    nextIndex := 0.
    [(nextIndex := nextIndex+1) <= self size] whileTrue:[
    	decomposed := Unicode decompose: (self at: nextIndex).
    	decomposed ifNotNil:[
    		lastIndex = 1 ifTrue:[out := WriteStream on: (String new: self size)].
    		out nextPutAll: (self copyFrom: lastIndex to: nextIndex-1).
    		out nextPutAll: decomposed.
    		lastIndex := nextIndex+1.
    	].
    ].
    ^out ifNil:[self] ifNotNil:[
    	out nextPutAll: (self copyFrom: lastIndex to: self size).
    	out contents]!
----- Method: String>>asDefaultDecodedString (in category 'converting') -----
asDefaultDecodedString
^ self
!
----- Method: String>>asDisplayText (in category 'converting') -----
asDisplayText
    "Answer a DisplayText whose text string is the receiver."
^DisplayText text: self asText!
----- Method: String>>asDuration (in category 'converting') -----
asDuration
    "convert from [nnnd]hh:mm:ss[.nanos] format. [] implies optional elements"
^ Duration fromString: self
!
----- Method: String>>asExplorerString (in category 'user interface') -----
asExplorerString
^ self printString!
----- Method: String>>asFileName (in category 'converting') -----
asFileName
    "Answer a String made up from the receiver that is an acceptable file 
    name."
| string checkedString |
    string := FileDirectory checkName: self fixErrors: true.
    checkedString := (FilePath pathName: string) asVmPathName.
    ^ (FilePath pathName: checkedString isEncoded: true) asSqueakPathName.
!
----- Method: String>>asFourCode (in category 'converting') -----
asFourCode
| result |
    self size = 4 ifFalse: [^self error: 'must be exactly four characters'].
    result := self inject: 0 into: [:val :each | 256 * val + each asciiValue].
    (result bitAnd: 16r80000000) = 0 
    	ifFalse: [self error: 'cannot resolve fourcode'].
    (result bitAnd: 16r40000000) = 0 ifFalse: [^result - 16r80000000].
    ^ result
!
----- Method: String>>asHex (in category 'converting') -----
asHex
    | stream |
    stream := WriteStream on: (String new: self size * 4).
    self do: [ :ch | stream nextPutAll: ch hex ].
    ^stream contents!
----- Method: String>>asHtml (in category 'converting') -----
asHtml
    "Do the basic character conversion for HTML.  Leave all original return 
    and tabs in place, so can conver back by simply removing bracked 
    things. 4/4/96 tk"
    | temp |
    temp := self copyReplaceAll: '&' with: '&amp;'.
    HtmlEntities keysAndValuesDo:
    	[:entity :char |
    	char = $& ifFalse:
    		[temp := temp copyReplaceAll: char asString with: '&' , entity , ';']].
    temp := temp copyReplaceAll: '	' with: '	<IMG SRC="tab.gif" ALT="    ">'.
    temp := temp copyReplaceAll: '
' with: '
<BR>'.
    ^ temp
"
    'A<&>B' asHtml
"!
----- Method: String>>asIRCLowercase (in category 'converting') -----
asIRCLowercase
    "Answer a String made up from the receiver whose characters are all 
    lowercase, where 'lowercase' is by IRC's definition"
^self collect: [ :c | c asIRCLowercase ]!
----- Method: String>>asIdentifier: (in category 'converting') -----
asIdentifier: shouldBeCapitalized
    "Return a legal identifier, with first character in upper case if shouldBeCapitalized is true, else lower case.  This will always return a legal identifier, even for an empty string"
| aString firstChar firstLetterPosition |
    aString := self select: [:el | el isAlphaNumeric].
    firstLetterPosition := aString findFirst: [:ch | ch isLetter].
    aString := firstLetterPosition == 0
    	ifFalse:
    		[aString copyFrom: firstLetterPosition to: aString size]
    	ifTrue:
    		['a', aString].
    firstChar := shouldBeCapitalized ifTrue: [aString first asUppercase] ifFalse: [aString first asLowercase].
^ firstChar asString, (aString copyFrom: 2 to: aString size)
"
'234Fred987' asIdentifier: false
'235Fred987' asIdentifier: true
'' asIdentifier: true
'()87234' asIdentifier: false
'())z>=PPve889  U >' asIdentifier: false
"!
----- Method: String>>asInteger (in category 'converting') -----
asInteger 
    ^self asSignedInteger
!
----- Method: String>>asLegalSelector (in category 'converting') -----
asLegalSelector
    | toUse |
    toUse := ''.
    self do:
    	[:char | char isAlphaNumeric ifTrue: [toUse := toUse copyWith: char]].
    (self size == 0 or: [self first isLetter not])
    	ifTrue:		[toUse := 'v', toUse].
^ toUse withFirstCharacterDownshifted
"'234znak 43 ) 2' asLegalSelector"!
----- Method: String>>asLowercase (in category 'converting') -----
asLowercase
    "Answer a String made up from the receiver whose characters are all 
    lowercase."
^ self copy asString translateToLowercase!
----- Method: String>>asNumber (in category 'converting') -----
asNumber 
    "Answer the Number created by interpreting the receiver as the string 
    representation of a number."
^Number readFromString: self!
----- Method: String>>asOctetString (in category 'converting') -----
asOctetString
    "Convert the receiver into an octet string"
    | string |
    string := String new: self size.
    1 to: self size do: [:i | string at: i put: (self at: i)].
    ^string!
----- Method: String>>asPacked (in category 'converting') -----
asPacked
    "Convert to a longinteger that describes the string"
^ self inject: 0 into: [ :pack :next | pack := pack * 256 + next asInteger ].!
----- Method: String>>asParagraph (in category 'converting') -----
asParagraph
    "Answer a Paragraph whose text string is the receiver."
^Paragraph withText: self asText!
----- Method: String>>asPluralBasedOn: (in category 'converting') -----
asPluralBasedOn: aNumberOrCollection
    "Append an 's' to this string based on whether aNumberOrCollection is 1 or of size 1."
^ (aNumberOrCollection = 1 or:
    	[aNumberOrCollection isCollection and: [aNumberOrCollection size = 1]])
    		ifTrue: [self]
    		ifFalse: [self, 's']
!
----- Method: String>>asPrecomposedUnicode (in category 'converting') -----
asPrecomposedUnicode
    "Convert the receiver into a precomposed Unicode representation.
    Optimized for the common case that no composition needs to take place."
    | lastIndex nextIndex composed out |
    lastIndex := 1.
    nextIndex := 0.
    [(nextIndex := nextIndex+1) < self size] whileTrue:[
    	composed := Unicode compose: (self at: nextIndex) with: (self at: nextIndex+1).
    	composed ifNotNil:[
    		lastIndex = 1 ifTrue:[out := WriteStream on: (String new: self size)].
    		out nextPutAll: (self copyFrom: lastIndex to: nextIndex-1).
    		out nextPut: composed.
    		nextIndex := nextIndex+1.
    		lastIndex := nextIndex+1.
    	].
    ].
    ^out ifNil:[self] ifNotNil:[
    	out nextPutAll: (self copyFrom: lastIndex to: self size).
    	out contents]!
----- Method: String>>asSignedInteger (in category 'converting') -----
asSignedInteger
    "Returns the first signed integer it can find or nil."
| start stream |
    start := self findFirst: [:char | char isDigit].
    start isZero ifTrue: [^ nil].
    stream := (ReadStream on: self) position: start.
    stream oldBack = $- ifTrue: [stream oldBack].
    ^ Integer readFrom: stream!
----- Method: String>>asSmalltalkComment (in category 'converting') -----
asSmalltalkComment
    "return this string, munged so that it can be treated as a comment in Smalltalk code.  Quote marks are added to the beginning and end of the string, and whenever a solitary quote mark appears within the string, it is doubled"
^String streamContents:  [ :str |
    	| quoteCount first |
str nextPut: $".
    
    	quoteCount := 0.
    	first := true.
    	self do: [ :char |
    		char = $"
    			ifTrue: [
    				first ifFalse: [
    					str nextPut: char.
    					quoteCount := quoteCount + 1 ] ]
    			ifFalse: [
    				quoteCount odd ifTrue: [
    					"add a quote to even the number of quotes in a row"
    					str nextPut: $" ].
    				quoteCount := 0.
    				str nextPut: char ].
    		first := false ].
quoteCount odd ifTrue: [
    		"check at the end"
    		str nextPut: $". ].
str nextPut: $".
    ].
    !
----- Method: String>>asSqueakPathName (in category 'converting') -----
asSqueakPathName
^ self.
!
----- Method: String>>asString (in category 'converting') -----
asString
    "Answer this string."
^ self
!
----- Method: String>>asStringOrText (in category 'converting') -----
asStringOrText
    "Answer this string."
^ self
!
----- Method: String>>asSymbol (in category 'converting') -----
asSymbol
    "Answer the unique Symbol whose characters are the characters of the 
    string."
    ^Symbol intern: self!
----- Method: String>>asText (in category 'converting') -----
asText
    "Answer a Text whose string is the receiver."
^Text fromString: self!
----- Method: String>>asTime (in category 'converting') -----
asTime
    "Many allowed forms, see Time>>readFrom:"
^ Time fromString: self.!
----- Method: String>>asTimeStamp (in category 'converting') -----
asTimeStamp
    "Convert from obsolete TimeStamp format"
^ TimeStamp fromString: self!
----- Method: String>>asUnHtml (in category 'converting') -----
asUnHtml
    "Strip out all Html stuff (commands in angle brackets <>) and convert
the characters &<> back to their real value.  Leave actual cr and tab as
they were in text."
    | in out char rest |
    in := ReadStream on: self.
    out := WriteStream on: (String new: self size).
    [in atEnd] whileFalse:
    	[in peek = $<
    		ifTrue: [in unCommand] 	"Absorb <...><...>"
    		ifFalse: [(char := in next) = $&
    					ifTrue: [rest := in upTo: $;.
    							out nextPut: (HtmlEntities
    								at: rest
    								ifAbsent: [Character space])]
    					ifFalse: [out nextPut: char]].
    	].
    ^ out contents!
----- Method: String>>asUnsignedInteger (in category 'converting') -----
asUnsignedInteger 
    "Returns the first integer it can find or nil."
| start stream |
    start := self findFirst: [:char | char isDigit].
    start isZero ifTrue: [^nil].
    stream := (ReadStream on: self) position: start - 1.
    ^Integer readFrom: stream!
----- Method: String>>asUppercase (in category 'converting') -----
asUppercase
    "Answer a String made up from the receiver whose characters are all 
    uppercase."
^self copy asString translateToUppercase!
----- Method: String>>asUrl (in category 'converting') -----
asUrl
    "convert to a Url"
    "'http://www.cc.gatech.edu/' asUrl"
    "msw://chaos.resnet.gatech.edu:9000/' asUrl"
    ^Url absoluteFromText: self!
----- Method: String>>asUrlRelativeTo: (in category 'converting') -----
asUrlRelativeTo: aUrl
    ^aUrl newFromRelativeText: self!
----- Method: String>>asVmPathName (in category 'converting') -----
asVmPathName
^ (FilePath pathName: self) asVmPathName.
!
----- Method: String>>asWideString (in category 'converting') -----
asWideString 
    self isWideString
    	ifTrue:[^self]
    	ifFalse:[^WideString from: self]!
----- Method: String>>askIfAddStyle:req: (in category 'converting') -----
askIfAddStyle: priorMethod req: requestor
    ^ self   "we are a string with no text style"!
----- Method: String>>base64Decoded (in category 'converting') -----
base64Decoded
    "Decode the receiver from base 64"
    "'SGVsbG8gV29ybGQ=' base64Decoded"
    ^(Base64MimeConverter mimeDecode: self as: self class)!
----- Method: String>>base64Encoded (in category 'converting') -----
base64Encoded
    "Encode the receiver as base64"
    "'Hello World' base64Encoded"
    ^(Base64MimeConverter mimeEncode: (ReadStream on: self)) contents!
----- Method: String>>basicType (in category 'printing') -----
basicType
    "Answer a symbol representing the inherent type of the receiver"
"Number String Boolean player collection sound color etc"
    ^ #String!
----- Method: String>>byteAt: (in category 'accessing') -----
byteAt: index
    ^self subclassResponsibility!
----- Method: String>>byteAt:put: (in category 'accessing') -----
byteAt: index put: value
    ^self subclassResponsibility!
----- Method: String>>byteEncode: (in category 'filter streaming') -----
byteEncode:aStream
^aStream writeString: self.
!
----- Method: String>>byteSize (in category 'accessing') -----
byteSize
    ^self subclassResponsibility!
----- Method: String>>capitalized (in category 'converting') -----
capitalized
    "Return a copy with the first letter capitalized"
    | cap |
    self isEmpty ifTrue: [ ^self copy ].
    cap := self copy.
    cap at: 1 put: (cap at: 1) asUppercase.
    ^ cap!
----- Method: String>>caseInsensitiveLessOrEqual: (in category 'comparing') -----
caseInsensitiveLessOrEqual: aString 
    "Answer whether the receiver sorts before or equal to aString.
    The collation order is case insensitive."
    ^(self compare: aString caseSensitive: false) <= 2!
----- Method: String>>caseSensitiveLessOrEqual: (in category 'comparing') -----
caseSensitiveLessOrEqual: aString 
    "Answer whether the receiver sorts before or equal to aString.
    The collation order is case sensitive."
    ^(self compare: aString caseSensitive: true) <= 2!
----- Method: String>>charactersExactlyMatching: (in category 'comparing') -----
charactersExactlyMatching: aString
    "Do a character-by-character comparison between the receiver and aString.  Return the index of the final character that matched exactly."
| count |
    count := self size min: aString size.
    1 to: count do: [:i | 
    	(self at: i) = (aString at: i) ifFalse: [
    		^ i - 1]].
    ^ count!
----- Method: String>>compare: (in category 'comparing') -----
compare: aString 
    "Answer a comparison code telling how the receiver sorts relative to aString:
    	1 - before
    	2 - equal
    	3 - after.
    The collation sequence is ascii with case differences ignored.
    To get the effect of a <= b, but ignoring case, use (a compare: b) <= 2."
    ^self compare: aString caseSensitive: false!
----- Method: String>>compare:caseSensitive: (in category 'comparing') -----
compare: aString caseSensitive: aBool
    "Answer a comparison code telling how the receiver sorts relative to aString:
    	1 - before
    	2 - equal
    	3 - after.
    "
    | map |
    map := aBool ifTrue:[CaseSensitiveOrder] ifFalse:[CaseInsensitiveOrder].
    ^self compare: self with: aString collated: map!
----- Method: String>>compare:with:collated: (in category 'comparing') -----
compare: string1 with: string2 collated: order
(string1 isByteString and: [string2 isByteString]) ifTrue: [
    	^ ByteString compare: string1 with: string2 collated: order
    ].
     "Primitive does not fail properly right now"
      ^ String compare: string1 with: string2 collated: order
"
self assert: 'abc' = 'abc' asWideString.
self assert: 'abc' asWideString = 'abc'.
self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString ~= 'a000' asWideString).
self assert: ('a000' asWideString ~= (ByteArray with: 97 with: 0 with: 0 with: 0) asString).
self assert: ('abc' sameAs: 'aBc' asWideString).
self assert: ('aBc' asWideString sameAs: 'abc').
self assert: ((ByteArray with: 97 with: 0 with: 0 with: 0) asString sameAs: 'Abcd' asWideString) not.
self assert: ('a000' asWideString sameAs: (ByteArray with: 97 with: 0 with: 0 with: 0) asString) not.
"!
----- Method: String>>compressWithTable: (in category 'converting') -----
compressWithTable: tokens
    "Return a string with all substrings that occur in tokens replaced
    by a character with ascii code = 127 + token index.
    This will work best if tokens are sorted by size.
    Assumes this string contains no characters > 127, or that they
    are intentionally there and will not interfere with this process."
    | str null finalSize start result ri c ts |
    null := Character value: 0.
    str := self copyFrom: 1 to: self size.  "Working string will get altered"
    finalSize := str size.
    tokens doWithIndex:
    	[:token :tIndex |
    	start := 1.
    	[(start := str findString: token startingAt: start) > 0]
    		whileTrue:
    		[ts := token size.
    		((start + ts) <= str size
    			and: [(str at: start + ts) = $  and: [tIndex*2 <= 128]])
    			ifTrue: [ts := token size + 1.  "include training blank"
    					str at: start put: (Character value: tIndex*2 + 127)]
    			ifFalse: [str at: start put: (Character value: tIndex + 127)].
    		str at: start put: (Character value: tIndex + 127).
    		1 to: ts-1 do: [:i | str at: start+i put: null].
    		finalSize := finalSize - (ts - 1).
    		start := start + ts]].
    result := String new: finalSize.
    ri := 0.
    1 to: str size do:
    	[:i | (c := str at: i) = null ifFalse: [result at: (ri := ri+1) put: c]].
    ^ result!
----- Method: String>>contractTo: (in category 'converting') -----
contractTo: smallSize
    "return myself or a copy shortened by ellipsis to smallSize"
    | leftSize |
    self size <= smallSize
    	ifTrue: [^ self].  "short enough"
    smallSize < 5
    	ifTrue: [^ self copyFrom: 1 to: smallSize].    "First N characters"
    leftSize := smallSize-2//2.
    ^ self copyReplaceFrom: leftSize+1		"First N/2 ... last N/2"
    	to: self size - (smallSize - leftSize - 3)
    	with: '...'
"
    'A clear but rather long-winded summary' contractTo: 18
"!
----- Method: String>>convertFromEncoding: (in category 'converting') -----
convertFromEncoding: encodingName
    ^self convertFromWithConverter: (TextConverter newForEncoding: encodingName)!
----- Method: String>>convertFromSuperSwikiServerString (in category 'converting') -----
convertFromSuperSwikiServerString
    ^self convertFromEncoding: 'shift_jis'!
----- Method: String>>convertFromWithConverter: (in category 'converting') -----
convertFromWithConverter: converter
| readStream writeStream c |
    readStream := self readStream.
    writeStream := String new writeStream.
    converter ifNil: [^ self].
    [readStream atEnd] whileFalse: [
    	c := converter nextFromStream: readStream.
    	c ifNotNil: [writeStream nextPut: c] ifNil: [^ writeStream contents]
    ].
    ^ writeStream contents
!
----- Method: String>>convertToEncoding: (in category 'converting') -----
convertToEncoding: encodingName
    ^self convertToWithConverter: (TextConverter newForEncoding: encodingName).!
----- Method: String>>convertToSuperSwikiServerString (in category 'converting') -----
convertToSuperSwikiServerString
    ^self convertToEncoding: 'shift_jis'!
----- Method: String>>convertToSystemString (in category 'converting') -----
convertToSystemString
| readStream writeStream converter |
    readStream := self readStream.
    writeStream := String new writeStream.
    converter := LanguageEnvironment defaultSystemConverter.
    converter ifNil: [^ self].
    [readStream atEnd] whileFalse: [
    	converter nextPut: readStream next toStream: writeStream
    ].
    converter emitSequenceToResetStateIfNeededOn: writeStream.
    ^ writeStream contents.
!
----- Method: String>>convertToWithConverter: (in category 'converting') -----
convertToWithConverter: converter
| readStream writeStream |
    readStream := self readStream.
    writeStream := String new writeStream.
    converter ifNil: [^ self].
    [readStream atEnd] whileFalse: [
    	converter nextPut: readStream next toStream: writeStream
    ].
    converter emitSequenceToResetStateIfNeededOn: writeStream.
    ^ writeStream contents.
!
----- Method: String>>copyReplaceTokens:with: (in category 'copying') -----
copyReplaceTokens: oldSubstring with: newSubstring 
    "Replace all occurrences of oldSubstring that are surrounded
    by non-alphanumeric characters"
    ^ self copyReplaceAll: oldSubstring with: newSubstring asTokens: true
    "'File asFile Files File''s File' copyReplaceTokens: 'File' with: 'Snick'"!
----- Method: String>>correctAgainst: (in category 'converting') -----
correctAgainst: wordList
    "Correct the receiver: assume it is a misspelled word and return the (maximum of five) nearest words in the wordList.  Depends on the scoring scheme of alike:"
    | results |
    results := self correctAgainst: wordList continuedFrom: nil.
    results := self correctAgainst: nil continuedFrom: results.
    ^ results!
----- Method: String>>correctAgainst:continuedFrom: (in category 'converting') -----
correctAgainst: wordList continuedFrom: oldCollection
    "Like correctAgainst:.  Use when you want to correct against several lists, give nil as the first oldCollection, and nil as the last wordList."
^ wordList isNil
    	ifTrue: [ self correctAgainstEnumerator: nil
    				continuedFrom: oldCollection ]
    	ifFalse: [ self correctAgainstEnumerator: [ :action | wordList do: action without: nil]
    				continuedFrom: oldCollection ]!
----- Method: String>>correctAgainstDictionary:continuedFrom: (in category 'converting') -----
correctAgainstDictionary: wordDict continuedFrom: oldCollection
    "Like correctAgainst:continuedFrom:.  Use when you want to correct against a dictionary."
^ wordDict isNil
    	ifTrue: [ self correctAgainstEnumerator: nil
    				continuedFrom: oldCollection ]
    	ifFalse: [ self correctAgainstEnumerator: [ :action | wordDict keysDo: action ]
    				continuedFrom: oldCollection ]!
----- Method: String>>correctAgainstEnumerator:continuedFrom: (in category 'private') -----
correctAgainstEnumerator: wordBlock continuedFrom: oldCollection
    "The guts of correction, instead of a wordList, there is a block that should take another block and enumerate over some list with it."
| choices scoreMin results score maxChoices |
    scoreMin := self size // 2 min: 3.
    maxChoices := 10.
    oldCollection isNil
    	ifTrue: [ choices := SortedCollection sortBlock: [ :x :y | x value > y value ] ]
    	ifFalse: [ choices := oldCollection ].
    wordBlock isNil
    	ifTrue:
    		[ results := OrderedCollection new.
    		1 to: (maxChoices min: choices size) do: [ :i | results add: (choices at: i) key ] ]
    	ifFalse:
    		[ wordBlock value: [ :word |
    			(score := self alike: word) >= scoreMin ifTrue:
    				[ choices add: (Association key: word value: score).
    					(choices size >= maxChoices) ifTrue: [ scoreMin := (choices at: maxChoices) value] ] ].
    		results := choices ].
    ^ results!
----- Method: String>>crc16 (in category 'comparing') -----
crc16
    "Compute a 16 bit cyclic redundancy check."
| crc |
    crc := 0.
    1 to: self byteSize do: [:i |
    	crc := (crc bitShift: -8) bitXor: (
    	 #(	16r0000	16rC0C1	16rC181	16r0140	16rC301	16r03C0	16r0280	16rC241
    		16rC601	16r06C0	16r0780	16rC741	16r0500	16rC5C1	16rC481	16r0440
    		16rCC01	16r0CC0	16r0D80	16rCD41	16r0F00	16rCFC1	16rCE81	16r0E40
    		16r0A00	16rCAC1	16rCB81	16r0B40	16rC901	16r09C0	16r0880	16rC841
    		16rD801	16r18C0	16r1980	16rD941	16r1B00	16rDBC1	16rDA81	16r1A40
    		16r1E00	16rDEC1	16rDF81	16r1F40	16rDD01	16r1DC0	16r1C80	16rDC41
    		16r1400	16rD4C1	16rD581	16r1540	16rD701	16r17C0	16r1680	16rD641
    		16rD201	16r12C0	16r1380	16rD341	16r1100	16rD1C1	16rD081	16r1040
    		16rF001	16r30C0	16r3180	16rF141	16r3300	16rF3C1	16rF281	16r3240
    		16r3600	16rF6C1	16rF781	16r3740	16rF501	16r35C0	16r3480	16rF441
    		16r3C00	16rFCC1	16rFD81	16r3D40	16rFF01	16r3FC0	16r3E80	16rFE41
    		16rFA01	16r3AC0	16r3B80	16rFB41	16r3900	16rF9C1	16rF881	16r3840
    		16r2800	16rE8C1	16rE981	16r2940	16rEB01	16r2BC0	16r2A80	16rEA41
    		16rEE01	16r2EC0	16r2F80	16rEF41	16r2D00	16rEDC1	16rEC81	16r2C40
    		16rE401	16r24C0	16r2580	16rE541	16r2700	16rE7C1	16rE681	16r2640
    		16r2200	16rE2C1	16rE381	16r2340	16rE101	16r21C0	16r2080	16rE041
    		16rA001	16r60C0	16r6180	16rA141	16r6300	16rA3C1	16rA281	16r6240
    		16r6600	16rA6C1	16rA781	16r6740	16rA501	16r65C0	16r6480	16rA441
    		16r6C00	16rACC1	16rAD81	16r6D40	16rAF01	16r6FC0	16r6E80	16rAE41
    		16rAA01	16r6AC0	16r6B80	16rAB41	16r6900	16rA9C1	16rA881	16r6840
    		16r7800	16rB8C1	16rB981	16r7940	16rBB01	16r7BC0	16r7A80	16rBA41
    		16rBE01	16r7EC0	16r7F80	16rBF41	16r7D00	16rBDC1	16rBC81	16r7C40
    		16rB401	16r74C0	16r7580	16rB541	16r7700	16rB7C1	16rB681	16r7640
    		16r7200	16rB2C1	16rB381	16r7340	16rB101	16r71C0	16r7080	16rB041
    		16r5000	16r90C1	16r9181	16r5140	16r9301	16r53C0	16r5280	16r9241
    		16r9601	16r56C0	16r5780	16r9741	16r5500	16r95C1	16r9481	16r5440
    		16r9C01	16r5CC0	16r5D80	16r9D41	16r5F00	16r9FC1	16r9E81	16r5E40
    		16r5A00	16r9AC1	16r9B81	16r5B40	16r9901	16r59C0	16r5880	16r9841
    		16r8801	16r48C0	16r4980	16r8941	16r4B00	16r8BC1	16r8A81	16r4A40
    		16r4E00	16r8EC1	16r8F81	16r4F40	16r8D01	16r4DC0	16r4C80	16r8C41
    		16r4400	16r84C1	16r8581	16r4540	16r8701	16r47C0	16r4680	16r8641
    		16r8201	16r42C0	16r4380	16r8341	16r4100	16r81C1	16r8081	16r4040)
    		 at: ((crc bitXor: (self byteAt: i)) bitAnd: 16rFF) + 1) ].
    ^crc!
----- Method: String>>decodeMimeHeader (in category 'internet') -----
decodeMimeHeader
    "See RFC 2047, MIME Part Three: Message Header Extension for Non-ASCII  
    Text. Text containing non-ASCII characters is encoded by the sequence  
    =?character-set?encoding?encoded-text?=  
    Encoding is Q (quoted printable) or B (Base64), handled by  
    Base64MimeConverter / RFC2047MimeConverter.
Thanks to Yokokawa-san, it works in m17n package.  Try the following:
'=?ISO-2022-JP?B?U1dJS0lQT1AvGyRCPUJDKyVpJXMlQRsoQi8=?= =?ISO-2022-JP?B?GyRCJVElRiUjJSobKEIoUGF0aW8p?=' decodeMimeHeader.
"
    | input output temp charset decoder encodedStream encoding pos |
    input := ReadStream on: self.
    output := WriteStream on: String new.
    [output
    	nextPutAll: (input upTo: $=).
    "ASCII Text"
    input atEnd]
    	whileFalse: [(temp := input next) = $?
    			ifTrue: [charset := input upTo: $?.
    				encoding := (input upTo: $?) asUppercase.
    				temp := input upTo: $?.
    				input next.
    				"Skip final ="
    				(charset isNil or: [charset size = 0]) ifTrue: [charset := 'LATIN-1'].
    				encodedStream := MultiByteBinaryOrTextStream on: String new encoding: charset.
    				decoder := encoding = 'B'
    							ifTrue: [Base64MimeConverter new]
    							ifFalse: [RFC2047MimeConverter new].
    				decoder
    					mimeStream: (ReadStream on: temp);
    					 dataStream: encodedStream;
    					 mimeDecode.
    				output nextPutAll: encodedStream reset contents.
    				pos := input position.
    				input skipSeparators.
    				"Delete spaces if followed by ="
    				input peek = $=
    					ifFalse: [input position: pos]]
    			ifFalse: [output nextPut: $=;
    					 nextPut: temp]].
    ^ output contents!
----- Method: String>>decodeQuotedPrintable (in category 'internet') -----
decodeQuotedPrintable
    "Assume receiver is in MIME 'quoted-printable' encoding, and decode it."
^QuotedPrintableMimeConverter mimeDecode: self as: self class!
----- Method: String>>deepCopy (in category 'copying') -----
deepCopy
    "DeepCopy would otherwise mean make a copy of the character;  since 
    characters are unique, just return a shallowCopy."
^self shallowCopy!
----- Method: String>>displayAt: (in category 'displaying') -----
displayAt: aPoint 
    "Display the receiver as a DisplayText at aPoint on the display screen."
self displayOn: Display at: aPoint!
----- Method: String>>displayOn: (in category 'displaying') -----
displayOn: aDisplayMedium
    "Display the receiver on the given DisplayMedium.  5/16/96 sw"
self displayOn: aDisplayMedium at: 0 @ 0!
----- Method: String>>displayOn:at: (in category 'displaying') -----
displayOn: aDisplayMedium at: aPoint 
    "Show a representation of the receiver as a DisplayText at location aPoint on aDisplayMedium, using black-colored text."
self displayOn: aDisplayMedium at: aPoint textColor: Color black!
----- Method: String>>displayOn:at:textColor: (in category 'displaying') -----
displayOn: aDisplayMedium at: aPoint textColor: aColor
    "Show a representation of the receiver as a DisplayText at location aPoint on aDisplayMedium, rendering the text in the designated color"
(self asDisplayText foregroundColor: (aColor ifNil: [Color black]) backgroundColor: Color white)
    	displayOn: aDisplayMedium at: aPoint!
----- Method: String>>displayProgressAt:from:to:during: (in category 'displaying') -----
displayProgressAt: aPoint from: minVal to: maxVal during: workBlock 
    "Display this string as a caption over a progress bar while workBlock is evaluated.
EXAMPLE (Select next 6 lines and Do It)
'Now here''s some Real Progress'
    displayProgressAt: Sensor cursorPoint
    from: 0 to: 10
    during: [:bar |
    1 to: 10 do: [:x | bar value: x.
    		(Delay forMilliseconds: 500) wait]].
HOW IT WORKS (Try this in any other language :-)
Since your code (the last 2 lines in the above example) is in a block,
this method gets control to display its heading before, and clean up 
the screen after, its execution.
The key, though, is that the block is supplied with an argument,
named 'bar' in the example, which will update the bar image every 
it is sent the message value: x, where x is in the from:to: range.
"
    ^ProgressInitiationException 
    	display: self
    	at: aPoint 
    	from: minVal 
    	to: maxVal 
    	during: workBlock!
----- Method: String>>do:toFieldNumber: (in category 'accessing') -----
do: aBlock toFieldNumber: aNumber
    "Considering the receiver as a holder of tab-delimited fields, evaluate aBlock on behalf of a field in this string"
| start end index |
    start := 1.
    index := 1.
    [start <= self size] whileTrue: 
    	[end := self indexOf: Character tab startingAt: start ifAbsent: [self size + 1].
    	end := end - 1.
    	aNumber = index ifTrue:
    		[aBlock value: (self copyFrom: start  to: end).
    		^ self].
    	index := index + 1.
    	start := end + 2]
"
1 to: 6 do:
    [:aNumber |
    	'fred	charlie	elmo		wimpy	friml' do:
    		[:aField | Transcript cr; show: aField] toFieldNumber: aNumber]
"!
----- Method: String>>encodeDoublingQuoteOn: (in category 'printing') -----
encodeDoublingQuoteOn: aStream 
    "Print inside string quotes, doubling inbedded quotes."
    | x |
    aStream print: $'.
    1 to: self size do:
    	[:i |
    	aStream print: (x := self at: i).
    	x = $' ifTrue: [aStream print: x]].
    aStream print: $'!
----- Method: String>>encodeForHTTP (in category 'converting') -----
encodeForHTTP
    "change dangerous characters to their %XX form, for use in HTTP transactions"
^ self encodeForHTTPWithTextEncoding: 'utf-8' conditionBlock: [:c | c isSafeForHTTP].
!
----- Method: String>>encodeForHTTPWithTextEncoding: (in category 'converting') -----
encodeForHTTPWithTextEncoding: encodingName
^ self encodeForHTTPWithTextEncoding: encodingName conditionBlock: [:c | c isSafeForHTTP].
!
----- Method: String>>encodeForHTTPWithTextEncoding:conditionBlock: (in category 'converting') -----
encodeForHTTPWithTextEncoding: encodingName conditionBlock: conditionBlock
    "change dangerous characters to their %XX form, for use in HTTP transactions"
| httpSafeStream encodedStream cont |
    httpSafeStream := WriteStream on: (String new).
    encodedStream := MultiByteBinaryOrTextStream on: (String new: 6).
    encodedStream converter: (TextConverter newForEncoding: encodingName).
    self do: [:c |
    	(conditionBlock value: c)
    		ifTrue: [httpSafeStream nextPut: (Character value: c charCode)]
    		ifFalse: [
    			encodedStream text; reset.
    			encodedStream nextPut: c.
    			encodedStream position: 0.
    			encodedStream binary.
    			cont := encodedStream contents.
    			cont do: [:byte |
    				httpSafeStream nextPut: $%.
    				httpSafeStream nextPut: (byte // 16) asHexDigit.
    				httpSafeStream nextPut: (byte \ 16) asHexDigit.
    			].
    		].
    ].
    ^ httpSafeStream contents.
!
----- Method: String>>endsWith: (in category 'comparing') -----
endsWith: suffix
    "Answer whether the tail end of the receiver is the same as suffix.
    The comparison is case-sensitive."
    
    | extra |
    (extra := self size - suffix size) < 0 ifTrue: [^ false].
    ^ (self findString: suffix startingAt: extra + 1) > 0
"
  'Elvis' endsWith: 'vis'
"!
----- Method: String>>endsWithAColon (in category 'system primitives') -----
endsWithAColon 
    "Answer whether the final character of the receiver is a colon"
^ self size > 0 and: [self last == $:]
"
#fred: endsWithAColon
'fred' endsWithAColon
"!
----- Method: String>>endsWithAnyOf: (in category 'comparing') -----
endsWithAnyOf: aCollection
    aCollection do:[:suffix|
    	(self endsWith: suffix) ifTrue:[^true].
    ].
    ^false!
----- Method: String>>endsWithDigit (in category 'accessing') -----
endsWithDigit
    "Answer whether the receiver's final character represents a digit.  3/11/96 sw"
^ self size > 0 and: [self last isDigit]!
----- Method: String>>evaluateExpression:parameters: (in category 'private') -----
evaluateExpression: aString parameters: aCollection 
    "private - evaluate the expression aString with  
    aCollection as the parameters and answer the  
    evaluation result as an string"
    | index |
    index := ('0' , aString) asNumber.
index isZero
    	ifTrue: [^ '[invalid subscript: {1}]' format: {aString}].
index > aCollection size
    	ifTrue: [^ '[subscript is out of bounds: {1}]' format: {aString}].
^ (aCollection at: index) asString!
----- Method: String>>expandMacros (in category 'formatting') -----
expandMacros
    ^self expandMacrosWithArguments: #()!
----- Method: String>>expandMacrosWith: (in category 'formatting') -----
expandMacrosWith: anObject 
    ^self expandMacrosWithArguments: (Array with: anObject)!
----- Method: String>>expandMacrosWith:with: (in category 'formatting') -----
expandMacrosWith: anObject with: anotherObject 
    ^self 
    	expandMacrosWithArguments: (Array with: anObject with: anotherObject)!
----- Method: String>>expandMacrosWith:with:with: (in category 'formatting') -----
expandMacrosWith: anObject with: anotherObject with: thirdObject 
    ^self expandMacrosWithArguments: (Array 
    			with: anObject
    			with: anotherObject
    			with: thirdObject)!
----- Method: String>>expandMacrosWith:with:with:with: (in category 'formatting') -----
expandMacrosWith: anObject with: anotherObject with: thirdObject with: fourthObject 
    ^self expandMacrosWithArguments: (Array 
    			with: anObject
    			with: anotherObject
    			with: thirdObject
    			with: fourthObject)!
----- Method: String>>expandMacrosWithArguments: (in category 'formatting') -----
expandMacrosWithArguments: anArray 
    | newStream readStream char index |
    newStream := WriteStream on: (String new: self size).
    readStream := ReadStream on: self.
    [readStream atEnd] whileFalse: 
    		[char := readStream next.
    		char == $< 
    			ifTrue: 
    				[| nextChar |
    				nextChar := readStream next asUppercase.
    				nextChar == $N ifTrue: [newStream cr].
    				nextChar == $T ifTrue: [newStream tab].
    				nextChar isDigit 
    					ifTrue: 
    						[index := nextChar digitValue.
    						
    						[readStream atEnd 
    							or: [(nextChar := readStream next asUppercase) isDigit not]] 
    								whileFalse: [index := index * 10 + nextChar digitValue]].
    				nextChar == $? 
    					ifTrue: 
    						[| trueString falseString |
    						trueString := readStream upTo: $:.
    						falseString := readStream upTo: $>.
    						readStream position: readStream position - 1.
    						newStream 
    							nextPutAll: ((anArray at: index) ifTrue: [trueString] ifFalse: [falseString])].
    				nextChar == $P 
    					ifTrue: [newStream nextPutAll: (anArray at: index) printString].
    				nextChar == $S ifTrue: [newStream nextPutAll: (anArray at: index)].
    				readStream skipTo: $>]
    			ifFalse: 
    				[newStream nextPut: (char == $% ifTrue: [readStream next] ifFalse: [char])]].
    ^newStream contents!
----- Method: String>>findAnySubStr:startingAt: (in category 'accessing') -----
findAnySubStr: delimiters startingAt: start 
    "Answer the index of the character within the receiver, starting at start, that begins a substring matching one of the delimiters.  delimiters is an Array of Strings (Characters are permitted also).  If the receiver does not contain any of the delimiters, answer size + 1."
| min ind |
    min := self size + 1.
    delimiters do: [:delim |	"May be a char, a string of length 1, or a substring"
    	delim isCharacter 
    		ifTrue: [ind := self indexOfSubCollection: (String with: delim) 
    					startingAt: start ifAbsent: [min]]
    		ifFalse: [ind := self indexOfSubCollection: delim 
    					startingAt: start ifAbsent: [min]].
    		min := min min: ind].
    ^ min!
----- Method: String>>findBetweenSubStrs: (in category 'accessing') -----
findBetweenSubStrs: delimiters
    "Answer the collection of String tokens that result from parsing self.  Tokens are separated by 'delimiters', which can be a collection of Strings, or a collection of Characters.  Several delimiters in a row are considered as just one separation."
| tokens keyStart keyStop |
    tokens := OrderedCollection new.
    keyStop := 1.
    [keyStop <= self size] whileTrue:
    	[keyStart := self skipAnySubStr: delimiters startingAt: keyStop.
    	keyStop := self findAnySubStr: delimiters startingAt: keyStart.
    	keyStart < keyStop
    		ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
    ^tokens!
----- Method: String>>findCloseParenthesisFor: (in category 'accessing') -----
findCloseParenthesisFor: startIndex
    "assume (self at: startIndex) is $(.  Find the matching $), allowing parentheses to nest."
    " '(1+(2-3))-3.14159' findCloseParenthesisFor: 1 "
    " '(1+(2-3))-3.14159' findCloseParenthesisFor: 4 "
    | pos nestLevel |
    pos := startIndex+1.
    nestLevel := 1.
    [ pos <= self size ] whileTrue: [
    	(self at: pos) = $( ifTrue: [ nestLevel := nestLevel + 1 ].
    	(self at: pos) = $) ifTrue: [ nestLevel := nestLevel - 1 ].
    	nestLevel = 0 ifTrue: [ ^pos ].
    	pos := pos + 1.
    ].
    ^self size + 1!
----- Method: String>>findDelimiters:startingAt: (in category 'accessing') -----
findDelimiters: delimiters startingAt: start 
    "Answer the index of the character within the receiver, starting at start, that matches one of the delimiters. If the receiver does not contain any of the delimiters, answer size + 1."
start to: self size do: [:i |
    	delimiters do: [:delim | delim = (self at: i) ifTrue: [^ i]]].
    ^ self size + 1!
----- Method: String>>findLastOccuranceOfString:startingAt: (in category 'accessing') -----
findLastOccuranceOfString: subString startingAt: start 
    "Answer the index of the last occurance of subString within the receiver, starting at start. If 
    the receiver does not contain subString, answer 0."
| last now |
    last := self findString: subString startingAt: start.
    last = 0 ifTrue: [^ 0].
    [last > 0] whileTrue: [
    	now := last.
    	last := self findString: subString startingAt: last + 1.
    ].
^ now.
!
----- Method: String>>findSelector (in category 'converting') -----
findSelector
    "Dan's code for hunting down selectors with keyword parts; while this doesn't give a true parse, in most cases it does what we want, in where it doesn't, we're none the worse for it."
    | sel possibleParens level n |
    sel := self withBlanksTrimmed.
    (sel includes: $:) ifTrue:
    	[sel := sel copyReplaceAll: ':' with: ': '.	"for the style (aa max:bb) with no space"
    	possibleParens := sel findTokens: Character separators.
    	sel := self class streamContents:
    		[:s | level := 0.
    		possibleParens do:
    			[:token |
    			(level = 0 and: [token endsWith: ':'])
    				ifTrue: [s nextPutAll: token]
    				ifFalse: [(n := token occurrencesOf: $( ) > 0 ifTrue: [level := level + n].
    						(n := token occurrencesOf: $[ ) > 0 ifTrue: [level := level + n].
    						(n := token occurrencesOf: $] ) > 0 ifTrue: [level := level - n].
    						(n := token occurrencesOf: $) ) > 0 ifTrue: [level := level - n]]]]].
sel isEmpty ifTrue: [^ nil].
    sel isOctetString ifTrue: [sel := sel asOctetString].
    Symbol hasInterned: sel ifTrue:
    	[:aSymbol | ^ aSymbol].
    ^ nil!
----- Method: String>>findString: (in category 'accessing') -----
findString: subString
    "Answer the index of subString within the receiver, starting at start. If 
    the receiver does not contain subString, answer 0."
    ^self findString: subString startingAt: 1.!
----- Method: String>>findString:startingAt: (in category 'accessing') -----
findString: subString startingAt: start 
    "Answer the index of subString within the receiver, starting at start. If 
    the receiver does not contain subString, answer 0."
^self findString: subString startingAt: start caseSensitive: true!
----- Method: String>>findString:startingAt:caseSensitive: (in category 'accessing') -----
findString: key startingAt: start caseSensitive: caseSensitive 
    "Answer the index in this String at which the substring key first occurs,
    at or beyond start. The match can be case-sensitive or not. If no match
    is found, zero will be returned."
    
    "IMPLEMENTATION NOTE: do not use CaseSensitiveOrder because it is broken for WideString
    This is a temporary work around until Wide CaseSensitiveOrder search is fixed
    Code should revert to:
    caseSensitive
    	ifTrue: [^ self findSubstring: key in: self startingAt: start matchTable: CaseSensitiveOrder]
    	ifFalse: [^ self findSubstring: key in: self startingAt: start matchTable: CaseInsensitiveOrder]"
    	
    ^caseSensitive
    	ifTrue: [
    		(self class isBytes and: [key class isBytes])
    			ifTrue: [self
    					findSubstring: key
    					in: self
    					startingAt: start
    					matchTable: CaseSensitiveOrder]
    			ifFalse: [WideString new
    					findSubstring: key
    					in: self
    					startingAt: start
    					matchTable: nil]]
    	ifFalse: [
    		(self class isBytes and: [key class isBytes])
    			ifTrue: [self
    					findSubstring: key
    					in: self
    					startingAt: start
    					matchTable: CaseInsensitiveOrder]
    			ifFalse: [WideString new
    					findSubstring: key
    					in: self
    					startingAt: start
    					matchTable: CaseInsensitiveOrder]]!
----- Method: String>>findSubstring:in:startingAt:matchTable: (in category 'system primitives') -----
findSubstring: key in: body startingAt: start matchTable: matchTable
    "Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned."
    | index c1 c2 |
    matchTable == nil ifTrue: [
    	key size = 0 ifTrue: [^ 0].
    	start to: body size - key size + 1 do:
    		[:startIndex |
    		index := 1.
    			[(body at: startIndex+index-1)
    				= (key at: index)]
    				whileTrue:
    				[index = key size ifTrue: [^ startIndex].
    				index := index+1]].
    	^ 0
    ].
key size = 0 ifTrue: [^ 0].
    start to: body size - key size + 1 do:
    	[:startIndex |
    	index := 1.
    	[c1 := body at: startIndex+index-1.
    	c2 := key at: index.
    	((c1 leadingChar = 0 and: [ c1 asciiValue < matchTable size ]) 
    		ifTrue: [ matchTable at: c1 asciiValue + 1 ]
    		ifFalse: [ c1 asciiValue + 1 ]) = 
    		((c2 leadingChar = 0 and: [ c2 asciiValue < matchTable size ])
    			ifTrue: [ matchTable at: c2 asciiValue + 1 ]
    			ifFalse: [c2 asciiValue + 1 ]) ]
    		whileTrue:
    			[index = key size ifTrue: [^ startIndex].
    			index := index+1]].
    ^ 0!
----- Method: String>>findTokens: (in category 'accessing') -----
findTokens: delimiters
    "Answer the collection of tokens that result from parsing self.  Return strings between the delimiters.  Any character in the Collection delimiters marks a border.  Several delimiters in a row are considered as just one separation.  Also, allow delimiters to be a single character."
| tokens keyStart keyStop separators |
tokens := OrderedCollection new.
    separators := delimiters isCharacter 
    	ifTrue: [Array with: delimiters]
    	ifFalse: [delimiters].
    keyStop := 1.
    [keyStop <= self size] whileTrue:
    	[keyStart := self skipDelimiters: separators startingAt: keyStop.
    	keyStop := self findDelimiters: separators startingAt: keyStart.
    	keyStart < keyStop
    		ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
    ^tokens!
----- Method: String>>findTokens:escapedBy: (in category 'accessing') -----
findTokens: delimiters escapedBy: quoteDelimiters 
    "Answer a collection of Strings separated by the delimiters, where  
    delimiters is a Character or collection of characters. Two delimiters in a  
    row produce an empty string (compare this to #findTokens, which  
    treats sequential delimiters as one).  
     
    The characters in quoteDelimiters are treated as quote characters, such  
    that any delimiter within a pair of matching quoteDelimiter characters  
    is treated literally, rather than as a delimiter.  
     
    The quoteDelimiter characters may be escaped within a quoted string.  
    Two sequential quote characters within a quoted string are treated as  
    a single character.  
     
    This method is useful for parsing comma separated variable strings for  
    spreadsheet import and export."
| tokens rs activeEscapeCharacter ts char token delimiterChars quoteChars |
    delimiterChars := (delimiters isNil
    			ifTrue: ['']
    			ifFalse: [delimiters]) asString.
    quoteChars := (quoteDelimiters isNil
    			ifTrue: ['']
    			ifFalse: [quoteDelimiters]) asString.
    tokens := OrderedCollection new.
    rs := ReadStream on: self.
    activeEscapeCharacter := nil.
    ts := WriteStream on: ''.
    [rs atEnd]
    	whileFalse: [char := rs next.
    		activeEscapeCharacter isNil
    			ifTrue: [(quoteChars includes: char)
    					ifTrue: [activeEscapeCharacter := char]
    					ifFalse: [(delimiterChars includes: char)
    							ifTrue: [token := ts contents.
    								tokens add: token.
    								ts := WriteStream on: '']
    							ifFalse: [ts nextPut: char]]]
    			ifFalse: [char == activeEscapeCharacter
    					ifTrue: [rs peek == activeEscapeCharacter
    							ifTrue: [ts nextPut: rs next]
    							ifFalse: [activeEscapeCharacter := nil]]
    					ifFalse: [ts nextPut: char]]].
    token := ts contents.
    (tokens isEmpty and: [token isEmpty])
    	ifFalse: [tokens add: token].
    ^ tokens!
----- Method: String>>findTokens:includes: (in category 'accessing') -----
findTokens: delimiters includes: subString
    "Divide self into pieces using delimiters.  Return the piece that includes subString anywhere in it.  Is case sensitive (say asLowercase to everything beforehand to make insensitive)."
^ (self findTokens: delimiters) 
    detect: [:str | (str includesSubString: subString)] 
    ifNone: [nil]!
----- Method: String>>findTokens:keep: (in category 'accessing') -----
findTokens: delimiters keep: keepers
    "Answer the collection of tokens that result from parsing self.  The tokens are seperated by delimiters, any of a string of characters.  If a delimiter is also in keepers, make a token for it.  (Very useful for carriage return.  A sole return ends a line, but is also saved as a token so you can see where the line breaks were.)"
| tokens keyStart keyStop |
    tokens := OrderedCollection new.
    keyStop := 1.
    [keyStop <= self size] whileTrue:
    	[keyStart := self skipDelimiters: delimiters startingAt: keyStop.
    	keyStop to: keyStart-1 do: [:ii | 
    		(keepers includes: (self at: ii)) ifTrue: [
    			tokens add: (self copyFrom: ii to: ii)]].	"Make this keeper be a token"
    	keyStop := self findDelimiters: delimiters startingAt: keyStart.
    	keyStart < keyStop
    		ifTrue: [tokens add: (self copyFrom: keyStart to: (keyStop - 1))]].
    ^tokens!
----- Method: String>>findWordStart:startingAt: (in category 'accessing') -----
findWordStart: key startingAt: start
    | ind |
    "HyperCard style searching.  Answer the index in self of the substring key, when that key is preceeded by a separator character.  Must occur at or beyond start.  The match is case-insensitive.  If no match is found, zero will be returned."
ind := start.
    [ind := self findString: key startingAt: ind caseSensitive: false.
    ind = 0 ifTrue: [^ 0].	"not found"
    ind = 1 ifTrue: [^ 1].	"First char is the start of a word"
    (self at: ind-1) isSeparator] whileFalse: [ind := ind + 1].
    ^ ind	"is a word start"!
----- Method: String>>format: (in category 'formatting') -----
format: aCollection 
    "format the receiver with aCollection  
     
    simplest example:  
    'foo {1} bar' format: {Date today}.
     
    complete example:  
    '{ } \ foo {1} bar {2}' format: {12. 'string'}.  
    "
    | result stream |
    result := String new writeStream.
    stream := self readStream.
[stream atEnd]
    	whileFalse: [| currentChar | 
    		currentChar := stream next.
    		currentChar == ${
    			ifTrue: [| expression | 
    				expression := self getEnclosedExpressionFrom: stream.
    				result
    					nextPutAll: (self evaluateExpression: expression parameters: aCollection)]
    			ifFalse: [
    				currentChar == $\
    					ifTrue: [stream atEnd
    							ifFalse: [result nextPut: stream next]]
    					ifFalse: [result nextPut: currentChar]]].
^ result contents!
----- Method: String>>getEnclosedExpressionFrom: (in category 'private') -----
getEnclosedExpressionFrom: aStream 
    "private - get the expression enclosed between '{' and 
    '}' and remove all the characters from the stream"
    | result currentChar |
    result := String new writeStream.
[aStream atEnd 
    	or: [(currentChar := aStream next) == $}]]
    	whileFalse: [result nextPut: currentChar].
^ result contents withBlanksTrimmed!
----- Method: String>>getInteger32: (in category 'encoding') -----
getInteger32: location
    | integer |
    <primitive: 'getInteger' module: 'IntegerPokerPlugin'>
    "^IntegerPokerPlugin doPrimitive: #getInteger"
"the following is about 7x faster than interpreting the plugin if not compiled"
integer := 
    	((self at: location) asInteger bitShift: 24) +
    	((self at: location+1) asInteger bitShift: 16) +
    	((self at: location+2) asInteger bitShift: 8) +
    	(self at: location+3) asInteger.
integer > 1073741824 ifTrue: [^1073741824 - integer ].
    ^integer
!
----- Method: String>>hasContentsInExplorer (in category 'testing') -----
hasContentsInExplorer
^false!
----- Method: String>>hash (in category 'comparing') -----
hash
    "#hash is implemented, because #= is implemented"
    "ar 4/10/2005: I had to change this to use ByteString hash as initial 
    hash in order to avoid having to rehash everything and yet compute
    the same hash for ByteString and WideString.
    md 16/10/2006: use identityHash as initialHash, as behavior hash will 
    use String hash (name) to have a better hash soon"
    ^ self class stringHash: self initialHash: ByteString identityHash!
----- Method: String>>hashMappedBy: (in category 'comparing') -----
hashMappedBy: map
    "My hash is independent of my oop."
^self hash!
----- Method: String>>howManyMatch: (in category 'comparing') -----
howManyMatch: string 
    "Count the number of characters that match up in self and aString."
    | count shorterLength |
    
    count  :=  0 .
    shorterLength  :=  ((self size ) min: (string size ) ) .
    (1 to: shorterLength  do: [:index |
    	 (((self at: index ) = (string at: index )  ) ifTrue: [count  :=  (count + 1 ) .
    		]   ).
    	]   ).
    ^  count 
    
    !
----- Method: String>>includesSubString: (in category 'accessing') -----
includesSubString: subString
    ^ (self findString: subString startingAt: 1) > 0!
----- Method: String>>includesSubstring:caseSensitive: (in category 'accessing') -----
includesSubstring: aString caseSensitive: caseSensitive
    
    ^ (self findString: aString startingAt: 1 caseSensitive: caseSensitive) > 0!
----- Method: String>>includesUnifiedCharacter (in category 'testing') -----
includesUnifiedCharacter
    ^false!
----- Method: String>>indentationIfBlank: (in category 'paragraph support') -----
indentationIfBlank: aBlock
    "Answer the number of leading tabs in the receiver.  If there are
     no visible characters, pass the number of tabs to aBlock and return its value."
| reader leadingTabs lastSeparator cr tab ch |
    cr := Character cr.
    tab := Character tab.
    reader := ReadStream on: self.
    leadingTabs := 0.
    [reader atEnd not and: [(ch := reader next) = tab]]
    	whileTrue: [leadingTabs := leadingTabs + 1].
    lastSeparator := leadingTabs + 1.
    [reader atEnd not and: [ch isSeparator and: [ch ~= cr]]]
    	whileTrue: [lastSeparator := lastSeparator + 1. ch := reader next].
    lastSeparator = self size | (ch = cr)
    	ifTrue: [^aBlock value: leadingTabs].
    ^ leadingTabs.
!
----- Method: String>>indexOf: (in category 'accessing') -----
indexOf: aCharacter
aCharacter isCharacter ifFalse: [^ 0].
    ^ self class
    	indexOfAscii: aCharacter asciiValue
    	inString: self
    	startingAt: 1.
!
----- Method: String>>indexOf:startingAt: (in category 'accessing') -----
indexOf: aCharacter startingAt: start
(aCharacter isCharacter) ifFalse: [^ 0].
    ^ self class indexOfAscii: aCharacter asciiValue inString: self startingAt: start!
----- Method: String>>indexOf:startingAt:ifAbsent: (in category 'accessing') -----
indexOf: aCharacter  startingAt: start  ifAbsent: aBlock
    | ans |
    (aCharacter isCharacter) ifFalse: [ ^ aBlock value ].
    ans := self class indexOfAscii: aCharacter asciiValue inString: self  startingAt: start.
    ans = 0
    	ifTrue: [ ^ aBlock value ]
    	ifFalse: [ ^ ans ]!
----- Method: String>>indexOfAnyOf: (in category 'accessing') -----
indexOfAnyOf: aCharacterSet
    "returns the index of the first character in the given set.  Returns 0 if none are found"
    ^self indexOfAnyOf: aCharacterSet  startingAt: 1!
----- Method: String>>indexOfAnyOf:ifAbsent: (in category 'accessing') -----
indexOfAnyOf: aCharacterSet  ifAbsent: aBlock
    "returns the index of the first character in the given set.  Returns the evaluation of aBlock if none are found"
    ^self indexOfAnyOf: aCharacterSet  startingAt: 1  ifAbsent: aBlock!
----- Method: String>>indexOfAnyOf:startingAt: (in category 'accessing') -----
indexOfAnyOf: aCharacterSet  startingAt: start
    "returns the index of the first character in the given set, starting from start.  Returns 0 if none are found"
    ^self indexOfAnyOf: aCharacterSet  startingAt: start  ifAbsent: [ 0 ]!
----- Method: String>>indexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') -----
indexOfAnyOf: aCharacterSet startingAt: start ifAbsent: aBlock 
    "returns the index of the first character in the given set, starting from start "
    
    | ans |
    ans := self isWideString
    			ifTrue: ["Fallback to naive implementation"
    				self class
    					findFirstInString: self
    					inCharacterSet: aCharacterSet
    					startingAt: start]
    			ifFalse: ["We know we contain only byte characters
    					So use a byteArrayMap opimized for primitive call"
    				self class
    					findFirstInString: self
    					inSet: aCharacterSet byteArrayMap
    					startingAt: start].
    ans = 0
    	ifTrue: [^ aBlock value]
    	ifFalse: [^ ans]!
----- Method: String>>indexOfSubCollection: (in category 'accessing') -----
indexOfSubCollection: sub 
    #Collectn.
    "Added 2000/04/08 For ANSI <sequenceReadableCollection> protocol."
    ^ self
    	indexOfSubCollection: sub
    	startingAt: 1
    	ifAbsent: [0]!
----- Method: String>>indexOfSubCollection:startingAt:ifAbsent: (in category 'accessing') -----
indexOfSubCollection: sub startingAt: start ifAbsent: exceptionBlock
    | index |
    index := self findString: sub startingAt: start.
    index = 0 ifTrue: [^ exceptionBlock value].
    ^ index!
----- Method: String>>initialIntegerOrNil (in category 'converting') -----
initialIntegerOrNil
    "Answer the integer represented by the leading digits of the receiver, or nil if the receiver does not begin with a digit"
    | firstNonDigit |
    (self size == 0 or: [self first isDigit not]) ifTrue: [^ nil].
    firstNonDigit := (self findFirst: [:m | m isDigit not]).
    firstNonDigit = 0 ifTrue: [firstNonDigit := self size + 1].
    ^ (self copyFrom: 1  to: (firstNonDigit - 1)) asNumber
"
'234Whoopie' initialIntegerOrNil
'wimpy' initialIntegerOrNil
'234' initialIntegerOrNil
'2N' initialIntegerOrNil
'2' initialIntegerOrNil
'  89Ten ' initialIntegerOrNil
'78 92' initialIntegerOrNil
"
!
----- Method: String>>isAllDigits (in category 'testing') -----
isAllDigits
    "whether the receiver is composed entirely of digits"
    self do: [:c | c isDigit ifFalse: [^ false]].
    ^ true!
----- Method: String>>isAllSeparators (in category 'testing') -----
isAllSeparators
    "whether the receiver is composed entirely of separators"
    self do: [ :c | c isSeparator ifFalse: [ ^false ] ].
    ^true!
----- Method: String>>isAsciiString (in category 'testing') -----
isAsciiString
| c |
    c := self detect: [:each | each asciiValue > 127] ifNone: [nil].
    ^ c isNil.
!
----- Method: String>>isByteString (in category 'testing') -----
isByteString
    "Answer whether the receiver is a ByteString"
    ^false!
----- Method: String>>isLiteral (in category 'printing') -----
isLiteral
^true!
----- Method: String>>isOctetString (in category 'testing') -----
isOctetString
    "Answer whether the receiver can be represented as a byte string. 
    This is different from asking whether the receiver *is* a ByteString 
    (i.e., #isByteString)"
    1 to: self size do: [:pos |
    	(self at: pos) asInteger >= 256 ifTrue: [^ false].
    ].
    ^ true.
!
----- Method: String>>isString (in category 'testing') -----
isString
    ^ true!
----- Method: String>>isWideString (in category 'testing') -----
isWideString
    "Answer whether the receiver is a WideString"
    ^false!
----- Method: String>>isoToSqueak (in category 'internet') -----
isoToSqueak
    ^self "no longer needed"!
----- Method: String>>isoToUtf8 (in category 'internet') -----
isoToUtf8
    "Convert ISO 8559-1 to UTF-8"
    | s v |
    s := WriteStream on: (String new: self size).
self do: [:c |
    	v := c asciiValue.
    	(v > 128)
    		ifFalse: [s nextPut: c]
    		ifTrue: [
    			s nextPut: (192+(v >> 6)) asCharacter.
    			s nextPut: (128+(v bitAnd: 63)) asCharacter]].
    ^s contents. 
!
----- Method: String>>keywords (in category 'converting') -----
keywords
    "Answer an array of the keywords that compose the receiver."
    | kwd char keywords |
    keywords := Array streamContents:
    	[:kwds | kwd := WriteStream on: (String new: 16).
    	1 to: self size do:
    		[:i |
    		kwd nextPut: (char := self at: i).
    		char = $: ifTrue: 
    				[kwds nextPut: kwd contents.
    				kwd reset]].
    	(kwd position = 0) ifFalse: [kwds nextPut: kwd contents]].
    (keywords size >= 1 and: [(keywords at: 1) = ':']) ifTrue:
    	["Has an initial keyword, as in #:if:then:else:"
    	keywords := keywords allButFirst].
    (keywords size >= 2 and: [(keywords at: keywords size - 1) = ':']) ifTrue:
    	["Has a final keyword, as in #nextPut::andCR"
    	keywords := keywords copyReplaceFrom: keywords size - 1
    							to: keywords size with: {':' , keywords last}].
    ^ keywords!
----- Method: String>>lastIndexOfPKSignature: (in category 'accessing') -----
lastIndexOfPKSignature: aSignature
    "Answer the last index in me where aSignature (4 bytes long) occurs, or 0 if not found"
    | a b c d |
    a := aSignature first.
    b := aSignature second.
    c := aSignature third.
    d := aSignature fourth.
    (self size - 3) to: 1 by: -1 do: [ :i |
    	(((self at: i) = a)
    		and: [ ((self at: i + 1) = b)
    			and: [ ((self at: i + 2) = c)
    				and: [ ((self at: i + 3) = d) ]]])
    					ifTrue: [ ^i ]
    ].
    ^0!
----- Method: String>>lastSpacePosition (in category 'testing') -----
lastSpacePosition
    "Answer the character position of the final space or other separator character in the receiver, and 0 if none"
    self size to: 1 by: -1 do:
    	[:i | ((self at: i) isSeparator) ifTrue: [^ i]].
    ^ 0
"
'fred the bear' lastSpacePosition
'ziggie' lastSpacePosition
'elvis ' lastSpacePosition
'wimpy  ' lastSpacePosition
'' lastSpacePosition
"!
----- Method: String>>leadingCharRunLengthAt: (in category 'accessing') -----
leadingCharRunLengthAt: index
| leadingChar |
    leadingChar := (self at: index) leadingChar.
    index to: self size do: [:i |
    	(self at: i) leadingChar ~= leadingChar ifTrue: [^ i - index].
    ].
    ^ self size - index + 1.
!
----- Method: String>>lineCorrespondingToIndex: (in category 'accessing') -----
lineCorrespondingToIndex: anIndex
    "Answer a string containing the line at the given character position.  1/15/96 sw:  Inefficient first stab at this"
| cr aChar answer |
    cr := Character cr.
    answer := ''.
    1 to: self size do:
    	[:i | 
    		aChar := self at: i.
    		aChar = cr
    			ifTrue:
    				[i > anIndex
    					ifTrue:
    						[^ answer]
    					ifFalse:
    						[answer := '']]
    			ifFalse:
    				[answer := answer copyWith: aChar]].
    ^ answer!
----- Method: String>>lineCount (in category 'accessing') -----
lineCount
    "Answer the number of lines represented by the receiver, where every cr adds one line.  5/10/96 sw"
| cr count |
    cr := Character cr.
    count := 1  min: self size..
    1 to: self size do:
    	[:i | (self at: i) = cr ifTrue: [count := count + 1]].
    ^ count
"
'Fred
the
Bear' lineCount
"!
----- Method: String>>lineNumber: (in category 'accessing') -----
lineNumber: anIndex
    "Answer a string containing the characters in the given line number.  5/10/96 sw"
| crString pos finalPos |
    crString := String with: Character cr.
    pos := 0.
    1 to: anIndex - 1 do:
    	[:i | pos := self findString: crString startingAt: pos + 1.
    		pos = 0 ifTrue: [^ nil]].
    finalPos := self findString: crString startingAt: pos + 1.
    finalPos = 0 ifTrue: [finalPos := self size + 1].
    ^ self copyFrom: pos + 1 to: finalPos - 1
"
'Fred
the
Bear' lineNumber: 3
"!
----- Method: String>>linesDo: (in category 'accessing') -----
linesDo: aBlock
    "execute aBlock with each line in this string.  The terminating CR's are not included in what is passed to aBlock"
    | start end |
    start := 1.
    [ start <= self size ] whileTrue: [
    	end := self indexOf: Character cr  startingAt: start  ifAbsent: [ self size + 1 ].
    	end := end - 1.
aBlock value: (self copyFrom: start  to: end).
    	start := end + 2. ].!
----- Method: String>>macToSqueak (in category 'internet') -----
macToSqueak
    "Convert the receiver from MacRoman to Squeak encoding"
    ^ self collect: [:each | each macToSqueak]!
----- Method: String>>match: (in category 'comparing') -----
match: text
    "Answer whether text matches the pattern in this string.
    Matching ignores upper/lower case differences.
    Where this string contains #, text may contain any character.
    Where this string contains *, text may contain any sequence of characters."
^ self startingAt: 1 match: text startingAt: 1
"
    '*'			match: 'zort' true
    '*baz'		match: 'mobaz' true
    '*baz'		match: 'mobazo' false
    '*baz*'		match: 'mobazo' true
    '*baz*'		match: 'mozo' false
    'foo*'		match: 'foozo' true
    'foo*'		match: 'bozo' false
    'foo*baz'	match: 'foo23baz' true
    'foo*baz'	match: 'foobaz' true
    'foo*baz'	match: 'foo23bazo' false
    'foo'		match: 'Foo' true
    'foo*baz*zort' match: 'foobazort' false
    'foo*baz*zort' match: 'foobazzort' false
    '*foo#zort'	match: 'afoo3zortthenfoo3zort' true
    '*foo*zort'	match: 'afoodezortorfoo3zort' true
"!
----- Method: String>>numArgs (in category 'system primitives') -----
numArgs 
    "Answer either the number of arguments that the receiver would take if considered a selector.  Answer -1 if it couldn't be a selector.  Note that currently this will answer -1 for anything begining with an uppercase letter even though the system will accept such symbols as selectors.  It is intended mostly for the assistance of spelling correction."
| firstChar numColons excess start ix |
    self size = 0 ifTrue: [^ -1].
    firstChar := self at: 1.
    (firstChar isLetter or: [firstChar = $:]) ifTrue:
    	["Fast reject if any chars are non-alphanumeric
    	NOTE: fast only for Byte things - Broken for Wide"
    	self class isBytes
    		ifTrue: [(self findSubstring: '~' in: self startingAt: 1 matchTable: Tokenish) > 0 ifTrue: [^ -1]]
    		ifFalse: [2 to: self size do: [:i | (self at: i) tokenish ifFalse: [^ -1]]].
    	"Fast colon count"
    	numColons := 0.  start := 1.
    	[(ix := self indexOf: $: startingAt: start) > 0]
    		whileTrue:
    			[numColons := numColons + 1.
    			start := ix + 1].
    	numColons = 0 ifTrue: [^ 0].
    	firstChar = $:
    		ifTrue: [excess := 2 "Has an initial keyword, as #:if:then:else:"]
    		ifFalse: [excess := 0].
    	self last = $:
    		ifTrue: [^ numColons - excess]
    		ifFalse: [^ numColons - excess - 1 "Has a final keywords as #nextPut::andCR"]].
    firstChar isSpecial ifTrue:
    	[self size = 1 ifTrue: [^ 1].
    	2 to: self size do: [:i | (self at: i) isSpecial ifFalse: [^ -1]].
    	^ 1].
    ^ -1.!
----- Method: String>>numericSuffix (in category 'converting') -----
numericSuffix
    ^ self stemAndNumericSuffix last
"
'abc98' numericSuffix
'98abc' numericSuffix
"!
----- Method: String>>onlyLetters (in category 'converting') -----
onlyLetters
    "answer the receiver with only letters"
    ^ self select:[:each | each isLetter]!
----- Method: String>>openInWorkspaceWithTitle: (in category 'user interface') -----
openInWorkspaceWithTitle: aTitle
    "Open up a workspace with the receiver as its contents, with the given title"
    UIManager default edit: self label: aTitle!
----- Method: String>>padded:to:with: (in category 'copying') -----
padded: leftOrRight to: length with: char
    leftOrRight = #left ifTrue:
    	[^ (String new: (length - self size max: 0) withAll: char) , self].
    leftOrRight = #right ifTrue:
    	[^ self , (String new: (length - self size max: 0) withAll: char)].!
----- Method: String>>printOn: (in category 'printing') -----
printOn: aStream 
    "Print inside string quotes, doubling inbedded quotes."
self storeOn: aStream!
----- Method: String>>putInteger32:at: (in category 'encoding') -----
putInteger32: anInteger at: location
    | integer |
    <primitive: 'putInteger' module: 'IntegerPokerPlugin'>
    "IntegerPokerPlugin doPrimitive: #putInteger"
"the following is close to 20x faster than the above if the primitive is not compiled"
    "PUTCOUNTER := PUTCOUNTER + 1."
    integer := anInteger.
    integer < 0 ifTrue: [integer :=  1073741824 - integer. ].
    self at: location+3 put: (Character value: (integer \ 256)).
    self at: location+2 put: (Character value: (integer bitShift: -8) \ 256).
    self at: location+1 put: (Character value: (integer bitShift: -16) \ 256).
    self at: location put: (Character value: (integer bitShift: -24) \ 256).
"Smalltalk at: #PUTCOUNTER put: 0"!
----- Method: String>>putOn: (in category 'filter streaming') -----
putOn:aStream
^aStream nextPutAll: self.
!
----- Method: String>>replaceFrom:to:with:startingAt: (in category 'private') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "Primitive. This destructively replaces elements from start to stop in the receiver starting at index, repStart, in the collection, replacement. Answer the receiver. Range checks are performed in the primitive only. Optional. See Object documentation whatIsAPrimitive."
    <primitive: 105>
    super replaceFrom: start to: stop with: replacement startingAt: repStart!
----- Method: String>>romanNumber (in category 'converting') -----
romanNumber
    | value v1 v2 |
    value := v1 := v2 := 0.
    self reverseDo:
    	[:each |
    	v1 := #(1 5 10 50 100 500 1000) at: ('IVXLCDM' indexOf: each).
    	v1 >= v2
    		ifTrue: [value := value + v1]
    		ifFalse: [value := value - v1].
    	v2 := v1].
    ^ value!
----- Method: String>>sameAs: (in category 'comparing') -----
sameAs: aString 
    "Answer whether the receiver sorts equal to aString. The 
    collation sequence is ascii with case differences ignored."
    ^(self compare: aString caseSensitive: false) = 2!
----- Method: String>>sansPeriodSuffix (in category 'converting') -----
sansPeriodSuffix
    "Return a copy of the receiver up to, but not including, the first period.  If the receiver's *first* character is a period, then just return the entire receiver. "
| likely |
    likely := self copyUpTo: $..
    ^ likely size == 0
    	ifTrue:	[self]
    	ifFalse:	[likely]!
----- Method: String>>skipAnySubStr:startingAt: (in category 'accessing') -----
skipAnySubStr: delimiters startingAt: start 
    "Answer the index of the last character within the receiver, starting at start, that does NOT match one of the delimiters. delimiters is a Array of substrings (Characters also allowed).  If the receiver is all delimiters, answer size + 1."
| any this ind ii |
    ii := start-1.
    [(ii := ii + 1) <= self size] whileTrue: [ "look for char that does not match"
    	any := false.
    	delimiters do: [:delim |
    		delim isCharacter 
    			ifTrue: [(self at: ii) == delim ifTrue: [any := true]]
    			ifFalse: ["a substring"
    				delim size > (self size - ii + 1) ifFalse: "Here's where the one-off error was."
    					[ind := 0.
    					this := true.
    					delim do: [:dd | 
    						dd == (self at: ii+ind) ifFalse: [this := false].
    						ind := ind + 1].
    					this ifTrue: [ii := ii + delim size - 1.  any := true]]
    						ifTrue: [any := false] "if the delim is too big, it can't match"]].
    	any ifFalse: [^ ii]].
    ^ self size + 1!
----- Method: String>>skipDelimiters:startingAt: (in category 'accessing') -----
skipDelimiters: delimiters startingAt: start 
    "Answer the index of the character within the receiver, starting at start, that does NOT match one of the delimiters. If the receiver does not contain any of the delimiters, answer size + 1.  Assumes the delimiters to be a non-empty string."
start to: self size do: [:i |
    	delimiters detect: [:delim | delim = (self at: i)]
    			ifNone: [^ i]].
    ^ self size + 1!
----- Method: String>>splitInteger (in category 'converting') -----
splitInteger
    "Answer an array that is a splitting of self into a string and an integer.
    '43Sam' ==> #(43 'Sam').  'Try90' ==> #('Try' 90)
    BUT NOTE: 'Sam' ==> #('Sam' 0), and '90' ==> #('' 90)  ie, (<string> <integer>)."
| pos |
    (pos := self findFirst: [:d | d isDigit not]) = 0 ifTrue: [^ Array with: '' with: self asNumber].
    self first isDigit ifTrue: [
    	^ Array with: (self copyFrom: 1 to: pos - 1) asNumber 
    			with: (self copyFrom: pos to: self size)].
    (pos := self findFirst: [:d | d isDigit]) = 0 ifTrue: [^ Array with: self with: 0].
    ^ Array with: (self copyFrom: 1 to: pos - 1)
    		with: (self copyFrom: pos to: self size) asNumber!
----- Method: String>>squeakToIso (in category 'internet') -----
squeakToIso
    ^self "no longer needed"!
----- Method: String>>squeakToMac (in category 'internet') -----
squeakToMac
    "Convert the receiver from Squeak to MacRoman encoding"
    ^ self collect: [:each | each squeakToMac]!
----- Method: String>>squeakToUtf8 (in category 'converting') -----
squeakToUtf8
    "Convert the receiver into a UTF8-encoded string"
    ^self convertToWithConverter: UTF8TextConverter new.!
----- Method: String>>startingAt:match:startingAt: (in category 'comparing') -----
startingAt: keyStart match: text startingAt: textStart
    "Answer whether text matches the pattern in this string.
    Matching ignores upper/lower case differences.
    Where this string contains #, text may contain any character.
    Where this string contains *, text may contain any sequence of characters."
    | anyMatch matchStart matchEnd i matchStr j ii jj |
    i := keyStart.
    j := textStart.
"Check for any #'s"
    [i > self size ifTrue: [^ j > text size "Empty key matches only empty string"].
    (self at: i) = $#] whileTrue:
    	["# consumes one char of key and one char of text"
    	j > text size ifTrue: [^ false "no more text"].
    	i := i+1.  j := j+1].
"Then check for *"
    (self at: i) = $*
    	ifTrue: [i = self size ifTrue:
    				[^ true "Terminal * matches all"].
    			"* means next match string can occur anywhere"
    			anyMatch := true.
    			matchStart := i + 1]
    	ifFalse: ["Otherwise match string must occur immediately"
    			anyMatch := false.
    			matchStart := i].
"Now determine the match string"
    matchEnd := self size.
    (ii := self indexOf: $* startingAt: matchStart) > 0 ifTrue:
    	[ii = 1 ifTrue: [self error: '** not valid -- use * instead'].
    	matchEnd := ii-1].
    (ii := self indexOf: $# startingAt: matchStart) > 0 ifTrue:
    	[ii = 1 ifTrue: [self error: '*# not valid -- use #* instead'].
    	matchEnd := matchEnd min: ii-1].
    matchStr := self copyFrom: matchStart to: matchEnd.
"Now look for the match string"
    [jj := text findString: matchStr startingAt: j caseSensitive: false.
    anyMatch ifTrue: [jj > 0] ifFalse: [jj = j]]
    	whileTrue:
    	["Found matchStr at jj.  See if the rest matches..."
    	(self startingAt: matchEnd+1 match: text startingAt: jj + matchStr size) ifTrue:
    		[^ true "the rest matches -- success"].
    	"The rest did not match."
    	anyMatch ifFalse: [^ false].
    	"Preceded by * -- try for a later match"
    	j := j+1].
    ^ false "Failed to find the match string"!
----- Method: String>>startsWithDigit (in category 'accessing') -----
startsWithDigit
    "Answer whether the receiver's first character represents a digit"
^ self size > 0 and: [self first isDigit]!
----- Method: String>>stemAndNumericSuffix (in category 'converting') -----
stemAndNumericSuffix
    "Parse the receiver into a string-valued stem and a numeric-valued suffix.  6/7/96 sw"
| stem suffix position |
stem := self.
    suffix := 0.
    position := 1.
    [stem endsWithDigit and: [stem size > 1]] whileTrue:
    	[suffix :=  stem last digitValue * position + suffix.
    	position := position * 10.
    	stem := stem copyFrom: 1 to: stem size - 1].
    ^ Array with: stem with: suffix
"'Fred2305' stemAndNumericSuffix"!
----- Method: String>>storeOn: (in category 'printing') -----
storeOn: aStream 
    "Print inside string quotes, doubling inbedded quotes."
    | x |
    aStream nextPut: $'.
    1 to: self size do:
    	[:i |
    	aStream nextPut: (x := self at: i).
    	x = $' ifTrue: [aStream nextPut: x]].
    aStream nextPut: $'!
----- Method: String>>string (in category 'accessing') -----
string
    ^self!
----- Method: String>>stringRepresentation (in category 'printing') -----
stringRepresentation
    "Answer a string that represents the receiver.  For most objects this is simply its printString, but for strings themselves, it's themselves, to avoid the superfluous extra pair of quotes.  6/12/96 sw"
^ self !
----- Method: String>>stringhash (in category 'private') -----
stringhash
^ self hash.
!
----- Method: String>>subStrings (in category 'converting') -----
subStrings
    "Answer an array of the substrings that compose the receiver."
    #Collectn.
    "Added 2000/04/08 For ANSI <readableString> protocol."
    ^ self substrings!
----- Method: String>>subStrings: (in category 'converting') -----
subStrings: separators 
    "Answer an array containing the substrings in the receiver separated 
    by the elements of separators."
    | char result sourceStream subString |
    #Collectn.
    "Changed 2000/04/08 For ANSI <readableString> protocol."
    (separators isString or:[separators allSatisfy: [:element | element isKindOf: Character]])
    	ifFalse: [^ self error: 'separators must be Characters.'].
    sourceStream := ReadStream on: self.
    result := OrderedCollection new.
    subString := String new.
    [sourceStream atEnd]
    	whileFalse: 
    		[char := sourceStream next.
    		(separators includes: char)
    			ifTrue: [subString notEmpty
    					ifTrue: 
    						[result add: subString copy.
    						subString := String new]]
    			ifFalse: [subString := subString , (String with: char)]].
    subString notEmpty ifTrue: [result add: subString copy].
    ^ result asArray!
----- Method: String>>substrings (in category 'converting') -----
substrings
    "Answer an array of the substrings that compose the receiver."
    | result end beginning |
    result := WriteStream on: (Array new: 10).
    end := 0.
    "find one substring each time through this loop"
    [ "find the beginning of the next substring"
    beginning := end+1.
    [beginning <= self size and:[(self at: beginning) isSeparator]]
    	whileTrue:[beginning := beginning + 1].
    beginning <= self size] whileTrue: [
    	"find the end"
    	end := beginning.
    	[end <= self size and:[(self at: end) isSeparator not]]
    		whileTrue:[end := end + 1].
    	end := end - 1.
    	result nextPut: (self copyFrom: beginning to: end).
    ].
    ^result contents!
----- Method: String>>surroundedBySingleQuotes (in category 'converting') -----
surroundedBySingleQuotes
    "Answer the receiver with leading and trailing quotes.  "
^ $' asString, self, $' asString!
----- Method: String>>tabDelimitedFieldsDo: (in category 'accessing') -----
tabDelimitedFieldsDo: aBlock
    "Considering the receiver as a holder of tab-delimited fields, evaluate execute aBlock with each field in this string.  The separatilng tabs are not included in what is passed to aBlock"
| start end |
    "No senders but was useful enough in earlier work that it's retained for the moment."
    start := 1.
    [start <= self size] whileTrue: 
    	[end := self indexOf: Character tab startingAt: start ifAbsent: [self size + 1].
    	end := end - 1.
    	aBlock value: (self copyFrom: start  to: end).
    	start := end + 2]
"
'fred	charlie	elmo		2' tabDelimitedFieldsDo: [:aField | Transcript cr; show: aField]
"!
----- Method: String>>translateFrom:to:table: (in category 'converting') -----
translateFrom: start  to: stop  table: table
    "translate the characters in the string by the given table, in place"
    self class translate: self from: start to: stop table: table!
----- Method: String>>translateToLowercase (in category 'converting') -----
translateToLowercase
    "Translate all characters to lowercase, in place"
self translateWith: LowercasingTable!
----- Method: String>>translateToUppercase (in category 'converting') -----
translateToUppercase
    "Translate all characters to lowercase, in place"
self translateWith: UppercasingTable!
----- Method: String>>translateWith: (in category 'converting') -----
translateWith: table
    "translate the characters in the string by the given table, in place"
    ^ self translateFrom: 1 to: self size table: table!
----- Method: String>>translated (in category 'translating') -----
translated
    "answer the receiver translated to the default language"
    ^ NaturalLanguageTranslator current  translate: self!
----- Method: String>>translatedIfCorresponds (in category 'translating') -----
translatedIfCorresponds
    "answer the receiver translated to the default language only if 
    the receiver begins and ends with an underscore (_)"
    ^ ('_*_' match: self)
    	ifTrue: [(self copyFrom: 2 to: self size - 1) translated]
    	ifFalse: [self]!
----- Method: String>>translatedTo: (in category 'translating') -----
translatedTo: localeID 
    "answer the receiver translated to the given locale id"
    ^ localeID translator translate: self!
----- Method: String>>truncateTo: (in category 'converting') -----
truncateTo: smallSize
    "return myself or a copy shortened to smallSize.  1/18/96 sw"
^ self size <= smallSize
    	ifTrue:
    		[self]
    	ifFalse:
    		[self copyFrom: 1 to: smallSize]!
----- Method: String>>truncateWithElipsisTo: (in category 'converting') -----
truncateWithElipsisTo: maxLength
    "Return myself or a copy suitably shortened but with elipsis added"
^ self size <= maxLength
    	ifTrue:
    		[self]
    	ifFalse:
    		[(self copyFrom: 1 to: (maxLength - 3)), '...']
"'truncateWithElipsisTo:' truncateWithElipsisTo: 20"!
----- Method: String>>unescapePercents (in category 'converting') -----
unescapePercents
    "decode %xx form.  This is the opposite of #encodeForHTTP"
    ^ self unescapePercentsWithTextEncoding: 'utf-8'.!
----- Method: String>>unescapePercentsWithTextEncoding: (in category 'converting') -----
unescapePercentsWithTextEncoding: encodingName 
    "decode string including %XX form"
    | unescaped char asciiVal specialChars oldPos pos converter |
    unescaped := ReadWriteStream on: String new.
    specialChars := '+%' asCharacterSet.
    oldPos := 1.
    [pos := self indexOfAnyOf: specialChars startingAt: oldPos.
    pos > 0]
    	whileTrue: [unescaped
    			nextPutAll: (self copyFrom: oldPos to: pos - 1).
    		char := self at: pos.
    		(char = $%
    				and: [pos + 2 <= self size])
    			ifTrue: [asciiVal := (self at: pos + 1) asUppercase digitValue * 16 + (self at: pos + 2) asUppercase digitValue.
    				asciiVal > 255
    					ifTrue: [^ self].
    				unescaped
    					nextPut: (Character value: asciiVal).
    				pos := pos + 3.
    				pos <= self size
    					ifFalse: [char := nil].
    				oldPos := pos]
    			ifFalse: [char = $+
    					ifTrue: [unescaped nextPut: Character space]
    					ifFalse: [unescaped nextPut: char].
    				oldPos := pos + 1]].
    oldPos <= self size
    	ifTrue: [unescaped
    			nextPutAll: (self copyFrom: oldPos to: self size)].
    converter := (TextConverter newForEncoding: encodingName)
    			ifNil: [TextConverter newForEncoding: nil].
    ^ [unescaped contents convertFromWithConverter: converter]
    	on: Error
    	do: ["the contents may be squeak-encoded"
    		unescaped contents]!
----- Method: String>>unparenthetically (in category 'converting') -----
unparenthetically
    "If the receiver starts with (..( and ends with matching )..), strip them"
| curr |
    curr := self.
    [((curr first = $() and: [curr last = $)])] whileTrue:
    	[curr := curr copyFrom: 2 to: (curr size - 1)].
^ curr
"
'((fred the bear))' unparenthetically
"
    	!
----- Method: String>>unzipped (in category 'converting') -----
unzipped
    | magic1 magic2 |
    magic1 := (self at: 1) asInteger.
    magic2 := (self at: 2) asInteger.
    (magic1 = 16r1F and:[magic2 = 16r8B]) ifFalse:[^self].
    ^(GZipReadStream on: self) upToEnd!
----- Method: String>>utf8ToIso (in category 'internet') -----
utf8ToIso
    "Only UTF-8 characters that maps to 8-bit ISO-8559-1 values are converted. Others raises an error"
    | s i c v c2 v2 |
    s := WriteStream on: (String new: self size).
    
    i := 1.
    [i <= self size] whileTrue: [
    	c := self at: i. i:=i+1.
    	v := c asciiValue.
    	(v > 128)
    		ifFalse: [ s nextPut: c ]
    		ifTrue: [((v bitAnd: 252) == 192)
    			ifFalse: [self error: 'illegal UTF-8 ISO character']
    			ifTrue: [
    				(i > self size) ifTrue: [ self error: 'illegal end-of-string, expected 2nd byte of UTF-8'].
    				c2 := self at: i. i:=i+1.
    				v2 := c2 asciiValue.
    				((v2 bitAnd: 192) = 128) ifFalse: [self error: 'illegal 2nd UTF-8 char']. 
    				s nextPut: ((v2 bitAnd: 63) bitOr: ((v << 6) bitAnd: 192)) asCharacter]]].
    ^s contents. 
!
----- Method: String>>utf8ToSqueak (in category 'converting') -----
utf8ToSqueak
    "Convert the receiver from a UTF8-encoded string"
    ^self convertFromWithConverter: UTF8TextConverter new.!
----- Method: String>>withBlanksCondensed (in category 'converting') -----
withBlanksCondensed
    "Return a copy of the receiver with leading/trailing blanks removed
     and consecutive white spaces condensed."
| trimmed lastBlank |
    trimmed := self withBlanksTrimmed.
    ^String streamContents: [:stream |
    	lastBlank := false.
    	trimmed do: [:c | (c isSeparator and: [lastBlank]) ifFalse: [stream nextPut: c].
    		lastBlank := c isSeparator]].
" ' abc  d   ' withBlanksCondensed"
!
----- Method: String>>withBlanksTrimmed (in category 'converting') -----
withBlanksTrimmed
    "Return a copy of the receiver from which leading and trailing blanks have been trimmed."
| first result |
    first := self findFirst: [:c | c isSeparator not].
    first = 0 ifTrue: [^ ''].  "no non-separator character"
    result :=  self
    	copyFrom: first
    	to: (self findLast: [:c | c isSeparator not]).
    result isOctetString ifTrue: [^ result asOctetString] ifFalse: [^ result].
" ' abc  d   ' withBlanksTrimmed"
!
----- Method: String>>withCRs (in category 'formatting') -----
withCRs
    "Return a copy of the receiver in which backslash () characters have been replaced with carriage returns."
^ self collect: [ :c | c = $\ ifTrue: [ Character cr ] ifFalse: [ c ]].!
----- Method: String>>withFirstCharacterDownshifted (in category 'converting') -----
withFirstCharacterDownshifted
    "Return a copy with the first letter downShifted"
    
    | answer |
    
    self ifEmpty: [^ self copy].
    answer := self copy.
    answer at: 1 put: (answer at: 1) asLowercase.
    ^ answer. !
----- Method: String>>withInternetLineEndings (in category 'internet') -----
withInternetLineEndings
    "change line endings from CR's to CRLF's.  This is probably in
prepration for sending a string over the Internet"
    | cr lf |
    cr := Character cr.
    lf := Character linefeed.
    ^self class streamContents: [ :stream |
    	self do: [ :c |
    		stream nextPut: c.
    		c = cr ifTrue:[ stream nextPut: lf ]. ] ].!
----- Method: String>>withNoLineLongerThan: (in category 'converting') -----
withNoLineLongerThan: aNumber
    "Answer a string with the same content as receiver, but rewrapped so that no line has more characters than the given number"
    | listOfLines currentLast currentStart resultString putativeLast putativeLine crPosition |
    aNumber isNumber not | (aNumber < 1) ifTrue: [self error: 'too narrow'].
    listOfLines := OrderedCollection new.
    currentLast := 0.
    [currentLast < self size] whileTrue:
    	[currentStart := currentLast + 1.
    	putativeLast := (currentStart + aNumber - 1) min: self size.
    	putativeLine := self copyFrom: currentStart to: putativeLast.
    	(crPosition := putativeLine indexOf: Character cr) > 0 ifTrue:
    		[putativeLast := currentStart + crPosition - 1.
    		putativeLine := self copyFrom: currentStart to: putativeLast].
    	currentLast := putativeLast == self size
    		ifTrue:
    			[putativeLast]
    		ifFalse:
    			[currentStart + putativeLine lastSpacePosition - 1].
    	currentLast <= currentStart ifTrue:
    		["line has NO spaces; baleout!!"
    		currentLast := putativeLast].
    	listOfLines add: (self copyFrom: currentStart to: currentLast) withBlanksTrimmed].
listOfLines size > 0 ifFalse: [^ ''].
    resultString := listOfLines first.
    2 to: listOfLines size do:
    	[:i | resultString := resultString, String cr, (listOfLines at: i)].
    ^ resultString
"#(5 7 20) collect:
    [:i | 'Fred the bear went down to the brook to read his book in silence' withNoLineLongerThan: i]"!
----- Method: String>>withSeparatorsCompacted (in category 'converting') -----
withSeparatorsCompacted
    "replace each sequences of whitespace by a single space character"
    "' test ' withSeparatorsCompacted = ' test '"
    "' test test' withSeparatorsCompacted = ' test test'"
    "'test test		' withSeparatorsCompacted = 'test test '"
| out in next isSeparator |
    self isEmpty ifTrue: [^ self].
out := WriteStream on: (String new: self size).
    in := self readStream.
    isSeparator := [:char | char asciiValue < 256
    			and: [CSSeparators includes: char]].
    [in atEnd] whileFalse: [
    	next := in next.
    	(isSeparator value: next)
    		ifTrue: [
    			out nextPut: $ .
    			[in atEnd or:
    				[next := in next.
    				(isSeparator value: next)
    					ifTrue: [false]
    					ifFalse: [out nextPut: next. true]]] whileFalse]
    		ifFalse: [out nextPut: next]].
    ^ out contents!
----- Method: String>>withSqueakLineEndings (in category 'internet') -----
withSqueakLineEndings
    "assume the string is textual, and that CR, LF, and CRLF are all 
    valid line endings.  Replace each occurence with a single CR"
    | cr lf input c crlf inPos outPos outString lineEndPos newOutPos |
    cr := Character cr.
    lf := Character linefeed.
    crlf := CharacterSet new.
    crlf add: cr; add: lf.
inPos := 1.
    outPos := 1.
    outString :=
 String new: self size.
[ lineEndPos := self indexOfAnyOf: crlf startingAt: inPos ifAbsent: [0].
    	lineEndPos ~= 0 ] whileTrue: [
    		newOutPos := outPos + (lineEndPos - inPos + 1).
    		outString replaceFrom: outPos to: newOutPos - 2 with: self startingAt: inPos.
    		outString at: newOutPos-1 put: cr.
    		outPos := newOutPos.
((self at: lineEndPos) = cr and: [ lineEndPos < self size and: [ (self at: lineEndPos+1) = lf ] ]) ifTrue: [
    			"CRLF ending"
    			inPos := lineEndPos + 2 ]
    		ifFalse: [ 
    			"CR or LF ending"
    			inPos := lineEndPos + 1 ]. ].
"no more line endings.  copy the rest"
    newOutPos := outPos + (self size - inPos + 1).
    outString replaceFrom: outPos to: newOutPos-1 with: self startingAt: inPos.
^outString copyFrom: 1 to: newOutPos-1
    !
----- Method: String>>withoutJustTrailingDigits (in category 'converting') -----
withoutJustTrailingDigits
    "Answer the portion of the receiver that precedes any trailing series of digits.  If the receiver consists entirely of digits and blanks, return an empty string"
    | firstDigit |
    firstDigit := (self findFirst: [:m | m isDigit]).
    ^ firstDigit > 0
    	ifTrue:
    		[(self copyFrom: 1 to: firstDigit-1) withoutTrailingBlanks]
    	ifFalse:
    		[self]
"
'Wh oopi e234' withoutJustTrailingDigits
'Wh oopi e 234' withoutJustTrailingDigits
"
!
----- Method: String>>withoutLeadingBlanks (in category 'converting') -----
withoutLeadingBlanks
    
    "Return a copy of the receiver from which leading blanks have been
trimmed."
| first |
    
    first := self findFirst: [:c | c isSeparator not ].
first = 0 ifTrue: [^ ''].  
    
    "no non-separator character"
    
    ^ self copyFrom: first to: self size
" '    abc  d' withoutLeadingBlanks"
!
----- Method: String>>withoutLeadingDigits (in category 'converting') -----
withoutLeadingDigits
    "Answer the portion of the receiver that follows any leading series of digits and blanks.  If the receiver consists entirely of digits and blanks, return an empty string"
    | firstNonDigit |
    firstNonDigit := (self findFirst: [:m | m isDigit not and: [m ~= $ ]]).
    ^ firstNonDigit > 0
    	ifTrue:
    		[self copyFrom: firstNonDigit  to: self size]
    	ifFalse:
    		['']
"
'234Whoopie' withoutLeadingDigits
' 4321 BlastOff!!' withoutLeadingDigits
'wimpy' withoutLeadingDigits
'  89Ten ' withoutLeadingDigits
'78 92' withoutLeadingDigits
"
!
----- Method: String>>withoutQuoting (in category 'internet') -----
withoutQuoting
    "remove the initial and final quote marks, if present"
    "'''h''' withoutQuoting"
    | quote |
    self size < 2 ifTrue: [ ^self ].
    quote := self first.
    (quote = $' or: [ quote = $" ])
    	ifTrue: [ ^self copyFrom: 2 to: self size - 1 ]
    	ifFalse: [ ^self ].!
----- Method: String>>withoutTrailingBlanks (in category 'converting') -----
withoutTrailingBlanks
    "Return a copy of the receiver from which trailing blanks have been trimmed."
| last |
    last := self findLast: [:c | c isSeparator not].
    last = 0 ifTrue: [^ ''].  "no non-separator character"
    ^ self copyFrom: 1 to: last
" ' abc  d   ' withoutTrailingBlanks"
!
----- Method: String>>withoutTrailingDigits (in category 'converting') -----
withoutTrailingDigits
    "Answer the portion of the receiver that precedes any trailing series of digits and blanks.  If the receiver consists entirely of digits and blanks, return an empty string"
    | firstDigit |
    firstDigit := (self findFirst: [:m | m isDigit or: [m = $ ]]).
    ^ firstDigit > 0
    	ifTrue:
    		[self copyFrom: 1 to: firstDigit-1]
    	ifFalse:
    		[self]
"
'Whoopie234' withoutTrailingDigits
' 4321 BlastOff!!' withoutLeadingDigits
'wimpy' withoutLeadingDigits
'  89Ten ' withoutLeadingDigits
'78 92' withoutLeadingDigits
"
!
----- Method: String>>writeLeadingCharRunsOn: (in category 'encoding') -----
writeLeadingCharRunsOn: stream
| runLength runValues runStart leadingChar |
    self isEmpty ifTrue: [^ self].
runLength := OrderedCollection new.
    runValues := OrderedCollection new.
    runStart := 1.
    leadingChar := (self at: runStart) leadingChar.
    2 to: self size do: [:index |
    	(self at: index) leadingChar = leadingChar ifFalse: [
    		runValues add: leadingChar.
    		runLength add: (index - runStart).
    		leadingChar := (self at: index) leadingChar.
    		runStart := index.
    	].
    ].
    runValues add: (self last) leadingChar.
    runLength add: self size + 1 -  runStart.
stream nextPut: $(.
    runLength do: [:rr | rr printOn: stream. stream space].
    stream skip: -1; nextPut: $).
    runValues do: [:vv | vv printOn: stream. stream nextPut: $,].
    stream skip: -1.
!
----- Method: String>>zipped (in category 'converting') -----
zipped
    | stream gzstream |
stream := RWBinaryOrTextStream on: String new.
gzstream := GZipWriteStream on: stream.
    gzstream nextPutAll: self.
    gzstream close.
    stream reset.
^ stream contents.
!
String subclass: #Symbol
    instanceVariableNames: ''
    classVariableNames: 'NewSymbols OneCharacterSymbols SymbolTable'
    poolDictionaries: ''
    category: 'Collections-Strings'!
!Symbol commentStamp: '<historical>' prior: 0!
I represent Strings that are created uniquely. Thus, someString asSymbol == someString asSymbol.!
Symbol variableByteSubclass: #ByteSymbol
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Strings'!
!ByteSymbol commentStamp: '<historical>' prior: 0!
This class represents the symbols containing 8bit characters.!
----- Method: ByteSymbol class>>findFirstInString:inSet:startingAt: (in category 'primitives') -----
findFirstInString: aString inSet: inclusionMap startingAt: start
    ^ByteString findFirstInString: aString  inSet: inclusionMap startingAt: start!
----- Method: ByteSymbol class>>indexOfAscii:inString:startingAt: (in category 'primitives') -----
indexOfAscii: anInteger inString: aString startingAt: start
    ^ByteString indexOfAscii: anInteger inString: aString startingAt: start!
----- Method: ByteSymbol class>>stringHash:initialHash: (in category 'primitives') -----
stringHash: aString initialHash: speciesHash
    ^ByteString stringHash: aString initialHash: speciesHash!
----- Method: ByteSymbol class>>translate:from:to:table: (in category 'primitives') -----
translate: aString from: start  to: stop  table: table
    ^ByteString translate: aString from: start  to: stop  table: table!
----- Method: ByteSymbol>>asByteArray (in category 'converting') -----
asByteArray
    | ba sz |
    sz := self byteSize.
    ba := ByteArray new: sz.
    ba replaceFrom: 1 to: sz with: self startingAt: 1.
    ^ba!
----- Method: ByteSymbol>>asOctetString (in category 'converting') -----
asOctetString
    ^ self!
----- Method: ByteSymbol>>at: (in category 'accessing') -----
at: index 
    "Primitive. Answer the Character stored in the field of the receiver
    indexed by the argument. Fail if the index argument is not an Integer or
    is out of bounds. Essential. See Object documentation whatIsAPrimitive."
<primitive: 63>
    ^ Character value: (super at: index)!
----- Method: ByteSymbol>>at:put: (in category 'accessing') -----
at: anInteger put: anObject 
    "You cannot modify the receiver."
    self errorNoModification!
----- Method: ByteSymbol>>beginsWith: (in category 'comparing') -----
beginsWith: prefix
    "Answer whether the receiver begins with the given prefix string.
    The comparison is case-sensitive."
"IMPLEMENTATION NOTE:
    following algorithm is optimized in primitive only in case self and prefix are bytes like.
    Otherwise, if self is wide, then super outperforms,
    Otherwise, if prefix is wide, primitive is not correct"
    
    prefix class isBytes ifFalse: [^super beginsWith: prefix].
    
    self size < prefix size ifTrue: [^ false].
    ^ (self findSubstring: prefix in: self startingAt: 1
    		matchTable: CaseSensitiveOrder) = 1
!
----- Method: ByteSymbol>>byteAt: (in category 'accessing') -----
byteAt: index
    <primitive: 60>
    ^(self at: index) asciiValue!
----- Method: ByteSymbol>>byteAt:put: (in category 'accessing') -----
byteAt: anInteger put: anObject 
    "You cannot modify the receiver."
    self errorNoModification!
----- Method: ByteSymbol>>byteSize (in category 'accessing') -----
byteSize
    ^self size!
----- Method: ByteSymbol>>findSubstring:in:startingAt:matchTable: (in category 'comparing') -----
findSubstring: key in: body startingAt: start matchTable: matchTable
    "Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned."
    <primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
    ^super findSubstring: key in: body startingAt: start matchTable: matchTable!
----- Method: ByteSymbol>>isByteString (in category 'testing') -----
isByteString
    "Answer whether the receiver is a ByteString"
    ^true!
----- Method: ByteSymbol>>isOctetString (in category 'testing') -----
isOctetString
    "Answer whether the receiver can be represented as a byte string. 
    This is different from asking whether the receiver *is* a ByteString 
    (i.e., #isByteString)"
    ^ true.
!
----- Method: ByteSymbol>>pvtAt:put: (in category 'private') -----
pvtAt: index put: aCharacter
    "Primitive. Store the Character in the field of the receiver indicated by
    the index. Fail if the index is not an Integer or is out of bounds, or if
    the argument is not a Character. Essential. See Object documentation
    whatIsAPrimitive."
<primitive: 64>
    aCharacter isCharacter 
    	ifFalse:[^self errorImproperStore].
    index isInteger
    	ifTrue: [self errorSubscriptBounds: index]
    	ifFalse: [self errorNonIntegerIndex]!
----- Method: ByteSymbol>>species (in category 'accessing') -----
species
    "Answer the preferred class for reconstructing the receiver."
    ^ByteString
!
----- Method: ByteSymbol>>string: (in category 'private') -----
string: aString
    1 to: aString size do: [:j | self pvtAt: j put: (aString at: j)].
    ^self!
----- Method: Symbol class>>allSymbolTablesDo: (in category 'class initialization') -----
allSymbolTablesDo: aBlock
NewSymbols do: aBlock.
    SymbolTable do: aBlock.!
----- Method: Symbol class>>allSymbolTablesDo:after: (in category 'class initialization') -----
allSymbolTablesDo: aBlock after: aSymbol
NewSymbols do: aBlock after: aSymbol.
    SymbolTable do: aBlock after: aSymbol.!
----- Method: Symbol class>>allSymbols (in category 'access') -----
allSymbols
    "Answer all interned symbols"
    ^Array streamContents:[:s|
    	s nextPutAll: NewSymbols.
    	s nextPutAll: OneCharacterSymbols.
    	s nextPutAll: SymbolTable.
    ].
!
----- Method: Symbol class>>compactSymbolTable (in category 'class initialization') -----
compactSymbolTable
    "Reduce the size of the symbol table so that it holds all existing symbols + 25% (changed from 1000 since sets like to have 25% free and the extra space would grow back in a hurry)"
| oldSize |
Smalltalk garbageCollect.
    oldSize := SymbolTable array size.
    SymbolTable growTo: SymbolTable size * 4 // 3 + 100.
    ^oldSize printString,'  ',(oldSize - SymbolTable array size) printString, ' slot(s) reclaimed'!
----- Method: Symbol class>>findInterned: (in category 'instance creation') -----
findInterned:aString
self hasInterned:aString ifTrue:[:symbol| ^symbol].
    ^nil.!
----- Method: Symbol class>>hasInterned:ifTrue: (in category 'private') -----
hasInterned: aString ifTrue: symBlock 
    "Answer with false if aString hasnt been interned (into a Symbol),  
    otherwise supply the symbol to symBlock and return true."
| symbol |
    ^ (symbol := self lookup: aString)
    	ifNil: [false]
    	ifNotNil: [symBlock value: symbol.
    		true]!
----- Method: Symbol class>>initialize (in category 'class initialization') -----
initialize
"Symbol initialize"
Symbol rehash.
    OneCharacterSymbols := nil.
    OneCharacterSymbols := (1 to: 256) collect: [ :i | (i - 1) asCharacter asSymbol].
    Smalltalk addToShutDownList: self.
!
----- Method: Symbol class>>intern: (in category 'instance creation') -----
intern: aStringOrSymbol
^(self lookup: aStringOrSymbol) ifNil:[
    	| aClass aSymbol |
    	aStringOrSymbol isSymbol ifTrue:[
    		aSymbol := aStringOrSymbol.
    	] ifFalse:[
    		aClass := aStringOrSymbol isOctetString ifTrue:[ByteSymbol] ifFalse:[WideSymbol].
    		aSymbol := aClass new: aStringOrSymbol size.
    		aSymbol string: aStringOrSymbol.
    	].
    	NewSymbols add: aSymbol.
    	aSymbol].!
----- Method: Symbol class>>internCharacter: (in category 'instance creation') -----
internCharacter: aCharacter
    aCharacter asciiValue > 256 ifTrue:[^self intern: aCharacter asString].
    OneCharacterSymbols ifNil: [^self intern: aCharacter asString].
    ^OneCharacterSymbols at: aCharacter asciiValue + 1
!
----- Method: Symbol class>>lookup: (in category 'instance creation') -----
lookup: aStringOrSymbol
^(SymbolTable like: aStringOrSymbol) ifNil: [
    	NewSymbols like: aStringOrSymbol
    ]!
----- Method: Symbol class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
^ (aCollection as: String) asSymbol
"	Symbol newFrom: {$P. $e. $n}
    {$P. $e. $n} as: Symbol
"!
----- Method: Symbol class>>possibleSelectorsFor: (in category 'private') -----
possibleSelectorsFor: misspelled 
    "Answer an ordered collection of possible corrections
    for the misspelled selector in order of likelyhood"
| numArgs candidates lookupString best binary short long first ss |
    lookupString := misspelled asLowercase. "correct uppercase selectors to lowercase"
    numArgs := lookupString numArgs.
    (numArgs < 0 or: [lookupString size < 2]) ifTrue: [^ OrderedCollection new: 0].
    first := lookupString first.
    short := lookupString size - (lookupString size // 4 max: 3) max: 2.
    long := lookupString size + (lookupString size // 4 max: 3).
"First assemble candidates for detailed scoring"
    candidates := OrderedCollection new.
    self allSymbolTablesDo: [:s | (((ss := s size) >= short	"not too short"
    		and: [ss <= long			"not too long"
    				or: [(s at: 1) = first]])	"well, any length OK if starts w/same letter"
    		and: [s numArgs = numArgs])	"and numArgs is the same"
    		ifTrue: [candidates add: s]].
"Then further prune these by correctAgainst:"
    best := lookupString correctAgainst: candidates.
    ((misspelled last ~~ $:) and: [misspelled size > 1]) ifTrue: [
    	binary := misspelled, ':'.		"try for missing colon"
    	Symbol hasInterned: binary ifTrue: [:him | best addFirst: him]].
    ^ best!
----- Method: Symbol class>>readFrom: (in category 'instance creation') -----
readFrom: strm  "Symbol readFromString: '#abc'"
strm peek = $# ifFalse: [self error: 'Symbols must be introduced by #'].
    ^ (Scanner new scan: strm) advance  "Just do what the code scanner does"!
----- Method: Symbol class>>rehash (in category 'private') -----
rehash		"Symbol rehash"
    "Rebuild the hash table, reclaiming unreferenced Symbols."
SymbolTable := WeakSet withAll: self allSubInstances.
    NewSymbols := WeakSet new.!
----- Method: Symbol class>>selectorsContaining: (in category 'access') -----
selectorsContaining: aString
    "Answer a list of selectors that contain aString within them. Case-insensitive.  Does return symbols that begin with a capital letter."
| size selectorList ascii |
selectorList := OrderedCollection new.
    (size := aString size) = 0 ifTrue: [^selectorList].
aString size = 1 ifTrue:
    	[
    		ascii := aString first asciiValue.
    		ascii < 128 ifTrue: [selectorList add: (OneCharacterSymbols at: ascii+1)]
    	].
aString first isLetter ifFalse:
    	[
    		aString size == 2 ifTrue: 
    			[Symbol hasInterned: aString ifTrue:
    				[:s | selectorList add: s]].
    		^selectorList
    	].
selectorList := selectorList copyFrom: 2 to: selectorList size.
self allSymbolTablesDo: [:each |
    	each size >= size ifTrue:
    		[(each findString: aString startingAt: 1 caseSensitive: false) > 0
    					ifTrue: [selectorList add: each]]].
^selectorList reject: [:each | "reject non-selectors, but keep ones that begin with an uppercase"
    	each numArgs < 0 and: [each asString withFirstCharacterDownshifted numArgs < 0]].
"Symbol selectorsContaining: 'scon'"!
----- Method: Symbol class>>shutDown: (in category 'private') -----
shutDown: aboutToQuit
SymbolTable addAll: NewSymbols.
    NewSymbols := WeakSet new.!
----- Method: Symbol class>>thatStarts:skipping: (in category 'access') -----
thatStarts: leadingCharacters skipping: skipSym
    "Answer a selector symbol that starts with leadingCharacters.
    Symbols beginning with a lower-case letter handled directly here.
    Ignore case after first char.
    If skipSym is not nil, it is a previous answer; start searching after it.
    If no symbols are found, answer nil.
    Used by Alt-q (Command-q) routines"
| size firstMatch key |
size := leadingCharacters size.
    size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]].
firstMatch := leadingCharacters at: 1.
    size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size].
self allSymbolTablesDo: [:each |
    		each size >= size ifTrue:
    			[
    				((each at: 1) == firstMatch and:
    					[key == nil or:
    						[(each findString: key startingAt: 2 caseSensitive: false) = 2]])
    							ifTrue: [^each]
    			]
    	] after: skipSym.
^nil
"Symbol thatStarts: 'sf' skipping: nil"
"Symbol thatStarts: 'sf' skipping: #sfpGetFile:with:with:with:with:with:with:with:with:"
"Symbol thatStarts: 'candidate' skipping: nil"
!
----- Method: Symbol class>>thatStartsCaseSensitive:skipping: (in category 'access') -----
thatStartsCaseSensitive: leadingCharacters skipping: skipSym
    "Same as thatStarts:skipping: but caseSensitive"
    | size firstMatch key |
size := leadingCharacters size.
    size = 0 ifTrue: [^skipSym ifNil: [#''] ifNotNil: [nil]].
    firstMatch := leadingCharacters at: 1.
    size > 1 ifTrue: [key := leadingCharacters copyFrom: 2 to: size].
    self allSymbolTablesDo: [:each |
    		each size >= size ifTrue:
    			[
    				((each at: 1) == firstMatch and:
    					[key == nil or:
    						[(each findString: key startingAt: 2 caseSensitive: true) = 2]])
    							ifTrue: [^each]
    			]
    	] after: skipSym.
^nil
!
----- Method: Symbol>>= (in category 'comparing') -----
= aSymbol
    "Compare the receiver and aSymbol." 
    self == aSymbol ifTrue: [^ true].
    self class == aSymbol class ifTrue: [^ false].
    "Use String comparison otherwise"
    ^ super = aSymbol!
----- Method: Symbol>>asExplorerString (in category 'user interface') -----
asExplorerString
    ^ self printString!
----- Method: Symbol>>asMutator (in category 'converting') -----
asMutator
    "Return a setter message from a getter message. For example,
    #name asMutator returns #name:"
    ^ (self copyWith: $:) asSymbol!
----- Method: Symbol>>asString (in category 'converting') -----
asString 
    "Refer to the comment in String|asString."
    | newString |
    newString := self species new: self size.
    newString replaceFrom: 1 to: newString size with: self startingAt: 1.
    ^newString!
----- Method: Symbol>>asSymbol (in category 'converting') -----
asSymbol 
    "Refer to the comment in String|asSymbol."!
----- Method: Symbol>>at:put: (in category 'accessing') -----
at: anInteger put: anObject 
    "You cannot modify the receiver."
self errorNoModification!
----- Method: Symbol>>byteEncode: (in category 'filter streaming') -----
byteEncode:aStream
    ^aStream writeSymbol:self.
!
----- Method: Symbol>>capitalized (in category 'converting') -----
capitalized
    ^ self asString capitalized asSymbol!
----- Method: Symbol>>clone (in category 'copying') -----
clone
    "Answer with the receiver, because Symbols are unique."!
----- Method: Symbol>>copy (in category 'copying') -----
copy
    "Answer with the receiver, because Symbols are unique."!
----- Method: Symbol>>errorNoModification (in category 'private') -----
errorNoModification
self error: 'symbols can not be modified.'!
----- Method: Symbol>>flushCache (in category 'system primitives') -----
flushCache
    "Tell the interpreter to remove all entries with this symbol as a selector from its method lookup cache, if it has one.  This primitive must be called whenever a method is defined or removed.
    NOTE:  Only one of the two selective flush methods needs to be used.
    Squeak 2.3 and later uses 116 (See CompiledMethod flushCache)."
<primitive: 119>
!
----- Method: Symbol>>includesKey: (in category 'testing') -----
includesKey: sym
    ^self == sym.!
----- Method: Symbol>>isDoIt (in category 'testing') -----
isDoIt
^ (self == #DoIt) or: [self == #DoItIn:].!
----- Method: Symbol>>isInfix (in category 'testing') -----
isInfix
    "Answer whether the receiver is an infix message selector."
^ self precedence == 2!
----- Method: Symbol>>isKeyword (in category 'testing') -----
isKeyword
    "Answer whether the receiver is a message keyword."
^ self precedence == 3!
----- Method: Symbol>>isLiteral (in category 'testing') -----
isLiteral
    "Answer whether the receiver is a valid Smalltalk literal."
^ true!
----- Method: Symbol>>isOrientedFill (in category 'printing') -----
isOrientedFill
    "Needs to be implemented here because symbols can occupy 'color' slots of morphs."
^ false!
----- Method: Symbol>>isPvtSelector (in category 'testing') -----
isPvtSelector
    "Answer whether the receiver is a private message selector, that is,
    begins with 'pvt' followed by an uppercase letter, e.g. pvtStringhash."
^ (self beginsWith: 'pvt') and: [self size >= 4 and: [(self at: 4) isUppercase]]!
----- Method: Symbol>>isSymbol (in category 'testing') -----
isSymbol
    ^ true !
----- Method: Symbol>>isUnary (in category 'testing') -----
isUnary
    "Answer whether the receiver is an unary message selector."
^ self precedence == 1!
----- Method: Symbol>>numArgs: (in category 'system primitives') -----
numArgs: n
    "Answer a string that can be used as a selector with n arguments.
     TODO: need to be extended to support shrinking and for selectors like #+ "
| selector numArgs aStream offs |
    
    selector := self.
    (numArgs := selector numArgs) >= n ifTrue: [^self].	
    aStream := WriteStream on: (String new: 16).
    aStream nextPutAll: self.
    
    (numArgs = 0) ifTrue: [aStream nextPutAll: ':'. offs := 0] ifFalse: [offs := 1].
    2 to: n - numArgs + offs do: [:i | aStream nextPutAll: 'with:'].	
    ^aStream contents asSymbol
    
!
----- Method: Symbol>>precedence (in category 'accessing') -----
precedence
    "Answer the receiver's precedence, assuming it is a valid Smalltalk
    message selector or 0 otherwise.  The numbers are 1 for unary,
    2 for binary and 3 for keyword selectors."
self size = 0 ifTrue: [^ 0].
    self first isLetter ifFalse: [^ 2].
    self last = $: ifTrue: [^ 3].
    ^ 1!
----- Method: Symbol>>replaceFrom:to:with:startingAt: (in category 'accessing') -----
replaceFrom: start to: stop with: replacement startingAt: repStart
self errorNoModification!
----- Method: Symbol>>shallowCopy (in category 'copying') -----
shallowCopy
    "Answer with the receiver, because Symbols are unique."!
----- Method: Symbol>>storeOn: (in category 'printing') -----
storeOn: aStream
aStream nextPut: $#.
    (Scanner isLiteralSymbol: self)
    	ifTrue: [aStream nextPutAll: self]
    	ifFalse: [super storeOn: aStream]!
----- Method: Symbol>>string: (in category 'private') -----
string: aString
1 to: aString size do: [:j | super at: j put: (aString at: j)].
    ^self  !
----- Method: Symbol>>value: (in category 'evaluating') -----
value: anObject 
    ^anObject perform: self.!
----- Method: Symbol>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
    "Return self.  I am immutable in the Morphic world.  Do not record me."!
----- Method: Symbol>>withFirstCharacterDownshifted (in category 'converting') -----
withFirstCharacterDownshifted
    "Answer an object like the receiver but with first character downshifted if necesary"
^self asString withFirstCharacterDownshifted asSymbol.!
Symbol variableWordSubclass: #WideSymbol
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Strings'!
!WideSymbol commentStamp: '<historical>' prior: 0!
This class represents the symbols containing 32bit characters.!
----- Method: WideSymbol class>>initialize (in category 'class initialization') -----
initialize
    Smalltalk removeFromShutDownList: self. "@@@ Remove this later @@@"!
----- Method: WideSymbol>>at: (in category 'accessing') -----
at: index 
    "Answer the Character stored in the field of the receiver indexed by the argument."
    ^ Character value: (self wordAt: index).
!
----- Method: WideSymbol>>at:put: (in category 'accessing') -----
at: anInteger put: anObject 
    "You cannot modify the receiver."
self errorNoModification
!
----- Method: WideSymbol>>byteAt: (in category 'accessing') -----
byteAt: index
| d r |
    d := (index + 3) // 4.
    r := (index - 1) \ 4 + 1.
    ^ (self wordAt: d) digitAt: ((4 - r) + 1).
!
----- Method: WideSymbol>>byteAt:put: (in category 'accessing') -----
byteAt: index put: aByte
    self errorNoModification.!
----- Method: WideSymbol>>byteSize (in category 'accessing') -----
byteSize
^ self size * 4.
!
----- Method: WideSymbol>>fixUponLoad:seg: (in category 'private') -----
fixUponLoad: aProject seg: anImageSegment
    "We are in an old project that is being loaded from disk. 
    Fix up conventions that have changed."
    | ms |
    "Yoshiki did not put MultiSymbols into outPointers in older 
images!!
    When all old images are gone, remove this method."
    ms := Symbol intern: self asString.
    self == ms ifFalse: [
    	"For a project from older m17n image, this is necessary."
    	self becomeForward: ms.
    	aProject projectParameters at: #MultiSymbolInWrongPlace put: true
    ].
"MultiString>>capitalized was not implemented 
correctly. 
    Fix eventual accessors and mutators here."
    ((self beginsWith: 'get')
    	and:[(self at: 4) asInteger < 256
    	and:[(self at: 4) isLowercase]]) ifTrue:[
    		ms := self asString.
    		ms at: 4 put: (ms at: 4) asUppercase.
    		ms := ms asSymbol.
    		self becomeForward: ms.
    		aProject projectParameters at: #MultiSymbolInWrongPlace put: true.
    	].
    ((self beginsWith: 'set')
    	and:[(self at: 4) asInteger < 256
    	and:[(self at: 4) isLowercase
    	and:[self last = $:
    	and:[(self occurrencesOf: $:) = 1]]]]) ifTrue:[
    		ms := self asString.
    		ms at: 4 put: (ms at: 4) asUppercase.
    		ms := ms asSymbol.
    		self becomeForward: ms.
    		aProject projectParameters at: #MultiSymbolInWrongPlace put: true.
    	].
    ^ super fixUponLoad: aProject seg: anImageSegment	"me, 
not the label"
!
----- Method: WideSymbol>>isWideString (in category 'testing') -----
isWideString
    "Answer whether the receiver is a WideString"
    ^true!
----- Method: WideSymbol>>mutateJISX0208StringToUnicode (in category 'private') -----
mutateJISX0208StringToUnicode
| c |
    1 to: self size do: [:i |
    	c := self at: i.
    	(c leadingChar = JISX0208 leadingChar or: [
    		c leadingChar = (JISX0208 leadingChar bitShift: 2)]) ifTrue: [
    		self basicAt: i put: (Character leadingChar: JapaneseEnvironment leadingChar code: (c asUnicode)) asciiValue.
    	]
    ].
!
----- Method: WideSymbol>>pvtAt:put: (in category 'private') -----
pvtAt: index put: aCharacter
    "Primitive. Store the Character in the field of the receiver indicated by
    the index. Fail if the index is not an Integer or is out of bounds, or if
    the argument is not a Character. Essential. See Object documentation
    whatIsAPrimitive."
<primitive: 61>
    index isInteger
    	ifTrue: [self errorSubscriptBounds: index]
    	ifFalse: [self errorNonIntegerIndex]!
----- Method: WideSymbol>>species (in category 'accessing') -----
species
    "Answer the preferred class for reconstructing the receiver."
    ^WideString
!
----- Method: WideSymbol>>string: (in category 'private') -----
string: aString
    1 to: aString size do: [:j | self pvtAt: j put: (aString at: j) asInteger].
    ^self!
----- Method: WideSymbol>>wordAt: (in category 'accessing') -----
wordAt: index
    <primitive: 60>
    ^ (self basicAt: index).
!
----- Method: WideSymbol>>wordAt:put: (in category 'accessing') -----
wordAt: index put: anInteger
    self errorNoModification.!
String variableWordSubclass: #WideString
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Strings'!
!WideString commentStamp: 'yo 10/19/2004 22:34' prior: 0!
This class represents the array of 32 bit wide characters.
!
----- Method: WideString class>>allMethodsWithEncodingTag: (in category 'enumeration') -----
allMethodsWithEncodingTag: encodingTag
    "Answer a SortedCollection of all the methods that implement the message 
    aSelector."
| list adder num i |
    list := Set new.
    adder := [ :mrClass :mrSel |
    	list add: (
    		MethodReference new
    			setStandardClass: mrClass
    			methodSymbol: mrSel
    	)
    ].
num := CompiledMethod allInstances size.
    i := 0.
    'processing...' displayProgressAt: Sensor cursorPoint from: 0 to: num during: [:bar |
    	SystemNavigation new allBehaviorsDo: [ :class |
    		class selectors do: [:s |
    			bar value: (i := i + 1).				
    			(self string: (class sourceCodeAt: s) asString hasEncoding: encodingTag) ifTrue: [
    				adder value: class value: s.
    			]
    		]
    	]
    ].
^ list.
!
----- Method: WideString class>>allMultiStringMethods (in category 'enumeration') -----
allMultiStringMethods  
    "Answer a SortedCollection of all the methods that implement the message 
    aSelector."
| list adder num i |
    list := Set new.
    adder := [ :mrClass :mrSel |
    	list add: (
    		MethodReference new
    			setStandardClass: mrClass
    			methodSymbol: mrSel
    	)
    ].
num := CompiledMethod allInstances size.
    i := 0.
    'processing...' displayProgressAt: Sensor cursorPoint from: 0 to: num during: [:bar |
    	SystemNavigation new allBehaviorsDo: [ :class |
    		class selectors do: [:s |
    			bar value: (i := i + 1).				
    			((class sourceCodeAt: s) asString isOctetString) ifFalse: [
    				adder value: class value: s.
    			]
    		]
    	]
    ].
^ list.
!
----- Method: WideString class>>allNonAsciiMethods (in category 'enumeration') -----
allNonAsciiMethods  
    "Answer a SortedCollection of all the methods that implement the message 
    aSelector."
| list adder num i |
    list := Set new.
    adder := [ :mrClass :mrSel |
    	list add: (
    		MethodReference new
    			setStandardClass: mrClass
    			methodSymbol: mrSel
    	)
    ].
num := CompiledMethod allInstances size.
    i := 0.
    'processing...' displayProgressAt: Sensor cursorPoint from: 0 to: num during: [:bar |
    	SystemNavigation new allBehaviorsDo: [ :class |
    		class selectors do: [:s |
    			bar value: (i := i + 1).				
    			((class sourceCodeAt: s) asString isAsciiString) ifFalse: [
    				adder value: class value: s.
    			]
    		]
    	]
    ].
^ list.
!
----- Method: WideString class>>from: (in category 'instance creation') -----
from: aString
| newString |
    (aString isMemberOf: self)
    	ifTrue: [^ aString copy].
    newString := self new: aString size.
    1 to: aString size do: [:index | newString basicAt: index put: (aString basicAt: index)].
    ^ newString
!
----- Method: WideString class>>fromByteArray: (in category 'instance creation') -----
fromByteArray: aByteArray
| inst |
    aByteArray size \ 4 = 0 ifFalse: [^ ByteString fromByteArray: aByteArray ].
    inst := self new: aByteArray size // 4.
    4 to: aByteArray size by: 4 do: [:i |
    	inst basicAt: i // 4
    		put: ((aByteArray at: i - 3) << 24) + 
    			((aByteArray at: i - 2) << 16) +
    			 ((aByteArray at: i - 1) << 8) +
    			(aByteArray at: i)
    ].
^ inst
!
----- Method: WideString class>>fromISO2022JPString: (in category 'instance creation') -----
fromISO2022JPString: string
| tempFileName stream contents |
    tempFileName := Time millisecondClockValue printString , '.txt'.
    FileDirectory default deleteFileNamed: tempFileName ifAbsent: [].
    stream := StandardFileStream fileNamed: tempFileName.
    [stream nextPutAll: string]
    	ensure: [stream close].
    stream := FileStream fileNamed: tempFileName.
    contents := stream contentsOfEntireFile.
    FileDirectory default deleteFileNamed: tempFileName ifAbsent: [].
    ^ contents
!
----- Method: WideString class>>fromPacked: (in category 'instance creation') -----
fromPacked: aLong
    "Convert from a longinteger to a String of length 4."
| s val |
    s := self new: 1.
    val := (((aLong digitAt: 4) << 24) bitOr:((aLong digitAt: 3) << 16))
    			bitOr: (((aLong digitAt: 2) << 8) bitOr: (aLong digitAt: 1)).
    s basicAt: 1 put: val.
    ^ s.
"WideString fromPacked: 'TEXT' asPacked"
!
----- Method: WideString class>>fromString: (in category 'instance creation') -----
fromString: aString 
    "Answer an instance of me that is a copy of the argument, aString."
| inst |
    (aString isMemberOf: self) ifTrue: [
    	^ aString copy.
    ].
    inst := self new: aString size.
    1 to: aString size do: [:pos |
    	inst basicAt: pos put: (aString basicAt: pos).
    ].
    ^ inst.
!
----- Method: WideString>>asFourCode (in category 'converting') -----
asFourCode
| result |
    self size = 1 ifFalse: [^self error: 'must be exactly four octets'].
    result := self basicAt: 1.
    (result bitAnd: 16r80000000) = 0 
    	ifFalse: [self error: 'cannot resolve fourcode'].
    (result bitAnd: 16r40000000) = 0 ifFalse: [^result - 16r80000000].
    ^ result
!
----- Method: WideString>>asPacked (in category 'converting') -----
asPacked
self inject: 0 into: [:pack :next | pack := pack * 16r100000000 + next asInteger].
!
----- Method: WideString>>at: (in category 'accessing') -----
at: index 
    "Answer the Character stored in the field of the receiver indexed by the argument."
    ^ Character value: (self wordAt: index).
!
----- Method: WideString>>at:put: (in category 'accessing') -----
at: index put: aCharacter 
    "Store the Character in the field of the receiver indicated by the index."
    aCharacter isCharacter ifFalse:[self errorImproperStore].
    self wordAt: index put: aCharacter asInteger.
    ^aCharacter!
----- Method: WideString>>byteAt: (in category 'accessing') -----
byteAt: index
| d r |
    d := (index + 3) // 4.
    r := (index - 1) \ 4 + 1.
    ^ (self wordAt: d) digitAt: ((4 - r) + 1).
!
----- Method: WideString>>byteAt:put: (in category 'accessing') -----
byteAt: index put: aByte
| d r w |
    d := (index + 3) // 4.
    r := (index - 1) \ 4 + 1.
    w := (self wordAt: d) bitAnd: ((16rFF<<((4 - r)*8)) bitInvert32).
    w := w + (aByte<<((4 - r)*8)).
    self basicAt: d put: w.
    ^ aByte.
!
----- Method: WideString>>byteSize (in category 'accessing') -----
byteSize
^ self size * 4.
!
----- Method: WideString>>copyFrom:to: (in category 'converting') -----
copyFrom: start to: stop
| n |
    n := super copyFrom: start to: stop.
    n isOctetString ifTrue: [^ n asOctetString].
    ^ n.
!
----- Method: WideString>>includesUnifiedCharacter (in category 'testing') -----
includesUnifiedCharacter
^ self isUnicodeStringWithCJK
!
----- Method: WideString>>isUnicodeStringWithCJK (in category 'testing') -----
isUnicodeStringWithCJK
self do: [:c |
    	(c isTraditionalDomestic not and: [Unicode isUnifiedKanji: c charCode]) ifTrue: [
    		^ true
    	].
    ].
^ false.
!
----- Method: WideString>>isWideString (in category 'testing') -----
isWideString
    "Answer whether the receiver is a WideString"
    ^true!
----- Method: WideString>>mutateJISX0208StringToUnicode (in category 'private') -----
mutateJISX0208StringToUnicode
| c |
    1 to: self size do: [:i |
    	c := self at: i.
    	(c leadingChar = JISX0208 leadingChar or: [
    		c leadingChar = (JISX0208 leadingChar bitShift: 2)]) ifTrue: [
    		self basicAt: i put: (Character leadingChar: JapaneseEnvironment leadingChar code: (c asUnicode)) asciiValue.
    	]
    ].
!
----- Method: WideString>>replaceFrom:to:with:startingAt: (in category 'accessing') -----
replaceFrom: start to: stop with: replacement startingAt: repStart
<primitive: 105>
    replacement class == String ifTrue: [
    	^ self replaceFrom: start to: stop with: (replacement asWideString) startingAt: repStart.
    ].
^ super replaceFrom: start to: stop with: replacement startingAt: repStart.
!
----- Method: WideString>>wordAt: (in category 'accessing') -----
wordAt: index
    <primitive: 60>
    ^ (self basicAt: index).
!
----- Method: WideString>>wordAt:put: (in category 'accessing') -----
wordAt: index put: anInteger
    <primitive: 61>
    self basicAt: index put: anInteger.
!
ArrayedCollection variableWordSubclass: #WordArray
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
!WordArray commentStamp: '<historical>' prior: 0!
WordArrays store 32-bit unsigned Integer values.
!
----- Method: WordArray class>>bobsTest (in category 'as yet unclassified') -----
bobsTest
    | wa s1 s2 wa2 answer rawData |
"
WordArray bobsTest
"
    answer := OrderedCollection new.
    wa := WordArray with: 16r01020304 with: 16r05060708.
    {false. true} do: [ :pad |
    	0 to: 3 do: [ :skip |
    		s1 := RWBinaryOrTextStream on: ByteArray new.
s1 next: skip put: 0.		"start at varying positions"
    		wa writeOn: s1.
    		pad ifTrue: [s1 next: 4-skip put: 0].	"force length to be multiple of 4"
rawData := s1 contents.
    		s2 := RWBinaryOrTextStream with: rawData.
    		s2 reset.
    		s2 skip: skip.			"get to beginning of object"
    		wa2 := WordArray newFromStream: s2.
    		answer add: {
    			rawData size. 
    			skip. 
    			wa2 = wa. 
    			wa2 asArray collect: [ :each | each radix: 16]
    		}
    	].
    ].
    ^answer explore!
----- Method: WordArray>>* (in category 'array arithmetic') -----
* other
| result |
    other isNumber ifTrue: [
    	other isFloat ifTrue: [
    		result := KedamaFloatArray new: self size.
    		^ self primMulScalar: self and: other into: result.
    	] ifFalse: [
    		result := WordArray new: self size.
    		^ self primMulScalar: self and: other into: result.
    	].
    ].
    (other isMemberOf: WordArray) ifTrue: [	
    	result := WordArray new: self size.
    	^ self primMulArray: self and: other into: result.
    ].
    (other isMemberOf: KedamaFloatArray) ifTrue: [	
    	result := KedamaFloatArray new: self size.
    	^ self primMulArray: self and: other into: result.
    ].
    ^ super * other.
!
----- Method: WordArray>>+ (in category 'array arithmetic') -----
+ other
| result |
    other isNumber ifTrue: [
    	other isFloat ifTrue: [
    		result := KedamaFloatArray new: self size.
    		^ self primAddScalar: self and: other into: result.
    	] ifFalse: [
    		result := WordArray new: self size.
    		^ self primAddScalar: self and: other into: result.
    	].
    ].
    (other isMemberOf: WordArray) ifTrue: [	
    	result := WordArray new: self size.
    	^ self primAddArray: self and: other into: result.
    ].
    (other isMemberOf: KedamaFloatArray) ifTrue: [	
    	result := KedamaFloatArray new: self size.
    	^ self primAddArray: self and: other into: result.
    ].
    ^ super + other.
!
----- Method: WordArray>>- (in category 'array arithmetic') -----
- other
| result |
    other isNumber ifTrue: [
    	other isFloat ifTrue: [
    		result := KedamaFloatArray new: self size.
    		^ self primSubScalar: self and: other into: result.
    	] ifFalse: [
    		result := WordArray new: self size.
    		^ self primSubScalar: self and: other into: result.
    	].
    ].
    (other isMemberOf: WordArray) ifTrue: [	
    	result := WordArray new: self size.
    	^ self primSubArray: self and: other into: result.
    ].
    (other isMemberOf: KedamaFloatArray) ifTrue: [	
    	result := KedamaFloatArray new: self size.
    	^ self primSubArray: self and: other into: result.
    ].
    ^ super - other.
!
----- Method: WordArray>>/ (in category 'array arithmetic') -----
/ other
| result |
    other isNumber ifTrue: [
    	other isFloat ifTrue: [
    		result := KedamaFloatArray new: self size.
    		^ self primDivScalar: self and: other into: result.
    	] ifFalse: [
    		result := WordArray new: self size.
    		^ self primDivScalar: self and: other into: result.
    	].
    ].
    (other isMemberOf: WordArray) ifTrue: [	
    	result := WordArray new: self size.
    	^ self primDivArray: self and: other into: result.
    ].
    (other isMemberOf: KedamaFloatArray) ifTrue: [	
    	result := KedamaFloatArray new: self size.
    	^ self primDivArray: self and: other into: result.
    ].
    ^ super / other.
!
----- Method: WordArray>>asWordArray (in category 'converting') -----
asWordArray
    ^self!
----- Method: WordArray>>atAllPut: (in category 'accessing') -----
atAllPut: value
    "Fill the receiver with the given value"
<primitive: 145>
    super atAllPut: value!
----- Method: WordArray>>byteSize (in category 'accessing') -----
byteSize
    ^self size * 4!
----- Method: WordArray>>bytesPerElement (in category 'accessing') -----
bytesPerElement
    "Number of bytes in each item.  This multiplied by (self size)*8 gives the number of bits stored."
    ^ 4!
----- Method: WordArray>>defaultElement (in category 'accessing') -----
defaultElement
    "Return the default element of the receiver"
    ^0!
----- Method: WordArray>>primAddArray:and:into: (in category 'array arithmetic primitives') -----
primAddArray: rcvr and: other into: result
<primitive: 'primitiveAddArrays' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveAddArrays."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) + (other at: i)
    ].
    ^ result.
!
----- Method: WordArray>>primAddScalar:and:into: (in category 'array arithmetic primitives') -----
primAddScalar: rcvr and: other into: result
<primitive: 'primitiveAddScalar' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveAddScalar."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) + other.
    ].
    ^ result.
!
----- Method: WordArray>>primDivArray:and:into: (in category 'array arithmetic primitives') -----
primDivArray: rcvr and: other into: result
<primitive: 'primitiveDivArrays' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveDivArrays."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) / (other at: i)
    ].
    ^ result.
!
----- Method: WordArray>>primDivScalar:and:into: (in category 'array arithmetic primitives') -----
primDivScalar: rcvr and: other into: result
<primitive: 'primitiveDivScalar' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveDivScalar."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) / other.
    ].
    ^ result.
!
----- Method: WordArray>>primMulArray:and:into: (in category 'array arithmetic primitives') -----
primMulArray: rcvr and: other into: result
<primitive: 'primitiveMulArrays' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveMulArrays."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) * (other at: i)
    ].
    ^ result.
!
----- Method: WordArray>>primMulScalar:and:into: (in category 'array arithmetic primitives') -----
primMulScalar: rcvr and: other into: result
<primitive: 'primitiveMulScalar' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveMulScalar."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) * other.
    ].
    ^ result.
!
----- Method: WordArray>>primSubArray:and:into: (in category 'array arithmetic primitives') -----
primSubArray: rcvr and: other into: result
<primitive: 'primitiveSubArrays' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveSubArrays."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) - (other at: i)
    ].
    ^ result.
!
----- Method: WordArray>>primSubScalar:and:into: (in category 'array arithmetic primitives') -----
primSubScalar: rcvr and: other into: result
<primitive: 'primitiveSubScalar' module:'KedamaPlugin'>
    "^ KedamaPlugin doPrimitive: #primitiveSubScalar."
1 to: rcvr size do: [:i |
    	result at: i put: (rcvr at: i) - other.
    ].
    ^ result.
!
----- Method: WordArray>>replaceFrom:to:with:startingAt: (in category 'private') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    <primitive: 105>
    ^super replaceFrom: start to: stop with: replacement startingAt: repStart !
WordArray variableWordSubclass: #WordArrayForSegment
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Arrayed'!
----- Method: WordArrayForSegment>>restoreEndianness (in category 'as yet unclassified') -----
restoreEndianness
    "This word object was just read in from a stream.  Do not correct the Endianness because the load primitive will reverse bytes as needed."
"^ self"
!
----- Method: WordArrayForSegment>>writeOn: (in category 'as yet unclassified') -----
writeOn: aByteStream
    "Write quickly and disregard the endianness of the words.  Store the array of bits onto the argument, aStream.  (leading byte ~= 16r80) identifies this as raw bits (uncompressed)."
aByteStream nextInt32Put: self size.	"4 bytes"
    aByteStream nextPutAll: self
!
SequenceableCollection subclass: #Heap
    instanceVariableNames: 'array tally sortBlock indexUpdateBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!Heap commentStamp: '<historical>' prior: 0!
Class Heap implements a special data structure commonly referred to as 'heap'. Heaps are more efficient than SortedCollections if:
a) Elements are only removed at the beginning
b) Elements are added with arbitrary sort order.
The sort time for a heap is O(n log n) in all cases.
Instance variables:
    array		<Array>		The data repository
    tally		<Integer>	The number of elements in the heap
    sortBlock	<Block|nil>	A two-argument block defining the sort order,
    						or nil in which case the default sort order is
    							[:element1 :element2| element1 <= element2]
    indexUpdateBlock 	<Block|nil> 
    						A two-argument block of the form [:data :index | ... ]
    						which allows an application object to keep track of its
    						index within the heap.  Useful for quick heap update
    						when object's sort value changes (for example, when an
    						object in a priority queue has its priority increased
    						by an external event, you don't want to have to search
    						through the whole heap to find the index before fixing
    						the heap).  No update occurs if nil.!
----- Method: Heap class>>new (in category 'instance creation') -----
new
    ^self new: 10!
----- Method: Heap class>>new: (in category 'instance creation') -----
new: n
    ^super new setCollection: (Array new: n)!
----- Method: Heap class>>sortBlock: (in category 'instance creation') -----
sortBlock: aBlock
    "Create a new heap sorted by the given block"
    ^self new sortBlock: aBlock!
----- Method: Heap class>>withAll: (in category 'instance creation') -----
withAll: aCollection
    "Create a new heap with all the elements from aCollection"
    ^(self basicNew)
    	setCollection: aCollection asArray copy tally: aCollection size;
    	reSort;
    	yourself!
----- Method: Heap class>>withAll:sortBlock: (in category 'instance creation') -----
withAll: aCollection sortBlock: sortBlock
    "Create a new heap with all the elements from aCollection"
    ^(self basicNew)
    	setCollection: aCollection asArray copy tally: aCollection size;
    	sortBlock: sortBlock;
    	yourself!
----- Method: Heap>>= (in category 'comparing') -----
= anObject
^ self == anObject
    	ifTrue: [true]
    	ifFalse: [anObject isHeap
    		ifTrue: [sortBlock = anObject sortBlock and: [super = anObject]]
    		ifFalse: [super = anObject]]!
----- Method: Heap>>add: (in category 'adding') -----
add: anObject
    "Include newObject as one of the receiver's elements. Answer newObject."
    tally = array size ifTrue:[self grow].
    array at: (tally := tally + 1) put: anObject.
    self updateObjectIndex: tally.
    self upHeap: tally.
    ^anObject!
----- Method: Heap>>array (in category 'private') -----
array
    ^array!
----- Method: Heap>>at: (in category 'accessing') -----
at: index
    "Return the element at the given position within the receiver"
    (index < 1 or:[index > tally]) ifTrue:[^self errorSubscriptBounds: index].
    ^array at: index!
----- Method: Heap>>at:put: (in category 'accessing') -----
at: index put: newObject
    "Heaps are accessed with #add: not #at:put:"
    ^self shouldNotImplement!
----- Method: Heap>>do: (in category 'enumerating') -----
do: aBlock
    "Evaluate aBlock with each of the receiver's elements as the argument."
    1 to: tally do:[:i| aBlock value: (array at: i)]!
----- Method: Heap>>downHeap: (in category 'private-heap') -----
downHeap: anIndex
    "Check the heap downwards for correctness starting at anIndex.
     Everything above (i.e. left of) anIndex is ok."
    | value k n j |
    anIndex = 0 ifTrue:[^self].
    n := tally bitShift: -1.
    k := anIndex.
    value := array at: anIndex.
    [k <= n] whileTrue:[
    	j := k + k.
    	"use max(j,j+1)"
    	(j < tally and:[self sorts: (array at: j+1) before: (array at: j)])
    			ifTrue:[ j := j + 1].
    	"check if position k is ok"
    	(self sorts: value before: (array at: j)) 
    		ifTrue:[	"yes -> break loop"
    				n := k - 1]
    		ifFalse:[	"no -> make room at j by moving j-th element to k-th position"
    				array at: k put: (array at: j).
    				self updateObjectIndex: k.
    				"and try again with j"
    				k := j]].
    array at: k put: value.
    self updateObjectIndex: k.!
----- Method: Heap>>downHeapSingle: (in category 'private-heap') -----
downHeapSingle: anIndex
    "This version is optimized for the case when only one element in the receiver can be at a wrong position. It avoids one comparison at each node when travelling down the heap and checks the heap upwards after the element is at a bottom position. Since the probability for being at the bottom of the heap is much larger than for being somewhere in the middle this version should be faster."
    | value k n j |
    anIndex = 0 ifTrue:[^self].
    n := tally bitShift: -1.
    k := anIndex.
    value := array at: anIndex.
    [k <= n] whileTrue:[
    	j := k + k.
    	"use max(j,j+1)"
    	(j < tally and:[self sorts: (array at: j+1) before: (array at: j)])
    			ifTrue:[	j := j + 1].
    	array at: k put: (array at: j).
    	self updateObjectIndex: k.
    	"and try again with j"
    	k := j].
    array at: k put: value.
    self updateObjectIndex: k.
    self upHeap: k!
----- Method: Heap>>first (in category 'accessing') -----
first
    "Return the first element in the receiver"
    ^array at: 1!
----- Method: Heap>>grow (in category 'growing') -----
grow
    "Become larger."
    self growTo: self size + self growSize.!
----- Method: Heap>>growSize (in category 'growing') -----
growSize
    "Return the size by which the receiver should grow if there are no empty slots left."
    ^array size max: 5!
----- Method: Heap>>growTo: (in category 'growing') -----
growTo: newSize
    "Grow to the requested size."
    | newArray |
    newArray := Array new: (newSize max: tally).
    newArray replaceFrom: 1 to: array size with: array startingAt: 1.
    array := newArray!
----- Method: Heap>>indexUpdateBlock: (in category 'accessing') -----
indexUpdateBlock: aBlockOrNil
indexUpdateBlock := aBlockOrNil.
    indexUpdateBlock fixTemps.
!
----- Method: Heap>>isEmpty (in category 'testing') -----
isEmpty
    "Answer whether the receiver contains any elements."
    ^tally = 0!
----- Method: Heap>>isHeap (in category 'testing') -----
isHeap
^ true!
----- Method: Heap>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    array := array copy!
----- Method: Heap>>privateRemoveAt: (in category 'private') -----
privateRemoveAt: index
    "Remove the element at the given index and make sure the sorting order is okay"
    | removed |
    removed := array at: index.
    array at: index put: (array at: tally).
    array at: tally put: nil.
    tally := tally - 1.
    index > tally ifFalse:[
    	"Use #downHeapSingle: since only one element has been removed"
    	self downHeapSingle: index].
    ^removed!
----- Method: Heap>>reSort (in category 'accessing') -----
reSort
    "Resort the entire heap"
    self isEmpty ifTrue:[^self].
    tally // 2 to: 1 by: -1 do:[:i| self downHeap: i].!
----- Method: Heap>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: aBlock
    "Remove oldObject as one of the receiver's elements. If several of the 
    elements are equal to oldObject, only one is removed. If no element is 
    equal to oldObject, answer the result of evaluating anExceptionBlock. 
    Otherwise, answer the argument, oldObject."
    1 to: tally do:[:i| 
    	(array at: i) = oldObject ifTrue:[^self privateRemoveAt: i]].
    ^aBlock value!
----- Method: Heap>>removeAll (in category 'removing') -----
removeAll
array atAllPut: nil.
    tally := 0!
----- Method: Heap>>removeAt: (in category 'removing') -----
removeAt: index
    "Remove the element at given position"
    (index < 1 or:[index > tally]) ifTrue:[^self errorSubscriptBounds: index].
    ^self privateRemoveAt: index!
----- Method: Heap>>removeFirst (in category 'removing') -----
removeFirst
    "Remove the first element from the receiver"
    ^self removeAt: 1!
----- Method: Heap>>setCollection: (in category 'private') -----
setCollection: aCollection
    array := aCollection.
    tally := 0.!
----- Method: Heap>>setCollection:tally: (in category 'private') -----
setCollection: aCollection tally: newTally
    array := aCollection.
    tally := newTally.!
----- Method: Heap>>size (in category 'accessing') -----
size
    "Answer how many elements the receiver contains."
^ tally!
----- Method: Heap>>sortBlock (in category 'accessing') -----
sortBlock
    ^sortBlock!
----- Method: Heap>>sortBlock: (in category 'accessing') -----
sortBlock: aBlock
    sortBlock := aBlock.
    sortBlock fixTemps.
    self reSort.!
----- Method: Heap>>sorts:before: (in category 'testing') -----
sorts: element1 before: element2
    "Return true if element1 should be sorted before element2.
    This method defines the sort order in the receiver"
    ^sortBlock == nil
    	ifTrue:[element1 <= element2]
    	ifFalse:[sortBlock value: element1 value: element2].!
----- Method: Heap>>species (in category 'private') -----
species
    ^ Array!
----- Method: Heap>>trim (in category 'growing') -----
trim
    "Remove any empty slots in the receiver."
    self growTo: self size.!
----- Method: Heap>>upHeap: (in category 'private-heap') -----
upHeap: anIndex
    "Check the heap upwards for correctness starting at anIndex.
     Everything below anIndex is ok."
    | value k kDiv2 tmp |
    anIndex = 0 ifTrue:[^self].
    k := anIndex.
    value := array at: anIndex.
    [ (k > 1) and:[self sorts: value before: (tmp := array at: (kDiv2 := k bitShift: -1))] ] 
    	whileTrue:[
    		array at: k put: tmp.
    		self updateObjectIndex: k.
    		k := kDiv2].
    array at: k put: value.
    self updateObjectIndex: k.!
----- Method: Heap>>updateObjectIndex: (in category 'private') -----
updateObjectIndex: index
    "If indexUpdateBlock is not nil, notify the object at index of its new position in the heap array."
    indexUpdateBlock ifNotNil: [
    	indexUpdateBlock value: (array at: index) value: index]!
SequenceableCollection subclass: #Interval
    instanceVariableNames: 'start stop step'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!Interval commentStamp: '<historical>' prior: 0!
I represent a finite arithmetic progression.!
----- Method: Interval class>>from:to: (in category 'instance creation') -----
from: startInteger to: stopInteger 
    "Answer an instance of me, starting at startNumber, ending at 
    stopNumber, and with an interval increment of 1."
^self new
    	setFrom: startInteger
    	to: stopInteger
    	by: 1!
----- Method: Interval class>>from:to:by: (in category 'instance creation') -----
from: startInteger to: stopInteger by: stepInteger 
    "Answer an instance of me, starting at startNumber, ending at 
    stopNumber, and with an interval increment of stepNumber."
^self new
    	setFrom: startInteger
    	to: stopInteger
    	by: stepInteger!
----- Method: Interval class>>new (in category 'instance creation') -----
new
    "Primitive. Create and answer with a new instance of the receiver
    (a class) with no indexable fields. Fail if the class is indexable. Override
    SequenceableCollection new. Essential. See Object documentation
    whatIsAPrimitive."
<primitive: 70>
    self isVariable ifTrue: [ ^ self new: 0 ].
    "space must be low"
    Smalltalk signalLowSpace.
    ^ self new  "retry if user proceeds"
!
----- Method: Interval class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
| newInterval n |
(n := aCollection size) <= 1 ifTrue: [
    	n = 0 ifTrue: [^self from: 1 to: 0].
    	^self from: aCollection first to: aCollection last].
    	newInterval := self from: aCollection first to: aCollection last
    by: (aCollection last - aCollection first) // (n - 1).
    aCollection ~= newInterval
    	ifTrue: [
    		"Give a second chance, because progression might be arithmetic, but = answer false"
    		(newInterval hasEqualElements: aCollection) ifFalse: [
    			self error: 'The argument is not an arithmetic progression']].
    ^newInterval
"	Interval newFrom: {1. 2. 3}
    {33. 5. -23} as: Interval
    {33. 5. -22} as: Interval    (an error)
    (-4 to: -12 by: -1) as: Interval
    #(2 4 6) asByteArray as: Interval.
"!
----- Method: Interval>>+ (in category 'arithmetic') -----
+ number
^ start + number to: stop + number by: step!
----- Method: Interval>>- (in category 'arithmetic') -----
- number
^ start - number to: stop - number by: step!
----- Method: Interval>>= (in category 'comparing') -----
= anObject
^ self == anObject
    	ifTrue: [true]
    	ifFalse: [anObject isInterval
    		ifTrue: [start = anObject first
    			and: [step = anObject increment
    				and: [self last = anObject last]]]
    		ifFalse: [super = anObject]]!
----- Method: Interval>>add: (in category 'adding') -----
add: newObject 
    "Adding to an Interval is not allowed."
self shouldNotImplement!
----- Method: Interval>>at: (in category 'accessing') -----
at: anInteger 
    "Answer the anInteger'th element."
(anInteger >= 1 and: [anInteger <= self size])
    	ifTrue: [^start + (step * (anInteger - 1))]
    	ifFalse: [self errorSubscriptBounds: anInteger]!
----- Method: Interval>>at:put: (in category 'accessing') -----
at: anInteger put: anObject 
    "Storing into an Interval is not allowed."
self error: 'you can not store into an interval'!
----- Method: Interval>>collect: (in category 'enumerating') -----
collect: aBlock
    | nextValue result |
    result := self species new: self size.
    nextValue := start.
    1 to: result size do:
    	[:i |
    	result at: i put: (aBlock value: nextValue).
    	nextValue := nextValue + step].
    ^ result!
----- Method: Interval>>do: (in category 'enumerating') -----
do: aBlock
| aValue |
    aValue := start.
    step < 0
    	ifTrue: [[stop <= aValue]
    			whileTrue: 
    				[aBlock value: aValue.
    				aValue := aValue + step]]
    	ifFalse: [[stop >= aValue]
    			whileTrue: 
    				[aBlock value: aValue.
    				aValue := aValue + step]]!
----- Method: Interval>>extent (in category 'accessing') -----
extent 
    "Answer the max - min of the receiver interval."
    "(10 to: 50) extent"
^stop - start!
----- Method: Interval>>first (in category 'accessing') -----
first 
    "Refer to the comment in SequenceableCollection|first."
^start!
----- Method: Interval>>hash (in category 'comparing') -----
hash
    "Hash is reimplemented because = is implemented."
^(((start hash bitShift: 2)
    	bitOr: stop hash)
    	bitShift: 1)
    	bitOr: self size!
----- Method: Interval>>hashMappedBy: (in category 'comparing') -----
hashMappedBy: map
    "My hash is independent of my oop."
^self hash!
----- Method: Interval>>increment (in category 'accessing') -----
increment
    "Answer the receiver's interval increment."
^step!
----- Method: Interval>>indexOf:startingAt:ifAbsent: (in category 'accessing') -----
indexOf: anElement startingAt: startIndex ifAbsent: exceptionBlock 
    "startIndex is an positive integer, the collection index where the search is started."
    "during the computation of val , floats are only used when the receiver	contains floats"
| index val |
    (self rangeIncludes: anElement)
    	ifFalse: [^ exceptionBlock value].
    val := anElement - self first / self increment.
    val isFloat
    	ifTrue: [(val - val rounded) abs * 100000000 < 1
    			ifTrue: [index := val rounded + 1]
    			ifFalse: [^ exceptionBlock value]]
    	ifFalse: [val isInteger
    			ifTrue: [index := val + 1]
    			ifFalse: [^ exceptionBlock value]].
    "finally, the value of startIndex comes into play:"
    ^ index < startIndex
    	ifTrue: [exceptionBlock value]
    	ifFalse: [index]!
----- Method: Interval>>isInterval (in category 'testing') -----
isInterval
^ true!
----- Method: Interval>>isSelfEvaluating (in category 'self evaluating') -----
isSelfEvaluating
    ^ self class == Interval!
----- Method: Interval>>last (in category 'accessing') -----
last 
    "Refer to the comment in SequenceableCollection|last."
^stop - (stop - start \ step)!
----- Method: Interval>>permutationsDo: (in category 'enumerating') -----
permutationsDo: aBlock
    "Repeatly value aBlock with a single copy of the receiver. Reorder the copy
    so that aBlock is presented all (self size factorial) possible permutations."
    "(1 to: 4) permutationsDo: [:each | Transcript cr; show: each printString]"
self asArray permutationsDo: aBlock
!
----- Method: Interval>>printOn: (in category 'printing') -----
printOn: aStream
    aStream nextPut: $(;
     print: start;
     nextPutAll: ' to: ';
     print: stop.
    step ~= 1 ifTrue: [aStream nextPutAll: ' by: '; print: step].
    aStream nextPut: $)!
----- Method: Interval>>rangeIncludes: (in category 'accessing') -----
rangeIncludes: aNumber
    "Return true if the number lies in the interval between start and stop."
step >= 0
    	ifTrue: [^ aNumber between: start and: stop]
    	ifFalse: [^ aNumber between: stop and: start]
!
----- Method: Interval>>remove: (in category 'removing') -----
remove: newObject 
    "Removing from an Interval is not allowed."
self error: 'elements cannot be removed from an Interval'!
----- Method: Interval>>reverseDo: (in category 'enumerating') -----
reverseDo: aBlock 
    "Evaluate aBlock for each element of my interval, in reverse order."
    | aValue |
    aValue := self last.
    step < 0
    	ifTrue: [[start >= aValue]
    			whileTrue: [aBlock value: aValue.
    				aValue := aValue - step]]
    	ifFalse: [[start <= aValue]
    			whileTrue: [aBlock value: aValue.
    				aValue := aValue - step]]!
----- Method: Interval>>setFrom:to:by: (in category 'private') -----
setFrom: startInteger to: stopInteger by: stepInteger
start := startInteger.
    stop := stopInteger.
    step := stepInteger!
----- Method: Interval>>size (in category 'accessing') -----
size
    "Answer how many elements the receiver contains."
step < 0
    	ifTrue: [start < stop
    			ifTrue: [^ 0]
    			ifFalse: [^ stop - start // step + 1]]
    	ifFalse: [stop < start
    			ifTrue: [^ 0]
    			ifFalse: [^ stop - start // step + 1]]!
----- Method: Interval>>species (in category 'private') -----
species
^Array!
----- Method: Interval>>storeOn: (in category 'printing') -----
storeOn: aStream 
    aStream nextPut: $(;
     store: start;
     nextPutAll: ' to: ';
     store: stop.
    step ~= 1 ifTrue: [aStream nextPutAll: ' by: '; store: step].
    aStream nextPut: $)!
SequenceableCollection subclass: #LinkedList
    instanceVariableNames: 'firstLink lastLink'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!LinkedList commentStamp: '<historical>' prior: 0!
I represent a collection of links, which are containers for other objects. Using the message sequence addFirst:/removeLast causes the receiver to behave as a stack; using addLast:/removeFirst causes the receiver to behave as a queue.!
----- Method: LinkedList>>add: (in category 'adding') -----
add: aLink 
    "Add aLink to the end of the receiver's list. Answer aLink."
^self addLast: aLink!
----- Method: LinkedList>>add:after: (in category 'adding') -----
add: link after: otherLink
"Add otherLink  after link in the list. Answer aLink."
| savedLink |
    lastLink == otherLink ifTrue: [^ self addLast: link].
    savedLink := otherLink nextLink.
    otherLink nextLink: link.
    link nextLink:  savedLink.
    ^link.!
----- Method: LinkedList>>add:before: (in category 'adding') -----
add: link before: otherLink
| aLink |
    firstLink == otherLink ifTrue: [^ self addFirst: link].
    aLink := firstLink.
    [aLink == nil] whileFalse: [
    	aLink nextLink == otherLink ifTrue: [
    		link nextLink: aLink nextLink.
    		aLink nextLink: link.
    		^ link
    	].
    	 aLink := aLink nextLink.
    ].
    ^ self errorNotFound: otherLink!
----- Method: LinkedList>>addFirst: (in category 'adding') -----
addFirst: aLink 
    "Add aLink to the beginning of the receiver's list. Answer aLink."
self isEmpty ifTrue: [lastLink := aLink].
    aLink nextLink: firstLink.
    firstLink := aLink.
    ^aLink!
----- Method: LinkedList>>addLast: (in category 'adding') -----
addLast: aLink 
    "Add aLink to the end of the receiver's list. Answer aLink."
self isEmpty
    	ifTrue: [firstLink := aLink]
    	ifFalse: [lastLink nextLink: aLink].
    lastLink := aLink.
    ^aLink!
----- Method: LinkedList>>at: (in category 'accessing') -----
at: index
| i |
    i := 0.
    self do: [:link |
    	(i := i + 1) = index ifTrue: [^ link]].
    ^ self errorSubscriptBounds: index!
----- Method: LinkedList>>do: (in category 'enumerating') -----
do: aBlock
| aLink |
    aLink := firstLink.
    [aLink == nil] whileFalse:
    	[aBlock value: aLink.
    	 aLink := aLink nextLink]!
----- Method: LinkedList>>first (in category 'accessing') -----
first
    "Answer the first link. Create an error notification if the receiver is 
    empty."
self emptyCheck.
    ^firstLink!
----- Method: LinkedList>>isEmpty (in category 'testing') -----
isEmpty
^firstLink == nil!
----- Method: LinkedList>>last (in category 'accessing') -----
last
    "Answer the last link. Create an error notification if the receiver is 
    empty."
self emptyCheck.
    ^lastLink!
----- Method: LinkedList>>postCopy (in category 'copying') -----
postCopy
    | aLink |
    super postCopy.
    firstLink isNil ifFalse: [
    	aLink := firstLink := firstLink copy.
    	[aLink nextLink isNil] whileFalse: [aLink nextLink: (aLink := aLink nextLink copy)].
    	lastLink := aLink].!
----- Method: LinkedList>>remove:ifAbsent: (in category 'removing') -----
remove: aLink ifAbsent: aBlock  
    "Remove aLink from the receiver. If it is not there, answer the result of
    evaluating aBlock."
| tempLink |
    aLink == firstLink
    	ifTrue: [firstLink := aLink nextLink.
    			aLink == lastLink
    				ifTrue: [lastLink := nil]]
    	ifFalse: [tempLink := firstLink.
    			[tempLink == nil ifTrue: [^aBlock value].
    			 tempLink nextLink == aLink]
    				whileFalse: [tempLink := tempLink nextLink].
    			tempLink nextLink: aLink nextLink.
    			aLink == lastLink
    				ifTrue: [lastLink := tempLink]].
    aLink nextLink: nil.
    ^aLink!
----- Method: LinkedList>>removeAll (in category 'removing') -----
removeAll
    "Implementation note: this has to be fast"
firstLink := lastLink := nil!
----- Method: LinkedList>>removeFirst (in category 'removing') -----
removeFirst
    "Remove the first element and answer it. If the receiver is empty, create 
    an error notification."
| oldLink |
    self emptyCheck.
    oldLink := firstLink.
    firstLink == lastLink
    	ifTrue: [firstLink := nil. lastLink := nil]
    	ifFalse: [firstLink := oldLink nextLink].
    oldLink nextLink: nil.
    ^oldLink!
----- Method: LinkedList>>removeLast (in category 'removing') -----
removeLast
    "Remove the receiver's last element and answer it. If the receiver is 
    empty, create an error notification."
| oldLink aLink |
    self emptyCheck.
    oldLink := lastLink.
    firstLink == lastLink
    	ifTrue: [firstLink := nil. lastLink := nil]
    	ifFalse: [aLink := firstLink.
    			[aLink nextLink == oldLink] whileFalse:
    				[aLink := aLink nextLink].
    			 aLink nextLink: nil.
    			 lastLink := aLink].
    oldLink nextLink: nil.
    ^oldLink!
----- Method: LinkedList>>species (in category 'enumerating') -----
species
^ Array!
SequenceableCollection subclass: #OrderedCollection
    instanceVariableNames: 'array firstIndex lastIndex'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!OrderedCollection commentStamp: '<historical>' prior: 0!
I represent a collection of objects ordered by the collector.!
----- Method: OrderedCollection class>>new (in category 'instance creation') -----
new
    ^ self new: 10!
----- Method: OrderedCollection class>>new: (in category 'instance creation') -----
new: anInteger 
    ^ self basicNew setCollection: (Array new: anInteger)!
----- Method: OrderedCollection class>>new:withAll: (in category 'instance creation') -----
new: anInteger withAll: anObject
    ^ self basicNew setContents: (Array new: anInteger withAll: anObject)!
----- Method: OrderedCollection class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
^(self new: aCollection size)
    	resetTo: 1;
    	addAll: aCollection;
    	yourself
"	OrderedCollection newFrom: {1. 2. 3}
    {1. 2. 3} as: OrderedCollection
    {4. 2. 7} as: SortedCollection
"!
----- Method: OrderedCollection class>>ofSize: (in category 'instance creation') -----
ofSize: n
    "Create a new collection of size n with nil as its elements.
    This method exists because OrderedCollection new: n creates an
    empty collection,  not one of size n."
    | collection |
    collection := self new: n.
    collection setContents: (collection collector).
    ^ collection
!
----- Method: OrderedCollection>>add: (in category 'adding') -----
add: newObject
^self addLast: newObject!
----- Method: OrderedCollection>>add:after: (in category 'adding') -----
add: newObject after: oldObject 
    "Add the argument, newObject, as an element of the receiver. Put it in 
    the sequence just succeeding oldObject. Answer newObject."
    
    | index |
    index := self find: oldObject.
    self insert: newObject before: index + 1.
    ^newObject!
----- Method: OrderedCollection>>add:afterIndex: (in category 'adding') -----
add: newObject afterIndex: index 
    "Add the argument, newObject, as an element of the receiver. Put it in 
    the sequence just after index. Answer newObject."
    (index between: 0 and: self size) ifFalse:[^self errorSubscriptBounds: index].
    self insert: newObject before: firstIndex + index.
    ^ newObject!
----- Method: OrderedCollection>>add:before: (in category 'adding') -----
add: newObject before: oldObject 
    "Add the argument, newObject, as an element of the receiver. Put it in 
    the sequence just preceding oldObject. Answer newObject."
    
    | index |
    index := self find: oldObject.
    self insert: newObject before: index.
    ^newObject!
----- Method: OrderedCollection>>add:beforeIndex: (in category 'adding') -----
add: newObject beforeIndex: index 
    "Add the argument, newObject, as an element of the receiver. Put it in 
    the sequence just before index. Answer newObject."
    (index between: 1 and: self size+1) ifFalse:[^self errorSubscriptBounds: index].
    self insert: newObject before: firstIndex + index - 1.
    ^ newObject!
----- Method: OrderedCollection>>addAll: (in category 'adding') -----
addAll: aCollection 
    "Add each element of aCollection at my end. Answer	aCollection."
^ self addAllLast: aCollection!
----- Method: OrderedCollection>>addAllFirst: (in category 'adding') -----
addAllFirst: anOrderedCollection 
    "Add each element of anOrderedCollection at the beginning of the 
    receiver. Answer anOrderedCollection."
anOrderedCollection reverseDo: [:each | self addFirst: each].
    ^anOrderedCollection!
----- Method: OrderedCollection>>addAllFirstUnlessAlreadyPresent: (in category 'adding') -----
addAllFirstUnlessAlreadyPresent: anOrderedCollection 
    "Add each element of anOrderedCollection at the beginning of the receiver, preserving the order, but do not add any items that are already in the receiver.  Answer anOrderedCollection."
anOrderedCollection reverseDo:
    	[:each | (self includes: each) ifFalse: [self addFirst: each]].
    ^ anOrderedCollection!
----- Method: OrderedCollection>>addAllLast: (in category 'adding') -----
addAllLast: aCollection 
    "Add each element of aCollection at the end of the receiver. 
    Answer aCollection."
aCollection do: [ :each | self addLast: each].
    ^aCollection!
----- Method: OrderedCollection>>addFirst: (in category 'adding') -----
addFirst: newObject 
    "Add newObject to the beginning of the receiver. Answer newObject."
firstIndex = 1 ifTrue: [self makeRoomAtFirst].
    firstIndex := firstIndex - 1.
    array at: firstIndex put: newObject.
    ^ newObject!
----- Method: OrderedCollection>>addLast: (in category 'adding') -----
addLast: newObject 
    "Add newObject to the end of the receiver. Answer newObject."
lastIndex = array size ifTrue: [self makeRoomAtLast].
    lastIndex := lastIndex + 1.
    array at: lastIndex put: newObject.
    ^ newObject!
----- Method: OrderedCollection>>at: (in category 'accessing') -----
at: anInteger 
    "Answer my element at index anInteger. at: is used by a knowledgeable
    client to access an existing element"
(anInteger < 1 or: [anInteger + firstIndex - 1 > lastIndex])
    	ifTrue: [self errorNoSuchElement]
    	ifFalse: [^ array at: anInteger + firstIndex - 1]!
----- Method: OrderedCollection>>at:ifAbsentPut: (in category 'adding') -----
at: index ifAbsentPut: block
    "Return value at index, however, if value does not exist (nil or out of bounds) then add block's value at index (growing self if necessary)"
| v |
    index <= self size ifTrue: [
    	^ (v := self at: index)
    		ifNotNil: [v]
    		ifNil: [self at: index put: block value]
    ].
    [self size < index] whileTrue: [self add: nil].
    ^ self at: index put: block value!
----- Method: OrderedCollection>>at:put: (in category 'accessing') -----
at: anInteger put: anObject 
    "Put anObject at element index anInteger. at:put: cannot be used to
    append, front or back, to an ordered collection; it is used by a
    knowledgeable client to replace an element."
| index |
    index := anInteger asInteger.
    (index < 1 or: [index + firstIndex - 1 > lastIndex])
    	ifTrue: [self errorNoSuchElement]
    	ifFalse: [^array at: index + firstIndex - 1 put: anObject]!
----- Method: OrderedCollection>>capacity (in category 'accessing') -----
capacity
    "Answer the current capacity of the receiver."
^ array size!
----- Method: OrderedCollection>>collect: (in category 'enumerating') -----
collect: aBlock 
    "Evaluate aBlock with each of my elements as the argument. Collect the 
    resulting values into a collection that is like me. Answer the new 
    collection. Override superclass in order to use addLast:, not at:put:."
| newCollection |
    newCollection := self species new: self size.
    firstIndex to: lastIndex do:
    	[:index |
    	newCollection addLast: (aBlock value: (array at: index))].
    ^ newCollection!
----- Method: OrderedCollection>>collect:from:to: (in category 'enumerating') -----
collect: aBlock from: fromIndex to: toIndex
    "Override superclass in order to use addLast:, not at:put:."
    | result |
    (fromIndex < 1 or:[toIndex + firstIndex - 1 > lastIndex])
    	ifTrue: [^self errorNoSuchElement].
    result := self species new: toIndex - fromIndex + 1.
    firstIndex + fromIndex - 1 to: firstIndex + toIndex - 1 do:
    	[:index | result addLast: (aBlock value: (array at: index))].
    ^ result
!
----- Method: OrderedCollection>>collector (in category 'private') -----
collector  "Private"
    ^ array!
----- Method: OrderedCollection>>copyEmpty (in category 'copying') -----
copyEmpty
    "Answer a copy of the receiver that contains no elements."
^self species new!
----- Method: OrderedCollection>>copyFrom:to: (in category 'copying') -----
copyFrom: startIndex to: endIndex 
    "Answer a copy of the receiver that contains elements from position
    startIndex to endIndex."
^self shallowCopy postCopyFrom: startIndex to: endIndex!
----- Method: OrderedCollection>>copyReplaceFrom:to:with: (in category 'copying') -----
copyReplaceFrom: start to: stop with: replacementCollection 
    "Answer a copy of the receiver with replacementCollection's elements in
    place of the receiver's start'th to stop'th elements. This does not expect
    a 1-1 map from replacementCollection to the start to stop elements, so it
    will do an insert or append."
| newOrderedCollection delta startIndex stopIndex |
    "if start is less than 1, ignore stop and assume this is inserting at the front. 
    if start greater than self size, ignore stop and assume this is appending. 
    otherwise, it is replacing part of me and start and stop have to be within my 
    bounds. "
    delta := 0.
    startIndex := start.
    stopIndex := stop.
    start < 1
    	ifTrue: [startIndex := stopIndex := 0]
    	ifFalse: [startIndex > self size
    			ifTrue: [startIndex := stopIndex := self size + 1]
    			ifFalse: 
    				[(stopIndex < (startIndex - 1) or: [stopIndex > self size])
    					ifTrue: [self errorOutOfBounds].
    				delta := stopIndex - startIndex + 1]].
    newOrderedCollection := 
    	self species new: self size + replacementCollection size - delta.
    1 to: startIndex - 1 do: [:index | newOrderedCollection add: (self at: index)].
    1 to: replacementCollection size do: 
    	[:index | newOrderedCollection add: (replacementCollection at: index)].
    stopIndex + 1 to: self size do: [:index | newOrderedCollection add: (self at: index)].
    ^newOrderedCollection!
----- Method: OrderedCollection>>copyWith: (in category 'copying') -----
copyWith: newElement 
    "Answer a copy of the receiver that is 1 bigger than the receiver and 
    includes the argument, newElement, at the end."
| newCollection |
    newCollection := self copy.
    newCollection add: newElement.
    ^newCollection!
----- Method: OrderedCollection>>do: (in category 'enumerating') -----
do: aBlock 
    "Override the superclass for performance reasons."
    | index |
    index := firstIndex.
    [index <= lastIndex]
    	whileTrue: 
    		[aBlock value: (array at: index).
    		index := index + 1]!
----- Method: OrderedCollection>>errorConditionNotSatisfied (in category 'private') -----
errorConditionNotSatisfied
self error: 'no element satisfies condition'!
----- Method: OrderedCollection>>errorNoSuchElement (in category 'private') -----
errorNoSuchElement
self error: 'attempt to index non-existent element in an ordered collection'!
----- Method: OrderedCollection>>find: (in category 'private') -----
find: oldObject
  "  This method answers an index in the range firstIndex .. lastIndex, which is meant for internal use only.
     Never use this method in your code, the methods for public use are:
        #indexOf:
        #indexOf:ifAbsent: "
| index |
    index := firstIndex.
    [index <= lastIndex]
    	whileTrue:
    		[(array at: index) = oldObject ifTrue: [^ index].
    		index := index + 1].
    self errorNotFound: oldObject!
----- Method: OrderedCollection>>grow (in category 'adding') -----
grow
    "Become larger. Typically, a subclass has to override this if the subclass
    adds instance variables."
    | newArray |
    newArray := Array new: self size + self growSize.
    newArray replaceFrom: 1 to: array size with: array startingAt: 1.
    array := newArray!
----- Method: OrderedCollection>>growSize (in category 'adding') -----
growSize
    ^ array size max: 2!
----- Method: OrderedCollection>>hasContentsInExplorer (in category 'testing') -----
hasContentsInExplorer
^self isEmpty not!
----- Method: OrderedCollection>>insert:before: (in category 'private') -----
insert: anObject before: spot
"  spot is an index in the range firstIndex .. lastIndex, such an index is not known from outside the collection. 
     Never use this method in your code, it is meant for private use by OrderedCollection only.
     The methods for use are:
        #add:before:   to insert an object before another object
        #add:beforeIndex:   to insert an object before a given position. "
    | "index" delta spotIndex|
    spotIndex := spot.
    delta := spotIndex - firstIndex.
    firstIndex = 1
    	ifTrue: 
    		[self makeRoomAtFirst.
    		spotIndex := firstIndex + delta].
    firstIndex := firstIndex - 1.
    array
    	replaceFrom: firstIndex
    	to: spotIndex - 2
    	with: array
    	startingAt: firstIndex + 1.
    array at: spotIndex - 1 put: anObject.
"	index := firstIndex := firstIndex - 1.
    [index < (spotIndex - 1)]
    	whileTrue: 
    		[array at: index put: (array at: index + 1).
    		index := index + 1].
    array at: index put: anObject."
    ^ anObject!
----- Method: OrderedCollection>>makeRoomAtFirst (in category 'private') -----
makeRoomAtFirst
    | delta index |
    delta := array size - self size.
    delta = 0 ifTrue: 
    		[self grow.
    		delta := array size - self size].
    lastIndex = array size ifTrue: [^ self]. "just in case we got lucky"
    index := array size.
    [index > delta]
    	whileTrue: 
    		[array at: index put: (array at: index - delta + firstIndex - 1).
    		array at: index - delta + firstIndex - 1 put: nil.
    		index := index - 1].
    firstIndex := delta + 1.
    lastIndex := array size!
----- Method: OrderedCollection>>makeRoomAtLast (in category 'private') -----
makeRoomAtLast
    | newLast delta |
    newLast := self size.
    array size - self size = 0 ifTrue: [self grow].
    (delta := firstIndex - 1) = 0 ifTrue: [^ self].
    "we might be here under false premises or grow did the job for us"
    1 to: newLast do:
    	[:index |
    	array at: index put: (array at: index + delta).
    	array at: index + delta put: nil].
    firstIndex := 1.
    lastIndex := newLast!
----- Method: OrderedCollection>>postCopy (in category 'copying') -----
postCopy
    array := array copy!
----- Method: OrderedCollection>>postCopyFrom:to: (in category 'copying') -----
postCopyFrom: startIndex to: endIndex 
    "finish copying the array in a certain range."
endIndex < startIndex ifFalse: [
    	"Because actual size of the array may be greater than used size,
    	postCopyFrom:to: may fail to fail and answer an incorrect result
    	if this sanity check were not applied"
    	(startIndex between: 1 and: self size) ifFalse: [^self error: 'startIndex is out of bounds'].
    	(endIndex between: 1 and: self size) ifFalse: [^self error: 'endIndex is out of bounds']].
    
    "Add a protection that lacks in Array>>postcopy"
    array := array copyFrom: startIndex + firstIndex - 1 to: (endIndex max: startIndex - 1) + firstIndex - 1.
    firstIndex := 1.
    lastIndex := array size!
----- Method: OrderedCollection>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: absentBlock
| index |
    index := firstIndex.
    [index <= lastIndex]
    	whileTrue: 
    		[oldObject = (array at: index)
    			ifTrue: 
    				[self removeIndex: index.
    				^ oldObject]
    			ifFalse: [index := index + 1]].
    ^ absentBlock value!
----- Method: OrderedCollection>>removeAll (in category 'removing') -----
removeAll
    "remove all the elements from this collection.
    Keep same amount of storage"
    
    self setCollection: (Array new: array size)!
----- Method: OrderedCollection>>removeAllSuchThat: (in category 'removing') -----
removeAllSuchThat: aBlock 
    "Remove each element of the receiver for which aBlock evaluates to true.
    The method in Collection is O(N^2), this is O(N)."
| n |
    n := firstIndex.
    firstIndex to: lastIndex do: [:index |
        (aBlock value: (array at: index)) ifFalse: [
    		array at: n put: (array at: index).
    		n := n + 1]].
    n to: lastIndex do: [:index | array at: index put: nil].
    lastIndex := n - 1!
----- Method: OrderedCollection>>removeAt: (in category 'removing') -----
removeAt: index
    | removed |
    removed := self at: index.
    self removeIndex: index + firstIndex - 1.
    ^removed!
----- Method: OrderedCollection>>removeFirst (in category 'removing') -----
removeFirst
    "Remove the first element of the receiver and answer it. If the receiver is 
    empty, create an error notification."
    | firstObject |
    self emptyCheck.
    firstObject := array at: firstIndex.
    array at: firstIndex put: nil.
    firstIndex := firstIndex + 1.
    ^ firstObject!
----- Method: OrderedCollection>>removeFirst: (in category 'removing') -----
removeFirst: n
    "Remove first n object into an array"
| list |
    list := Array new: n.
    1 to: n do: [:i |
    	list at: i put: self removeFirst].
    ^ list!
----- Method: OrderedCollection>>removeIndex: (in category 'private') -----
removeIndex: removedIndex
  "  removedIndex is an index in the range firstIndex .. lastIndex, such an index is not known from outside the collection.
    Never use this method in your code, it is meant for private use by OrderedCollection only.
     The method for public use is:
        #removeAt: "
array 
    	replaceFrom: removedIndex 
    	to: lastIndex - 1 
    	with: array 
    	startingAt: removedIndex+1.
    array at: lastIndex put: nil.
    lastIndex := lastIndex - 1.!
----- Method: OrderedCollection>>removeLast (in category 'removing') -----
removeLast
    "Remove the last element of the receiver and answer it. If the receiver is 
    empty, create an error notification."
    | lastObject |
    self emptyCheck.
    lastObject := array at: lastIndex.
    array at: lastIndex put: nil.
    lastIndex := lastIndex - 1.
    ^ lastObject!
----- Method: OrderedCollection>>removeLast: (in category 'removing') -----
removeLast: n
    "Remove last n object into an array with last in last position"
| list |
    list := Array new: n.
    n to: 1 by: -1 do: [:i |
    	list at: i put: self removeLast].
    ^ list!
----- Method: OrderedCollection>>reset (in category 'private') -----
reset
    firstIndex := array size // 3 max: 1.
    lastIndex := firstIndex - 1!
----- Method: OrderedCollection>>resetTo: (in category 'private') -----
resetTo: index
    firstIndex := index.
    lastIndex := firstIndex - 1!
----- Method: OrderedCollection>>reverseDo: (in category 'enumerating') -----
reverseDo: aBlock 
    "Override the superclass for performance reasons."
    | index |
    index := lastIndex.
    [index >= firstIndex]
    	whileTrue: 
    		[aBlock value: (array at: index).
    		index := index - 1]!
----- Method: OrderedCollection>>reversed (in category 'copying') -----
reversed
    "Answer a copy of the receiver with element order reversed.  "
    | newCol |
    newCol := self species new.
    self reverseDo:
    	[:elem | newCol addLast: elem].
    ^ newCol
"#(2 3 4 'fred') reversed"!
----- Method: OrderedCollection>>select: (in category 'enumerating') -----
select: aBlock 
    "Evaluate aBlock with each of my elements as the argument. Collect into
    a new collection like the receiver, only those elements for which aBlock
    evaluates to true."
| newCollection element |
    newCollection := self copyEmpty.
    firstIndex to: lastIndex do:
    	[:index |
    	(aBlock value: (element := array at: index))
    		ifTrue: [newCollection addLast: element]].
    ^ newCollection!
----- Method: OrderedCollection>>setCollection: (in category 'private') -----
setCollection: anArray
    array := anArray.
    self reset!
----- Method: OrderedCollection>>setContents: (in category 'private') -----
setContents: anArray
    array := anArray.
    firstIndex := 1.
    lastIndex := array size.!
----- Method: OrderedCollection>>size (in category 'accessing') -----
size
    "Answer how many elements the receiver contains."
^ lastIndex - firstIndex + 1!
----- Method: OrderedCollection>>sort (in category 'sorting') -----
sort
    "Sort this array into ascending order using the '<=' operator."
self sort: [:a :b | a <= b]!
----- Method: OrderedCollection>>sort: (in category 'sorting') -----
sort: aSortBlock 
    "Sort this array using aSortBlock. The block should take two arguments
    and return true if the first element should preceed the second one."
self ifNotEmpty: [
    	array
    		mergeSortFrom: firstIndex
    		to: lastIndex
    		by: aSortBlock ]!
----- Method: OrderedCollection>>with:collect: (in category 'enumerating') -----
with: otherCollection collect: twoArgBlock 
    "Collect and return the result of evaluating twoArgBlock with 
    corresponding elements from this collection and otherCollection."
    | result |
    otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size'].
    result := self species new: self size.
    1 to: self size do:
    	[:index | result addLast: (twoArgBlock value: (self at: index)
    								value: (otherCollection at: index))].
    ^ result!
----- Method: OrderedCollection>>withIndexCollect: (in category 'enumerating') -----
withIndexCollect: elementAndIndexBlock 
    "Just like with:collect: except that the iteration index supplies the second argument to the block. Override superclass in order to use addLast:, not at:put:."
| newCollection |
    newCollection := self species new: self size.
    firstIndex to: lastIndex do:
    	[:index |
    	newCollection addLast: (elementAndIndexBlock
    		value: (array at: index)
    		value: index - firstIndex + 1)].
    ^ newCollection!
OrderedCollection subclass: #SortedCollection
    instanceVariableNames: 'sortBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!SortedCollection commentStamp: 'dtl 9/6/2009 16:02' prior: 0!
I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a BlockContext. The default sorting function is a <= comparison on elements.!
----- Method: SortedCollection class>>sortBlock: (in category 'instance creation') -----
sortBlock: aBlock 
    "Answer an instance of me such that its elements are sorted according to 
    the criterion specified in aBlock."
^(super new: 10) sortBlock: aBlock!
----- Method: SortedCollection>>= (in category 'comparing') -----
= aSortedCollection
    "Answer true if my and aSortedCollection's species are the same,
    and if our blocks are the same, and if our elements are the same."
self species = aSortedCollection species ifFalse: [^ false].
    sortBlock = aSortedCollection sortBlock
    	ifTrue: [^ super = aSortedCollection]
    	ifFalse: [^ false]!
----- Method: SortedCollection>>add: (in category 'adding') -----
add: newObject
    ^ super insert: newObject before: (self indexForInserting: newObject)!
----- Method: SortedCollection>>addAll: (in category 'adding') -----
addAll: aCollection
    aCollection size > (self size // 3)
    	ifTrue:
    		[aCollection do: [:each | self addLast: each].
    		self reSort]
    	ifFalse: [aCollection do: [:each | self add: each]].
    ^ aCollection!
----- Method: SortedCollection>>addFirst: (in category 'adding') -----
addFirst: newObject
    self shouldNotImplement!
----- Method: SortedCollection>>at:put: (in category 'accessing') -----
at: anInteger put: anObject
    self shouldNotImplement!
----- Method: SortedCollection>>collect: (in category 'enumerating') -----
collect: aBlock 
    "Evaluate aBlock with each of my elements as the argument. Collect the 
    resulting values into an OrderedCollection. Answer the new collection. 
    Override the superclass in order to produce an OrderedCollection instead
    of a SortedCollection."
| newCollection | 
    newCollection := OrderedCollection new: self size.
    self do: [:each | newCollection addLast: (aBlock value: each)].
    ^ newCollection!
----- Method: SortedCollection>>copyEmpty (in category 'adding') -----
copyEmpty
    "Answer a copy of the receiver without any of the receiver's elements."
^self species sortBlock: sortBlock!
----- Method: SortedCollection>>indexForInserting: (in category 'private') -----
indexForInserting: newObject
| index low high |
    low := firstIndex.
    high := lastIndex.
    sortBlock isNil
    	ifTrue: [[index := high + low // 2.  low > high]
    		whileFalse: 
    			[((array at: index) <= newObject)
    				ifTrue: [low := index + 1]
    				ifFalse: [high := index - 1]]]
    	ifFalse: [[index := high + low // 2.  low > high]
    		whileFalse: 
    			[(sortBlock value: (array at: index) value: newObject)
    				ifTrue: [low := index + 1]
    				ifFalse: [high := index - 1]]].
    ^low!
----- Method: SortedCollection>>insert:before: (in category 'private') -----
insert: anObject before: spot
    self shouldNotImplement!
----- Method: SortedCollection>>median (in category 'accessing') -----
median
    "Return the middle element, or as close as we can get."
^ self at: self size + 1 // 2!
----- Method: SortedCollection>>reSort (in category 'private') -----
reSort
    self sort: firstIndex to: lastIndex!
----- Method: SortedCollection>>reverseInPlace (in category 'converting') -----
reverseInPlace
    "Change this colleciton into its reversed.
    Do not make a copy like reversed do, but change self in place."
    
    | newFirstIndex oldSortBlock |
    newFirstIndex := 1 + array size - lastIndex.
    lastIndex := 1 + array size - firstIndex.
    firstIndex := newFirstIndex.
    array := array reversed.
    oldSortBlock := (sortBlock ifNil: [[:a :b | a <= b]]) copy.
    sortBlock := [:a :b | oldSortBlock value: b value: a] fixTemps!
----- Method: SortedCollection>>reversed (in category 'converting') -----
reversed
    "Answer a collection that Sort elements in reverse order"
    
    ^self shallowCopy reverseInPlace!
----- Method: SortedCollection>>should:precede: (in category 'private') -----
should: a precede: b
^sortBlock ifNil: [a <= b] ifNotNil: [sortBlock value: a value: b]
!
----- Method: SortedCollection>>sort:to: (in category 'private') -----
sort: i to: j 
    "Sort elements i through j of self to be nondescending according to
    sortBlock."
| di dij dj tt ij k l n |
    "The prefix d means the data at that index."
    (n := j + 1  - i) <= 1 ifTrue: [^self].	"Nothing to sort." 
     "Sort di,dj."
    di := array at: i.
    dj := array at: j.
    (self should: di precede: dj)
    	ifFalse: 
    		[array swap: i with: j.
    		 tt := di.
    		 di := dj.
    		 dj := tt].
    n > 2
    	ifTrue:  "More than two elements."
    		[ij := (i + j) // 2.  "ij is the midpoint of i and j."
    		 dij := array at: ij.  "Sort di,dij,dj.  Make dij be their median."
    		 (self should: di precede: dij)
    		   ifTrue: 
    			[(self should: dij precede: dj)
    			  ifFalse: 
    				[array swap: j with: ij.
    				 dij := dj]]
    		   ifFalse:
    			[array swap: i with: ij.
    			 dij := di].
    		n > 3
    		  ifTrue:  "More than three elements."
    			["Find k>i and l<j such that dk,dij,dl are in reverse order.
    			Swap k and l.  Repeat this procedure until k and l pass each other."
    			 k := i.
    			 l := j.
    			 [[l := l - 1.  k <= l and: [self should: dij precede: (array at: l)]]
    			   whileTrue.  "i.e. while dl succeeds dij"
    			  [k := k + 1.  k <= l and: [self should: (array at: k) precede: dij]]
    			   whileTrue.  "i.e. while dij succeeds dk"
    			  k <= l]
    			   whileTrue:
    				[array swap: k with: l]. 
    "Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk
    through dj.  Sort those two segments."
    			self sort: i to: l.
    			self sort: k to: j]]!
----- Method: SortedCollection>>sortBlock (in category 'accessing') -----
sortBlock
    "Answer the blockContext which is the criterion for sorting elements of 
    the receiver."
^sortBlock!
----- Method: SortedCollection>>sortBlock: (in category 'accessing') -----
sortBlock: aBlock 
    "Make the argument, aBlock, be the criterion for ordering elements of the 
    receiver."
aBlock
    	ifNotNil: [sortBlock := aBlock fixTemps]
    	ifNil: [sortBlock := aBlock].
    "The sortBlock must copy its home context, so as to avoid circularities!!"
    "Therefore sortBlocks with side effects may not work right"
    self size > 0 ifTrue: [self reSort]!
----- Method: SortedCollection>>sortTopologically (in category 'topological sort') -----
sortTopologically
    "Plenty of room for increased efficiency in this one."
| remaining result pick |
    remaining := self asOrderedCollection.
    result := OrderedCollection new.
    [remaining isEmpty] whileFalse: [
    	pick := remaining select: [:item |
    		remaining allSatisfy: [:anotherItem |
    			item == anotherItem or: [self should: item precede: anotherItem]]].
    	pick isEmpty ifTrue: [self error: 'bad topological ordering'].
    	result addAll: pick.
    	remaining removeAll: pick].
    ^self copySameFrom: result!
----- Method: SequenceableCollection class>>new:streamContents: (in category 'stream creation') -----
new: newSize streamContents: blockWithArg
| stream |
    stream := WriteStream on: (self new: newSize).
    blockWithArg value: stream.
    stream position = newSize
    	ifTrue: [ ^stream originalContents ]
    	ifFalse: [ ^stream contents ]!
----- Method: SequenceableCollection class>>streamContents: (in category 'stream creation') -----
streamContents: blockWithArg
    
    ^self new: 100 streamContents: blockWithArg!
----- Method: SequenceableCollection class>>streamContents:limitedTo: (in category 'stream creation') -----
streamContents: blockWithArg limitedTo: sizeLimit
    | stream |
    stream := LimitedWriteStream on: (self new: (100 min: sizeLimit)).
    stream setLimit: sizeLimit limitBlock: [^ stream contents].
    blockWithArg value: stream.
    ^ stream contents
"
String streamContents: [:s | 1000 timesRepeat: [s nextPutAll: 'Junk']] limitedTo: 25
 'JunkJunkJunkJunkJunkJunkJ'
"!
----- Method: SequenceableCollection>>, (in category 'copying') -----
, otherCollection 
    "Concatenate two Strings or Collections."
    
    ^ self copyReplaceFrom: self size + 1
    	  to: self size
    	  with: otherCollection
"
#(2 4 6 8) , #(who do we appreciate)
((2989 storeStringBase: 16) copyFrom: 4 to: 6) , ' boy!!'
"!
----- Method: SequenceableCollection>>= (in category 'comparing') -----
= otherCollection 
    "Answer true if the receiver is equivalent to the otherCollection.
    First test for identity, then rule out different species and sizes of
    collections. As a last resort, examine each element of the receiver
    and the otherCollection."
self == otherCollection ifTrue: [^ true].
    self species == otherCollection species ifFalse: [^ false].
    ^ self hasEqualElements: otherCollection!
----- Method: SequenceableCollection>>@ (in category 'converting') -----
@ aCollection 
    ^ self with: aCollection collect: [:a :b | a @ b]!
----- Method: SequenceableCollection>>after: (in category 'accessing') -----
after: target
    "Answer the element after target.  Raise an error if target is not
    in the receiver, or if there are no elements after it."
^ self after: target ifAbsent: [self errorNotFound: target]!
----- Method: SequenceableCollection>>after:ifAbsent: (in category 'accessing') -----
after: target ifAbsent: exceptionBlock
    "Answer the element after target.  Answer the result of evaluation
    the exceptionBlock if target is not in the receiver, or if there are 
    no elements after it."
| index |
    index := self indexOf: target.
    ^ (index == 0 or: [index = self size])
    	ifTrue: [exceptionBlock value]
    	ifFalse: [self at: index + 1]!
----- Method: SequenceableCollection>>allButFirst (in category 'accessing') -----
allButFirst
    "Answer a copy of the receiver containing all but the first
    element. Raise an error if there are not enough elements."
^ self allButFirst: 1!
----- Method: SequenceableCollection>>allButFirst: (in category 'accessing') -----
allButFirst: n
    "Answer a copy of the receiver containing all but the first n
    elements. Raise an error if there are not enough elements."
^ self copyFrom: n + 1 to: self size!
----- Method: SequenceableCollection>>allButFirstDo: (in category 'enumerating') -----
allButFirstDo: block
2 to: self size do:
    	[:index | block value: (self at: index)]!
----- Method: SequenceableCollection>>allButLast (in category 'accessing') -----
allButLast
    "Answer a copy of the receiver containing all but the last
    element. Raise an error if there are not enough elements."
^ self allButLast: 1!
----- Method: SequenceableCollection>>allButLast: (in category 'accessing') -----
allButLast: n
    "Answer a copy of the receiver containing all but the last n
    elements. Raise an error if there are not enough elements."
^ self copyFrom: 1 to: self size - n!
----- Method: SequenceableCollection>>allButLastDo: (in category 'enumerating') -----
allButLastDo: block
1 to: self size - 1 do:
    	[:index | block value: (self at: index)]!
----- Method: SequenceableCollection>>anyOne (in category 'accessing') -----
anyOne
    ^ self first!
----- Method: SequenceableCollection>>asArray (in category 'converting') -----
asArray
    "Answer an Array whose elements are the elements of the receiver."
^ Array withAll: self!
----- Method: SequenceableCollection>>asByteArray (in category 'converting') -----
asByteArray
    "Answer a ByteArray whose elements are the elements of the receiver."
^ ByteArray withAll: self!
----- Method: SequenceableCollection>>asColorArray (in category 'converting') -----
asColorArray
    ^ColorArray withAll: self!
----- Method: SequenceableCollection>>asDigitsAt:in:do: (in category 'private') -----
asDigitsAt: anInteger in: aCollection do: aBlock
    "(0 to: 1) asDigitsToPower: 4 do: [:each | Transcript cr; show: each printString]"
self do: 
    	[:each | 
    	aCollection at: anInteger put: each.
    	anInteger = aCollection size 
    		ifTrue: [aBlock value: aCollection]
    		ifFalse: [self asDigitsAt: anInteger + 1 in: aCollection do: aBlock]].!
----- Method: SequenceableCollection>>asDigitsToPower:do: (in category 'enumerating') -----
asDigitsToPower: anInteger do: aBlock
    "Repeatedly value aBlock with a single Array.  Adjust the collection
    so that aBlock is presented all (self size raisedTo: anInteger) possible 
    combinations of the receiver's elements taken as digits of an anInteger long number."
    "(0 to: 1) asDigitsToPower: 4 do: [:each | Transcript cr; show: each printString]"
| aCollection |
    aCollection := Array new: anInteger.
    self asDigitsAt: 1 in: aCollection do: aBlock!
----- Method: SequenceableCollection>>asFloatArray (in category 'converting') -----
asFloatArray
    "Answer a FloatArray whose elements are the elements of the receiver, in 
    the same order."
| floatArray |
    floatArray := FloatArray new: self size.
    1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ].
    ^floatArray!
----- Method: SequenceableCollection>>asIntegerArray (in category 'converting') -----
asIntegerArray
    "Answer an IntegerArray whose elements are the elements of the receiver, in 
    the same order."
| intArray |
    intArray := IntegerArray new: self size.
    1 to: self size do:[:i| intArray at: i put: (self at: i)].
    ^intArray!
----- Method: SequenceableCollection>>asPointArray (in category 'converting') -----
asPointArray
    "Answer an PointArray whose elements are the elements of the receiver, in 
    the same order."
| pointArray |
    pointArray := PointArray new: self size.
    1 to: self size do:[:i| pointArray at: i put: (self at: i)].
    ^pointArray!
----- Method: SequenceableCollection>>asStringWithCr (in category 'converting') -----
asStringWithCr
    "Convert to a string with returns between items.  Elements are
usually strings.
     Useful for labels for PopUpMenus."
    | labelStream |
    labelStream := WriteStream on: (String new: 200).
    self do: [:each |
    	each isString
    		ifTrue: [labelStream nextPutAll: each; cr]
    		ifFalse: [each printOn: labelStream. labelStream cr]].
    self size > 0 ifTrue: [labelStream skip: -1].
    ^ labelStream contents!
----- Method: SequenceableCollection>>asWordArray (in category 'converting') -----
asWordArray
    "Answer a WordArray whose elements are the elements of the receiver, in 
    the same order."
| wordArray |
    wordArray := WordArray new: self size.
    1 to: self size do:[:i| wordArray at: i put: (self at: i)].
    ^wordArray!
----- Method: SequenceableCollection>>at:ifAbsent: (in category 'accessing') -----
at: index ifAbsent: exceptionBlock 
    "Answer the element at my position index. If I do not contain an element 
    at index, answer the result of evaluating the argument, exceptionBlock."
(index <= self size  and: [ 1 <= index ]) ifTrue: [ ^self at: index ].
    ^exceptionBlock value!
----- Method: SequenceableCollection>>at:incrementBy: (in category 'accessing') -----
at: index incrementBy: value
    ^self at: index put: (self at: index) + value!
----- Method: SequenceableCollection>>atAll: (in category 'accessing') -----
atAll: indexArray
    "Answer a new collection like the receiver which contains all elements
    of the receiver at the indices of indexArray."
    "#('one' 'two' 'three' 'four') atAll: #(3 2 4)"
| newCollection |
    newCollection := self species ofSize: indexArray size.
    1 to: indexArray size do:
    	[:index |
    	newCollection at: index put: (self at: (indexArray at: index))].
    ^ newCollection!
----- Method: SequenceableCollection>>atAll:put: (in category 'accessing') -----
atAll: aCollection put: anObject 
    "Put anObject at every index specified by the elements of aCollection."
aCollection do: [:index | self at: index put: anObject].
    ^ anObject!
----- Method: SequenceableCollection>>atAll:putAll: (in category 'accessing') -----
atAll: indexArray putAll: valueArray
    "Store the elements of valueArray into the slots
    of this collection selected by indexArray."
indexArray with: valueArray do: [:index :value | self at: index put: value].
    ^ valueArray!
----- Method: SequenceableCollection>>atAllPut: (in category 'accessing') -----
atAllPut: anObject 
    "Put anObject at every one of the receiver's indices."
| size |
    (size := self size) > 26 "first method faster from 27 accesses and on"
    	ifTrue: [self from: 1 to: size put: anObject]
    	ifFalse: [1 to: size do: [:index | self at: index put: anObject]]!
----- Method: SequenceableCollection>>atLast: (in category 'accessing') -----
atLast: indexFromEnd
    "Return element at indexFromEnd from the last position.
     atLast: 1, returns the last element"
^ self atLast: indexFromEnd ifAbsent: [self error: 'index out of range']!
----- Method: SequenceableCollection>>atLast:ifAbsent: (in category 'accessing') -----
atLast: indexFromEnd ifAbsent: block
    "Return element at indexFromEnd from the last position.
     atLast: 1 ifAbsent: [] returns the last element"
^ self at: self size + 1 - indexFromEnd ifAbsent: block!
----- Method: SequenceableCollection>>atLast:put: (in category 'accessing') -----
atLast: indexFromEnd put: obj
    "Set the element at indexFromEnd from the last position.
     atLast: 1 put: obj, sets the last element"
^ self at: self size + 1 - indexFromEnd put: obj!
----- Method: SequenceableCollection>>atPin: (in category 'accessing') -----
atPin: index 
    "Return the index'th element of me if possible.
    Return the first or last element if index is out of bounds."
index < 1 ifTrue: [^ self first].
    index > self size ifTrue: [^ self last].
    ^ self at: index!
----- Method: SequenceableCollection>>atRandom: (in category 'accessing') -----
atRandom: aGenerator
    "Answer a random element of the receiver.  Uses aGenerator which
    should be kept by the user in a variable and used every time. Use
    this instead of #atRandom for better uniformity of random numbers 
    because only you use the generator.  Causes an error if self has no 
    elements."
^ self at: (aGenerator nextInt: self size)!
----- Method: SequenceableCollection>>atWrap: (in category 'accessing') -----
atWrap: index 
    "Answer the index'th element of the receiver.  If index is out of bounds,
    let it wrap around from the end to the beginning until it is in bounds."
^ self at: index - 1 \ self size + 1!
----- Method: SequenceableCollection>>atWrap:put: (in category 'accessing') -----
atWrap: index put: value
    "Store value into the index'th element of the receiver.  If index is out
    of bounds, let it wrap around from the end to the beginning until it 
    is in bounds. Answer value."
^ self at: index  - 1 \ self size + 1 put: value!
----- Method: SequenceableCollection>>before: (in category 'accessing') -----
before: target
    "Answer the receiver's element immediately before target. Raise an
    error if target is not an element of the receiver, or if there are no 
    elements before it (i.e. it is the first element)."
^ self before: target ifAbsent: [self errorNotFound: target]!
----- Method: SequenceableCollection>>before:ifAbsent: (in category 'accessing') -----
before: target ifAbsent: exceptionBlock
    "Answer the receiver's element immediately before target. Answer
    the result of evaluating the exceptionBlock if target is not an element
    of the receiver, or if there are no elements before it."
| index |
    index := self indexOf: target.
    ^ (index == 0 or: [index == 1])
    	ifTrue: [exceptionBlock value]
    	ifFalse: [self at: index - 1]!
----- Method: SequenceableCollection>>beginsWith: (in category 'testing') -----
beginsWith: aSequenceableCollection
(aSequenceableCollection isEmpty or: [self size < aSequenceableCollection size]) ifTrue: [^false].
    aSequenceableCollection withIndexDo: [:each :index | (self at: index) ~= each ifTrue: [^false]].
    ^true!
----- Method: SequenceableCollection>>checkedAt: (in category 'private') -----
checkedAt: index
    index > self size ifTrue: [self error: 'not enough elements'].
    ^ self at: index!
----- Method: SequenceableCollection>>collect: (in category 'enumerating') -----
collect: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument.  
    Collect the resulting values into a collection like the receiver. Answer  
    the new collection."
| newCollection |
    newCollection := self species new: self size.
    1 to: self size do:
    	[:index |
    	newCollection at: index put: (aBlock value: (self at: index))].
    ^ newCollection!
----- Method: SequenceableCollection>>collect:from:to: (in category 'enumerating') -----
collect: aBlock from: firstIndex to: lastIndex
    "Refer to the comment in Collection|collect:."
| size result j |
    size := lastIndex - firstIndex + 1.
    result := self species new: size.
    j := firstIndex.
    1 to: size do: [:i | result at: i put: (aBlock value: (self at: j)). j := j + 1].
    ^ result!
----- Method: SequenceableCollection>>collectWithIndex: (in category 'enumerating') -----
collectWithIndex: elementAndIndexBlock
    "Use the new version with consistent naming"
    ^ self withIndexCollect: elementAndIndexBlock!
----- Method: SequenceableCollection>>combinations:atATimeDo: (in category 'enumerating') -----
combinations: kk atATimeDo: aBlock
    "Take the items in the receiver, kk at a time, and evaluate the block for each combination.  Hand in an array of elements of self as the block argument.  Each combination only occurs once, and order of the elements does not matter.  There are (self size take: kk) combinations."
    " 'abcde' combinations: 3 atATimeDo: [:each | Transcript cr; show: each printString]"
| aCollection |
    aCollection := Array new: kk.
    self combinationsAt: 1 in: aCollection after: 0 do: aBlock!
----- Method: SequenceableCollection>>combinationsAt:in:after:do: (in category 'private') -----
combinationsAt: jj in: aCollection after: nn do: aBlock
    "Choose k of N items and put in aCollection.  jj-1 already chosen.  Indexes of items are in numerical order, to avoid the same combo being used twice.  In this slot, we are allowed to use items in self indexed by nn+1 to self size.  nn is the index used for position jj-1."
    "(1 to: 6) combinationsSize: 3 do: [:each | Transcript cr; show: each printString]"
nn+1 to: self size do: [:index | 
    	aCollection at: jj put: (self at: index).
    	jj = aCollection size 
    		ifTrue: [aBlock value: aCollection]
    		ifFalse: [self combinationsAt: jj + 1 in: aCollection after: index do: aBlock]].!
----- Method: SequenceableCollection>>concatenation (in category 'converting') -----
concatenation
    |result index|
result := Array new: (self inject: 0 into: [:sum :each | sum + each size]).
    index := 0.
    self do: [:each | each do: [:item | result at: (index := index+1) put: item]].
    ^result!
----- Method: SequenceableCollection>>copyAfter: (in category 'copying') -----
copyAfter: anElement
    "Answer a copy of the receiver from after the first occurence
    of anElement up to the end. If no such element exists, answer 
    an empty copy."
^ self allButFirst: (self indexOf: anElement ifAbsent: [^ self copyEmpty])!
----- Method: SequenceableCollection>>copyAfterLast: (in category 'copying') -----
copyAfterLast: anElement
    "Answer a copy of the receiver from after the last occurence
    of anElement up to the end. If no such element exists, answer 
    an empty copy."
^ self allButFirst: (self lastIndexOf: anElement ifAbsent: [^ self copyEmpty])!
----- Method: SequenceableCollection>>copyEmpty (in category 'copying') -----
copyEmpty
    ^ self species new: 0!
----- Method: SequenceableCollection>>copyFrom:to: (in category 'copying') -----
copyFrom: start to: stop 
    "Answer a copy of a subset of the receiver, starting from element at 
    index start until element at index stop."
| newSize |
    newSize := stop - start + 1.
    ^(self species new: newSize)
    	replaceFrom: 1
    	to: newSize
    	with: self
    	startingAt: start!
----- Method: SequenceableCollection>>copyLast: (in category 'copying') -----
copyLast: num
    "Deprecated. Use #last:"
^ self last: num!
----- Method: SequenceableCollection>>copyReplaceAll:with: (in category 'copying') -----
copyReplaceAll: oldSubstring with: newSubstring 
    "Default is not to do token matching.
    See also String copyReplaceTokens:with:"
    ^ self copyReplaceAll: oldSubstring with: newSubstring asTokens: false
    "'How now brown cow?' copyReplaceAll: 'ow' with: 'ello'"
    "'File asFile Files File''s File' copyReplaceTokens: 'File' with: 'Pile'"!
----- Method: SequenceableCollection>>copyReplaceAll:with:asTokens: (in category 'private') -----
copyReplaceAll: oldSubstring with: newSubstring asTokens: ifTokens
    "Answer a copy of the receiver in which all occurrences of
    oldSubstring have been replaced by newSubstring.
    ifTokens (valid for Strings only) specifies that the characters
    surrounding the recplacement must not be alphanumeric.
    	Bruce Simth,  must be incremented by 1 and not 
    newSubstring if ifTokens is true.  See example below. "
| aString startSearch currentIndex endIndex |
    (ifTokens and: [(self isString) not])
    	ifTrue: [(self isKindOf: Text) ifFalse: [
    		self error: 'Token replacement only valid for Strings']].
    aString := self.
    startSearch := 1.
    [(currentIndex := aString indexOfSubCollection: oldSubstring startingAt: startSearch)
    		 > 0]
    	whileTrue: 
    	[endIndex := currentIndex + oldSubstring size - 1.
    	(ifTokens not
    		or: [(currentIndex = 1
    				or: [(aString at: currentIndex-1) isAlphaNumeric not])
    			and: [endIndex = aString size
    				or: [(aString at: endIndex+1) isAlphaNumeric not]]])
    		ifTrue: [aString := aString
    				copyReplaceFrom: currentIndex
    				to: endIndex
    				with: newSubstring.
    			startSearch := currentIndex + newSubstring size]
    		ifFalse: [
    			ifTokens 
    				ifTrue: [startSearch := currentIndex + 1]
    				ifFalse: [startSearch := currentIndex + newSubstring size]]].
    ^ aString
"Test case:
    'test te string' copyReplaceAll: 'te' with: 'longone' asTokens: true   "
!
----- Method: SequenceableCollection>>copyReplaceFrom:to:with: (in category 'copying') -----
copyReplaceFrom: start to: stop with: replacementCollection 
    "Answer a copy of the receiver satisfying the following conditions: If 
    stop is less than start, then this is an insertion; stop should be exactly 
    start-1, start = 1 means insert before the first character, start = size+1 
    means append after last character. Otherwise, this is a replacement; start 
    and stop have to be within the receiver's bounds."
| newSequenceableCollection newSize endReplacement |
    newSize := self size - (stop - start + 1) + replacementCollection size.
    endReplacement := start - 1 + replacementCollection size.
    newSequenceableCollection := self species new: newSize.
    start > 1 ifTrue:[
    	newSequenceableCollection
    		replaceFrom: 1
    		to: start - 1
    		with: self
    		startingAt: 1].
    start <= endReplacement ifTrue:[
    	newSequenceableCollection
    		replaceFrom: start
    		to: endReplacement
    		with: replacementCollection
    		startingAt: 1].
    endReplacement < newSize ifTrue:[
    	newSequenceableCollection
    		replaceFrom: endReplacement + 1
    		to: newSize
    		with: self
    		startingAt: stop + 1].
    ^newSequenceableCollection!
----- Method: SequenceableCollection>>copyUpTo: (in category 'copying') -----
copyUpTo: anElement 
    "Answer all elements up to but not including anObject. If there
    is no such object, answer a copy of the receiver."
^ self first: (self indexOf: anElement ifAbsent: [^ self copy]) - 1!
----- Method: SequenceableCollection>>copyUpToLast: (in category 'copying') -----
copyUpToLast: anElement
    "Answer a copy of the receiver from index 1 to the last occurrence of 
    anElement, not including anElement."
^ self first: (self lastIndexOf: anElement ifAbsent: [^ self copy]) - 1!
----- Method: SequenceableCollection>>copyWith: (in category 'copying') -----
copyWith: newElement 
    "Answer a copy of the receiver that is 1 bigger than the receiver and has 
    newElement at the last element."
| newIC |
    newIC := self species new: self size + 1.
    newIC 
    	replaceFrom: 1
    	to: self size
    	with: self
    	startingAt: 1.
    newIC at: newIC size put: newElement.
    ^newIC!
----- Method: SequenceableCollection>>copyWithFirst: (in category 'copying') -----
copyWithFirst: newElement 
    "Answer a copy of the receiver that is 1 bigger than the receiver with newElement as the first element."
| newIC |
    newIC := self species ofSize: self size + 1.
    newIC 
    	replaceFrom: 2
    	to: self size + 1
    	with: self
    	startingAt: 1.
    newIC at: 1 put: newElement.
    ^ newIC!
----- Method: SequenceableCollection>>copyWithoutFirst (in category 'copying') -----
copyWithoutFirst
    "Deprecatd. Return a copy of the receiver which doesn't include
    the first element."
^ self allButFirst!
----- Method: SequenceableCollection>>copyWithoutIndex: (in category 'copying') -----
copyWithoutIndex: index
    "Return a copy containing all elements except the index-th."
| copy |
    copy := self species ofSize: self size - 1.
    copy replaceFrom: 1 to: index-1 with: self startingAt: 1.
    copy replaceFrom: index to: copy size with: self startingAt: index+1.
    ^ copy!
----- Method: SequenceableCollection>>do: (in category 'enumerating') -----
do: aBlock 
    "Refer to the comment in Collection|do:."
    1 to: self size do:
    	[:index | aBlock value: (self at: index)]!
----- Method: SequenceableCollection>>do:displayingProgress: (in category 'enumerating') -----
do: aBlock displayingProgress: aString
    aString
    	displayProgressAt: Sensor cursorPoint
    	from: 0 to: self size
    	during:
    		[:bar |
    		self withIndexDo:
    			[:each :i |
    			bar value: i.
    			aBlock value: each]]!
----- Method: SequenceableCollection>>do:separatedBy: (in category 'enumerating') -----
do: elementBlock separatedBy: separatorBlock
    "Evaluate the elementBlock for all elements in the receiver,
    and evaluate the separatorBlock between."
1 to: self size do:
    	[:index |
    	index = 1 ifFalse: [separatorBlock value].
    	elementBlock value: (self at: index)]!
----- Method: SequenceableCollection>>do:without: (in category 'enumerating') -----
do: aBlock without: anItem
    "Enumerate all elements in the receiver.
    Execute aBlock for those elements that are not equal to the given item"
    "Refer to the comment in Collection|do:."
    1 to: self size do:
    	[:index | anItem = (self at: index) ifFalse:[aBlock value: (self at: index)]]!
----- Method: SequenceableCollection>>doWithIndex: (in category 'enumerating') -----
doWithIndex: elementAndIndexBlock
    "Use the new version with consistent naming"
    ^ self withIndexDo: elementAndIndexBlock!
----- Method: SequenceableCollection>>eighth (in category 'accessing') -----
eighth
    "Answer the eighth element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 8!
----- Method: SequenceableCollection>>endsWith: (in category 'testing') -----
endsWith: aSequenceableCollection
| start |
    (aSequenceableCollection isEmpty or: [self size < aSequenceableCollection size]) ifTrue: [^false].
    start := self size - aSequenceableCollection size.
    aSequenceableCollection withIndexDo: [:each :index | (self at: start + index) ~= each ifTrue: [^false]].
    ^true!
----- Method: SequenceableCollection>>errorFirstObject: (in category 'private') -----
errorFirstObject: anObject
    self error: 'specified object is first object'!
----- Method: SequenceableCollection>>errorLastObject: (in category 'private') -----
errorLastObject: anObject
    self error: 'specified object is last object'!
----- Method: SequenceableCollection>>errorOutOfBounds (in category 'private') -----
errorOutOfBounds
self error: 'indices are out of bounds'!
----- Method: SequenceableCollection>>explorerContents (in category 'explorer') -----
explorerContents
^self asOrderedCollection withIndexCollect: [:value :index |
    	ObjectExplorerWrapper
    		with: value
    		name: index printString
    		model: self]!
----- Method: SequenceableCollection>>fifth (in category 'accessing') -----
fifth
    "Answer the fifth element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 5!
----- Method: SequenceableCollection>>findBinary: (in category 'enumerating') -----
findBinary: aBlock
    "Search for an element in the receiver using binary search.
    The argument aBlock is a one-element block returning
    	0 	- if the element is the one searched for
    	<0	- if the search should continue in the first half
    	>0	- if the search should continue in the second half
    If no matching element is found, raise an error.
    Examples:
    	#(1 3 5 7 11 15 23) findBinary:[:arg| 11 - arg]
    "
    ^self findBinary: aBlock ifNone: [self errorNotFound: aBlock]!
----- Method: SequenceableCollection>>findBinary:ifNone: (in category 'enumerating') -----
findBinary: aBlock ifNone: exceptionBlock
    "Search for an element in the receiver using binary search.
    The argument aBlock is a one-element block returning
    	0 	- if the element is the one searched for
    	<0	- if the search should continue in the first half
    	>0	- if the search should continue in the second half
    If no matching element is found, evaluate exceptionBlock."
    | index low high test item |
    low := 1.
    high := self size.
    [index := high + low // 2.
    low > high] whileFalse:[
    	test := aBlock value: (item := self at: index).
    	test = 0 
    		ifTrue:[^item]
    		ifFalse:[test > 0
    			ifTrue: [low := index + 1]
    			ifFalse: [high := index - 1]]].
    ^exceptionBlock value!
----- Method: SequenceableCollection>>findBinaryIndex: (in category 'enumerating') -----
findBinaryIndex: aBlock
    "Search for an element in the receiver using binary search.
    The argument aBlock is a one-element block returning
    	0 	- if the element is the one searched for
    	<0	- if the search should continue in the first half
    	>0	- if the search should continue in the second half
    If no matching element is found, raise an error.
    Examples:
    	#(1 3 5 7 11 15 23) findBinaryIndex:[:arg| 11 - arg]
    "
    ^self findBinaryIndex: aBlock ifNone: [self errorNotFound: aBlock]!
----- Method: SequenceableCollection>>findBinaryIndex:ifNone: (in category 'enumerating') -----
findBinaryIndex: aBlock ifNone: exceptionBlock
    "Search for an element in the receiver using binary search.
    The argument aBlock is a one-element block returning
    	0 	- if the element is the one searched for
    	<0	- if the search should continue in the first half
    	>0	- if the search should continue in the second half
    If no matching element is found, evaluate exceptionBlock."
    | index low high test |
    low := 1.
    high := self size.
    [index := high + low // 2.
    low > high] whileFalse:[
    	test := aBlock value: (self at: index).
    	test = 0 
    		ifTrue:[^index]
    		ifFalse:[test > 0
    			ifTrue: [low := index + 1]
    			ifFalse: [high := index - 1]]].
    ^exceptionBlock value!
----- Method: SequenceableCollection>>findFirst: (in category 'enumerating') -----
findFirst: aBlock
    "Return the index of my first element for which aBlock evaluates as true."
| index |
    index := 0.
    [(index := index + 1) <= self size] whileTrue:
    	[(aBlock value: (self at: index)) ifTrue: [^index]].
    ^ 0!
----- Method: SequenceableCollection>>findLast: (in category 'enumerating') -----
findLast: aBlock
    "Return the index of my last element for which aBlock evaluates as true."
| index |
    index := self size + 1.
    [(index := index - 1) >= 1] whileTrue:
    	[(aBlock value: (self at: index)) ifTrue: [^index]].
    ^ 0!
----- Method: SequenceableCollection>>first (in category 'accessing') -----
first
    "Answer the first element of the receiver"
^ self at: 1!
----- Method: SequenceableCollection>>first: (in category 'accessing') -----
first: n
    "Answer the first n elements of the receiver.
    Raise an error if there are not enough elements."
^ self copyFrom: 1 to: n!
----- Method: SequenceableCollection>>forceTo:paddingStartWith: (in category 'copying') -----
forceTo: length paddingStartWith: elem 
    "Force the length of the collection to length, padding  
    the beginning of the result if necessary with elem.  
    Note that this makes a copy."
    | newCollection padLen |
    newCollection := self species ofSize: length.
    padLen := length - self size max: 0.
    newCollection
    	from: 1
    	to: padLen
    	put: elem.
    newCollection
    	replaceFrom: padLen + 1
    	to: ((padLen + self size) min: length)
    	with: self
    	startingAt:  1.
    ^ newCollection!
----- Method: SequenceableCollection>>forceTo:paddingWith: (in category 'copying') -----
forceTo: length paddingWith: elem
    "Force the length of the collection to length, padding
    if necessary with elem.  Note that this makes a copy."
| newCollection |
    newCollection := self species new: length withAll: elem.
    newCollection replaceFrom: 1 to: (self size min: length) with: self startingAt: 1.
    ^ newCollection!
----- Method: SequenceableCollection>>fourth (in category 'accessing') -----
fourth
    "Answer the fourth element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 4!
----- Method: SequenceableCollection>>from:to:do: (in category 'enumerating') -----
from: start to: stop do: aBlock
    "Evaluate aBlock for all elements between start and stop (inclusive)."
start to: stop do: [:index | aBlock value: (self at: index)]!
----- Method: SequenceableCollection>>from:to:put: (in category 'accessing') -----
from: startIndex to: endIndex put: anObject
    "Put anObject in all indexes between startIndex 
    and endIndex. Very fast. Faster than to:do: for
    more than 26 positions. Answer anObject"
| written toWrite thisWrite |
startIndex > endIndex ifTrue: [^self].
    self at: startIndex put: anObject.
    written := 1.
    toWrite := endIndex - startIndex + 1.
    [written < toWrite] whileTrue:
    	[
    		thisWrite := written min: toWrite - written.
    		self 
    			replaceFrom: startIndex + written
    			to: startIndex + written + thisWrite - 1
    			with: self startingAt: startIndex.
    		written := written + thisWrite
    	].
    ^anObject!
----- Method: SequenceableCollection>>groupsOf:atATimeCollect: (in category 'enumerating') -----
groupsOf: n atATimeCollect: aBlock 
    "Evaluate aBlock with my elements taken n at a time. Ignore any 
    leftovers at the end. 
    Allows use of a flattened  
    array for things that naturally group into groups of n. 
    If aBlock has a single argument, pass it an array of n items, 
    otherwise, pass the items as separate arguments. 
    See also pairsDo:"
    | passArray args  |
    passArray := aBlock numArgs = 1.
    ^(n
    	to: self size
    	by: n)
    	collect: [:index | 
    		args := (self copyFrom: index - n + 1 to: index) asArray.
    		passArray
    			ifTrue: [aBlock value: args]
    			ifFalse: [aBlock valueWithArguments: args]]!
----- Method: SequenceableCollection>>groupsOf:atATimeDo: (in category 'enumerating') -----
groupsOf: n atATimeDo: aBlock 
    "Evaluate aBlock with my elements taken n at a time. Ignore any leftovers at the end.
    Allows use of a flattened 
    array for things that naturally group into groups of n.
    If aBlock has a single argument, pass it an array of n items,
    otherwise, pass the items as separate arguments.
    See also pairsDo:"
    | passArray args |
    passArray := (aBlock numArgs = 1).
    n
    	to: self size
    	by: n
    	do: [:index | 
    		args := (self copyFrom: index - n + 1 to: index) asArray.
    		passArray ifTrue: [ aBlock value: args ]
    			ifFalse: [ aBlock valueWithArguments: args ]].!
----- Method: SequenceableCollection>>grownBy: (in category 'copying') -----
grownBy: length
    "Answer a copy of receiver collection with size grown by length"
| newCollection |
    newCollection := self species ofSize: self size + length.
    newCollection replaceFrom: 1 to: self size with: self startingAt: 1.
    ^ newCollection!
----- Method: SequenceableCollection>>hasEqualElements: (in category 'comparing') -----
hasEqualElements: otherCollection
    "Answer whether the receiver's size is the same as otherCollection's
    size, and each of the receiver's elements equal the corresponding 
    element of otherCollection.
    This should probably replace the current definition of #= ."
| size |
    (otherCollection isKindOf: SequenceableCollection) ifFalse: [^ false].
    (size := self size) = otherCollection size ifFalse: [^ false].
    1 to: size do:
    	[:index |
    	(self at: index) = (otherCollection at: index) ifFalse: [^ false]].
    ^ true!
----- Method: SequenceableCollection>>hash (in category 'comparing') -----
hash
    | hash |
hash := self species hash.
    1 to: self size do: [:i | hash := (hash + (self at: i) hash) hashMultiply].
    ^hash!
----- Method: SequenceableCollection>>identityIndexOf: (in category 'accessing') -----
identityIndexOf: anElement 
    "Answer the index of anElement within the receiver. If the receiver does 
    not contain anElement, answer 0."
^self identityIndexOf: anElement ifAbsent: [0]!
----- Method: SequenceableCollection>>identityIndexOf:ifAbsent: (in category 'accessing') -----
identityIndexOf: anElement ifAbsent: exceptionBlock
    "Answer the index of anElement within the receiver. If the receiver does 
    not contain anElement, answer the result of evaluating the argument, 
    exceptionBlock."
    1 to: self size do:
    	[:i | (self at: i) == anElement ifTrue: [^ i]].
    ^ exceptionBlock value!
----- Method: SequenceableCollection>>includes: (in category 'testing') -----
includes: anObject
    "Answer whether anObject is one of the receiver's elements."
^ (self indexOf: anObject) ~= 0!
----- Method: SequenceableCollection>>indexOf: (in category 'accessing') -----
indexOf: anElement
    "Answer the index of the first occurence of anElement within the  
    receiver. If the receiver does not contain anElement, answer 0."
^ self indexOf: anElement ifAbsent: [0]!
----- Method: SequenceableCollection>>indexOf:ifAbsent: (in category 'accessing') -----
indexOf: anElement ifAbsent: exceptionBlock
    "Answer the index of the first occurence of anElement within the  
    receiver. If the receiver does not contain anElement, answer the 
    result of evaluating the argument, exceptionBlock."
^ self indexOf: anElement startingAt: 1 ifAbsent: exceptionBlock!
----- Method: SequenceableCollection>>indexOf:startingAt:ifAbsent: (in category 'accessing') -----
indexOf: anElement startingAt: start ifAbsent: exceptionBlock
    "Answer the index of the first occurence of anElement after start
    within the receiver. If the receiver does not contain anElement, 
    answer the 	result of evaluating the argument, exceptionBlock."
start to: self size do:
    	[:index |
    	(self at: index) = anElement ifTrue: [^ index]].
    ^ exceptionBlock value!
----- Method: SequenceableCollection>>indexOfSubCollection:startingAt: (in category 'accessing') -----
indexOfSubCollection: aSubCollection startingAt: anIndex 
    "Answer the index of the receiver's first element, such that that element 
    equals the first element of aSubCollection, and the next elements equal 
    the rest of the elements of aSubCollection. Begin the search at element 
    anIndex of the receiver. If no such match is found, answer 0."
^self
    	indexOfSubCollection: aSubCollection
    	startingAt: anIndex
    	ifAbsent: [0]!
----- Method: SequenceableCollection>>indexOfSubCollection:startingAt:ifAbsent: (in category 'accessing') -----
indexOfSubCollection: sub startingAt: start ifAbsent: exceptionBlock
    "Answer the index of the receiver's first element, such that that element 
    equals the first element of sub, and the next elements equal 
    the rest of the elements of sub. Begin the search at element 
    start of the receiver. If no such match is found, answer the result of 
    evaluating argument, exceptionBlock."
    | first index |
    sub isEmpty ifTrue: [^ exceptionBlock value].
    first := sub first.
    start to: self size - sub size + 1 do:
    	[:startIndex |
    	(self at: startIndex) = first ifTrue:
    		[index := 1.
    		[(self at: startIndex+index-1) = (sub at: index)]
    			whileTrue:
    			[index = sub size ifTrue: [^startIndex].
    			index := index+1]]].
    ^ exceptionBlock value!
----- Method: SequenceableCollection>>integerAt: (in category 'accessing') -----
integerAt: index
    "Return the integer at the given index"
    ^self at: index!
----- Method: SequenceableCollection>>integerAt:put: (in category 'accessing') -----
integerAt: index put: value
    "Return the integer at the given index"
    ^self at: index put: value!
----- Method: SequenceableCollection>>isSequenceable (in category 'converting') -----
isSequenceable
    ^ true!
----- Method: SequenceableCollection>>keysAndValuesDo: (in category 'enumerating') -----
keysAndValuesDo: aBlock 
    "Enumerate the receiver with all the keys (aka indices) and values."
1 to: self size do: [:index | aBlock value: index value: (self at: index)]!
----- Method: SequenceableCollection>>last (in category 'accessing') -----
last
    "Answer the last element of the receiver"
^ self at: self size!
----- Method: SequenceableCollection>>last: (in category 'accessing') -----
last: n
    "Answer the last n elements of the receiver.  
    Raise an error if there are not enough elements."
| size |
    size := self size.
    ^ self copyFrom: size - n + 1 to: size!
----- Method: SequenceableCollection>>lastIndexOf: (in category 'accessing') -----
lastIndexOf: anElement
    "Answer the index of the last occurence of anElement within the 
    receiver. If the receiver does not contain anElement, answer 0."
^ self lastIndexOf: anElement startingAt: self size ifAbsent: [0]!
----- Method: SequenceableCollection>>lastIndexOf:ifAbsent: (in category 'accessing') -----
lastIndexOf: anElement ifAbsent: exceptionBlock
    "Answer the index of the last occurence of anElement within the  
    receiver. If the receiver does not contain anElement, answer the
    result of evaluating the argument, exceptionBlock."
    ^self lastIndexOf: anElement startingAt: self size ifAbsent: exceptionBlock!
----- Method: SequenceableCollection>>lastIndexOf:startingAt:ifAbsent: (in category 'accessing') -----
lastIndexOf: anElement startingAt: lastIndex ifAbsent: exceptionBlock
    "Answer the index of the last occurence of anElement within the  
    receiver. If the receiver does not contain anElement, answer the
    result of evaluating the argument, exceptionBlock."
lastIndex to: 1 by: -1 do:
    	[:index |
    	(self at: index) = anElement ifTrue: [^ index]].
    ^ exceptionBlock value!
----- Method: SequenceableCollection>>middle (in category 'accessing') -----
middle
    "Answer the middle element of the receiver."
    ^ self at: self size // 2 + 1!
----- Method: SequenceableCollection>>nextToLast (in category 'enumerating') -----
nextToLast
    ^self at: self size - 1!
----- Method: SequenceableCollection>>ninth (in category 'accessing') -----
ninth
    "Answer the ninth element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 9!
----- Method: SequenceableCollection>>overlappingPairsCollect: (in category 'enumerating') -----
overlappingPairsCollect: aBlock 
    "Answer the result of evaluating aBlock with all of the overlapping pairs of my elements."
    | retval |
    retval := self species new: self size - 1.
    1 to: self size - 1
    	do: [:i | retval at: i put: (aBlock value: (self at: i) value: (self at: i + 1)) ].
    ^retval!
----- Method: SequenceableCollection>>overlappingPairsDo: (in category 'enumerating') -----
overlappingPairsDo: aBlock 
    "Emit overlapping pairs of my elements into aBlock"
1 to: self size - 1
    	do: [:i | aBlock value: (self at: i) value: (self at: i + 1)]!
----- Method: SequenceableCollection>>overlappingPairsWithIndexDo: (in category 'enumerating') -----
overlappingPairsWithIndexDo: aBlock 
    "Emit overlapping pairs of my elements into aBlock, along with an index."
1 to: self size - 1
    	do: [:i | aBlock value: (self at: i) value: (self at: i + 1) value: i ]!
----- Method: SequenceableCollection>>paddedWith:do: (in category 'enumerating') -----
paddedWith: otherCollection do: twoArgBlock 
    "Evaluate twoArgBlock with corresponding elements from this collection and otherCollection.
    Missing elements from either will be passed as nil."
    1 to: (self size max: otherCollection size) do:
    	[:index | twoArgBlock value: (self at: index ifAbsent: [])
    			value: (otherCollection at: index ifAbsent: [])]!
----- Method: SequenceableCollection>>pairsCollect: (in category 'enumerating') -----
pairsCollect: aBlock 
    "Evaluate aBlock with my elements taken two at a time, and return an Array with the results"
^ (1 to: self size // 2) collect:
    	[:index | aBlock value: (self at: 2 * index - 1) value: (self at: 2 * index)]
"
#(1 'fred' 2 'charlie' 3 'elmer') pairsCollect:
    [:a :b | b, ' is number ', a printString]
"!
----- Method: SequenceableCollection>>pairsDo: (in category 'enumerating') -----
pairsDo: aBlock 
    "Evaluate aBlock with my elements taken two at a time.  If there's an odd number of items, ignore the last one.  Allows use of a flattened array for things that naturally group into pairs.  See also pairsCollect:"
1 to: self size // 2 do:
    	[:index | aBlock value: (self at: 2 * index - 1) value: (self at: 2 * index)]
"
#(1 'fred' 2 'charlie' 3 'elmer') pairsDo:
    [:a :b | Transcript cr; show: b, ' is number ', a printString]
"!
----- Method: SequenceableCollection>>permutationsDo: (in category 'enumerating') -----
permutationsDo: aBlock
    "Repeatly value aBlock with a single copy of the receiver. Reorder the copy
    so that aBlock is presented all (self size factorial) possible permutations."
    "(1 to: 4) permutationsDo: [:each | Transcript cr; show: each printString]"
self shallowCopy permutationsStartingAt: 1 do: aBlock!
----- Method: SequenceableCollection>>permutationsStartingAt:do: (in category 'private') -----
permutationsStartingAt: anInteger do: aBlock
    "#(1 2 3 4) permutationsDo: [:each | Transcript cr; show: each printString]"
anInteger > self size ifTrue: [^self].
    anInteger = self size ifTrue: [^aBlock value: self].
    anInteger to: self size do:
    	[:i | self swap: anInteger with: i.
    	self permutationsStartingAt: anInteger + 1 do: aBlock.
    	self swap: anInteger with: i]!
----- Method: SequenceableCollection>>polynomialEval: (in category 'enumerating') -----
polynomialEval: thisX
    | sum valToPower |
    "Treat myself as the coeficients of a polynomial in X.  Evaluate it with thisX.  First element is the constant and last is the coeficient for the highest power."
    "  #(1 2 3) polynomialEval: 2   "   "is 3*X^2 + 2*X + 1 with X = 2"
sum := self first.
    valToPower := thisX.
    2 to: self size do: [:ind | 
    	sum := sum + ((self at: ind) * valToPower).
    	valToPower := valToPower * thisX].
    ^ sum!
----- Method: SequenceableCollection>>readStream (in category 'converting') -----
readStream
    ^ ReadStream on: self!
----- Method: SequenceableCollection>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: anExceptionBlock 
    "SequencableCollections cannot implement removing."
self shouldNotImplement!
----- Method: SequenceableCollection>>replaceAll:with: (in category 'accessing') -----
replaceAll: oldObject with: newObject 
    "Replace all occurences of oldObject with newObject"
    | index |
    index := self
    			indexOf: oldObject
    			startingAt: 1
    			ifAbsent: [0].
    [index = 0]
    	whileFalse: 
    		[self at: index put: newObject.
    		index := self
    					indexOf: oldObject
    					startingAt: index + 1
    					ifAbsent: [0]]!
----- Method: SequenceableCollection>>replaceFrom:to:with: (in category 'accessing') -----
replaceFrom: start to: stop with: replacement 
    "This destructively replaces elements from start to stop in the receiver. 
    Answer the receiver itself. Use copyReplaceFrom:to:with: for 
    insertion/deletion which may alter the size of the result."
replacement size = (stop - start + 1)
    	ifFalse: [self error: 'Size of replacement doesnt match'].
    ^self replaceFrom: start to: stop with: replacement startingAt: 1!
----- Method: SequenceableCollection>>replaceFrom:to:with:startingAt: (in category 'accessing') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "This destructively replaces elements from start to stop in the receiver 
    starting at index, repStart, in the sequenceable collection, 
    replacementCollection. Answer the receiver. No range checks are 
    performed."
| index repOff |
    repOff := repStart - start.
    index := start - 1.
    [(index := index + 1) <= stop]
    	whileTrue: [self at: index put: (replacement at: repOff + index)]!
----- Method: SequenceableCollection>>reverse (in category 'converting') -----
reverse
    ^ self reversed!
----- Method: SequenceableCollection>>reverseDo: (in category 'enumerating') -----
reverseDo: aBlock
    "Evaluate aBlock with each of the receiver's elements as the argument, 
    starting with the last element and taking each in sequence up to the 
    first. For SequenceableCollections, this is the reverse of the enumeration 
    for do:."
self size to: 1 by: -1 do: [:index | aBlock value: (self at: index)]!
----- Method: SequenceableCollection>>reverseWith:do: (in category 'enumerating') -----
reverseWith: aSequenceableCollection do: aBlock 
    "Evaluate aBlock with each of the receiver's elements, in reverse order, 
    along with the  
    corresponding element, also in reverse order, from 
    aSequencableCollection. "
self size ~= aSequenceableCollection size ifTrue: [^ self errorNoMatch].
    self size
    	to: 1
    	by: -1
    	do: [:index | aBlock value: (self at: index)
    			value: (aSequenceableCollection at: index)]!
----- Method: SequenceableCollection>>reversed (in category 'converting') -----
reversed
    "Answer a copy of the receiver with element order reversed."
    "Example: 'frog' reversed"
| n result src |
    n := self size.
    result := self species new: n.
    src := n + 1.
    1 to: n do: [:i | result at: i put: (self at: (src := src - 1))].
    ^ result
!
----- Method: SequenceableCollection>>second (in category 'accessing') -----
second
    "Answer the second element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 2!
----- Method: SequenceableCollection>>select: (in category 'enumerating') -----
select: aBlock 
    "Refer to the comment in Collection|select:."
    | aStream |
    aStream := WriteStream on: (self species new: self size).
    1 to: self size do: 
    	[:index |
    	(aBlock value: (self at: index))
    		ifTrue: [aStream nextPut: (self at: index)]].
    ^ aStream contents!
----- Method: SequenceableCollection>>seventh (in category 'accessing') -----
seventh
    "Answer the seventh element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 7!
----- Method: SequenceableCollection>>shuffled (in category 'copying') -----
shuffled
    ^ self shuffledBy: Collection randomForPicking
"Examples:
    ($A to: $Z) shuffled
"!
----- Method: SequenceableCollection>>shuffledBy: (in category 'copying') -----
shuffledBy: aRandom
| copy | 
    copy := self copy.
    copy size to: 1 by: -1 do: [ :i | 
    	copy swap: i with: (aRandom nextInt: i) ].
    ^copy!
----- Method: SequenceableCollection>>sixth (in category 'accessing') -----
sixth
    "Answer the sixth element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 6!
----- Method: SequenceableCollection>>sortBy: (in category 'copying') -----
sortBy: aBlock
    "Create a copy that is sorted.  Sort criteria is the block that accepts two arguments.
    When the block is true, the first arg goes first ([:a :b | a > b] sorts in descending
    order)."
^ self asOrderedCollection
    	sort: aBlock;
    	yourself!
----- Method: SequenceableCollection>>swap:with: (in category 'accessing') -----
swap: oneIndex with: anotherIndex 
    "Move the element at oneIndex to anotherIndex, and vice-versa."
| element |
    element := self at: oneIndex.
    self at: oneIndex put: (self at: anotherIndex).
    self at: anotherIndex put: element!
----- Method: SequenceableCollection>>third (in category 'accessing') -----
third
    "Answer the third element of the receiver.
    Raise an error if there are not enough elements."
^ self at: 3!
----- Method: SequenceableCollection>>upTo: (in category 'enumerating') -----
upTo: anObject
    "Deprecated. Use copyUpTo:"
    self deprecated: 'Use #copyUpTo:'.
    ^ self copyUpTo: anObject!
----- Method: SequenceableCollection>>with:collect: (in category 'enumerating') -----
with: otherCollection collect: twoArgBlock 
    "Collect and return the result of evaluating twoArgBlock with corresponding elements from this collection and otherCollection."
    | result |
    otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size'].
    result := self species new: self size.
    1 to: self size do:
    	[:index | result at: index put:
    	(twoArgBlock
    		value: (self at: index)
    		value: (otherCollection at: index))].
    ^ result!
----- Method: SequenceableCollection>>with:do: (in category 'enumerating') -----
with: otherCollection do: twoArgBlock 
    "Evaluate twoArgBlock with corresponding elements from this collection and otherCollection."
    otherCollection size = self size ifFalse: [self error: 'otherCollection must be the same size'].
    1 to: self size do:
    	[:index |
    	twoArgBlock value: (self at: index)
    			value: (otherCollection at: index)]!
----- Method: SequenceableCollection>>withIndexCollect: (in category 'enumerating') -----
withIndexCollect: elementAndIndexBlock 
    "Just like with:collect: except that the iteration index supplies the second argument to the block."
    | result |
    result := self species new: self size.
    1 to: self size do:
    	[:index | result at: index put:
    	(elementAndIndexBlock
    		value: (self at: index)
    		value: index)].
    ^ result!
----- Method: SequenceableCollection>>withIndexDo: (in category 'enumerating') -----
withIndexDo: elementAndIndexBlock 
    "Just like with:do: except that the iteration index supplies the second argument to the block."
    1 to: self size do:
    	[:index |
    	elementAndIndexBlock
    		value: (self at: index)
    		value: index]!
----- Method: SequenceableCollection>>writeStream (in category 'converting') -----
writeStream
    ^ WriteStream on: self!
Collection subclass: #Set
    instanceVariableNames: 'tally array'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!Set commentStamp: '<historical>' prior: 0!
I represent a set of objects without duplicates.  I can hold anything that responds to
#hash and #=, except for nil.  My instances will automatically grow, if necessary,
Note that I rely on #=, not #==.  If you want a set using #==, use IdentitySet.
Instance structure:
array	An array whose non-nil elements are the elements of the set,
    	and whose nil elements are empty slots.  There is always at least one nil.
    	In fact I try to keep my "load" at 75% or less so that hashing will work well.
tally	The number of elements in the set.  The array size is always greater than this.
The core operation is #findElementOrNil:, which either finds the position where an
object is stored in array, if it is present, or finds a suitable position holding nil, if
its argument is not present in array,!
Set subclass: #Dictionary
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!Dictionary commentStamp: '<historical>' prior: 0!
I represent a set of elements that can be viewed from one of two perspectives: a set of associations, or a container of values that are externally named where the name can be any object that responds to =. The external name is referred to as the key.  I inherit many operations from Set.!
----- Method: Dictionary class>>newFrom: (in category 'instance creation') -----
newFrom: aDict 
    "Answer an instance of me containing the same associations as aDict.
     Error if any key appears twice."
    | newDictionary |
    newDictionary := self new: aDict size.
    aDict associationsDo:
    	[:x |
    	(newDictionary includesKey: x key)
    		ifTrue: [self error: 'Duplicate key: ', x key printString]
    		ifFalse: [newDictionary add: x]].
    ^ newDictionary
"	NewDictionary newFrom: {1->#a. 2->#b. 3->#c}
    {1->#a. 2->#b. 3->#c} as: NewDictionary
    NewDictionary newFrom: {1->#a. 2->#b. 1->#c}
    {1->#a. 2->#b. 1->#c} as: NewDictionary
"!
----- Method: Dictionary class>>newFromPairs: (in category 'instance creation') -----
newFromPairs: anArray
"Answer an instance of me associating (anArray at:i) to (anArray at: i+i)
     for each odd i.  anArray must have an even number of entries."
| newDictionary |
newDictionary := self new: (anArray size/2).
    1 to: (anArray size-1) by: 2 do: [ :i|
    	newDictionary at: (anArray at: i) put: (anArray at: i+1).
    ].
    ^ newDictionary
"  Dictionary newFromPairs: {'Red' . Color red . 'Blue' . Color blue . 'Green' . Color green}. "!
----- Method: Dictionary>>= (in category 'comparing') -----
= aDictionary
    "Two dictionaries are equal if
     (a) they are the same 'kind' of thing.
     (b) they have the same set of keys.
     (c) for each (common) key, they have the same value"
self == aDictionary ifTrue: [ ^ true ].
    (aDictionary isKindOf: Dictionary) ifFalse: [^false].
    self size = aDictionary size ifFalse: [^false].
    self associationsDo: [:assoc|
    	(aDictionary at: assoc key ifAbsent: [^false]) = assoc value
    		ifFalse: [^false]].
    ^true
!
----- Method: Dictionary>>add: (in category 'adding') -----
add: anAssociation
    | index element |
    index := self scanFor: anAssociation key.
    element := array at: index.
    element == nil
    	ifTrue: [self atNewIndex: index put: anAssociation]
    	ifFalse: [element value: anAssociation value].
    ^ anAssociation!
----- Method: Dictionary>>addAll: (in category 'adding') -----
addAll: aKeyedCollection
    aKeyedCollection == self ifFalse: [
    	aKeyedCollection keysAndValuesDo: [:key :value |
    		self at: key put: value]].
    ^aKeyedCollection!
----- Method: Dictionary>>asSet (in category 'converting') -----
asSet
    "Though implemented as a subclass of Set for conveniency, a Dictionary is not a Set.
    It has to be converted, like super super implementation."
    
    ^Set withAll: self!
----- Method: Dictionary>>associationAt: (in category 'accessing') -----
associationAt: key 
    ^ self associationAt: key ifAbsent: [self errorKeyNotFound]!
----- Method: Dictionary>>associationAt:ifAbsent: (in category 'accessing') -----
associationAt: key ifAbsent: aBlock 
    "Answer the association with the given key.
    If key is not found, return the result of evaluating aBlock."
| index assoc |
    index := self scanFor: key.
    assoc := array at: index.
    nil == assoc ifTrue: [ ^ aBlock value ].
    ^ assoc!
----- Method: Dictionary>>associationDeclareAt: (in category 'accessing') -----
associationDeclareAt: aKey
    "Return an existing association, or create and return a new one.  Needed as a single message by ImageSegment.prepareToBeSaved."
| existing |
    ^ self associationAt: aKey ifAbsent: [
    	(Undeclared includesKey: aKey)
    		ifTrue: 
    			[existing := Undeclared associationAt: aKey.
    			Undeclared removeKey: aKey.
    			self add: existing]
    		ifFalse: 
    			[self add: aKey -> false]]!
----- Method: Dictionary>>associations (in category 'accessing') -----
associations
    "Answer a Collection containing the receiver's associations."
    
    ^Array new: self size streamContents: [ :stream |
    	self associationsDo: [ :each | stream nextPut: each ] ]!
----- Method: Dictionary>>associationsDo: (in category 'enumerating') -----
associationsDo: aBlock 
    "Evaluate aBlock for each of the receiver's elements (key/value 
    associations)."
super do: aBlock!
----- Method: Dictionary>>associationsSelect: (in category 'enumerating') -----
associationsSelect: aBlock 
    "Evaluate aBlock with each of my associations as the argument. Collect
    into a new dictionary, only those associations for which aBlock evaluates
    to true."
| newCollection |
    newCollection := self species new.
    self associationsDo: 
    	[:each | 
    	(aBlock value: each) ifTrue: [newCollection add: each]].
    ^newCollection!
----- Method: Dictionary>>at: (in category 'accessing') -----
at: key 
    "Answer the value associated with the key."
^ self at: key ifAbsent: [self errorKeyNotFound]!
----- Method: Dictionary>>at:ifAbsent: (in category 'accessing') -----
at: key ifAbsent: aBlock 
    "Answer the value associated with the key or, if key isn't found,
    answer the result of evaluating aBlock."
| assoc |
    assoc := array at: (self scanFor: key).
    assoc ifNil: [^ aBlock value].
    ^ assoc value!
----- Method: Dictionary>>at:ifAbsentPut: (in category 'accessing') -----
at: key ifAbsentPut: aBlock 
    "Return the value at the given key. 
    If key is not included in the receiver store the result 
    of evaluating aBlock as new value."
^ self at: key ifAbsent: [self at: key put: aBlock value]!
----- Method: Dictionary>>at:ifPresent: (in category 'accessing') -----
at: key ifPresent: aBlock
    "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."
| v |
    v := self at: key ifAbsent: [^ nil].
    ^ aBlock value: v
!
----- Method: Dictionary>>at:ifPresentAndInMemory: (in category 'accessing') -----
at: key ifPresentAndInMemory: aBlock
    "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."
| v |
    v := self at: key ifAbsent: [^ nil].
    v isInMemory ifFalse: [^ nil].
    ^ aBlock value: v
!
----- Method: Dictionary>>at:put: (in category 'accessing') -----
at: key put: anObject 
    "Set the value at key to be anObject.  If key is not found, create a
    new entry for key and set is value to anObject. Answer anObject."
| index assoc |
    index := self scanFor: key.
    assoc := array at: index.
    assoc
    	ifNil: [self atNewIndex: index put: (Association key: key value: anObject)]
    	ifNotNil: [assoc value: anObject].
    ^ anObject!
----- Method: Dictionary>>collect: (in category 'enumerating') -----
collect: aBlock 
    "Evaluate aBlock with each of my values as the argument.  Collect the resulting values into a collection that is like me. Answer with the new collection."
    
    | newCollection |
    newCollection := self species new: self size.
    self associationsDo: [ :each |
    	newCollection at: each key put: (aBlock value: each value) ].
    ^newCollection!
----- Method: Dictionary>>declare:from: (in category 'adding') -----
declare: key from: aDictionary 
    "Add key to the receiver. If key already exists, do nothing. If aDictionary 
    includes key, then remove it from aDictionary and use its association as 
    the element of the receiver."
(self includesKey: key) ifTrue: [^ self].
    (aDictionary includesKey: key)
    	ifTrue: 
    		[self add: (aDictionary associationAt: key).
    		aDictionary removeKey: key]
    	ifFalse: 
    		[self add: key -> nil]!
----- Method: Dictionary>>do: (in category 'enumerating') -----
do: aBlock
super do: [:assoc | aBlock value: assoc value]!
----- Method: Dictionary>>errorKeyNotFound (in category 'private') -----
errorKeyNotFound
self error: 'key not found'!
----- Method: Dictionary>>errorValueNotFound (in category 'private') -----
errorValueNotFound
self error: 'value not found'!
----- Method: Dictionary>>explorerContents (in category 'user interface') -----
explorerContents
| contents |
    
    contents := OrderedCollection new.
    self keysSortedSafely do: [:key |
    	contents add: (ObjectExplorerWrapper
    		with: (self at: key)
    		name: (key printString contractTo: 32)
    		model: self)].
    ^contents
!
----- Method: Dictionary>>flattenOnStream: (in category 'printing') -----
flattenOnStream:aStream
    ^aStream writeDictionary:self.
!
----- Method: Dictionary>>hasBindingThatBeginsWith: (in category 'testing') -----
hasBindingThatBeginsWith: aString
    "Answer true if the receiver has a key that begins with aString, false otherwise"
    
    self keysDo:[:each | 
    	(each beginsWith: aString)
    		ifTrue:[^true]].
    ^false!
----- Method: Dictionary>>hasContentsInExplorer (in category 'testing') -----
hasContentsInExplorer
^self isEmpty not!
----- Method: Dictionary>>includes: (in category 'testing') -----
includes: anObject
self do: [:each | anObject = each ifTrue: [^true]].
    ^false!
----- Method: Dictionary>>includesAssociation: (in category 'testing') -----
includesAssociation: anAssociation
  ^ (self   
      associationAt: anAssociation key
      ifAbsent: [ ^ false ]) value = anAssociation value
!
----- Method: Dictionary>>includesIdentity: (in category 'testing') -----
includesIdentity: anObject
    "Answer whether anObject is one of the values of the receiver.  Contrast #includes: in which there is only an equality check, here there is an identity check"
self do: [:each | anObject == each ifTrue: [^ true]].
    ^ false!
----- Method: Dictionary>>includesKey: (in category 'testing') -----
includesKey: key 
    "Answer whether the receiver has a key equal to the argument, key."
    
    self at: key ifAbsent: [^false].
    ^true!
----- Method: Dictionary>>isDictionary (in category 'testing') -----
isDictionary
    ^true!
----- Method: Dictionary>>keyAt: (in category 'private') -----
keyAt: index
    "May be overridden by subclasses so that fixCollisions will work"
    | assn |
    assn := array at: index.
    assn == nil ifTrue: [^ nil]
    			ifFalse: [^ assn key]!
----- Method: Dictionary>>keyAtIdentityValue: (in category 'accessing') -----
keyAtIdentityValue: value 
    "Answer the key that is the external name for the argument, value. If 
    there is none, answer nil.
    Note: There can be multiple keys with the same value. Only one is returned."
^self keyAtIdentityValue: value ifAbsent: [self errorValueNotFound]!
----- Method: Dictionary>>keyAtIdentityValue:ifAbsent: (in category 'accessing') -----
keyAtIdentityValue: value ifAbsent: exceptionBlock
    "Answer the key that is the external name for the argument, value. If 
    there is none, answer the result of evaluating exceptionBlock.
    Note: There can be multiple keys with the same value. Only one is returned."
self associationsDo: 
    	[:association | value == association value ifTrue: [^association key]].
    ^exceptionBlock value!
----- Method: Dictionary>>keyAtValue: (in category 'accessing') -----
keyAtValue: value 
    "Answer the key that is the external name for the argument, value. If 
    there is none, answer nil."
^self keyAtValue: value ifAbsent: [self errorValueNotFound]!
----- Method: Dictionary>>keyAtValue:ifAbsent: (in category 'accessing') -----
keyAtValue: value ifAbsent: exceptionBlock
    "Answer the key that is the external name for the argument, value. If 
    there is none, answer the result of evaluating exceptionBlock.
    : Use =, not ==, so stings like 'this' can be found.  Note that MethodDictionary continues to use == so it will be fast."
self associationsDo: 
    	[:association | value = association value ifTrue: [^association key]].
    ^exceptionBlock value!
----- Method: Dictionary>>keyForIdentity: (in category 'testing') -----
keyForIdentity: anObject
    "If anObject is one of the values of the receive, return its key, else return nil.  Contrast #keyAtValue: in which there is only an equality check, here there is an identity check"
self associationsDo: [:assoc | assoc value == anObject ifTrue: [^ assoc key]].
    ^ nil!
----- Method: Dictionary>>keys (in category 'accessing') -----
keys
    "Answer a Set containing the receiver's keys."
    | aSet |
    aSet := Set new: self size.
    self keysDo: [:key | aSet add: key].
    ^ aSet!
----- Method: Dictionary>>keysAndValuesDo: (in category 'enumerating') -----
keysAndValuesDo: aBlock
    ^self associationsDo:[:assoc|
    	aBlock value: assoc key value: assoc value].!
----- Method: Dictionary>>keysAndValuesRemove: (in category 'removing') -----
keysAndValuesRemove: keyValueBlock
    "Removes all entries for which keyValueBlock returns true."
    "When removing many items, you must not do it while iterating over the dictionary, since it may be changing.  This method takes care of tallying the removals in a first pass, and then performing all the deletions afterward.  Many places in the sytem could be simplified by using this method."
| removals |
    removals := OrderedCollection new.
    self associationsDo:
    	[:assoc | (keyValueBlock value: assoc key value: assoc value)
    		ifTrue: [removals add: assoc key]].
    removals do:
    	[:aKey | self removeKey: aKey]!
----- Method: Dictionary>>keysDo: (in category 'enumerating') -----
keysDo: aBlock 
    "Evaluate aBlock for each of the receiver's keys."
self associationsDo: [:association | aBlock value: association key]!
----- Method: Dictionary>>keysSortedSafely (in category 'accessing') -----
keysSortedSafely
    "Answer an Array containing the receiver's keys."
    
    | sortedKeys |
    sortedKeys := Array new: self size streamContents: [ :stream |
    	self keysDo: [ :each | stream nextPut: each ] ].
    sortedKeys sort: [ :x :y |
    	"Should really be use <obj, string, num> compareSafely..."
    	((x isString and: [ y isString ])
    		or: [ x isNumber and: [ y isNumber ] ])
    		ifTrue: [ x < y ]
    		ifFalse: [ x class == y class
    			ifTrue: [ x printString < y printString ]
    			ifFalse: [ x class name < y class name ] ] ].
    ^sortedKeys!
----- Method: Dictionary>>noCheckAdd: (in category 'private') -----
noCheckAdd: anObject
    "Must be defined separately for Dictionary because (self scanFor:) expects a key,
    not an association.  9/7/96 tk"
self deprecated: 'This method should not be used anymore.'.
    array at: (self scanFor: anObject key) put: anObject.
    tally := tally + 1!
----- Method: Dictionary>>noCheckNoGrowFillFrom: (in category 'private') -----
noCheckNoGrowFillFrom: anArray
    "Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
1 to: anArray size do: [ :index |
    	| object |
    	(object := anArray at: index) ifNotNil: [
    		array
    			at: (self scanForEmptySlotFor: object key)
    			put: object ] ]!
----- Method: Dictionary>>occurrencesOf: (in category 'testing') -----
occurrencesOf: anObject 
    "Answer how many of the receiver's elements are equal to anObject."
| count |
    count := 0.
    self do: [:each | anObject = each ifTrue: [count := count + 1]].
    ^count!
----- Method: Dictionary>>postCopy (in category 'copying') -----
postCopy
    "Must copy the associations, or later store will affect both the
original and the copy"
array := array collect: [ :association |
    	association ifNotNil: [ association copy ] ]!
----- Method: Dictionary>>printElementsOn: (in category 'printing') -----
printElementsOn: aStream 
    aStream nextPut: $(.
    self size > 100
    	ifTrue: [aStream nextPutAll: 'size '.
    		self size printOn: aStream]
    	ifFalse: [self keysSortedSafely
    			do: [:key | aStream print: key;
    					 nextPutAll: '->';				
    					 print: (self at: key);
    					 space]].
    aStream nextPut: $)!
----- Method: Dictionary>>remove: (in category 'removing') -----
remove: anObject
self shouldNotImplement!
----- Method: Dictionary>>remove:ifAbsent: (in category 'removing') -----
remove: anObject ifAbsent: exceptionBlock
self shouldNotImplement!
----- Method: Dictionary>>removeKey: (in category 'removing') -----
removeKey: key 
    "Remove key from the receiver.
    If key is not in the receiver, notify an error."
^ self removeKey: key ifAbsent: [self errorKeyNotFound]!
----- Method: Dictionary>>removeKey:ifAbsent: (in category 'removing') -----
removeKey: key ifAbsent: aBlock 
    "Remove key (and its associated value) from the receiver. If key is not in 
    the receiver, answer the result of evaluating aBlock. Otherwise, answer 
    the value externally named by key."
| index association |
    index := self scanFor: key.
    (association := array at: index) ifNil: [ ^ aBlock value ].
    array at: index put: nil.
    tally := tally - 1.
    self fixCollisionsFrom: index.
    ^association value!
----- Method: Dictionary>>removeUnreferencedKeys (in category 'removing') -----
removeUnreferencedKeys   "Undeclared removeUnreferencedKeys"
^ self unreferencedKeys do: [:key | self removeKey: key].!
----- Method: Dictionary>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start |
    index := start := anObject hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ element key = anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: Dictionary>>select: (in category 'enumerating') -----
select: aBlock 
    "Evaluate aBlock with each of my values as the argument. Collect into a new dictionary, only those associations for which aBlock evaluates to true."
| newCollection |
    newCollection := self copyEmpty.
    self associationsDo: [ :each |
    	(aBlock value: each value) ifTrue: [
    		newCollection add: each copy ] ].
    ^newCollection!
----- Method: Dictionary>>storeOn: (in category 'printing') -----
storeOn: aStream
    | noneYet |
    aStream nextPutAll: '(('.
    aStream nextPutAll: self class name.
    aStream nextPutAll: ' new)'.
    noneYet := true.
    self associationsDo: 
    		[:each | 
    		noneYet
    			ifTrue: [noneYet := false]
    			ifFalse: [aStream nextPut: $;].
    		aStream nextPutAll: ' add: '.
    		aStream store: each].
    noneYet ifFalse: [aStream nextPutAll: '; yourself'].
    aStream nextPut: $)!
----- Method: Dictionary>>unreferencedKeys (in category 'removing') -----
unreferencedKeys
    "TextConstants unreferencedKeys"
| n |
    ^'Scanning for references . . .' 
    	displayProgressAt: Sensor cursorPoint
    	from: 0
    	to: self size
    	during: 
    		[:bar | 
    		n := 0.
    		self keys select: 
    				[:key | 
    				bar value: (n := n + 1).
    				(self systemNavigation allCallsOn: (self associationAt: key)) isEmpty]]!
----- Method: Dictionary>>valueAtNewKey:put:atIndex:declareFrom: (in category 'private') -----
valueAtNewKey: aKey put: anObject atIndex: index declareFrom: aDictionary 
    "Support for coordinating class variable and global declarations
    with variables that have been put in Undeclared so as to
    redirect all references to the undeclared variable."
(aDictionary includesKey: aKey)
    	ifTrue: 
    		[self atNewIndex: index 
    			put: ((aDictionary associationAt: aKey) value: anObject).
    		aDictionary removeKey: aKey]
    	ifFalse: 
    		[self atNewIndex: index put: (Association key: aKey value: anObject)]!
----- Method: Dictionary>>values (in category 'accessing') -----
values
    "Answer a Collection containing the receiver's values."
^Array new: self size streamContents: [ :stream |
    	self valuesDo: [ :value | stream nextPut: value] ]!
----- Method: Dictionary>>valuesDo: (in category 'enumerating') -----
valuesDo: aBlock 
    "Evaluate aBlock for each of the receiver's values."
self associationsDo: [:association | aBlock value: association value]!
Dictionary subclass: #IdentityDictionary
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!IdentityDictionary commentStamp: 'ls 06/15/02 22:35' prior: 0!
Like a Dictionary, except that keys are compared with #== instead of #= .
See the comment of IdentitySet for more information.!
----- Method: IdentityDictionary>>fasterKeys (in category 'private') -----
fasterKeys
    "This was taking some time in publishing and we didn't really need a Set"
    | answer index |
    answer := Array new: self size.
    index := 0.
    self keysDo: [:key | answer at: (index := index + 1) put: key].
    ^ answer!
----- Method: IdentityDictionary>>keyAtValue:ifAbsent: (in category 'private') -----
keyAtValue: value ifAbsent: exceptionBlock
    "Answer the key that is the external name for the argument, value. If 
    there is none, answer the result of evaluating exceptionBlock."
self associationsDo: 
    	[:association | value == association value ifTrue: [^ association key]].
    ^ exceptionBlock value!
----- Method: IdentityDictionary>>keys (in category 'private') -----
keys
    "Answer a Set containing the receiver's keys."
    | aSet |
    aSet := IdentitySet new: self size.
    self keysDo: [:key | aSet add: key].
    ^ aSet!
----- Method: IdentityDictionary>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ element key == anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: IdentityDictionary>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
Dictionary subclass: #PluggableDictionary
    instanceVariableNames: 'hashBlock equalBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!PluggableDictionary commentStamp: '<historical>' prior: 0!
Class PluggableDictionary allows the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the dictionary. See the class comment of PluggableSet for an example.
Instance variables:
    hashBlock	<BlockContext>	A one argument block used for hashing the elements.
    equalBlock	<BlockContext>	A two argument block used for comparing the elements.
!
----- Method: PluggableDictionary class>>integerDictionary (in category 'as yet unclassified') -----
integerDictionary
    ^ self new hashBlock: [:integer | integer hash \ 1064164 * 1009]!
----- Method: PluggableDictionary>>copyEmpty (in category 'copying') -----
copyEmpty
    ^super copyEmpty
    	hashBlock: hashBlock;
    	equalBlock: equalBlock!
----- Method: PluggableDictionary>>equalBlock (in category 'accessing') -----
equalBlock
    "Return the block used for comparing the elements in the receiver."
    ^equalBlock!
----- Method: PluggableDictionary>>equalBlock: (in category 'accessing') -----
equalBlock: aBlock
    "Set a new equality block. The block must accept two arguments and return true if the argumets are considered to be equal, false otherwise"
    equalBlock := aBlock.!
----- Method: PluggableDictionary>>hashBlock (in category 'accessing') -----
hashBlock
    "Return the block used for hashing the elements in the receiver."
    ^hashBlock!
----- Method: PluggableDictionary>>hashBlock: (in category 'accessing') -----
hashBlock: aBlock
    "Set a new hash block. The block must accept one argument and must return the hash value of the given argument."
    hashBlock := aBlock.!
----- Method: PluggableDictionary>>keys (in category 'accessing') -----
keys
    "Answer a Set containing the receiver's keys."
    | aSet |
    aSet := PluggableSet new: self size.
    self equalBlock ifNotNil: [aSet equalBlock: self equalBlock fixTemps].
    self hashBlock ifNotNil: [aSet hashBlock: self hashBlock fixTemps].
    self keysDo: [:key | aSet add: key].
    ^ aSet!
----- Method: PluggableDictionary>>scanFor: (in category 'private') -----
scanFor: anObject 
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start |
    index := start := (hashBlock
    	ifNil: [ anObject hash ]
    	ifNotNil: [ hashBlock value: anObject ]) \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [
    		equalBlock
    			ifNil: [ element key = anObject ]
    			ifNotNil: [ equalBlock value: element key value: anObject ] ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: PluggableDictionary>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start |
    index := start := (hashBlock
    	ifNil: [ anObject hash ]
    	ifNotNil: [ hashBlock value: anObject ]) \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
Dictionary subclass: #WeakKeyDictionary
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Weak'!
!WeakKeyDictionary commentStamp: '<historical>' prior: 0!
I am a dictionary holding only weakly on my keys. This is a bit dangerous since at any time my keys can go away. Clients are responsible to register my instances by WeakArray such that the appropriate actions can be taken upon loss of any keys.
See WeakRegistry for an example of use.
!
WeakKeyDictionary subclass: #WeakIdentityKeyDictionary
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Weak'!
!WeakIdentityKeyDictionary commentStamp: '<historical>' prior: 0!
This class represents an identity dictionary with weak keys.!
----- Method: WeakIdentityKeyDictionary>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ element key == anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: WeakIdentityKeyDictionary>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
WeakIdentityKeyDictionary subclass: #WeakKeyToCollectionDictionary
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Weak'!
!WeakKeyToCollectionDictionary commentStamp: '<historical>' prior: 0!
This class represents an identity dictionary with weak keys, whose values are collections. 
Keys not in the dictionary are mapped to the empty collection.  Conversely, if a collection becomes empty, the mapping can be removed to save time and space.  However, because this requires re-hashing, it does not pay to do this to eagerly.!
----- Method: WeakKeyToCollectionDictionary>>finalizeValues (in category 'as yet unclassified') -----
finalizeValues 
    self rehash!
----- Method: WeakKeyToCollectionDictionary>>noCheckNoGrowFillFrom: (in category 'as yet unclassified') -----
noCheckNoGrowFillFrom: anArray
    "Add the elements of anArray except nils and associations with empty collections (or with only nils) to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
tally := 0.
    1 to: anArray size do:[ :i |
    	| association cleanedValue |
    	((association := anArray at: i) == nil or: [ 
    		(cleanedValue := association value copyWithout: nil) isEmpty ]) 
    			ifFalse: [
    				association value: cleanedValue.
    				array
    					at: (self scanForEmptySlotFor: association key)
    					put: association.
    				tally := tally + 1 ] ]!
----- Method: WeakKeyDictionary>>add: (in category 'adding') -----
add: anAssociation
    self at: anAssociation key put: anAssociation value.
    ^ anAssociation!
----- Method: WeakKeyDictionary>>at:put: (in category 'accessing') -----
at: key put: anObject 
    "Set the value at key to be anObject.  If key is not found, create a new
    entry for key and set is value to anObject. Answer anObject."
    | index element |
    key isNil ifTrue:[^anObject].
    index := self scanFor: key.
    element := array at: index.
    element == nil
    	ifTrue: [self atNewIndex: index put: (WeakKeyAssociation key: key value: anObject)]
    	ifFalse: [element value: anObject].
    ^ anObject!
----- Method: WeakKeyDictionary>>finalizeValues (in category 'finalization') -----
finalizeValues
    "remove all nil keys and rehash the receiver afterwards"
    | assoc |
    1 to: array size do:[:i|
    	assoc := array at: i.
    	(assoc notNil and:[assoc key == nil]) ifTrue:[array at: i put: nil].
    ].
    self rehash.!
----- Method: WeakKeyDictionary>>finalizeValues: (in category 'finalization') -----
finalizeValues: finiObjects
    "Remove all associations with key == nil and value is in finiObjects.
    This method is folded with #rehash for efficiency."
    
    | oldArray |
    oldArray := array.
    array := Array new: oldArray size.
    tally := 0.
    1 to: array size do:[ :i |
    	| association |
    	(association := oldArray at: i) ifNotNil: [
    		(association key == nil and: [ finiObjects includes: association value ])
    			ifFalse:[
    				array 
    					at: (self scanForEmptySlotFor: association key) 
    					put: association ] ] ]!
----- Method: WeakKeyDictionary>>fixCollisionsFrom: (in category 'private') -----
fixCollisionsFrom: oldIndex
    "The element at index has been removed and replaced by nil."
    self rehash. "Do it the hard way - we may have any number of nil keys and #rehash deals with them"!
----- Method: WeakKeyDictionary>>keysDo: (in category 'accessing') -----
keysDo: aBlock 
    "Evaluate aBlock for each of the receiver's keys."
    
    self associationsDo: [ :association |
    	| key |
    	(key := association key) ifNotNil: [
    		aBlock value: key ] ].!
----- Method: WeakKeyDictionary>>noCheckNoGrowFillFrom: (in category 'private') -----
noCheckNoGrowFillFrom: anArray
    "Add the elements of anArray except nils and flag to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
tally := 0.
    1 to: anArray size do:[ :i |
    	| association |
    	(association := anArray at: i) ifNotNil: [
    		array
    			at: (self scanForEmptySlotFor: association key)
    			put: association.
    		tally := tally + 1 ] ]!
Dictionary subclass: #WeakValueDictionary
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Weak'!
!WeakValueDictionary commentStamp: '<historical>' prior: 0!
I am a dictionary holding only weakly on my values. Clients may expect to get a nil value for any object they request.!
----- Method: WeakValueDictionary>>add: (in category 'adding') -----
add: anAssociation
    self at: anAssociation key put: anAssociation value.
    ^ anAssociation!
----- Method: WeakValueDictionary>>at:put: (in category 'accessing') -----
at: key put: anObject 
    "Set the value at key to be anObject.  If key is not found, create a new
    entry for key and set is value to anObject. Answer anObject."
    | index element |
    index := self scanFor: key.
    element := array at: index.
    element == nil
    	ifTrue: [self atNewIndex: index put: (WeakValueAssociation key: key value: anObject)]
    	ifFalse: [element value: anObject].
    ^ anObject!
Set subclass: #IdentitySet
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!IdentitySet commentStamp: 'sw 1/14/2003 22:35' prior: 0!
The same as a Set, except that items are compared using #== instead of #=.
Almost any class named IdentityFoo is the same as Foo except for the way items are compared.  In Foo, #= is used, while in IdentityFoo, #== is used.  That is, identity collections will treat items as the same only if they have the same identity.
For example, note that copies of a string are equal:
('abc' copy) = ('abc' copy)
but they are not identitcal:
('abc' copy) == ('abc' copy)
A regular Set will only include equal objects once:
| aSet |
    aSet := Set new.
    aSet add: 'abc' copy.
    aSet add: 'abc' copy.
    aSet
An IdentitySet will include multiple equal objects if they are not identical:
| aSet |
    aSet := IdentitySet new.
    aSet add: 'abc' copy.
    aSet add: 'abc' copy.
    aSet
!
----- Method: IdentitySet>>asIdentitySet (in category 'converting') -----
asIdentitySet
    ^self!
----- Method: IdentitySet>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ element == anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: IdentitySet>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
Set subclass: #KeyedSet
    instanceVariableNames: 'keyBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!KeyedSet commentStamp: '<historical>' prior: 0!
Like Set except a key of every element is used for hashing and searching instead of the element itself.  keyBlock gets the key of an element.!
KeyedSet subclass: #KeyedIdentitySet
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
----- Method: KeyedIdentitySet>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ (keyBlock value: element) == anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: KeyedIdentitySet>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start hash |
    array size > 4096
    	ifTrue: [ hash := anObject identityHash * (array size // 4096) ]
    	ifFalse: [ hash := anObject identityHash ].
    index := start := hash \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: KeyedSet class>>keyBlock: (in category 'instance creation') -----
keyBlock: oneArgBlock
    "Create a new KeySet whose way to access an element's key is by executing oneArgBlock on the element"
^ self new keyBlock: oneArgBlock!
----- Method: KeyedSet>>add: (in category 'adding') -----
add: newObject
    "Include newObject as one of the receiver's elements, but only if
    not already present. Answer newObject."
| index |
    newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
    index := self scanFor: (keyBlock value: newObject).
    (array at: index) ifNil: [self atNewIndex: index put: newObject].
    ^ newObject!
----- Method: KeyedSet>>addAll: (in category 'adding') -----
addAll: aCollection 
    "Include all the elements of aCollection as the receiver's elements"
(aCollection respondsTo: #associationsDo:)
    	ifTrue: [aCollection associationsDo: [:ass | self add: ass]]
    	ifFalse: [aCollection do: [:each | self add: each]].
    ^ aCollection!
----- Method: KeyedSet>>at: (in category 'accessing') -----
at: key 
    "Answer the value associated with the key."
^ self at: key ifAbsent: [self errorKeyNotFound]!
----- Method: KeyedSet>>at:ifAbsent: (in category 'accessing') -----
at: key ifAbsent: aBlock 
    "Answer the value associated with the key or, if key isn't found,
    answer the result of evaluating aBlock."
| obj |
    obj := array at: (self scanFor: key).
    obj ifNil: [^ aBlock value].
    ^ obj!
----- Method: KeyedSet>>at:ifAbsentPut: (in category 'accessing') -----
at: key ifAbsentPut: aBlock 
    "Answer the value associated with the key or, if key isn't found,
    add the result of evaluating aBlock to self"
^ self at: key ifAbsent: [self add: aBlock value]!
----- Method: KeyedSet>>at:ifPresent: (in category 'accessing') -----
at: key ifPresent: aBlock
    "Lookup the given key in the receiver. If it is present, answer the value of evaluating the given block with the value associated with the key. Otherwise, answer nil."
| v |
    v := self at: key ifAbsent: [^ nil].
    ^ aBlock value: v
!
----- Method: KeyedSet>>copyEmpty (in category 'copying') -----
copyEmpty
    ^super copyEmpty
    	keyBlock: keyBlock!
----- Method: KeyedSet>>errorKeyNotFound (in category 'private') -----
errorKeyNotFound
self error: 'key not found'!
----- Method: KeyedSet>>includes: (in category 'testing') -----
includes: anObject 
    ^ (array at: (self scanFor: (keyBlock value: anObject))) ~~ nil!
----- Method: KeyedSet>>includesKey: (in category 'testing') -----
includesKey: key
^ (array at: (self scanFor: key)) ~~ nil!
----- Method: KeyedSet>>initialize: (in category 'private') -----
initialize: n
    super initialize: n.
    keyBlock := [:element | element key].
!
----- Method: KeyedSet>>keyAt: (in category 'private') -----
keyAt: index
    
    ^keyBlock value: (array at: index)!
----- Method: KeyedSet>>keyBlock: (in category 'initialize') -----
keyBlock: oneArgBlock
    "When evaluated return the key of the argument which will be an element of the set"
keyBlock := oneArgBlock!
----- Method: KeyedSet>>keys (in category 'accessing') -----
keys
| keys |
    keys := Set new.
    self keysDo: [:key | keys add: key].
    ^ keys!
----- Method: KeyedSet>>keysDo: (in category 'accessing') -----
keysDo: block
self do: [:item | block value: (keyBlock value: item)]!
----- Method: KeyedSet>>keysSorted (in category 'accessing') -----
keysSorted
| keys |
    keys := SortedCollection new.
    self do: [:item | keys add: (keyBlock value: item)].
    ^ keys!
----- Method: KeyedSet>>member: (in category 'adding') -----
member: newObject
    "Include newObject as one of the receiver's elements, if already exists just return it"
| index |
    newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
    index := self scanFor: (keyBlock value: newObject).
    (array at: index) ifNotNil: [^ array at: index].
    self atNewIndex: index put: newObject.
    ^ newObject!
----- Method: KeyedSet>>noCheckAdd: (in category 'private') -----
noCheckAdd: anObject
self deprecated: 'This method should not be used anymore.'.
    array at: (self scanFor: (keyBlock value: anObject)) put: anObject.
    tally := tally + 1!
----- Method: KeyedSet>>noCheckNoGrowFillFrom: (in category 'private') -----
noCheckNoGrowFillFrom: anArray
    "Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
1 to: anArray size do: [ :index |
    	| object |
    	(object := anArray at: index) ifNotNil: [
    		array
    			at: (self scanForEmptySlotFor: (keyBlock value: object))
    			put: object ] ]!
----- Method: KeyedSet>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: aBlock
| index |
    index := self scanFor: (keyBlock value: oldObject).
    (array at: index) == nil ifTrue: [ ^ aBlock value ].
    array at: index put: nil.
    tally := tally - 1.
    self fixCollisionsFrom: index.
    ^ oldObject!
----- Method: KeyedSet>>removeAll (in category 'removing') -----
removeAll
    "See super."
    
    | tmp |
    tmp := keyBlock.
    super removeAll.
    keyBlock := tmp!
----- Method: KeyedSet>>removeKey: (in category 'removing') -----
removeKey: key
^ self removeKey: key ifAbsent: [self errorKeyNotFound]!
----- Method: KeyedSet>>removeKey:ifAbsent: (in category 'removing') -----
removeKey: key ifAbsent: aBlock
| index obj |
    index := self scanFor: key.
    (obj := array at: index) == nil ifTrue: [ ^ aBlock value ].
    array at: index put: nil.
    tally := tally - 1.
    self fixCollisionsFrom: index.
    ^ obj!
----- Method: KeyedSet>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start |
    index := start := anObject hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ (keyBlock value: element) = anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
Set subclass: #PluggableSet
    instanceVariableNames: 'hashBlock equalBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Unordered'!
!PluggableSet commentStamp: '<historical>' prior: 0!
PluggableSets allow the redefinition of hashing and equality by clients. This is in particular useful if the clients know about specific properties of the objects stored in the set which in turn can heavily improve the performance of sets and dictionaries.
Instance variables:
    hashBlock	<BlockContext>	A one argument block used for hashing the elements.
    equalBlock	<BlockContext>	A two argument block used for comparing the elements.
Example: Adding 1000 integer points in the range (0@0) to: (100@100) to a set.
| rnd set max pt |
    set _ Set new: 1000.
    rnd _ Random new.
    max _ 100.
    Time millisecondsToRun:[
    	1 to: 1000 do:[:i|
    		pt _ (rnd next * max) truncated @ (rnd next * max) truncated.
    		set add: pt.
    	].
    ].
The above is way slow since the default hashing function of points leads to an awful lot of collisions in the set. And now the same, with a somewhat different hash function:
| rnd set max pt |
    set _ PluggableSet new: 1000.
    set hashBlock:[:item| (item x bitShift: 16) + item y].
    rnd _ Random new.
    max _ 100.
    Time millisecondsToRun:[
    	1 to: 1000 do:[:i|
    		pt _ (rnd next * max) truncated @ (rnd next * max) truncated.
    		set add: pt.
    	].
    ].
!
----- Method: PluggableSet class>>integerSet (in category 'as yet unclassified') -----
integerSet
    ^self new hashBlock: [:integer | integer hash \ 1064164 * 1009]!
----- Method: PluggableSet>>copyEmpty (in category 'copying') -----
copyEmpty
    ^super copyEmpty
    	hashBlock: hashBlock;
    	equalBlock: equalBlock!
----- Method: PluggableSet>>equalBlock (in category 'accessing') -----
equalBlock
    "Return the block used for comparing the elements in the receiver."
    ^equalBlock!
----- Method: PluggableSet>>equalBlock: (in category 'accessing') -----
equalBlock: aBlock
    "Set a new equality block. The block must accept two arguments and return true if the argumets are considered equal, false otherwise"
    equalBlock := aBlock.!
----- Method: PluggableSet>>hashBlock (in category 'accessing') -----
hashBlock
    "Return the block used for hashing the elements in the receiver."
    ^hashBlock!
----- Method: PluggableSet>>hashBlock: (in category 'accessing') -----
hashBlock: aBlock
    "Set a new hash block. The block must accept one argument and return the hash value of the given argument."
    hashBlock := aBlock.!
----- Method: PluggableSet>>scanFor: (in category 'private') -----
scanFor: anObject 
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start |
    index := start := (hashBlock
    	ifNil: [ anObject hash ]
    	ifNotNil: [ hashBlock value: anObject ]) \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [
    		equalBlock
    			ifNil: [ element = anObject ]
    			ifNotNil: [ equalBlock value: element value: anObject ] ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: PluggableSet>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start |
    index := start := (hashBlock
    	ifNil: [ anObject hash ]
    	ifNotNil: [ hashBlock value: anObject ]) \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: Set class>>new (in category 'instance creation') -----
new
    ^ self basicNew initialize: 5!
----- Method: Set class>>new: (in category 'instance creation') -----
new: nElements
    "Create a Set large enough to hold nElements without growing"
    ^ self basicNew initialize: (self sizeFor: nElements)!
----- Method: Set class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection 
    "Answer an instance of me containing the same elements as aCollection."
    | newCollection |
    newCollection := self new: aCollection size.
    newCollection addAll: aCollection.
    ^ newCollection
"
    Set newFrom: {1. 2. 3}
    {1. 2. 3} as: Set
"!
----- Method: Set class>>quickRehashAllSets (in category 'initialization') -----
quickRehashAllSets  "Set rehashAllSets"
    | insts |
    self withAllSubclassesDo:
    	[:c |
    		insts := c allInstances.
    		(insts isEmpty or: [c = MethodDictionary]) ifFalse:
    		['Rehashing instances of ' , c name
    			displayProgressAt: Sensor cursorPoint
    			from: 1 to: insts size
    			during: [:bar | 1 to: insts size do: [:x | bar value: x. (insts at: x) rehash]]
    		]
    	]!
----- Method: Set class>>rehashAllSets (in category 'initialization') -----
rehashAllSets
    "Set rehashAllSets"	
    self withAllSubclassesDo: [ :setClass |
    	| instances |
    	instances := setClass allInstances.
    	instances isEmpty ifFalse: [
    		1 to: instances size do: [ :index |
    			(instances at: index) rehash ] ] ]!
----- Method: Set class>>sizeFor: (in category 'instance creation') -----
sizeFor: nElements
    "Large enough size to hold nElements with some slop (see fullCheck)"
    nElements <= 0 ifTrue: [^ 1].
    ^ nElements+1*4//3!
----- Method: Set>>= (in category 'testing') -----
= aSet
    self == aSet ifTrue: [^ true].	"stop recursion"
    (aSet isKindOf: Set) ifFalse: [^ false].
    self size = aSet size ifFalse: [^ false].
    self do: [:each | (aSet includes: each) ifFalse: [^ false]].
    ^ true!
----- Method: Set>>add: (in category 'adding') -----
add: newObject
    "Include newObject as one of the receiver's elements, but only if
    not already present. Answer newObject."
| index |
    newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
    index := self scanFor: newObject.
    (array at: index) ifNil: [self atNewIndex: index put: newObject].
    ^ newObject!
----- Method: Set>>add:withOccurrences: (in category 'adding') -----
add: newObject withOccurrences: anInteger
    ^ self add: newObject!
----- Method: Set>>array (in category 'private') -----
array
    ^ array!
----- Method: Set>>asSet (in category 'converting') -----
asSet
    ^self!
----- Method: Set>>atNewIndex:put: (in category 'private') -----
atNewIndex: index put: anObject
    array at: index put: anObject.
    tally := tally + 1.
    self fullCheck!
----- Method: Set>>atRandom: (in category 'accessing') -----
atRandom: aGenerator
    "Answer a random element of the receiver. Uses aGenerator which
    should be kept by the user in a variable and used every time. Use
    this instead of #atRandom for better uniformity of random numbers because 
    only you use the generator. Causes an error if self has no elements."
    | rand |
self emptyCheck.
    rand := aGenerator nextInt: self size.
    self doWithIndex:[:each :ind |
    	ind == rand ifTrue:[^each]].
    ^ self errorEmptyCollection
!
----- Method: Set>>capacity (in category 'accessing') -----
capacity
    "Answer the current capacity of the receiver."
^ array size!
----- Method: Set>>collect: (in category 'enumerating') -----
collect: aBlock 
    "Evaluate aBlock with each of the receiver's elements as the argument.  
    Collect the resulting values into a collection like the receiver. Answer  
    the new collection."
| newSet |
    newSet := Set new: self size.
    array do: [:each | each ifNotNil: [newSet add: (aBlock value: each)]].
    ^ newSet!
----- Method: Set>>comeFullyUpOnReload: (in category 'objects from disk') -----
comeFullyUpOnReload: smartRefStream
    "Symbols have new hashes in this image."
self rehash.
    "^ self"
!
----- Method: Set>>copyEmpty (in category 'copying') -----
copyEmpty
    "Answer an empty copy of this collection"
    
    "Note: this code could be moved to super"
    
    ^self species new!
----- Method: Set>>copyWithout: (in category 'removing') -----
copyWithout: oldElement 
    "Answer a copy of the receiver that does not contain any
    elements equal to oldElement."
^ self copy
    	remove: oldElement ifAbsent: [];
    	yourself!
----- Method: Set>>do: (in category 'enumerating') -----
do: aBlock 
    tally = 0 ifTrue: [^ self].
    1 to: array size do:
    	[:index |
    	| each |
    	(each := array at: index) ifNotNil: [aBlock value: each]]!
----- Method: Set>>doWithIndex: (in category 'enumerating') -----
doWithIndex: aBlock2
    "Support Set enumeration with a counter, even though not ordered"
    | index |
    index := 0.
    self do: [:item | aBlock2 value: item value: (index := index+1)]!
----- Method: Set>>errorNoFreeSpace (in category 'private') -----
errorNoFreeSpace
self error: 'There is no free space in this collection!!'!
----- Method: Set>>explorerContents (in category 'explorer') -----
explorerContents
^self asOrderedCollection withIndexCollect: [:each :index |
    	ObjectExplorerWrapper
    		with: each
    		name: index printString
    		model: self]!
----- Method: Set>>findElementOrNil: (in category 'private') -----
findElementOrNil: anObject
    "Answer the index of a first slot containing either a nil (indicating an empty slot) or an element that matches the given object. Answer the index of that slot or zero. Fail if neither a match nor an empty slot is found."
| index |
    self deprecated: 'Use #scanFor:.'.
    index := self scanFor: anObject.
    index > 0 ifTrue: [^index].
"Bad scene.  Neither have we found a matching element
    nor even an empty slot.  No hashed set is ever supposed to get
    completely full."
    self error: 'There is no free space in this set!!'.!
----- Method: Set>>fixCollisionsFrom: (in category 'private') -----
fixCollisionsFrom: start
    "The element at start has been removed and replaced by nil.
    This method moves forward from there, relocating any entries
    that had been placed below due to collisions with this one."
| element index |
    index := start.
    [ (element := self keyAt: (index := index \ array size + 1)) == nil ] whileFalse: [
    	| newIndex |
    	(newIndex := self scanFor: element) = index ifFalse: [
    		self swap: index with: newIndex ] ]!
----- Method: Set>>fullCheck (in category 'private') -----
fullCheck
    "Keep array at least 1/4 free for decent hash behavior"
    array size - tally < (array size // 4 max: 1)
    	ifTrue: [self grow]!
----- Method: Set>>grow (in category 'private') -----
grow
    "Grow the elements array and reinsert the old elements"
    
    self growTo: array size + self growSize!
----- Method: Set>>growSize (in category 'private') -----
growSize
    ^ array size max: 2!
----- Method: Set>>growTo: (in category 'private') -----
growTo: anInteger
    "Grow the elements array and reinsert the old elements"
    
    | oldElements |
    oldElements := array.
    array := Array new: anInteger.
    self noCheckNoGrowFillFrom: oldElements!
----- Method: Set>>hasContentsInExplorer (in category 'explorer') -----
hasContentsInExplorer
^self isEmpty not!
----- Method: Set>>includes: (in category 'testing') -----
includes: anObject 
    ^ (array at: (self scanFor: anObject)) ~~ nil!
----- Method: Set>>initialize: (in category 'private') -----
initialize: n
    "Initialize array to an array size of n"
    array := Array new: n.
    tally := 0!
----- Method: Set>>keyAt: (in category 'private') -----
keyAt: index
    "May be overridden by subclasses so that fixCollisions will work"
    ^ array at: index!
----- Method: Set>>like: (in category 'accessing') -----
like: anObject
    "Answer an object in the receiver that is equal to anObject,
    nil if no such object is found. Relies heavily on hash properties"
^array at: (self scanFor: anObject)!
----- Method: Set>>noCheckAdd: (in category 'private') -----
noCheckAdd: anObject
self deprecated: 'This method should not be used anymore.'.
    array at: (self scanFor: anObject) put: anObject.
    tally := tally + 1!
----- Method: Set>>noCheckNoGrowFillFrom: (in category 'private') -----
noCheckNoGrowFillFrom: anArray
    "Add the elements of anArray except nils to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
1 to: anArray size do: [ :index |
    	| object |
    	(object := anArray at: index) ifNotNil: [
    		array
    			at: (self scanForEmptySlotFor: object)
    			put: object ] ]!
----- Method: Set>>occurrencesOf: (in category 'testing') -----
occurrencesOf: anObject 
    ^ (self includes: anObject) ifTrue: [1] ifFalse: [0]!
----- Method: Set>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    array := array copy!
----- Method: Set>>rehash (in category 'private') -----
rehash
    
    self growTo: array size!
----- Method: Set>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: aBlock
| index |
    index := self scanFor: oldObject.
    (array at: index) ifNil: [ ^ aBlock value ].
    array at: index put: nil.
    tally := tally - 1.
    self fixCollisionsFrom: index.
    ^ oldObject!
----- Method: Set>>removeAll (in category 'removing') -----
removeAll
    "remove all elements from this collection.
    Preserve the capacity"
    
    self initialize: self capacity!
----- Method: Set>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start |
    index := start := anObject hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == nil or: [ element = anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: Set>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start |
    index := start := anObject hash \ array size + 1.
    [ 
    	(array at: index) ifNil: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: Set>>select: (in category 'enumerating') -----
select: aBlock 
    "Use copyEmpty instead of self species new to give subclasses a chance to initialize additional inst vars."
"Note: this code could be moved to super"
    
    | newCollection |
    newCollection := self copyEmpty.
    self do: [:each | (aBlock value: each) ifTrue: [newCollection add: each]].
    ^newCollection!
----- Method: Set>>size (in category 'accessing') -----
size
    ^ tally!
----- Method: Set>>someElement (in category 'accessing') -----
someElement
    "Deprecated. Use anyOne."
^ self anyOne!
----- Method: Set>>swap:with: (in category 'private') -----
swap: oneIndex with: otherIndex
    "May be overridden by subclasses so that fixCollisions will work"
array swap: oneIndex with: otherIndex
!
----- Method: Set>>union: (in category 'enumerating') -----
union: aCollection
    "Answer the set theoretic union of the receiver and aCollection, using the receiver's notion of equality and not side effecting the receiver at all."
^ self copy addAll: aCollection; yourself
!
Set subclass: #WeakSet
    instanceVariableNames: 'flag'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Weak'!
----- Method: WeakSet>>add: (in category 'public') -----
add: newObject
    "Include newObject as one of the receiver's elements, but only if
    not already present. Answer newObject"
| index |
    newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
    index := self scanFor: newObject.
    ((array at: index) == flag or: [(array at: index) isNil])
    	ifTrue: [self atNewIndex: index put: newObject].
    ^newObject!
----- Method: WeakSet>>collect: (in category 'public') -----
collect: aBlock
    | each newSet |
    newSet := self species new: self size.
    tally = 0 ifTrue: [^newSet ].
    1 to: array size do:
    	[:index |
    		((each := array at: index) == nil or: [each == flag])
    			ifFalse: [newSet add: (aBlock value: each)]
    	].
    ^newSet!
----- Method: WeakSet>>do: (in category 'public') -----
do: aBlock
    | each |
tally = 0 ifTrue: [^self].
    1 to: array size do:
    	[:index |
    		((each := array at: index) == nil or: [each == flag])
    			ifFalse: [aBlock value: each]
    	]!
----- Method: WeakSet>>do:after: (in category 'public') -----
do: aBlock after: anElement
    | each startIndex |
tally = 0 ifTrue: [^self].
    startIndex := anElement ifNil: [1] ifNotNil:
    	[self scanFor: anElement].
    startIndex + 1 to: array size do:
    	[:index |
    		((each := array at: index) == nil or: [each == flag])
    			ifFalse: [aBlock value: each]
    	]!
----- Method: WeakSet>>fixCollisionsFrom: (in category 'private') -----
fixCollisionsFrom: start
"The element at start has been removed and replaced by flag.
    This method moves forward from there, relocating any entries
    that had been placed below due to collisions with this one."
| element index |
    index := start.
    [ (element := self keyAt: (index := index \ array size + 1)) == flag ] whileFalse: [
    	| newIndex |
    	(newIndex := self scanFor: element) = index ifFalse: [
    		self swap: index with: newIndex ] ]
!
----- Method: WeakSet>>growTo: (in category 'private') -----
growTo: anInteger
    "Grow the elements array and reinsert the old elements"
| oldElements |
oldElements := array.
    array := WeakArray new: anInteger.
    array atAllPut: flag.
    self noCheckNoGrowFillFrom: oldElements!
----- Method: WeakSet>>includes: (in category 'public') -----
includes: anObject 
    ^(array at: (self scanFor: anObject)) ~~ flag!
----- Method: WeakSet>>initialize: (in category 'private') -----
initialize: n
    "Initialize array to an array size of n"
flag := Object new.
    array := WeakArray new: n.
    array atAllPut: flag.
    tally := 0!
----- Method: WeakSet>>like: (in category 'public') -----
like: anObject
    "Answer an object in the receiver that is equal to anObject,
    nil if no such object is found. Relies heavily on hash properties"
| element |
    ^(element  := array at: (self scanFor: anObject)) == flag
    	ifFalse: [ element ]!
----- Method: WeakSet>>noCheckNoGrowFillFrom: (in category 'private') -----
noCheckNoGrowFillFrom: anArray
    "Add the elements of anArray except nils and flag to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
tally := 0.
    1 to: anArray size do: [ :index |
    	| object |
    	((object := anArray at: index) == flag or: [
    		object == nil ]) ifFalse: [ 
    			array
    				at: (self scanForEmptySlotFor: object)
    				put: object.
    			tally := tally + 1 ] ]!
----- Method: WeakSet>>postCopy (in category 'copying') -----
postCopy
    | oldFlag |
    super postCopy.
    oldFlag := flag.
    flag := Object new.
    array replaceAll: oldFlag with: flag.!
----- Method: WeakSet>>printElementsOn: (in category 'public') -----
printElementsOn: aStream
    | oldPos |
    aStream nextPut: $(.
    oldPos := aStream position.
    self do: [:element | aStream print: element; space].
    aStream position > oldPos ifTrue: [aStream skip: -1 "remove the extra space"].
    aStream nextPut: $)!
----- Method: WeakSet>>remove:ifAbsent: (in category 'public') -----
remove: oldObject ifAbsent: aBlock
| index |
    index := self scanFor: oldObject.
    (array at: index) == flag ifTrue: [ ^ aBlock value ].
    array at: index put: flag.
    tally := tally - 1.
    self fixCollisionsFrom: index.
    ^oldObject!
----- Method: WeakSet>>scanFor: (in category 'private') -----
scanFor: anObject
    "Scan the key array for the first slot containing either flag (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or raise an error if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
| index start |
    index := start := anObject hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == flag or: [ element = anObject ])
    		ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: WeakSet>>scanForEmptySlotFor: (in category 'private') -----
scanForEmptySlotFor: anObject
    "Scan the key array for the first slot containing an empty slot (indicated by flag or a nil). Answer the index of that slot. This method will be overridden in various subclasses that have different interpretations for matching elements."
    
    | index start |
    index := start := anObject hash \ array size + 1.
    [ 
    	| element |
    	((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ].
    	(index := index \ array size + 1) = start ] whileFalse.
    self errorNoFreeSpace!
----- Method: WeakSet>>scanForLoadedSymbol: (in category 'private') -----
scanForLoadedSymbol: anObject
    "Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements"
| element start finish |
start := (anObject hash \ array size) + 1.
    finish := array size.
"Search from (hash mod size) to the end."
    start to: finish do:
    	[:index | ((element := array at: index) == flag or: [element asString = anObject asString])
    		ifTrue: [^ index ]].
"Search from 1 to where we started."
    1 to: start-1 do:
    	[:index | ((element := array at: index) == flag or: [element asString = anObject asString])
    		ifTrue: [^ index ]].
^ 0  "No match AND no empty slot"!
----- Method: WeakSet>>size (in category 'public') -----
size
    "Careful!! Answer the maximum amount
    of elements in the receiver, not the
    exact amount"
^tally!
----- Method: WeakSet>>slowSize (in category 'public') -----
slowSize
    "Careful!! Answer the maximum amount
    of elements in the receiver, not the
    exact amount"
tally := array inject: 0 into:
    	[:total :each | (each == nil or: [each == flag])
    		ifTrue: [total] ifFalse: [total + 1]].
    ^tally!
Collection subclass: #WeakRegistry
    instanceVariableNames: 'valueDictionary accessLock'
    classVariableNames: 'Default'
    poolDictionaries: ''
    category: 'Collections-Weak'!
!WeakRegistry commentStamp: '<historical>' prior: 0!
I am a registry for objects needing finalization. When an object is added the object as well as its executor is stored. When the object is garbage collected, the executor can take the appropriate action for any resources associated with the object.
See also:
    Object executor
    Object actAsExecutor
    Object finalize
!
----- Method: WeakRegistry class>>default (in category 'accessing') -----
default
    ^Default ifNil:[Default := self new]!
----- Method: WeakRegistry class>>new (in category 'instance creation') -----
new
    ^self new: 5!
----- Method: WeakRegistry class>>new: (in category 'instance creation') -----
new: n
    | registry |
    registry := super new initialize: n.
    WeakArray addWeakDependent: registry.
    ^registry!
----- Method: WeakRegistry>>add: (in category 'adding') -----
add: anObject
    "Add anObject to the receiver. Store the object as well as the associated executor."
    | executor |
    executor := anObject executor.
    self protected:[
    	valueDictionary at: anObject put: executor.
    ].
    ^anObject!
----- Method: WeakRegistry>>add:executor: (in category 'adding') -----
add: anObject executor: anExecutor
    "Add anObject to the receiver. Store the object as well as the associated executor."
    self protected:[
    	valueDictionary at: anObject put: anExecutor.
    ].
    ^anObject!
----- Method: WeakRegistry>>do: (in category 'enumerating') -----
do: aBlock
    ^self protected:[
    	valueDictionary keysDo: aBlock.
    ].
!
----- Method: WeakRegistry>>finalizeValues (in category 'finalization') -----
finalizeValues
    "Some of our elements may have gone away. Look for those and activate the associated executors."
    | finiObjects |
    finiObjects := nil.
    "First collect the objects."
    self protected:[
    	valueDictionary associationsDo:[:assoc|
    		assoc key isNil ifTrue:[
    			finiObjects isNil 
    				ifTrue:[finiObjects := OrderedCollection with: assoc value]
    				ifFalse:[finiObjects add: assoc value]]
    	].
    	finiObjects isNil ifFalse:[valueDictionary finalizeValues: finiObjects asArray].
    ].
    "Then do the finalization"
    finiObjects isNil ifTrue:[^self].
    finiObjects do:[:each| each finalize].
!
----- Method: WeakRegistry>>initialize: (in category 'initialize') -----
initialize: n
    valueDictionary := WeakKeyDictionary new: n.
    accessLock := Semaphore forMutualExclusion.!
----- Method: WeakRegistry>>keys (in category 'accessing') -----
keys
    ^self protected:[
    	Array streamContents:[:s| valueDictionary keysDo:[:key| s nextPut: key]]].!
----- Method: WeakRegistry>>postCopy (in category 'copying') -----
postCopy
    accessLock := Semaphore forMutualExclusion.
    valueDictionary := valueDictionary copy.!
----- Method: WeakRegistry>>printElementsOn: (in category 'printing') -----
printElementsOn: aStream
    aStream nextPut: $(.
    accessLock 
    	ifNil: [self do: [:element | aStream print: element; space]]
    	ifNotNil: [aStream nextPutAll: '<this WeakRegistry is locked>; space'].
    self isEmpty ifFalse: [aStream skip: -1].
    aStream nextPut: $)!
----- Method: WeakRegistry>>protected: (in category 'private') -----
protected: aBlock
    "Execute aBlock protected by the accessLock"
    ^accessLock isNil
    	ifTrue:[aBlock value]
    	ifFalse:[accessLock critical: aBlock ifError:[:msg :rcvr| rcvr error: msg]]!
----- Method: WeakRegistry>>remove:ifAbsent: (in category 'removing') -----
remove: oldObject ifAbsent: exceptionBlock
    "Remove oldObject as one of the receiver's elements."
    | removedObject |
    oldObject isNil ifTrue:[^oldObject].
    self protected:[
    	removedObject := valueDictionary removeKey: oldObject ifAbsent:[nil].
    ].
    ^removedObject isNil
    	ifTrue:[exceptionBlock value]
    	ifFalse:[removedObject].
!
----- Method: WeakRegistry>>removeAll (in category 'removing') -----
removeAll
    "See super"
    
    self protected:[
    	valueDictionary removeAll.
    ].!
----- Method: WeakRegistry>>size (in category 'accessing') -----
size
    ^ self protected: [valueDictionary size]!
----- Method: WeakRegistry>>species (in category 'accessing') -----
species
    ^Set!
Collection subclass: #WideCharacterSet
    instanceVariableNames: 'map'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!WideCharacterSet commentStamp: 'nice 5/9/2006 23:33' prior: 0!
WideCharacterSet is used to store a Set of WideCharacter with fast access and inclusion test.
Implementation should be efficient in memory if sets are sufficently sparse.
Wide Characters are at most 32bits.
We split them into 16 highBits and 16 lowBits.
map is a dictionary key: 16 highBits value: map of 16 lowBits.
Maps of lowBits  are stored as arrays of bits in a WordArray.
If a bit is set to 1, this indicate that corresponding character is present.
Only 2048 entries are necessary in each lowmap.
And only lowmap corresponding to a present high value are stored.!
----- Method: WideCharacterSet class>>newFrom: (in category 'instance creation') -----
newFrom: aCollection
    | newCollection |
    newCollection := self new.
    newCollection addAll: aCollection.
    ^newCollection!
----- Method: WideCharacterSet>>= (in category 'comparing') -----
= anObject
    ^self species == anObject species and: [
    	self wideCharacterMap = anObject wideCharacterMap ]!
----- Method: WideCharacterSet>>add: (in category 'collection ops') -----
add: aCharacter 
    | val high low lowmap |
    val := aCharacter asciiValue.
    high := val bitShift: -16.
    low := val bitAnd: 16rFFFF.
    lowmap := map at: high ifAbsentPut: [WordArray new: 2048].
    self setBitmap: lowmap at: low.
    ^ aCharacter!
----- Method: WideCharacterSet>>bitmap:at: (in category 'private') -----
bitmap: aMap at: shortInteger
    "access a single bit in aMap.
    shortInteger should be between: 0 and: 16rFFFF"
    
    | collecIndex bitIndex |
    collecIndex := shortInteger bitShift: -5.
    bitIndex := shortInteger bitAnd: 16r1F.
    ^(aMap at: collecIndex + 1) bitAnd: (1 bitShift: bitIndex)!
----- Method: WideCharacterSet>>bitmap:do: (in category 'private') -----
bitmap: aMap do: aBlock
    "Execute a block with each value (0 based) corresponding to set bits"
    
    0 to: 31 do: [:shift |
    	| mask |
    	mask := 1 bitShift: shift.
    	1 to: aMap size do: [:i | 
    		((aMap at: i) bitAnd: mask) isZero ifFalse: [aBlock value: ((i - 1 bitShift: 5) bitOr: shift)]]]!
----- Method: WideCharacterSet>>byteArrayMap (in category 'comparing') -----
byteArrayMap
    "return a ByteArray mapping each ascii value to a 1 if that ascii value is in the set, and a 0 if it isn't.
    Intended for use by primitives only. (and comparison)
    This version will answer a subset with only byte characters"
    
    | aMap lowmap |
    aMap := ByteArray new: 256.
    lowmap := map at: 0 ifAbsent: [^aMap].
    lowmap := lowmap copyFrom: 1 to: 8. "Keep first 8*32=256 bits..."
    self bitmap: lowmap do: [:code | aMap at: code + 1 put: 1].
    ^aMap!
----- Method: WideCharacterSet>>clearBitmap:at: (in category 'private') -----
clearBitmap: aMap at: shortInteger
    "clear a single bit in aMap.
    shortInteger should be between: 0 and: 16rFFFF"
    
    | collecIndex bitIndex |
    collecIndex := shortInteger bitShift: -5.
    bitIndex := shortInteger bitAnd: 16r1F.
    ^aMap at: collecIndex + 1 put: ((aMap at: collecIndex + 1) bitClear: (1 bitShift: bitIndex))!
----- Method: WideCharacterSet>>complement (in category 'converting') -----
complement
    "return a character set containing precisely the characters the receiver does not"
    
    ^CharacterSetComplement of: self copy!
----- Method: WideCharacterSet>>do: (in category 'collection ops') -----
do: aBlock 
    map
    	keysAndValuesDo: [:high :lowmap | self
    			bitmap: lowmap
    			do: [:low | aBlock
    					value: (Character value: ((high bitShift: 16) bitOr: low))]]!
----- Method: WideCharacterSet>>hasWideCharacters (in category 'testing') -----
hasWideCharacters
    "Answer true if i contain any wide character"
    
    self do: [:e | e asciiValue >= 256 ifTrue: [^true]].
    ^false!
----- Method: WideCharacterSet>>hash (in category 'comparing') -----
hash
    "Answer a hash code aimed at storing and retrieving the receiver in a Set or Dictionary.
    Two equal objects should have equal hash.
    Note: as the receiver can be equal to an ordinary CharacterSet,
    the hash code must reflect this"
    
    ^self hasWideCharacters
    	ifTrue: [map hash]
    	ifFalse: [self asCharacterSet hash]!
----- Method: WideCharacterSet>>includes: (in category 'collection ops') -----
includes: aCharacter 
    | val high low |
    val := aCharacter asciiValue.
    high := val bitShift: -16.
    low := val bitAnd: 16rFFFF.
    ^(self
    	bitmap: (map
    			at: high
    			ifAbsent: [^ false])
    	at: low) isZero not!
----- Method: WideCharacterSet>>initialize (in category 'initialize-release') -----
initialize
    map := Dictionary new.!
----- Method: WideCharacterSet>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    map := map collect: [:each | each copy]!
----- Method: WideCharacterSet>>remove: (in category 'collection ops') -----
remove: aCharacter 
    | val high low lowmap |
    val := aCharacter asciiValue.
    high := val bitShift: -16.
    low := val bitAnd: 16rFFFF.
    lowmap := map
    			at: high
    			ifAbsent: [^ aCharacter].
    self clearBitmap: lowmap at: low.
    lowmap max = 0
    	ifTrue: [map removeKey: high].
    ^ aCharacter!
----- Method: WideCharacterSet>>removeAll (in category 'collection ops') -----
removeAll
    map removeAll!
----- Method: WideCharacterSet>>setBitmap:at: (in category 'private') -----
setBitmap: aMap at: shortInteger
    "set a single bit in aMap.
    shortInteger should be between: 0 and: 16rFFFF"
    
    | collecIndex bitIndex |
    collecIndex := shortInteger bitShift: -5.
    bitIndex := shortInteger bitAnd: 16r1F.
    ^aMap at: collecIndex + 1 put: ((aMap at: collecIndex + 1) bitOr: (1 bitShift: bitIndex))!
----- Method: WideCharacterSet>>size (in category 'collection ops') -----
size
    | size |
    size := 0.
    map
    	keysAndValuesDo: [:high :lowmap | self
    			bitmap: lowmap
    			do: [:low | size := size + 1]].
    ^ size!
----- Method: WideCharacterSet>>species (in category 'comparing') -----
species
    ^self hasWideCharacters
    	ifTrue: [WideCharacterSet]
    	ifFalse: [CharacterSet]!
----- Method: WideCharacterSet>>wideCharacterMap (in category 'comparing') -----
wideCharacterMap
    ^map!
Object subclass: #Link
    instanceVariableNames: 'nextLink'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Support'!
!Link commentStamp: '<historical>' prior: 0!
An instance of me is a simple record of a pointer to another Link. I am an abstract class; my concrete subclasses, for example, Process, can be stored in a LinkedList structure.!
----- Method: Link class>>nextLink: (in category 'instance creation') -----
nextLink: aLink 
    "Answer an instance of me referring to the argument, aLink."
^self new nextLink: aLink; yourself!
----- Method: Link>>nextLink (in category 'accessing') -----
nextLink
    "Answer the link to which the receiver points."
^nextLink!
----- Method: Link>>nextLink: (in category 'accessing') -----
nextLink: aLink 
    "Store the argument, aLink, as the link to which the receiver refers. 
    Answer aLink."
^nextLink := aLink!
Link subclass: #StackLink
    instanceVariableNames: 'element'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Stack'!
!StackLink commentStamp: '<historical>' prior: 0!
I implement an element of a stack. I'm a container for any type of object, saved into the 'element' variable. My superclass Link allows me to be part of a LinkedList.!
----- Method: StackLink class>>with: (in category 'instance creation') -----
with: anObject 
    ^ self new element: anObject!
----- Method: StackLink>>element (in category 'accessing') -----
element
    ^element!
----- Method: StackLink>>element: (in category 'accessing') -----
element: anObject 
    "Any kind of Object."
    element := anObject!
----- Method: StackLink>>printOn: (in category 'printing') -----
printOn: aStream 
    aStream nextPutAll: self class printString;
    	 nextPutAll: ' with: ';
    	 nextPutAll: self element printString!
Object subclass: #MimeConverter
    instanceVariableNames: 'dataStream mimeStream'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
MimeConverter subclass: #Base64MimeConverter
    instanceVariableNames: 'data'
    classVariableNames: 'FromCharTable ToCharTable'
    poolDictionaries: ''
    category: 'Collections-Streams'!
!Base64MimeConverter commentStamp: '<historical>' prior: 0!
This class encodes and decodes data in Base64 format.  This is MIME encoding.  We translate a whole stream at once, taking a Stream as input and giving one as output.  Returns a whole stream for the caller to use.
           0 A            17 R            34 i            51 z
           1 B            18 S            35 j            52 0
           2 C            19 T            36 k            53 1
           3 D            20 U            37 l            54 2
           4 E            21 V            38 m            55 3
           5 F            22 W            39 n            56 4
           6 G            23 X            40 o            57 5
           7 H            24 Y            41 p            58 6
           8 I            25 Z            42 q            59 7
           9 J            26 a            43 r            60 8
          10 K            27 b            44 s            61 9
          11 L            28 c            45 t            62 +
          12 M            29 d            46 u            63 /
          13 N            30 e            47 v
          14 O            31 f            48 w         (pad) =
          15 P            32 g            49 x
          16 Q            33 h            50 y
Outbound: bytes are broken into 6 bit chunks, and the 0-63 value is converted to a character.  3 data bytes go into 4 characters.
Inbound: Characters are translated in to 0-63 values and shifted into 8 bit bytes.
(See: N. Borenstein, Bellcore, N. Freed, Innosoft, Network Working Group, Request for Comments: RFC 1521, September 1993, MIME (Multipurpose Internet Mail Extensions) Part One: Mechanisms for Specifying and Describing the Format of Internet Message Bodies. Sec 6.2)
By Ted Kaehler, based on Tim Olson's Base64Filter.!
----- Method: Base64MimeConverter class>>decodeInteger: (in category 'as yet unclassified') -----
decodeInteger: mimeString
    | bytes sum |
    "Decode the MIME string into an integer of any length"
bytes := (Base64MimeConverter mimeDecodeToBytes: 
    			(ReadStream on: mimeString)) contents.
    sum := 0.
    bytes reverseDo: [:by | sum := sum * 256 + by].
    ^ sum!
----- Method: Base64MimeConverter class>>encodeInteger: (in category 'as yet unclassified') -----
encodeInteger: int
    | strm |
    "Encode an integer of any length and return the MIME string"
strm := ReadWriteStream on: (ByteArray new: int digitLength).
    1 to: int digitLength do: [:ii | strm nextPut: (int digitAt: ii)].
    strm reset.
    ^ ((self mimeEncode: strm) contents) copyUpTo: $=	"remove padding"!
----- Method: Base64MimeConverter class>>initialize (in category 'as yet unclassified') -----
initialize
FromCharTable := Array new: 256.	"nils"
    ToCharTable := Array new: 64.
    ($A asciiValue to: $Z asciiValue) doWithIndex: [:val :ind | 
    	FromCharTable at: val+1 put: ind-1.
    	ToCharTable at: ind put: val asCharacter].
    ($a asciiValue to: $z asciiValue) doWithIndex: [:val :ind | 
    	FromCharTable at: val+1 put: ind+25.
    	ToCharTable at: ind+26 put: val asCharacter].
    ($0 asciiValue to: $9 asciiValue) doWithIndex: [:val :ind | 
    	FromCharTable at: val+1 put: ind+25+26.
    	ToCharTable at: ind+26+26 put: val asCharacter].
    FromCharTable at: $+ asciiValue + 1 put: 62.
    ToCharTable at: 63 put: $+.
    FromCharTable at: $/ asciiValue + 1 put: 63.
    ToCharTable at: 64 put: $/.
    !
----- Method: Base64MimeConverter class>>mimeDecodeToBytes: (in category 'as yet unclassified') -----
mimeDecodeToBytes: aStream 
    "Return a RWBinaryOrTextStream of the original ByteArray.  aStream has only 65 innocuous character values.  aStream is not binary.  (See class comment). 4 bytes in aStream goes to 3 bytes in output."
| me |
    aStream position: 0.
    me := self new mimeStream: aStream.
    me dataStream: (RWBinaryOrTextStream on: (ByteArray new: aStream size * 3 // 4)).
    me mimeDecodeToByteArray.
    me dataStream position: 0.
    ^ me dataStream!
----- Method: Base64MimeConverter class>>mimeDecodeToChars: (in category 'as yet unclassified') -----
mimeDecodeToChars: aStream 
    "Return a ReadWriteStream of the original String.  aStream has only 65 innocuous character values.  It is not binary.  (See class comment). 4 bytes in aStream goes to 3 bytes in output."
| me |
    aStream position: 0.
    me := self new mimeStream: aStream.
    me dataStream: (ReadWriteStream on: (String new: aStream size * 3 // 4)).
    me mimeDecode.
    me dataStream position: 0.
    ^ me dataStream!
----- Method: Base64MimeConverter class>>mimeEncode: (in category 'as yet unclassified') -----
mimeEncode: aStream
    "Return a ReadWriteStream of characters.  The data of aStream is encoded as 65 innocuous characters.  (See class comment). 3 bytes in aStream goes to 4 bytes in output."
| me |
    me := self new dataStream: aStream.
    me mimeStream: (ReadWriteStream on: (String new: aStream size + 20 * 4 // 3)).
    me mimeEncode.
    me mimeStream position: 0.
    ^ me mimeStream!
----- Method: Base64MimeConverter>>mimeDecode (in category 'conversion') -----
mimeDecode
    "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full byte stream of characters.  Reutrn a whole stream for the user to read."
| nibA nibB nibC nibD |
    [mimeStream atEnd] whileFalse: [
    	(nibA := self nextValue) ifNil: [^ dataStream].
    	(nibB := self nextValue) ifNil: [^ dataStream].
    	dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)) asCharacter.
    	nibB := nibB bitAnd: 16rF.
    	(nibC := self nextValue) ifNil: [^ dataStream].
    	dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)) asCharacter.
    	nibC := nibC bitAnd: 16r3.
    	(nibD := self nextValue) ifNil: [^ dataStream].
    	dataStream nextPut: ((nibC bitShift: 6) + nibD) asCharacter.
    	].
    ^ dataStream!
----- Method: Base64MimeConverter>>mimeDecodeToByteArray (in category 'conversion') -----
mimeDecodeToByteArray
    "Convert a stream in base 64 with only a-z,A-Z,0-9,+,/ to a full ByteArray of 0-255 values.  Reutrn a whole stream for the user to read."
| nibA nibB nibC nibD |
    [mimeStream atEnd] whileFalse: [
    	(nibA := self nextValue) ifNil: [^ dataStream].
    	(nibB := self nextValue) ifNil: [^ dataStream].
    	dataStream nextPut: ((nibA bitShift: 2) + (nibB bitShift: -4)).
    	nibB := nibB bitAnd: 16rF.
    	(nibC := self nextValue) ifNil: [^ dataStream].
    	dataStream nextPut: ((nibB bitShift: 4) + (nibC bitShift: -2)).
    	nibC := nibC bitAnd: 16r3.
    	(nibD := self nextValue) ifNil: [^ dataStream].
    	dataStream nextPut: ((nibC bitShift: 6) + nibD).
    	].
    ^ dataStream!
----- Method: Base64MimeConverter>>mimeEncode (in category 'conversion') -----
mimeEncode
    "Convert from data to 6 bit characters."
| phase1 phase2 raw nib lineLength |
    phase1 := phase2 := false.
    lineLength := 0.
    [dataStream atEnd] whileFalse: [
    	lineLength >= 70 ifTrue: [ mimeStream cr.  lineLength := 0. ].
    	data := raw := dataStream next asInteger.
    	nib := (data bitAnd: 16rFC) bitShift: -2.
    	mimeStream nextPut: (ToCharTable at: nib+1).
    	(raw := dataStream next) ifNil: [raw := 0. phase1 := true].
    	data := ((data bitAnd: 3) bitShift: 8) + raw asInteger.
    	nib := (data bitAnd: 16r3F0) bitShift: -4.
    	mimeStream nextPut: (ToCharTable at: nib+1).
    	(raw := dataStream next) ifNil: [raw := 0. phase2 := true].
    	data := ((data bitAnd: 16rF) bitShift: 8) + (raw asInteger).
    	nib := (data bitAnd: 16rFC0) bitShift: -6.
    	mimeStream nextPut: (ToCharTable at: nib+1).
    	nib := (data bitAnd: 16r3F).
    	mimeStream nextPut: (ToCharTable at: nib+1).
lineLength := lineLength + 4.].
    phase1 ifTrue: [mimeStream skip: -2; nextPut: $=; nextPut: $=.
    		^ mimeStream].
    phase2 ifTrue: [mimeStream skip: -1; nextPut: $=.
    		^ mimeStream].
!
----- Method: Base64MimeConverter>>nextValue (in category 'conversion') -----
nextValue
    "The next six bits of data char from the mimeStream, or nil.  Skip all other chars"
    | raw num |
    [raw := mimeStream next.
    raw ifNil: [^ nil].	"end of stream"
    raw == $= ifTrue: [^ nil].
    num := FromCharTable at: raw asciiValue + 1.
    num ifNotNil: [^ num].
    "else ignore space, return, tab, ..."
    true] whileTrue.!
----- Method: MimeConverter class>>forEncoding: (in category 'convenience') -----
forEncoding: encodingString
    "Answer a converter class for the given encoding or nil if unknown"
    encodingString ifNil: [^nil].
    ^ encodingString asLowercase caseOf: 
    	{ ['base64'] -> [Base64MimeConverter].
    	  ['quoted-printable'] -> [QuotedPrintableMimeConverter]}
    	otherwise: [].
!
----- Method: MimeConverter class>>mimeDecode:as: (in category 'convenience') -----
mimeDecode: aStringOrStream as: contentsClass
    ^ contentsClass streamContents: [:out |
    	self mimeDecode: aStringOrStream to: out]!
----- Method: MimeConverter class>>mimeDecode:to: (in category 'convenience') -----
mimeDecode: aStringOrStream to: outStream
    self new
    	mimeStream: (aStringOrStream isStream
    		ifTrue: [aStringOrStream]
    		ifFalse: [ReadStream on: aStringOrStream]);
    	dataStream: outStream;
    	mimeDecode!
----- Method: MimeConverter class>>mimeEncode: (in category 'convenience') -----
mimeEncode: aCollectionOrStream
    ^ String streamContents: [:out |
    	self mimeEncode: aCollectionOrStream to: out]!
----- Method: MimeConverter class>>mimeEncode:to: (in category 'convenience') -----
mimeEncode: aCollectionOrStream to: outStream
    self new
    	dataStream: (aCollectionOrStream isStream
    		ifTrue: [aCollectionOrStream]
    		ifFalse: [ReadStream on: aCollectionOrStream]);
    	mimeStream: outStream;
    	mimeEncode!
----- Method: MimeConverter>>dataStream (in category 'accessing') -----
dataStream
    ^dataStream!
----- Method: MimeConverter>>dataStream: (in category 'accessing') -----
dataStream: anObject
    dataStream := anObject!
----- Method: MimeConverter>>mimeDecode (in category 'conversion') -----
mimeDecode
    "Do conversion reading from mimeStream writing to dataStream"
self subclassResponsibility!
----- Method: MimeConverter>>mimeEncode (in category 'conversion') -----
mimeEncode
    "Do conversion reading from dataStream writing to mimeStream"
self subclassResponsibility!
----- Method: MimeConverter>>mimeStream (in category 'accessing') -----
mimeStream
    ^mimeStream!
----- Method: MimeConverter>>mimeStream: (in category 'accessing') -----
mimeStream: anObject
    mimeStream := anObject!
MimeConverter subclass: #QuotedPrintableMimeConverter
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!QuotedPrintableMimeConverter commentStamp: '<historical>' prior: 0!
I do quoted printable MIME decoding as specified in RFC 2045 "MIME Part One: Format of Internet Message Bodies".
Short version of RFC2045, Sect. 6.7:
(1) Any octet, except a CR or LF that is part of a CRLF line break of the canonical (standard) form of the data being encoded, may be represented by an "=" followed by a two digit hexadecimal representation of the octet's value. [...]
(2) Octets with decimal values of 33 through 60 inclusive, and 62 through 126, inclusive, MAY be represented as the US-ASCII characters which correspond to those octets [...].
(3) Octets with values of 9 and 32 MAY be represented as US-ASCII TAB (HT) and SPACE characters,
 respectively, but MUST NOT be so represented at the end of an encoded line.  [...]
(4) A line break in a text body, represented as a CRLF sequence in the text canonical form, must be represented by a (RFC 822) line break, which is also a CRLF sequence, in the Quoted-Printable encoding.  [...]
(5) The Quoted-Printable encoding REQUIRES that encoded lines be no more than 76 characters long.  If longer lines are to be encoded with the Quoted-Printable encoding, "soft" line breaks
 must be used.  An equal sign as the last character on a encoded line indicates such a non-significant ("soft") line break in the encoded text.
--bf 11/27/1998 16:50!
----- Method: QuotedPrintableMimeConverter>>mimeDecode (in category 'conversion') -----
mimeDecode
    "Do conversion reading from mimeStream writing to dataStream"
| line s c1 v1 c2 v2 |
    [(line := mimeStream nextLine) isNil] whileFalse: [
    	line := line withoutTrailingBlanks.
    	line size = 0
    		ifTrue: [dataStream cr]
    		ifFalse: [
    			s := ReadStream on: line.
    			[dataStream nextPutAll: (s upTo: $=).
    			s atEnd] whileFalse: [
    				c1 := s next. v1 := c1 digitValue.
    				((v1 between: 0 and: 15) and: [s atEnd not])
    					ifFalse: [dataStream nextPut: $=; nextPut: c1]
    					ifTrue: [c2 := s next. v2 := c2 digitValue.
    						(v2 between: 0 and: 15)
    							ifFalse: [dataStream nextPut: $=; nextPut: c1; nextPut: c2]
    							ifTrue: [dataStream nextPut: (Character value: v1 * 16 + v2)]]].
    			line last = $= ifFalse: [dataStream cr]]].
    ^ dataStream!
QuotedPrintableMimeConverter subclass: #RFC2047MimeConverter
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!RFC2047MimeConverter commentStamp: '<historical>' prior: 0!
I do quoted printable MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader!
----- Method: RFC2047MimeConverter>>encodeChar:to: (in category 'private-encoding') -----
encodeChar: aChar to: aStream
aChar = Character space
    	ifTrue: [^ aStream nextPut: $_].
    ((aChar asciiValue between: 32 and: 127) and: [('?=_' includes: aChar) not])
    	ifTrue: [^ aStream nextPut: aChar].
    aStream nextPut: $=;
    	nextPut: (Character digitValue: aChar asciiValue // 16);
    	nextPut: (Character digitValue: aChar asciiValue \ 16)
!
----- Method: RFC2047MimeConverter>>encodeWord: (in category 'private-encoding') -----
encodeWord: aString
(aString allSatisfy: [:c | c asciiValue < 128])
    	ifTrue: [^ aString].
    ^ String streamContents: [:stream |
    	stream nextPutAll: '=?iso-8859-1?Q?'.
    	aString do: [:c | self encodeChar: c to: stream].
    	stream nextPutAll: '?=']!
----- Method: RFC2047MimeConverter>>isStructuredField: (in category 'private-encoding') -----
isStructuredField: aString
| fName |
    fName := aString copyUpTo: $:.
    ('Resent' sameAs: (fName copyUpTo: $-))
    	ifTrue: [fName := fName copyFrom: 8 to: fName size].
    ^#('Sender' 'From' 'Reply-To' 'To' 'cc' 'bcc') anySatisfy: [:each | fName sameAs: each]!
----- Method: RFC2047MimeConverter>>mimeDecode (in category 'conversion') -----
mimeDecode
    "Do conversion reading from mimeStream writing to dataStream. See String>>decodeMimeHeader"
| c |
    [mimeStream atEnd] whileFalse: [
    	c _ mimeStream next.
    	c = $=
    		ifTrue: [c _ Character value: mimeStream next digitValue * 16
    			+ mimeStream next digitValue]
    		ifFalse: [c = $_ ifTrue: [c _ $ ]].
    	dataStream nextPut: c].
    ^ dataStream!
----- Method: RFC2047MimeConverter>>mimeEncode (in category 'conversion') -----
mimeEncode
    "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars."
| word pos wasGood isGood max |
    true ifTrue: [mimeStream nextPutAll: dataStream upToEnd].
    pos := 0.
    max := 72.
    wasGood := true.
    [dataStream atEnd] whileFalse: [
    	word := self readWord.
    	isGood := word allSatisfy: [:c | c asciiValue < 128].
    	wasGood & isGood ifTrue: [
    		pos + word size < max
    			ifTrue: [dataStream nextPutAll: word.
    				pos := pos + word size]
    			ifFalse: []
    	]
    ].
    ^ mimeStream!
----- Method: RFC2047MimeConverter>>readWord (in category 'private-encoding') -----
readWord
| strm |
    strm := WriteStream on: (String new: 20)
    dataStream skipSeparators.
    [dataStream atEnd] whileFalse: 
    	[ | c |
    	c := dataStream next.
    	strm nextPut: c.
    	c isSeparator ifTrue: [^ strm contents]].
    ^ strm contents!
Object subclass: #SharedQueue
    instanceVariableNames: 'contentsArray readPosition writePosition accessProtect readSynch'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!SharedQueue commentStamp: '<historical>' prior: 0!
I provide synchronized communication of arbitrary objects between Processes. An object is sent by sending the message nextPut: and received by sending the message next. If no object has been sent when a next message is sent, the Process requesting the object will be suspended until one is sent.!
----- Method: SharedQueue class>>new (in category 'instance creation') -----
new
    "Answer a new instance of SharedQueue that has 10 elements."
^self new: 10!
----- Method: SharedQueue class>>new: (in category 'instance creation') -----
new: anInteger 
    ^super new initialize: anInteger!
----- Method: SharedQueue>>flush (in category 'accessing') -----
flush
    "Throw out all pending contents"
    accessProtect critical: [
    	"nil out flushed slots --bf 02/11/2006"
    	contentsArray from: readPosition to: writePosition-1 put: nil.
    	readPosition := 1.
    	writePosition := 1.
    	"Reset the read synchronization semaphore"
    	readSynch initSignals].!
----- Method: SharedQueue>>flushAllSuchThat: (in category 'accessing') -----
flushAllSuchThat: aBlock
    "Remove from the queue all objects that satisfy aBlock."
    | value newReadPos |
    accessProtect critical: [
    	newReadPos := writePosition.
    	writePosition-1 to: readPosition by: -1 do:
    		[:i | value := contentsArray at: i.
    		contentsArray at: i put: nil.
    		(aBlock value: value) ifTrue: [
    			"We take an element out of the queue, and therefore, we need to decrement 
    			the readSynch signals"
    			readSynch wait.
    		] ifFalse: [
    			newReadPos := newReadPos - 1.
    			contentsArray at: newReadPos put: value]].
    	readPosition := newReadPos].
    ^value
!
----- Method: SharedQueue>>initialize: (in category 'private') -----
initialize: size
contentsArray := Array new: size.
    readPosition := 1.
    writePosition := 1.
    accessProtect := Semaphore forMutualExclusion.
    readSynch := Semaphore new!
----- Method: SharedQueue>>isEmpty (in category 'testing') -----
isEmpty
    "Answer whether any objects have been sent through the receiver and 
    not yet received by anyone."
^readPosition = writePosition!
----- Method: SharedQueue>>makeRoomAtEnd (in category 'private') -----
makeRoomAtEnd
    | contentsSize |
    readPosition = 1
    	ifTrue: [contentsArray := contentsArray , (Array new: 10)]
    	ifFalse: 
    		[contentsSize := writePosition - readPosition.
    		"BLT direction ok for this. Lots faster!!!!!!!!!!!! SqR!!!! 4/10/2000 10:47"
    		contentsArray
    			replaceFrom: 1
    			to: contentsSize
    			with: contentsArray
    			startingAt: readPosition.
    		"nil out remainder --bf 10/25/2005"
    		contentsArray
    			from: contentsSize+1
    			to: contentsArray size
    			put: nil.
    		readPosition := 1.
    		writePosition := contentsSize + 1]!
----- Method: SharedQueue>>next (in category 'accessing') -----
next
    "Answer the object that was sent through the receiver first and has not 
    yet been received by anyone. If no object has been sent, suspend the 
    requesting process until one is."
| value |
    readSynch wait.
    accessProtect
    	critical: [readPosition = writePosition
    				ifTrue: 
    					[self error: 'Error in SharedQueue synchronization'.
    					 value := nil]
    				ifFalse: 
    					[value := contentsArray at: readPosition.
    					 contentsArray at: readPosition put: nil.
    					 readPosition := readPosition + 1]].
    ^value!
----- Method: SharedQueue>>nextOrNil (in category 'accessing') -----
nextOrNil
    "Answer the object that was sent through the receiver first and has not 
    yet been received by anyone. If no object has been sent, answer <nil>."
| value |
accessProtect critical: [
    	readPosition >= writePosition ifTrue: [
    		value := nil
    	] ifFalse: [
    		value := contentsArray at: readPosition.
    		contentsArray at: readPosition put: nil.
    		readPosition := readPosition + 1
    	].
    	readPosition >= writePosition ifTrue: [readSynch initSignals].
    ].
    ^value!
----- Method: SharedQueue>>nextOrNilSuchThat: (in category 'accessing') -----
nextOrNilSuchThat: aBlock
    "Answer the next object that satisfies aBlock, skipping any intermediate objects.
    If no object has been sent, answer <nil> and leave me intact.
    NOTA BENE:  aBlock MUST NOT contain a non-local return (^)."
| value readPos |
    accessProtect critical: [
    	value := nil.
    	readPos := readPosition.
    	[readPos < writePosition and: [value isNil]] whileTrue: [
    		value := contentsArray at: readPos.
    		readPos := readPos + 1.
    		(aBlock value: value) ifTrue: [
    			readPosition to: readPos - 1 do: [ :j |
    				contentsArray at: j put: nil.
    			].
    			readPosition := readPos.
    		] ifFalse: [
    			value := nil.
    		].
    	].
    	readPosition >= writePosition ifTrue: [readSynch initSignals].
    ].
    ^value
"===
q := SharedQueue new.
1 to: 10 do: [ :i | q nextPut: i].
c := OrderedCollection new.
[
    v := q nextOrNilSuchThat: [ :e | e odd].
    v notNil
] whileTrue: [
    c add: {v. q size}
].
{c. q} explore
==="!
----- Method: SharedQueue>>nextPut: (in category 'accessing') -----
nextPut: value 
    "Send value through the receiver. If a Process has been suspended 
    waiting to receive a value through the receiver, allow it to proceed."
accessProtect
    	critical: [writePosition > contentsArray size
    					ifTrue: [self makeRoomAtEnd].
    			 contentsArray at: writePosition put: value.
    			 writePosition := writePosition + 1].
    readSynch signal.
    ^value!
----- Method: SharedQueue>>peek (in category 'accessing') -----
peek
    "Answer the object that was sent through the receiver first and has not 
    yet been received by anyone but do not remove it from the receiver. If 
    no object has been sent, return nil"
| value |
    accessProtect
    	critical: [readPosition >= writePosition
    				ifTrue: [readPosition := 1.
    						writePosition := 1.
    						value := nil]
    				ifFalse: [value := contentsArray at: readPosition]].
    ^value!
----- Method: SharedQueue>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    contentsArray := contentsArray copy.
    accessProtect := Semaphore forMutualExclusion.
    readSynch := Semaphore new!
----- Method: SharedQueue>>size (in category 'accessing') -----
size
    "Answer the number of objects that have been sent through the
    receiver and not yet received by anyone."
^writePosition - readPosition!
Object subclass: #Stack
    instanceVariableNames: 'linkedList'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Stack'!
!Stack commentStamp: 'dc 7/24/2005 15:41' prior: 0!
I implement a simple Stack. #push: adds a new object of any kind on top of the stack. #pop returns the first element and remove it from the stack. #top answer the first element of the stack without removing it.!
----- Method: Stack>>errorEmptyStack (in category 'private') -----
errorEmptyStack
    self error: 'this stack is empty'!
----- Method: Stack>>initialize (in category 'initialize-release') -----
initialize
    super initialize.
    linkedList := LinkedList new!
----- Method: Stack>>isEmpty (in category 'testing') -----
isEmpty
    ^ self linkedList isEmpty!
----- Method: Stack>>linkedList (in category 'private') -----
linkedList
    "The stack is implemented with a LinkedList. Do NOT call this function, it  
    is for private use !!"
    ^ linkedList!
----- Method: Stack>>notEmptyCheck (in category 'private') -----
notEmptyCheck
    "Ensure the stack is not empty."
    self isEmpty
    	ifTrue: [self errorEmptyStack]!
----- Method: Stack>>pop (in category 'removing') -----
pop
    "Returns the first element and remove it from the stack."
self notEmptyCheck.
    ^self linkedList removeFirst element!
----- Method: Stack>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    linkedList := linkedList copy!
----- Method: Stack>>push: (in category 'adding') -----
push: anObject 
    "Adds a new object of any kind on top of the stack."
    self linkedList
    	addFirst: (StackLink with: anObject).
    ^ anObject.!
----- Method: Stack>>size (in category 'accessing') -----
size
    "How many objects in me ?"
    ^ self linkedList size!
----- Method: Stack>>top (in category 'accessing') -----
top
    "Answer the first element of the stack without removing it."
    self notEmptyCheck.
    ^ self linkedList first element!
Object subclass: #Stream
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!Stream commentStamp: '<historical>' prior: 0!
I am an abstract class that represents an accessor for a sequence of objects. This sequence is referred to as my "contents".!
Stream subclass: #AttributedTextStream
    instanceVariableNames: 'characters attributeRuns attributeValues currentAttributes currentRun'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!AttributedTextStream commentStamp: '<historical>' prior: 0!
a stream on Text's which keeps track of the last attribute put; new characters are added with those attributes.
instance vars:
characters - a WriteStream of the characters in the stream
    attributeRuns - a RunArray with the attributes for the stream
    currentAttributes - the attributes to be used for new text
    attributesChanged - whether the attributes have changed since the last addition!
----- Method: AttributedTextStream class>>new (in category 'instance creation') -----
new
    "For this class we override Stream class>>new since this
    class actually is created using #new, even though it is a Stream."
    
    ^self basicNew initialize!
----- Method: AttributedTextStream>>contents (in category 'retrieving the text') -----
contents
    | ans |
    currentRun > 0 ifTrue:[
    	attributeValues nextPut: currentAttributes.
    	attributeRuns nextPut: currentRun.
    	currentRun := 0].
    ans := Text new: characters size.
    "this is declared private, but it's exactly what I need, and it's declared as exactly what I want it to do...."
    ans setString: characters contents  setRuns: 
    	(RunArray runs: attributeRuns contents values: attributeValues contents).
    ^ans!
----- Method: AttributedTextStream>>currentAttributes (in category 'access') -----
currentAttributes
    "return the current attributes"
    ^currentAttributes!
----- Method: AttributedTextStream>>currentAttributes: (in category 'access') -----
currentAttributes: newAttributes
    "set the current attributes"
    (currentRun > 0 and:[currentAttributes ~= newAttributes]) ifTrue:[
    	attributeRuns nextPut: currentRun.
    	attributeValues nextPut: currentAttributes.
    	currentRun := 0.
    ].
    currentAttributes := newAttributes.
!
----- Method: AttributedTextStream>>initialize (in category 'private-initialization') -----
initialize
    characters := WriteStream on: String new.
    currentAttributes := OrderedCollection new.
    currentRun := 0.
    attributeValues := WriteStream on: (Array new: 50).
    attributeRuns := WriteStream on: (Array new: 50).	!
----- Method: AttributedTextStream>>nextPut: (in category 'stream protocol') -----
nextPut: aChar
    currentRun := currentRun + 1.
    characters nextPut: aChar!
----- Method: AttributedTextStream>>nextPutAll: (in category 'stream protocol') -----
nextPutAll: aString
    "add an entire string with the same attributes"
    currentRun := currentRun + aString size.
    characters nextPutAll: aString.!
----- Method: AttributedTextStream>>size (in category 'access') -----
size
    "number of characters in the stream so far"
    ^characters size!
Stream subclass: #PositionableStream
    instanceVariableNames: 'collection position readLimit'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!PositionableStream commentStamp: '<historical>' prior: 0!
I represent an accessor for a sequence of objects (a collection) that are externally named by indices so that the point of access can be repositioned. I am abstract in that I do not implement the messages next and nextPut: which are inherited from my superclass Stream.!
----- Method: PositionableStream class>>on: (in category 'instance creation') -----
on: aCollection 
    "Answer an instance of me, streaming over the elements of aCollection."
^self basicNew on: aCollection!
----- Method: PositionableStream class>>on:from:to: (in category 'instance creation') -----
on: aCollection from: firstIndex to: lastIndex 
    "Answer an instance of me, streaming over the elements of aCollection 
    starting with the element at firstIndex and ending with the one at 
    lastIndex."
^self basicNew on: (aCollection copyFrom: firstIndex to: lastIndex)!
----- Method: PositionableStream>>asBinaryOrTextStream (in category 'converting') -----
asBinaryOrTextStream
    "Convert to a stream that can switch between bytes and characters"
^ (RWBinaryOrTextStream with: self contentsOfEntireFile) reset!
----- Method: PositionableStream>>asZLibReadStream (in category 'converting') -----
asZLibReadStream
    ^ZLibReadStream on: collection from: position+1 to: readLimit!
----- Method: PositionableStream>>atEnd (in category 'testing') -----
atEnd
    "Primitive. Answer whether the receiver can access any more objects.
    Optional. See Object documentation whatIsAPrimitive."
<primitive: 67>
    ^position >= readLimit!
----- Method: PositionableStream>>back (in category 'accessing') -----
back
    "Go back one element and return it."
    self position = 0 ifTrue: [self errorCantGoBack].
    self skip: -1.
    ^ self peek!
----- Method: PositionableStream>>backChunk (in category 'fileIn/Out') -----
backChunk
    "Answer the contents of the receiver back to the previous terminator character.  Doubled terminators indicate an embedded terminator character."
| terminator out ch |
    terminator := $!!.
    out := WriteStream on: (String new: 1000).
    [(ch := self oldBack) == nil] whileFalse: 
    		[ch == terminator 
    			ifTrue: 
    				[self peekBack == terminator 
    					ifTrue: [self oldBack	"skip doubled terminator"]
    					ifFalse: [^ out contents reversed]].
    		out nextPut: ch].
    ^ out contents reversed!
----- Method: PositionableStream>>backUpTo: (in category 'positioning') -----
backUpTo: subCollection
    "Back up the position to he subCollection.  Position must be somewhere within the stream initially.  Leave it just after it.  Return true if succeeded.  No wildcards, and case does matter."
"Example:
    | strm | strm := ReadStream on: 'zabc abdc'.
    strm setToEnd; backUpTo: 'abc'; position 
"
| pattern startMatch |
    pattern := ReadStream on: subCollection reversed.
    startMatch := nil.
    [pattern atEnd] whileFalse: 
    	[self position = 0 ifTrue: [^ false].
    	self skip: -1.
    	(self next) = (pattern next) 
    		ifTrue: [pattern position = 1 ifTrue: [startMatch := self position]]
    		ifFalse: [pattern position: 0.
    				startMatch ifNotNil: [
    					self position: startMatch-1.
    					startMatch := nil]].
    	self skip: -1].
    self position: startMatch.
    ^ true
!
----- Method: PositionableStream>>basicNextChunk (in category 'fileIn/Out') -----
basicNextChunk
    "Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."
    | terminator out ch |
    terminator := $!!.
    out := WriteStream on: (String new: 1000).
    self skipSeparators.
    [(ch := self next) == nil] whileFalse: [
    	(ch == terminator) ifTrue: [
    		self peek == terminator ifTrue: [
    			self next.  "skip doubled terminator"
    		] ifFalse: [
    			^ out contents  "terminator is not doubled; we're done!!"
    		].
    	].
    	out nextPut: ch.
    ].
    ^ out contents!
----- Method: PositionableStream>>boolean (in category 'data get/put') -----
boolean
    "Answer the next boolean value from this (binary) stream."
^ self next ~= 0
!
----- Method: PositionableStream>>boolean: (in category 'data get/put') -----
boolean: aBoolean
    "Store the given boolean value on this (binary) stream."
self nextPut: (aBoolean ifTrue: [1] ifFalse: [0]).
!
----- Method: PositionableStream>>checkForPreamble: (in category 'fileIn/Out') -----
checkForPreamble: chunk
    ((chunk beginsWith: '"Change Set:') and: [ChangeSet current preambleString == nil])
    	ifTrue: [ChangeSet current preambleString: chunk].
    ((chunk beginsWith: '"Postscript:') and: [ChangeSet current postscriptString == nil])
    	ifTrue: [ChangeSet current postscriptString: chunk].
    						
!
----- Method: PositionableStream>>command: (in category 'fileIn/Out') -----
command: aString
    "Overridden by HtmlFileStream to append commands directly without translation.  4/5/96 tk"
    "We ignore any HTML commands.  Do nothing"!
----- Method: PositionableStream>>contents (in category 'accessing') -----
contents
    "Answer with a copy of my collection from 1 to readLimit."
^collection copyFrom: 1 to: readLimit!
----- Method: PositionableStream>>contentsOfEntireFile (in category 'accessing') -----
contentsOfEntireFile
    "For non-file streams"
    ^ self contents!
----- Method: PositionableStream>>copyMethodChunkFrom: (in category 'fileIn/Out') -----
copyMethodChunkFrom: aStream
    "Copy the next chunk from aStream (must be different from the receiver)."
    | chunk |
    chunk := aStream nextChunkText.
    chunk runs values size = 1 "Optimize for unembellished text"
    	ifTrue: [self nextChunkPut: chunk asString]
    	ifFalse: [self nextChunkPutWithStyle: chunk]!
----- Method: PositionableStream>>copyMethodChunkFrom:at: (in category 'fileIn/Out') -----
copyMethodChunkFrom: aStream at: pos
    "Copy the next chunk from aStream (must be different from the receiver)."
    | chunk |
    aStream position: pos.
    chunk := aStream nextChunkText.
    chunk runs values size = 1 "Optimize for unembellished text"
    	ifTrue: [self nextChunkPut: chunk asString]
    	ifFalse: [self nextChunkPutWithStyle: chunk]!
----- Method: PositionableStream>>copyPreamble:from:at: (in category 'fileIn/Out') -----
copyPreamble: preamble from: aStream at: pos
    "Look for a changeStamp for this method by peeking backward.
    Write a method preamble, with that stamp if found."
    | terminator last50 stamp i |
    terminator := $!!.
"Look back to find stamp in old preamble, such as...
    Polygon methodsFor: 'private' stamp: 'di 6/25/97 21:42' prior: 34957598!! "
    aStream position: pos.
    	aStream backChunk.				"to beginning of method"
    	last50 := aStream backChunk.	"to get preamble"
    aStream position: pos.
stamp := String new.
    (i := last50 findLastOccuranceOfString: 'stamp:' startingAt: 1) > 0 ifTrue:
    	[stamp := (last50 copyFrom: i+8 to: last50 size) copyUpTo: $'].
"Write the new preamble, with old stamp if any."
    self cr; nextPut: terminator.
    self nextChunkPut: (String streamContents:
    	[:strm |
    	strm nextPutAll: preamble.
    	stamp size > 0 ifTrue:
    		[strm nextPutAll: ' stamp: '; print: stamp]]).
    self cr!
----- Method: PositionableStream>>decodeString:andRuns: (in category 'fileIn/Out') -----
decodeString: string andRuns: runsRaw
| strm runLength runValues newString index |
    strm := ReadStream on: runsRaw from: 1 to: runsRaw size.
    (strm peekFor: $( ) ifFalse: [^ nil].
    runLength := OrderedCollection new.
    [strm skipSeparators.
     strm peekFor: $)] whileFalse: 
    	[runLength add: (Number readFrom: strm)].
runValues := OrderedCollection new.
    [strm atEnd not] whileTrue: 
    	[runValues add: (Number readFrom: strm).
    	strm next.].
newString := WideString new: string size.
    index := 1.
    runLength with: runValues do: [:length :leadingChar |
    	index to: index + length - 1 do: [:pos |
    		newString at: pos put: (Character leadingChar: leadingChar code: (string at: pos) charCode).
    	].
    	index := index + length.
    ].
^ newString.
!
----- Method: PositionableStream>>decodeStyle:version: (in category 'fileIn/Out') -----
decodeStyle: runsObjData version: styleVersion
    "Decode the runs array from the ReferenceStream it is stored in."
    "Verify that the class mentioned have the same inst vars as we have now"
| structureInfo |
    styleVersion = RemoteString currentTextAttVersion ifTrue: [
    	"Matches our classes, no need for checking"
    	^ (ReferenceStream on: runsObjData) next].
    structureInfo := RemoteString structureAt: styleVersion.	"or nil"
    	"See SmartRefStream instVarInfo: for dfn"
    ^ SmartRefStream read: runsObjData withClasses: structureInfo!
----- Method: PositionableStream>>fileIn (in category 'fileIn/Out') -----
fileIn
    "This is special for reading expressions from text that has been formatted 
    with exclamation delimitors. The expressions are read and passed to the 
    Compiler. Answer the result of compilation."
^ self fileInAnnouncing: 'Reading ' , self name!
----- Method: PositionableStream>>fileInAnnouncing: (in category 'fileIn/Out') -----
fileInAnnouncing: announcement 
    "This is special for reading expressions from text that has been formatted 
    with exclamation delimitors. The expressions are read and passed to the 
    Compiler. Answer the result of compilation.  Put up a progress report with
     the given announcement as the title."
| val chunk |
    announcement 
    	displayProgressAt: Sensor cursorPoint
    	from: 0
    	to: self size
    	during: 
    		[:bar | 
    		[self atEnd] whileFalse: 
    				[bar value: self position.
    				self skipSeparators.
    				
    				[val := (self peekFor: $!!) 
    							ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
    							ifFalse: 
    								[chunk := self nextChunk.
    								self checkForPreamble: chunk.
    								Compiler evaluate: chunk logged: true]] 
    						on: InMidstOfFileinNotification
    						do: [:ex | ex resume: true].
    				self skipStyleChunk].
    		self close].
    "Note:  The main purpose of this banner is to flush the changes file."
    SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'.
    self flag: #ThisMethodShouldNotBeThere.	"sd"
    Smalltalk forgetDoIts.
    ^val!
----- Method: PositionableStream>>fileInFor:announcing: (in category 'fileIn/Out') -----
fileInFor: client announcing: announcement
    "This is special for reading expressions from text that has been formatted 
    with exclamation delimitors. The expressions are read and passed to the 
    Compiler. Answer the result of compilation.  Put up a progress report with
     the given announcement as the title.
    Does NOT handle preambles or postscripts specially."
    | val chunk |
    announcement displayProgressAt: Sensor cursorPoint
    	from: 0 to: self size
    	during:
    	[:bar |
    	[self atEnd]
    		whileFalse: 
    			[bar value: self position.
    			self skipSeparators.
    			[ val := (self peekFor: $!!) ifTrue: [
    					(Compiler evaluate: self nextChunk for: client logged: false) scanFrom: self
    				] ifFalse: [
    					chunk := self nextChunk.
    					self checkForPreamble: chunk.
    					Compiler evaluate: chunk for: client logged: true ].
    			] on: InMidstOfFileinNotification
    			  do: [ :ex | ex resume: true].
    			self atEnd ifFalse: [ self skipStyleChunk ]].
    	self close].
    "Note:  The main purpose of this banner is to flush the changes file."
    SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'.
    Smalltalk forgetDoIts.
    ^ val!
----- Method: PositionableStream>>fileInSilentlyAnnouncing: (in category 'fileIn/Out') -----
fileInSilentlyAnnouncing: announcement 
    "This is special for reading expressions from text that has been formatted 
    with exclamation delimitors. The expressions are read and passed to the 
    Compiler. Answer the result of compilation.  Put up a progress report with
     the given announcement as the title."
| val chunk |
    [self atEnd] whileFalse: 
    		[self skipSeparators.
    		
    		[val := (self peekFor: $!!) 
    					ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
    					ifFalse: 
    						[chunk := self nextChunk.
    						self checkForPreamble: chunk.
    						Compiler evaluate: chunk logged: true]] 
    				on: InMidstOfFileinNotification
    				do: [:ex | ex resume: true].
    		self skipStyleChunk].
    self close.
    "Note:  The main purpose of this banner is to flush the changes file."
    SmalltalkImage current  logChange: '----End fileIn of ' , self name , '----'.
    self flag: #ThisMethodShouldNotBeThere.	"sd"
    SystemNavigation new allBehaviorsDo: 
    		[:cl | 
    		cl
    			removeSelectorSimply: #DoIt;
    			removeSelectorSimply: #DoItIn:].
    ^val!
----- Method: PositionableStream>>header (in category 'fileIn/Out') -----
header
    "If the stream requires a standard header, override this message.  See HtmlFileStream"!
----- Method: PositionableStream>>int16 (in category 'data get/put') -----
int16
    "Answer the next signed, 16-bit integer from this (binary) stream."
| n |
    n := self next.
    n := (n bitShift: 8) + (self next).
    n >= 16r8000 ifTrue: [n := n - 16r10000].
    ^ n
!
----- Method: PositionableStream>>int16: (in category 'data get/put') -----
int16: anInteger
    "Store the given signed, 16-bit integer on this (binary) stream."
| n |
    (anInteger < -16r8000) | (anInteger >= 16r8000)
    	ifTrue: [self error: 'outside 16-bit integer range'].
anInteger < 0
    	ifTrue: [n := 16r10000 + anInteger]
    	ifFalse: [n := anInteger].
    self nextPut: (n digitAt: 2).
    self nextPut: (n digitAt: 1).
!
----- Method: PositionableStream>>int32 (in category 'data get/put') -----
int32
    "Answer the next signed, 32-bit integer from this (binary) stream."
    "Details: As a fast check for negative number, check the high bit of the first digit"
| n firstDigit |
    n := firstDigit := self next.
    n := (n bitShift: 8) + self next.
    n := (n bitShift: 8) + self next.
    n := (n bitShift: 8) + self next.
    firstDigit >= 128 ifTrue: [n := -16r100000000 + n].  "decode negative 32-bit integer"
    ^ n
!
----- Method: PositionableStream>>int32: (in category 'data get/put') -----
int32: anInteger
    "Store the given signed, 32-bit integer on this (binary) stream."
| n |
    (anInteger < -16r80000000) | (anInteger >= 16r80000000)
    	ifTrue: [self error: 'outside 32-bit integer range'].
anInteger < 0
    	ifTrue: [n := 16r100000000 + anInteger]
    	ifFalse: [n := anInteger].
    self nextPut: (n digitAt: 4).
    self nextPut: (n digitAt: 3).
    self nextPut: (n digitAt: 2).
    self nextPut: (n digitAt: 1).
!
----- Method: PositionableStream>>isBinary (in category 'testing') -----
isBinary
    "Return true if the receiver is a binary byte stream"
    ^collection class == ByteArray!
----- Method: PositionableStream>>isEmpty (in category 'testing') -----
isEmpty
    "Answer whether the receiver's contents has no elements."
"Returns true if both the set of past and future sequence values of
the receiver are empty. Otherwise returns false"
^ self atEnd and: [position = 0]!
----- Method: PositionableStream>>last (in category 'accessing') -----
last
    "Return the final element in the receiver"
^ collection at: position!
----- Method: PositionableStream>>match: (in category 'positioning') -----
match: subCollection
    "Set the access position of the receiver to be past the next occurrence of the subCollection. Answer whether subCollection is found.  No wildcards, and case does matter."
| pattern startMatch |
    pattern := ReadStream on: subCollection.
    startMatch := nil.
    [pattern atEnd] whileFalse: 
    	[self atEnd ifTrue: [^ false].
    	(self next) = (pattern next) 
    		ifTrue: [pattern position = 1 ifTrue: [startMatch := self position]]
    		ifFalse: [pattern position: 0.
    				startMatch ifNotNil: [
    					self position: startMatch.
    					startMatch := nil]]].
    ^ true
!
----- Method: PositionableStream>>next: (in category 'accessing') -----
next: anInteger 
    "Answer the next anInteger elements of my collection. Must override 
    because default uses self contents species, which might involve a large 
    collection."
| newArray |
    newArray := collection species new: anInteger.
    1 to: anInteger do: [:index | newArray at: index put: self next].
    ^newArray!
----- Method: PositionableStream>>next:into: (in category 'accessing') -----
next: n into: aCollection
    "Read n objects into the given collection.
    Return aCollection or a partial copy if less than
    n elements have been read."
    ^self next: n into: aCollection startingAt: 1!
----- Method: PositionableStream>>next:into:startingAt: (in category 'accessing') -----
next: n into: aCollection startingAt: startIndex
    "Read n objects into the given collection. 
    Return aCollection or a partial copy if less than
    n elements have been read."
    | obj |
    0 to: n-1 do:[:i|
    	(obj := self next) == nil ifTrue:[^aCollection copyFrom: 1 to: startIndex+i-1].
    	aCollection at: startIndex+i put: obj].
    ^aCollection!
----- Method: PositionableStream>>next:putAll: (in category 'accessing') -----
next: anInteger putAll: aCollection
    "Store the next anInteger elements from the given collection."
    ^self next: anInteger putAll: aCollection startingAt: 1!
----- Method: PositionableStream>>next:putAll:startingAt: (in category 'accessing') -----
next: anInteger putAll: aCollection startingAt: startIndex
    "Store the next anInteger elements from the given collection."
    (startIndex = 1 and:[anInteger = aCollection size])
    	ifTrue:[^self nextPutAll: aCollection].
    ^self nextPutAll: (aCollection copyFrom: startIndex to: startIndex+anInteger-1)!
----- Method: PositionableStream>>nextChunk (in category 'fileIn/Out') -----
nextChunk
    "Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."
    | terminator out ch |
    terminator := $!!.
    out := WriteStream on: (String new: 1000).
    self skipSeparators.
    [(ch := self next) == nil] whileFalse: [
    	(ch == terminator) ifTrue: [
    		self peek == terminator ifTrue: [
    			self next.  "skip doubled terminator"
    		] ifFalse: [
    			^ self parseLangTagFor: out contents  "terminator is not doubled; we're done!!"
    		].
    	].
    	out nextPut: ch.
    ].
    ^ self parseLangTagFor: out contents.
!
----- Method: PositionableStream>>nextChunkText (in category 'fileIn/Out') -----
nextChunkText
    "Deliver the next chunk as a Text.  Decode the following ]style[ chunk if present.  Position at start of next real chunk."
    | string runsRaw strm runs peek pos |
    "Read the plain text"
    string := self nextChunk.
    
    "Test for ]style[ tag"
    pos := self position.
    peek := self skipSeparatorsAndPeekNext.
    peek = $] ifFalse: [self position: pos. ^ string asText].  "no tag"
    (self upTo: $[) = ']style' ifFalse: [self position: pos. ^ string asText].  "different tag"
"Read and decode the style chunk"
    runsRaw := self basicNextChunk.	"style encoding"
    strm := ReadStream on: runsRaw from: 1 to: runsRaw size.
    runs := RunArray scanFrom: strm.
^ Text basicNew setString: string setRunsChecking: runs.
!
----- Method: PositionableStream>>nextDelimited: (in category 'accessing') -----
nextDelimited: terminator
    "Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character.  For example: 'this '' was a quote'. Start postioned before the initial terminator."
| out ch |
    out := WriteStream on: (String new: 1000).
    self atEnd ifTrue: [^ ''].
    self next == terminator ifFalse: [self skip: -1].	"absorb initial terminator"
    [(ch := self next) == nil] whileFalse: [
    	(ch == terminator) ifTrue: [
    		self peek == terminator ifTrue: [
    			self next.  "skip doubled terminator"
    		] ifFalse: [
    			^ out contents  "terminator is not doubled; we're done!!"
    		].
    	].
    	out nextPut: ch.
    ].
    ^ out contents!
----- Method: PositionableStream>>nextInt32 (in category 'nonhomogeneous accessing') -----
nextInt32
    "Read a 32-bit signed integer from the next 4 bytes"
    | s |
    s := 0.
    1 to: 4 do: [:i | s := (s bitShift: 8) + self next].
    (s bitAnd: 16r80000000) = 0
    	ifTrue: [^ s]
    	ifFalse: [^ -1 - s bitInvert32]!
----- Method: PositionableStream>>nextInt32Put: (in category 'nonhomogeneous accessing') -----
nextInt32Put: int32
    "Write a signed integer to the next 4 bytes"
    | pos |
    pos := int32 < 0
    	ifTrue: [(0-int32) bitInvert32 + 1]
    	ifFalse: [int32].
    1 to: 4 do: [:i | self nextPut: (pos digitAt: 5-i)].
    ^ int32!
----- Method: PositionableStream>>nextInto: (in category 'accessing') -----
nextInto: aCollection
    "Read the next elements of the receiver into aCollection.
    Return aCollection or a partial copy if less than aCollection
    size elements have been read."
    ^self next: aCollection size into: aCollection startingAt: 1.!
----- Method: PositionableStream>>nextInto:startingAt: (in category 'accessing') -----
nextInto: aCollection startingAt: startIndex
    "Read the next elements of the receiver into aCollection.
    Return aCollection or a partial copy if less than aCollection
    size elements have been read."
    ^self next: (aCollection size - startIndex+1) into: aCollection startingAt: startIndex.!
----- Method: PositionableStream>>nextLine (in category 'accessing') -----
nextLine
    "Answer next line (may be empty), or nil if at end"
self atEnd ifTrue: [^nil].
    ^self upTo: Character cr!
----- Method: PositionableStream>>nextLittleEndianNumber: (in category 'nonhomogeneous accessing') -----
nextLittleEndianNumber: n 
    "Answer the next n bytes as a positive Integer or LargePositiveInteger, where the bytes are ordered from least significant to most significant."
| bytes s |
    bytes := self next: n.
    s := 0.
    n to: 1 by: -1 do: [:i | s := (s bitShift: 8) bitOr: (bytes at: i)].
    ^ s
!
----- Method: PositionableStream>>nextLittleEndianNumber:put: (in category 'nonhomogeneous accessing') -----
nextLittleEndianNumber: n put: value
    "Answer the next n bytes as a positive Integer or LargePositiveInteger, where the bytes are ordered from least significant to most significant."
    | bytes |
    bytes := ByteArray new: n.
    1 to: n do: [: i | bytes at: i put: (value digitAt: i)].
    self nextPutAll: bytes!
----- Method: PositionableStream>>nextNumber: (in category 'nonhomogeneous accessing') -----
nextNumber: n 
    "Answer the next n bytes as a positive Integer or LargePositiveInteger."
    | s |
    s := 0.
    1 to: n do: 
    	[:i | s := (s bitShift: 8) bitOr: self next asInteger].
    ^ s normalize!
----- Method: PositionableStream>>nextNumber:put: (in category 'nonhomogeneous accessing') -----
nextNumber: n put: v 
    "Append to the receiver the argument, v, which is a positive 
    SmallInteger or a LargePositiveInteger, as the next n bytes.
    Possibly pad with leading zeros."
1 to: n do: [:i | self nextPut: (v digitAt: n+1-i)].
    ^ v
!
----- Method: PositionableStream>>nextString (in category 'nonhomogeneous accessing') -----
nextString
    "Read a string from the receiver. The first byte is the length of the string, unless it is greater than 192, in which case the first four bytes encode the length.  I expect to be in ascii mode when called (caller puts back to binary)."
| length aByteArray |
"read the length in binary mode"
    self binary.
    length := self next.		"first byte."
    length >= 192 ifTrue: [length := length - 192.
    	1 to: 3 do: [:ii | length := length * 256 + self next]].
    aByteArray := ByteArray new: length.
self nextInto: aByteArray.
    ^aByteArray asString.
!
----- Method: PositionableStream>>nextStringOld (in category 'nonhomogeneous accessing') -----
nextStringOld
    "Read a string from the receiver. The first byte is the length of the 
    string, unless it is greater than 192, in which case the first *two* bytes 
    encode the length.  Max size 16K. "
| aString length |
    length := self next.		"first byte."
    length >= 192 ifTrue: [length := (length - 192) * 256 + self next].
    aString := String new: length.
    1 to: length do: [:ii | aString at: ii put: self next asCharacter].
    ^aString!
----- Method: PositionableStream>>nextStringPut: (in category 'nonhomogeneous accessing') -----
nextStringPut: s 
    "Append the string, s, to the receiver.  Only used by DataStream.  Max size of 64*256*256*256."
| length |
    (length := s size) < 192
    	ifTrue: [self nextPut: length]
    	ifFalse: 
    		[self nextPut: (length digitAt: 4)+192.
    		self nextPut: (length digitAt: 3).
    		self nextPut: (length digitAt: 2).
    		self nextPut: (length digitAt: 1)].
    self nextPutAll: s asByteArray.
    ^s!
----- Method: PositionableStream>>nextWord (in category 'nonhomogeneous accessing') -----
nextWord
    "Answer the next two bytes from the receiver as an Integer."
| high low |
    high := self next.
    	high==nil ifTrue: [^false].
    low := self next.
    	low==nil ifTrue: [^false].
    ^(high asInteger bitShift: 8) + low asInteger!
----- Method: PositionableStream>>nextWordPut: (in category 'nonhomogeneous accessing') -----
nextWordPut: aWord 
    "Append to the receiver an Integer as the next two bytes."
self nextPut: ((aWord bitShift: -8) bitAnd: 255).
    self nextPut: (aWord bitAnd: 255).
    ^aWord!
----- Method: PositionableStream>>nextWordsInto: (in category 'accessing') -----
nextWordsInto: aBitmap 
    "Fill the word based buffer from my collection. 
    Stored on stream as Big Endian. Optimized for speed. 
    Read in BigEndian, then restoreEndianness."
    | blt pos source byteSize |
    collection class isBytes
    	ifFalse: [^ self next: aBitmap size into: aBitmap startingAt: 1].
byteSize := aBitmap byteSize.
    "is the test on collection basicSize \ 4 necessary?"
    ((self position bitAnd: 3) = 0 and: [ (collection basicSize bitAnd: 3) = 0])
    	ifTrue: [source := collection.
    		pos := self position.
    		self skip: byteSize]
    	ifFalse: ["forced to copy it into a buffer"
    		source := self next: byteSize.
    		pos := 0].
"Now use BitBlt to copy the bytes to the bitmap."
    blt := (BitBlt current
    			toForm: (Form new hackBits: aBitmap))
    			sourceForm: (Form new hackBits: source).
    blt combinationRule: Form over. "store"
    blt sourceX: 0;
    	 sourceY: pos // 4;
    	 height: byteSize // 4;
    	 width: 4.
    blt destX: 0;
    	 destY: 0.
    blt copyBits.
"And do whatever the bitmap needs to do to convert from big-endian order."
    aBitmap restoreEndianness.
^ aBitmap 	"May be WordArray, ColorArray, etc"
!
----- Method: PositionableStream>>oldBack (in category 'accessing') -----
oldBack
    "Go back one element and return it.  Use indirect messages in case I am a StandardFileStream"
    "The method is a misconception about what a stream is. A stream contains a pointer *between* elements with past and future elements. This method considers that the pointer is *on* an element. Please consider unit tests which verifies #back and #oldBack behavior. (Damien Cassou - 1 August 2007)"
    self position = 0 ifTrue: [self errorCantGoBack].
    self position = 1 ifTrue: [self position: 0.  ^ nil].
    self skip: -2.
    ^ self next
!
----- Method: PositionableStream>>on: (in category 'private') -----
on: aCollection
collection := aCollection.
    readLimit := aCollection size.
    position := 0.
    self reset!
----- Method: PositionableStream>>originalContents (in category 'accessing') -----
originalContents
    "Answer the receiver's actual contents collection, NOT a copy.  1/29/96 sw"
^ collection!
----- Method: PositionableStream>>padTo:put: (in category 'positioning') -----
padTo: nBytes put: aCharacter 
    "Pad using the argument, aCharacter, to the next boundary of nBytes characters."
    | rem |
    rem := nBytes - (self position \ nBytes).
    rem = nBytes ifTrue: [^ 0].
    self next: rem put: aCharacter.!
----- Method: PositionableStream>>padToNextLongPut: (in category 'positioning') -----
padToNextLongPut: char 
    "Make position be on long word boundary, writing the padding 
    character, char, if necessary."
    [self position \ 4 = 0]
    	whileFalse: [self nextPut: char]!
----- Method: PositionableStream>>parseLangTagFor: (in category 'fileIn/Out') -----
parseLangTagFor: aString
| string peek runsRaw pos |
    string := aString.
    "Test for ]lang[ tag"
    pos := self position.
    peek := self skipSeparatorsAndPeekNext.
    peek = $] ifFalse: [self position: pos. ^ string].  "no tag"
    (self upTo: $[) = ']lang' ifTrue: [
    	runsRaw := self basicNextChunk.
    	string := self decodeString: aString andRuns: runsRaw
    ] ifFalse: [
    	self position: pos
    ].
    ^ string.
!
----- Method: PositionableStream>>peek (in category 'accessing') -----
peek
    "Answer what would be returned if the message next were sent to the 
    receiver. If the receiver is at the end, answer nil."
| nextObject |
    self atEnd ifTrue: [^nil].
    nextObject := self next.
    position := position - 1.
    ^nextObject!
----- Method: PositionableStream>>peekBack (in category 'accessing') -----
peekBack
    "Return the element at the previous position, without changing position.  Use indirect messages in case self is a StandardFileStream."
| element |
    element := self oldBack.
    self skip: 1.
    ^ element!
----- Method: PositionableStream>>peekFor: (in category 'accessing') -----
peekFor: anObject 
    "Answer false and do not move over the next element if it is not equal to 
    the argument, anObject, or if the receiver is at the end. Answer true 
    and increment the position for accessing elements, if the next element is 
    equal to anObject."
| nextObject |
    self atEnd ifTrue: [^false].
    nextObject := self next.
    "peek for matching element"
    anObject = nextObject ifTrue: [^true].
    "gobble it if found"
    position := position - 1.
    ^false!
----- Method: PositionableStream>>position (in category 'positioning') -----
position
    "Answer the current position of accessing the sequence of objects."
^position!
----- Method: PositionableStream>>position: (in category 'positioning') -----
position: anInteger 
    "Set the current position for accessing the objects to be anInteger, as long 
    as anInteger is within the bounds of the receiver's contents. If it is not, 
    create an error notification."
(anInteger >= 0 and: [anInteger <= readLimit])
    	ifTrue: [position := anInteger]
    	ifFalse: [self positionError]!
----- Method: PositionableStream>>positionError (in category 'private') -----
positionError
    "Since I am not necessarily writable, it is up to my subclasses to override 
    position: if expanding the collection is preferrable to giving this error."
self error: 'Attempt to set the position of a PositionableStream out of bounds'!
----- Method: PositionableStream>>positionOfSubCollection: (in category 'positioning') -----
positionOfSubCollection: subCollection
    "Return a position such that that element at the new position equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at the current position.
    If no such match is found, answer 0."
^self positionOfSubCollection: subCollection ifAbsent: [0]!
----- Method: PositionableStream>>positionOfSubCollection:ifAbsent: (in category 'positioning') -----
positionOfSubCollection: subCollection ifAbsent: exceptionBlock
    "Return a position such that that element at the new position equals the first element of sub, and the next elements equal the rest of the elements of sub. Begin the search at the current position.
    If no such match is found, answer the result of evaluating argument, exceptionBlock."
| pattern startPosition currentPosition |
    pattern := ReadStream on: subCollection.
    startPosition := self position.
    [pattern atEnd] whileFalse: 
    	[self atEnd ifTrue: [^exceptionBlock value].
    	self next = pattern next
    		ifFalse: [
    			self position: self position-pattern position+1.
    			pattern reset]].
    currentPosition := self position.
    self position: startPosition.
    ^pattern atEnd
    	ifTrue: [currentPosition + 1 - subCollection size]
    	ifFalse: [exceptionBlock value]!
----- Method: PositionableStream>>pushBack: (in category 'positioning') -----
pushBack: aString
    "Compatibility with SocketStreams"
    self skip: aString size negated!
----- Method: PositionableStream>>reset (in category 'positioning') -----
reset
    "Set the receiver's position to the beginning of the sequence of objects."
position := 0!
----- Method: PositionableStream>>resetContents (in category 'positioning') -----
resetContents
    "Set the position and limits to 0."
position := 0.
    readLimit := 0!
----- Method: PositionableStream>>setFrom:to: (in category 'private') -----
setFrom: newStart to: newStop
position := newStart - 1.
    readLimit := newStop!
----- Method: PositionableStream>>setToEnd (in category 'positioning') -----
setToEnd
    "Set the position of the receiver to the end of the sequence of objects."
position := readLimit!
----- Method: PositionableStream>>skip: (in category 'positioning') -----
skip: anInteger 
    "Set the receiver's position to be the current position+anInteger. A 
    subclass might choose to be more helpful and select the minimum of the 
    receiver's size and position+anInteger, or the maximum of 1 and 
    position+anInteger for the repositioning."
self position: position + anInteger!
----- Method: PositionableStream>>skipSeparators (in category 'fileIn/Out') -----
skipSeparators
    [self atEnd]
    	whileFalse:
    	[self next isSeparator ifFalse: [^ self position: self position-1]]!
----- Method: PositionableStream>>skipSeparatorsAndPeekNext (in category 'fileIn/Out') -----
skipSeparatorsAndPeekNext
    "A special function to make nextChunk fast"
    | peek |
    [self atEnd]
    	whileFalse:
    	[(peek := self next) isSeparator
    		ifFalse: [self position: self position-1. ^ peek]]!
----- Method: PositionableStream>>skipStyleChunk (in category 'fileIn/Out') -----
skipStyleChunk
    "Get to the start of the next chunk that is not a style for the previous chunk"
| pos |
    pos := self position.
    self skipSeparators.
    self peek == $] 
    	ifTrue: [(self upTo: $[) = ']text' 	"old -- no longer needed"
    			"now positioned past the open bracket"
    		ifFalse: [self nextChunk]]	"absorb ]style[ and its whole chunk"
    			
    	ifFalse: [self position: pos]	"leave untouched"
!
----- Method: PositionableStream>>skipTo: (in category 'positioning') -----
skipTo: anObject 
    "Set the access position of the receiver to be past the next occurrence of 
    anObject. Answer whether anObject is found."
[self atEnd]
    	whileFalse: [self next = anObject ifTrue: [^true]].
    ^false!
----- Method: PositionableStream>>string (in category 'data get/put') -----
string
    "Answer the next string from this (binary) stream."
| size |
    size := self uint16.
    ^ (self next: size) asString
!
----- Method: PositionableStream>>string: (in category 'data get/put') -----
string: aString
    "Store the given string on this (binary) stream. The string must contain 65535 or fewer characters."
aString size > 16rFFFF ifTrue: [self error: 'string too long for this format'].
    self uint16: aString size.
    self nextPutAll: aString asByteArray.
!
----- Method: PositionableStream>>trailer (in category 'fileIn/Out') -----
trailer
    "If the stream requires a standard trailer, override this message.  See HtmlFileStream"!
----- Method: PositionableStream>>uint16 (in category 'data get/put') -----
uint16
    "Answer the next unsigned, 16-bit integer from this (binary) stream."
| n |
    n := self next.
    n := (n bitShift: 8) + (self next).
    ^ n
!
----- Method: PositionableStream>>uint16: (in category 'data get/put') -----
uint16: anInteger
    "Store the given unsigned, 16-bit integer on this (binary) stream."
(anInteger < 0) | (anInteger >= 16r10000)
    	ifTrue: [self error: 'outside unsigned 16-bit integer range'].
self nextPut: (anInteger digitAt: 2).
    self nextPut: (anInteger digitAt: 1).
!
----- Method: PositionableStream>>uint24 (in category 'data get/put') -----
uint24
    "Answer the next unsigned, 24-bit integer from this (binary) stream."
| n |
    n := self next.
    n := (n bitShift: 8) + self next.
    n := (n bitShift: 8) + self next.
    ^ n
!
----- Method: PositionableStream>>uint24: (in category 'data get/put') -----
uint24: anInteger
    "Store the given unsigned, 24-bit integer on this (binary) stream."
(anInteger < 0) | (anInteger >= 16r1000000)
    	ifTrue: [self error: 'outside unsigned 24-bit integer range'].
self nextPut: (anInteger digitAt: 3).
    self nextPut: (anInteger digitAt: 2).
    self nextPut: (anInteger digitAt: 1).
!
----- Method: PositionableStream>>uint32 (in category 'data get/put') -----
uint32
    "Answer the next unsigned, 32-bit integer from this (binary) stream."
| n |
    n := self next.
    n := (n bitShift: 8) + self next.
    n := (n bitShift: 8) + self next.
    n := (n bitShift: 8) + self next.
    ^ n
!
----- Method: PositionableStream>>uint32: (in category 'data get/put') -----
uint32: anInteger
    "Store the given unsigned, 32-bit integer on this (binary) stream."
(anInteger < 0) | (anInteger >= 16r100000000)
    	ifTrue: [self error: 'outside unsigned 32-bit integer range'].
self nextPut: (anInteger digitAt: 4).
    self nextPut: (anInteger digitAt: 3).
    self nextPut: (anInteger digitAt: 2).
    self nextPut: (anInteger digitAt: 1).
!
----- Method: PositionableStream>>unCommand (in category 'fileIn/Out') -----
unCommand
    "If this read stream is at a <, then skip up to just after the next >.  For removing html commands."
    | char |
    [self peek = $<] whileTrue: ["begin a block"
    	[self atEnd == false and: [self next ~= $>]] whileTrue.
    	"absorb characters"
    	].
 !
----- Method: PositionableStream>>untilEndWithFork:displayingProgress: (in category 'positioning') -----
untilEndWithFork: aBlock displayingProgress: aString 
    | sem done result |
    sem := Semaphore new.
    done := false.
    [[result := aBlock value]
    	ensure: [done := true.
    		sem signal]] fork.
    self
    	untilEnd: [done
    			ifTrue: [^ result].
    		(Delay forSeconds: 0.2) wait]
    	displayingProgress: aString.
    sem wait.
    ^ result!
----- Method: PositionableStream>>upTo: (in category 'accessing') -----
upTo: anObject 
    "Answer a subcollection from the current access position to the 
    occurrence (if any, but not inclusive) of anObject in the receiver. If 
    anObject is not in the collection, answer the entire rest of the receiver."
    | newStream element |
    newStream := WriteStream on: (collection species new: 100).
    [self atEnd or: [(element := self next) = anObject]]
    	whileFalse: [newStream nextPut: element].
    ^newStream contents!
----- Method: PositionableStream>>upToAll: (in category 'accessing') -----
upToAll: aCollection
    "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of aCollection. If aCollection is not in the stream, answer the entire rest of the stream."
| startPos endMatch result |
    startPos := self position.
    (self match: aCollection) 
    	ifTrue: [endMatch := self position.
    		self position: startPos.
    		result := self next: endMatch - startPos - aCollection size.
    		self position: endMatch.
    		^ result]
    	ifFalse: [self position: startPos.
    		^ self upToEnd]!
----- Method: PositionableStream>>upToAnyOf: (in category 'accessing') -----
upToAnyOf: aCollection 
    "Answer a subcollection from the current access position to the 
    occurrence (if any, but not inclusive) of any object in the collection. If 
    no matching object is found, answer the entire rest of the receiver."
    | newStream element |
    newStream := WriteStream on: (collection species new: 100).
    [self atEnd or: [aCollection includes: (element := self next)]]
    	whileFalse: [newStream nextPut: element].
    ^newStream contents!
----- Method: PositionableStream>>upToEnd (in category 'accessing') -----
upToEnd
    "Answer a subcollection from the current access position through the last element of the receiver."
| newStream |
    newStream := WriteStream on: (collection species new: 100).
    [self atEnd] whileFalse: [ newStream nextPut: self next ].
    ^ newStream contents!
----- Method: PositionableStream>>verbatim: (in category 'fileIn/Out') -----
verbatim: aString
    "Do not attempt to translate the characters.  Use to override nextPutAll:"
    ^ self nextPutAll: aString!
PositionableStream subclass: #ReadStream
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!ReadStream commentStamp: '<historical>' prior: 0!
I represent an accessor for a sequence of objects that can only read objects from the sequence.!
----- Method: ReadStream class>>on:from:to: (in category 'instance creation') -----
on: aCollection from: firstIndex to: lastIndex 
    "Answer with a new instance streaming over a copy of aCollection from
    firstIndex to lastIndex."
^self basicNew
    	on: aCollection
    	from: firstIndex
    	to: lastIndex!
----- Method: ReadStream>>ascii (in category 'accessing') -----
ascii!
----- Method: ReadStream>>binary (in category 'accessing') -----
binary!
----- Method: ReadStream>>localName (in category 'file stream compatibility') -----
localName
    ^'ReadStream'!
----- Method: ReadStream>>next (in category 'accessing') -----
next
    "Primitive. Answer the next object in the Stream represented by the
    receiver. Fail if the collection of this stream is not an Array or a String.
    Fail if the stream is positioned at its end, or if the position is out of
    bounds in the collection. Optional. See Object documentation
    whatIsAPrimitive."
<primitive: 65>
    position >= readLimit
    	ifTrue: [^nil]
    	ifFalse: [^collection at: (position := position + 1)]!
----- Method: ReadStream>>next: (in category 'accessing') -----
next: anInteger 
    "Answer the next anInteger elements of my collection.  overriden for efficiency"
| ans endPosition |
endPosition := position + anInteger  min:  readLimit.
    ans := collection copyFrom: position+1 to: endPosition.
    position := endPosition.
    ^ans
!
----- Method: ReadStream>>next:into:startingAt: (in category 'accessing') -----
next: n into: aCollection startingAt: startIndex
    "Read n objects into the given collection. 
    Return aCollection or a partial copy if less than
    n elements have been read."
    | max |
    max := (readLimit - position) min: n.
    aCollection 
    	replaceFrom: startIndex 
    	to: startIndex+max-1
    	with: collection
    	startingAt: position+1.
    position := position + max.
    max = n
    	ifTrue:[^aCollection]
    	ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1]!
----- Method: ReadStream>>nextFloat (in category 'accessing') -----
nextFloat
    "Read a floating point value from the receiver. This method is highly optimized for cases
    where many floating point values need to be read subsequently. And if this needs to go
    even faster, look at the inner loops fetching the characters - moving those into a plugin
    would speed things up even more."
    | buffer count sign index cc value digit fraction exp startIndex anyDigit digitNeeded |
    buffer := collection.
    count := readLimit.
    index := position+1.
"Skip separators"
    index := ByteString findFirstInString: buffer inSet: String noSeparatorMap startingAt: index.
    index = 0 ifTrue:[self setToEnd. ^nil].
"check for sign"
    digitNeeded := false.
    sign := 1. cc := buffer byteAt: index.
    cc = 45 "$- asciiValue"
    	ifTrue:[sign := -1. index := index+1. digitNeeded := true]
    	ifFalse:[cc =  43 "$+ asciiValue" ifTrue:[index := index+1. digitNeeded := true]].
"Read integer part"
    startIndex := index.
    value := 0.
    [index <= count and:[
    	digit := (buffer byteAt: index) - 48. "$0 asciiValue"
    	digit >= 0 and:[digit <= 9]]] whileTrue:[
    		value := value * 10 + digit.
    		index := index + 1.
    ].
    anyDigit := index > startIndex.
    index > count ifTrue:[
    	(digitNeeded and:[anyDigit not]) ifTrue:[^self error: 'At least one digit expected'].
    	self setToEnd. ^value asFloat * sign].
(buffer byteAt: index) = 46 "$. asciiValue" ifTrue:["<integer>.<fraction>"
    	index := index+1.
    	startIndex := index.
    	"NOTE: fraction and exp below can overflow into LargeInteger range. If they do, then things slow down horribly due to the relatively slow LargeInt -> Float conversion. This can be avoided by changing fraction and exp to use floats to begin with (0.0 and 1.0 respectively), however, this will give different results to Float>>readFrom: and it is not clear if that is acceptable here."
    	fraction := 0. exp := 1.
    	[index <= count and:[
    		digit := (buffer byteAt: index) - 48. "$0 asciiValue"
    		digit >= 0 and:[digit <= 9]]] whileTrue:[
    			fraction := fraction * 10 + digit.
    			exp := exp * 10.
    			index := index + 1.
    	].
    	value := value + (fraction asFloat / exp asFloat).
    	anyDigit := anyDigit or:[index > startIndex].
    ].
    value := value asFloat * sign.
"At this point we require at least one digit to avoid allowing:
    	- . ('0.0' without leading digits)
    	- e32 ('0e32' without leading digits) 
    	- .e32 ('0.0e32' without leading digits)
    but these are currently allowed:
    	- .5 (0.5)
    	- 1. ('1.0')
    	- 1e32 ('1.0e32')
    	- 1.e32 ('1.0e32')
    	- .5e32 ('0.5e32')
    "
    anyDigit ifFalse:["Check for NaN/Infinity first"
    	(count - index >= 2 and:[(buffer copyFrom: index to: index+2) = 'NaN'])
    		ifTrue:[position := index+2. ^Float nan * sign].
    	(count - index >= 7 and:[(buffer copyFrom: index to: index+7) = 'Infinity'])
    		ifTrue:[position := index+7. ^Float infinity * sign].
    	^self error: 'At least one digit expected'
    ].
index > count ifTrue:[self setToEnd. ^value asFloat].
(buffer byteAt: index) = 101 "$e asciiValue" ifTrue:["<number>e[+|-]<exponent>"
    	index := index+1. "skip e"
    	sign := 1. cc := buffer byteAt: index.
    	cc = 45 "$- asciiValue"
    		ifTrue:[sign := -1. index := index+1]
    		ifFalse:[cc = 43 "$+ asciiValue" ifTrue:[index := index+1]].
    	startIndex := index.
    	exp := 0. anyDigit := false.
    	[index <= count and:[
    		digit := (buffer byteAt: index) - 48. "$0 asciiValue"
    		digit >= 0 and:[digit <= 9]]] whileTrue:[
    			exp := exp * 10 + digit.
    			index := index + 1.
    	].
    	index> startIndex ifFalse:[^self error: 'Exponent expected'].
    	value := value * (10.0 raisedToInteger: exp * sign).
    ].
position := index-1.
    ^value!
----- Method: ReadStream>>nextPut: (in category 'accessing') -----
nextPut: anObject
self shouldNotImplement!
----- Method: ReadStream>>on:from:to: (in category 'private') -----
on: aCollection from: firstIndex to: lastIndex
| len |
    collection := aCollection.
    readLimit :=  lastIndex > (len := collection size)
    					ifTrue: [len]
    					ifFalse: [lastIndex].
    position := firstIndex <= 1
    			ifTrue: [0]
    			ifFalse: [firstIndex - 1]!
----- Method: ReadStream>>openReadOnly (in category 'file stream compatibility') -----
openReadOnly!
----- Method: ReadStream>>readOnly (in category 'file stream compatibility') -----
readOnly!
----- Method: ReadStream>>readStream (in category 'accessing') -----
readStream
    "polymorphic with SequenceableCollection.  Return self"
^ self!
----- Method: ReadStream>>size (in category 'accessing') -----
size
    "Compatibility with other streams (e.g., FileStream)"
    ^readLimit!
----- Method: ReadStream>>upTo: (in category 'accessing') -----
upTo: anObject
    "fast version using indexOf:"
    | start end |
start := position+1.
    end := collection indexOf: anObject startingAt: start ifAbsent: [ 0 ].
"not present--return rest of the collection"	
    end = 0 ifTrue: [ ^self upToEnd ].
"skip to the end and return the data passed over"
    position := end.
    ^collection copyFrom: start to: (end-1)!
----- Method: ReadStream>>upToEnd (in category 'accessing') -----
upToEnd
    | start |
start := position+1.
    position := collection size.
    ^collection copyFrom: start to: position!
PositionableStream subclass: #WriteStream
    instanceVariableNames: 'writeLimit'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!WriteStream commentStamp: '<historical>' prior: 0!
I represent an accessor for a sequence of objects that can only store objects in the sequence.!
WriteStream subclass: #LimitedWriteStream
    instanceVariableNames: 'limit limitBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!LimitedWriteStream commentStamp: '<historical>' prior: 0!
A LimitedWriteStream is a specialized WriteStream that has a maximum size of the collection it streams over. When this limit is reached a special limitBlock is executed. This can for example be used to "bail out" of lengthy streaming operations before they have finished.  For a simple example take a look at the universal Object printString.
The message SequenceableCollection class streamContents:limitedTo: creates a LimitedWriteStream. In this case it prevents very large (or possibly recursive) object structures to "overdo" their textual representation. !
----- Method: LimitedWriteStream>>nextPut: (in category 'accessing') -----
nextPut: anObject 
    "Ensure that the limit is not exceeded"
position >= limit ifTrue: [limitBlock value]
    ifFalse: [super nextPut: anObject].
!
----- Method: LimitedWriteStream>>nextPutAll: (in category 'as yet unclassified') -----
nextPutAll: aCollection
| newEnd |
    collection class == aCollection class ifFalse:
    	[^ super nextPutAll: aCollection ].
newEnd := position + aCollection size.
    newEnd > limit ifTrue: [
    	super nextPutAll: (aCollection copyFrom: 1 to: (limit - position max: 0)).
    	^ limitBlock value.
    ].
    newEnd > writeLimit ifTrue: [
    	self growTo: newEnd + 10
    ].
collection replaceFrom: position+1 to: newEnd  with: aCollection startingAt: 1.
    position := newEnd.!
----- Method: LimitedWriteStream>>pastEndPut: (in category 'as yet unclassified') -----
pastEndPut: anObject
    collection size >= limit ifTrue: [limitBlock value].  "Exceptional return"
    ^ super pastEndPut: anObject!
----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'as yet unclassified') -----
setLimit: sizeLimit limitBlock: aBlock
    "Limit the numer of elements this stream will write..."
    limit := sizeLimit.
    "Execute this (typically ^ contents) when that limit is exceded"
    limitBlock := aBlock!
WriteStream subclass: #ReadWriteStream
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!ReadWriteStream commentStamp: '<historical>' prior: 0!
I represent an accessor for a sequence of objects. My instances can both read and store objects.!
ReadWriteStream subclass: #RWBinaryOrTextStream
    instanceVariableNames: 'isBinary'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!RWBinaryOrTextStream commentStamp: '<historical>' prior: 0!
A simulation of a FileStream, but living totally in memory.  Hold the contents of a file or web page from the network.  Can then fileIn like a normal FileStream.
Need to be able to switch between binary and text, as a FileStream does, without recopying the whole collection.  Convert to binary upon input and output.  Always keep as text internally.!
----- Method: RWBinaryOrTextStream>>asBinaryOrTextStream (in category 'as yet unclassified') -----
asBinaryOrTextStream
^ self!
----- Method: RWBinaryOrTextStream>>ascii (in category 'as yet unclassified') -----
ascii
    isBinary := false!
----- Method: RWBinaryOrTextStream>>binary (in category 'as yet unclassified') -----
binary
    isBinary := true!
----- Method: RWBinaryOrTextStream>>contents (in category 'as yet unclassified') -----
contents
    "Answer with a copy of my collection from 1 to readLimit."
| newArray |
    isBinary ifFalse: [^ super contents].	"String"
    readLimit := readLimit max: position.
    newArray := ByteArray new: readLimit.
    ^ newArray replaceFrom: 1
    	to: readLimit
    	with: collection
    	startingAt: 1.!
----- Method: RWBinaryOrTextStream>>contentsOfEntireFile (in category 'as yet unclassified') -----
contentsOfEntireFile
    "For compatibility with file streams."
^ self contents!
----- Method: RWBinaryOrTextStream>>isBinary (in category 'as yet unclassified') -----
isBinary
    ^ isBinary!
----- Method: RWBinaryOrTextStream>>next (in category 'as yet unclassified') -----
next
| byte |
    ^ isBinary 
    		ifTrue: [byte := super next.
    			 byte ifNil: [nil] ifNotNil: [byte asciiValue]]
    		ifFalse: [super next].
!
----- Method: RWBinaryOrTextStream>>next: (in category 'as yet unclassified') -----
next: anInteger 
    "Answer the next anInteger elements of my collection. Must override to get class right."
| newArray |
    newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: anInteger.
    ^ self nextInto: newArray!
----- Method: RWBinaryOrTextStream>>next:into:startingAt: (in category 'as yet unclassified') -----
next: n into: aCollection startingAt: startIndex
    "Read n objects into the given collection. 
    Return aCollection or a partial copy if less than n elements have been read."
    "Overriden for efficiency"
    | max |
    max := (readLimit - position) min: n.
    aCollection 
    	replaceFrom: startIndex 
    	to: startIndex+max-1
    	with: collection
    	startingAt: position+1.
    position := position + max.
    max = n
    	ifTrue:[^aCollection]
    	ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1]!
----- Method: RWBinaryOrTextStream>>next:putAll:startingAt: (in category 'writing') -----
next: anInteger putAll: aCollection startingAt: startIndex
    "Optimized for ByteArrays"
    aCollection class == ByteArray 
    	ifTrue:[^super next: anInteger putAll: aCollection asString startingAt: startIndex].
    ^super next: anInteger putAll: aCollection startingAt: startIndex!
----- Method: RWBinaryOrTextStream>>nextPut: (in category 'as yet unclassified') -----
nextPut: charOrByte
super nextPut: charOrByte asCharacter!
----- Method: RWBinaryOrTextStream>>nextPutAll: (in category 'writing') -----
nextPutAll: aCollection
    "Optimized for ByteArrays"
    aCollection class == ByteArray 
    	ifTrue:[^super nextPutAll: aCollection asString].
    ^super nextPutAll: aCollection!
----- Method: RWBinaryOrTextStream>>padToEndWith: (in category 'as yet unclassified') -----
padToEndWith: aChar
    "We don't have pages, so we are at the end, and don't need to pad."!
----- Method: RWBinaryOrTextStream>>reset (in category 'as yet unclassified') -----
reset
    "Set the receiver's position to the beginning of the sequence of objects."
super reset.
    isBinary ifNil: [isBinary := false].
    collection class == ByteArray ifTrue: ["Store as String and convert as needed."
    	collection := collection asString.
    	isBinary := true].
!
----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'as yet unclassified') -----
setFileTypeToObject
    "do nothing.  We don't have a file type"!
----- Method: RWBinaryOrTextStream>>text (in category 'as yet unclassified') -----
text
    isBinary := false!
----- Method: RWBinaryOrTextStream>>upTo: (in category 'accessing') -----
upTo: anObject 
    "Answer a subcollection from the current access position to the 
    occurrence (if any, but not inclusive) of anObject in the receiver. If 
    anObject is not in the collection, answer the entire rest of the receiver."
    | newStream element species |
    species := isBinary ifTrue:[ByteArray] ifFalse:[String].
    newStream := WriteStream on: (species new: 100).
    [self atEnd or: [(element := self next) = anObject]]
    	whileFalse: [newStream nextPut: element].
    ^newStream contents!
----- Method: RWBinaryOrTextStream>>upToEnd (in category 'as yet unclassified') -----
upToEnd
    "Must override to get class right."
    | newArray |
    newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position.
    ^ self nextInto: newArray!
----- Method: ReadWriteStream>>= (in category 'testing') -----
= other
(self class == ReadWriteStream and: [other class == ReadWriteStream]) ifFalse: [
    	^ super = other].	"does an identity test.  Don't read contents of FileStream"
    ^ self position = other position and: [self contents = other contents]!
----- Method: ReadWriteStream>>asUnZippedStream (in category 'converting') -----
asUnZippedStream
    | isGZip outputStream first strm archive which |
    "Decompress this file if needed, and return a stream.  No file is written.  File extension may be .gz or anything else.  Also works on archives (.zip, .gZip)."
strm := self binary.
    strm isZipArchive ifTrue: [
    	archive := ZipArchive new readFrom: strm.
    	which := archive members detect: [:any | any fileName asLowercase endsWith: '.ttf'] 
    							ifNone: [nil].
    	which ifNil: [archive close.
    				^ self error: 'Can''t find .ttf file in archive'].
    	strm := which contentStream.
    	archive close].
first := strm next.
    isGZip := (strm next * 256 + first) = (GZipConstants gzipMagic).
    strm skip: -2.
    isGZip 
    	ifTrue: [outputStream := (MultiByteBinaryOrTextStream with:
    								(GZipReadStream on: strm) upToEnd) reset.
    			strm close]
    	ifFalse: [outputStream := strm].
    ^ outputStream!
----- Method: ReadWriteStream>>close (in category 'file status') -----
close
    "Presumably sets the status of the receiver to be closed. This message does 
    nothing at this level, but is included for FileStream compatibility."
^self!
----- Method: ReadWriteStream>>closed (in category 'file status') -----
closed
    "If you have close (for FileStream compatibility), you must respond to closed.  The result in nonsense here.  TK 29 May 96"
^ false!
----- Method: ReadWriteStream>>contents (in category 'accessing') -----
contents
    "Answer with a copy of my collection from 1 to readLimit."
readLimit := readLimit max: position.
    ^collection copyFrom: 1 to: readLimit!
----- Method: ReadWriteStream>>fileInObjectAndCode (in category 'fileIn/Out') -----
fileInObjectAndCode
    "This file may contain:
1) a fileIn of code  
2) just an object in SmartReferenceStream format 
3) both code and an object.
    File it in and return the object.  Note that self must be a FileStream or RWBinaryOrTextStream.  Maybe ReadWriteStream incorporate RWBinaryOrTextStream?"
    | refStream object |
    self text.
    self peek asciiValue = 4
    	ifTrue: [  "pure object file"
    		refStream := SmartRefStream on: self.
    		object := refStream nextAndClose]
    	ifFalse: [  "objects mixed with a fileIn"
    		self fileIn.  "reads code and objects, then closes the file"
    		object := SmartRefStream scannedObject].	"set by side effect of one of the chunks"
    SmartRefStream scannedObject: nil.  "clear scannedObject"
    ^ object!
----- Method: ReadWriteStream>>fileNameEndsWith: (in category 'fileIn/Out') -----
fileNameEndsWith: aString
    "See comment in FileStream fileNameEndsWith:"
^false!
----- Method: ReadWriteStream>>fileOutChangeSet:andObject: (in category 'fileIn/Out') -----
fileOutChangeSet: aChangeSetOrNil andObject: theObject
    "Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
"An experimental version to fileout a changeSet first so that a project can contain its own classes"
self setFileTypeToObject.
    	"Type and Creator not to be text, so can attach correctly to an email msg"
    self header; timeStamp.
aChangeSetOrNil ifNotNil: [
    	aChangeSetOrNil fileOutPreambleOn: self.
    	aChangeSetOrNil fileOutOn: self.
    	aChangeSetOrNil fileOutPostscriptOn: self.
    ].
    self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
"Append the object's raw data"
    (SmartRefStream on: self)
    	nextPut: theObject;  "and all subobjects"
    	close.		"also closes me"
!
----- Method: ReadWriteStream>>fileOutChanges (in category 'fileIn/Out') -----
fileOutChanges
    "Append to the receiver a description of all class changes."
    Cursor write showWhile:
    	[self header; timeStamp.
    	ChangeSet current fileOutOn: self.
    	self trailer; close]!
----- Method: ReadWriteStream>>fileOutClass:andObject: (in category 'fileIn/Out') -----
fileOutClass: extraClass andObject: theObject
    "Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
| class srefStream |
    self setFileTypeToObject.
    	"Type and Creator not to be text, so can attach correctly to an email msg"
    self text.
    self header; timeStamp.
extraClass ifNotNil: [
    	class := extraClass.	"A specific class the user wants written"
    	class sharedPools size > 0 ifTrue:
    		[class shouldFileOutPools
    			ifTrue: [class fileOutSharedPoolsOn: self]].
    	class fileOutOn: self moveSource: false toFile: 0].
    self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
    self binary.
"Append the object's raw data"
    srefStream := SmartRefStream on: self.
    srefStream nextPut: theObject.  "and all subobjects"
    srefStream close.		"also closes me"
!
----- Method: ReadWriteStream>>fileOutClass:andObject:blocking: (in category 'fileIn/Out') -----
fileOutClass: extraClass andObject: theObject blocking: anIdentDict
    "Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically.  Accept a list of objects to map to nil or some other object (blockers).  In addition to teh choices in each class's objectToStoreOnDataStream"
| class srefStream |
    self setFileTypeToObject.
    	"Type and Creator not to be text, so can attach correctly to an email msg"
    self header; timeStamp.
extraClass ifNotNil: [
    	class := extraClass.	"A specific class the user wants written"
    	class sharedPools size > 0 ifTrue:
    		[class shouldFileOutPools
    			ifTrue: [class fileOutSharedPoolsOn: self]].
    	class fileOutOn: self moveSource: false toFile: 0].
    self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
"Append the object's raw data"
    srefStream := SmartRefStream on: self.
    srefStream blockers: anIdentDict.
    srefStream nextPut: theObject.  "and all subobjects"
    srefStream close.		"also closes me"
!
----- Method: ReadWriteStream>>hash (in category 'testing') -----
hash
self class == ReadWriteStream ifFalse: [^ super hash].
    ^ (self position + readLimit + 53) hash!
----- Method: ReadWriteStream>>isZipArchive (in category 'testing') -----
isZipArchive
    "Determine if this appears to be a valid Zip archive"
    | sig |
    self binary.
    sig := self next: 4.
    self position: self position - 4. "rewind"
    ^ZipArchive validSignatures includes: sig!
----- Method: ReadWriteStream>>name (in category 'accessing') -----
name
    ^ 'a stream'   "for fileIn compatibility"!
----- Method: ReadWriteStream>>next (in category 'accessing') -----
next
    "Primitive. Return the next object in the Stream represented by the
    receiver. Fail if the collection of this stream is not an Array or a String.
    Fail if the stream is positioned at its end, or if the position is out of
    bounds in the collection. Optional. See Object documentation
    whatIsAPrimitive."
<primitive: 65>
    "treat me as a FIFO"
    position >= readLimit
    	ifTrue: [^nil]
    	ifFalse: [^collection at: (position := position + 1)]!
----- Method: ReadWriteStream>>next: (in category 'accessing') -----
next: anInteger 
    "Answer the next anInteger elements of my collection.  overriden for efficiency"
| ans endPosition |
    readLimit := readLimit max: position.
endPosition := position + anInteger  min:  readLimit.
    ans := collection copyFrom: position+1 to: endPosition.
    position := endPosition.
    ^ans
!
----- Method: ReadWriteStream>>readStream (in category 'converting') -----
readStream
    "polymorphic with SequenceableCollection.  Return self"
^ self!
ReadWriteStream subclass: #Transcripter
    instanceVariableNames: 'frame para'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
!Transcripter commentStamp: '<historical>' prior: 0!
Transcripter is a dog-simple scrolling stream with display.  It is intended to operate with no support from MVC or color in a minimal, or headless version of Squeak.  No attention has been paid to appearance or performance.!
----- Method: Transcripter class>>emergencyEvaluator (in category 'utilities') -----
emergencyEvaluator
    (Transcripter newInFrame: (0@0 corner: 320@200))
    	show: 'Type ''revert'' to revert your last method change.
Type ''exit'' to exit the emergency evaluator.';
    	readEvalPrint!
----- Method: Transcripter class>>newInFrame: (in category 'instance creation') -----
newInFrame: frame
"
(Transcripter newInFrame: (0@0 extent: 100@200))
    nextPutAll: 'Hello there'; endEntry;
    cr; print: 355.0/113; endEntry;
    readEvalPrint.
"
    | transcript |
    transcript := self on: (String new: 100).
    transcript initInFrame: frame.
    ^ transcript clear!
----- Method: Transcripter class>>startTranscriptProcess (in category 'instance creation') -----
startTranscriptProcess   "Transcripter startTranscriptProcess"
    | activeProcess |
    Transcript := self newInFrame: Display boundingBox.
    activeProcess := [Transcript readEvalPrint.
    				Smalltalk processShutDownList: true; quitPrimitive]
    					newProcess
    				priority: Processor userSchedulingPriority.
    activeProcess resume.
    Processor terminateActive
!
----- Method: Transcripter>>black (in category 'private') -----
black
    Display depth = 1 ifTrue: [^ Bitmap with: 16rFFFFFFFF "Works without color support"].
    ^ Color black!
----- Method: Transcripter>>clear (in category 'accessing') -----
clear
    Display fill: (frame insetBy: -2) fillColor: self black;
    		fill: frame fillColor: self white.
    self on: (String new: 100); endEntry!
----- Method: Transcripter>>confirm: (in category 'command line') -----
confirm: queryString 
    | choice |
    [true]
    	whileTrue: 
    		[choice := self request: queryString , '
Please type yes or no followed by return'.
    		choice first asUppercase = $Y ifTrue: [^ true].
    		choice first asUppercase = $N ifTrue: [^ false]]!
----- Method: Transcripter>>endEntry (in category 'accessing') -----
endEntry
    | c d cb |
    c := self contents.
    Display extent ~= DisplayScreen actualScreenSize ifTrue:
    	["Handle case of user resizing physical window"
    	DisplayScreen startUp.
    	frame := frame intersect: Display boundingBox.
    	^ self clear; show: c].
    para setWithText: c asText
    	style: TextStyle default
    	compositionRectangle: ((frame insetBy: 4) withHeight: 9999)
    	clippingRectangle: frame
    	foreColor: self black backColor: self white.
    d := para compositionRectangle bottom - frame bottom.
    d > 0 ifTrue:
    	["Scroll up to keep all contents visible"
    	cb := para characterBlockAtPoint: para compositionRectangle topLeft
    										+ (0@(d+para lineGrid)).
    	self on: (c copyFrom: cb stringIndex to: c size).
    	readLimit:= position:= collection size.
    	^ self endEntry].
    para display!
----- Method: Transcripter>>initInFrame: (in category 'initialization') -----
initInFrame: rect
    frame := rect insetBy: 2.  "Leave room for border"
    para := Paragraph withText: self contents asText
    			style: TextStyle default
    			compositionRectangle: ((frame insetBy: 4) withHeight: 9999)
    			clippingRectangle: frame
    			foreColor: self black backColor: self white!
----- Method: Transcripter>>readEvalPrint (in category 'command line') -----
readEvalPrint
    | line okToRevert |
    okToRevert := true.
    [#('quit' 'exit' 'done' ) includes: (line := self request: '>')]
    	whileFalse:
    	[line = 'revert'
    	ifTrue: [okToRevert
    		ifTrue: [Utilities revertLastMethodSubmission.
    				self cr; show: 'reverted: ' , Utilities mostRecentlySubmittedMessage.
    				okToRevert := false]
    		ifFalse: [self cr; show: 'Only one level of revert currently supported']]
    	ifFalse: [self cr; show: ([Compiler evaluate: line] ifError: [:err :ex | err])]]!
----- Method: Transcripter>>request: (in category 'command line') -----
request: prompt
    | startPos char contents | 
    self cr; show: prompt.
    startPos := position.
    [[Sensor keyboardPressed] whileFalse.
    (char := Sensor keyboard) = Character cr]
    	whileFalse:
    	[char = Character backspace
    		ifTrue: [readLimit := position := (position - 1 max: startPos)]
    		ifFalse: [self nextPut: char].
    	self endEntry].
    contents := self contents.
    ^ contents copyFrom: startPos + 1 to: contents size!
----- Method: Transcripter>>show: (in category 'accessing') -----
show: anObject
    self nextPutAll: anObject asString; endEntry!
----- Method: Transcripter>>white (in category 'private') -----
white
    Display depth = 1 ifTrue: [^ Bitmap with: 0 "Works without color support"].
    ^ Color white!
WriteStream subclass: #TextStream
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Streams'!
----- Method: TextStream>>applyAttribute:beginningAt: (in category 'as yet unclassified') -----
applyAttribute: att beginningAt: startPos
    collection addAttribute: att from: startPos to: self position!
----- Method: TextStream>>nextPutAll: (in category 'as yet unclassified') -----
nextPutAll: aCollection 
    "Optimized access to get around Text at:Put: overhead"
    | n |
    n := aCollection size.
     position + n > writeLimit
       ifTrue:
        [self growTo: position + n + 10].
    collection 
    	replaceFrom: position+1
    	to: position + n
    	with: aCollection
    	startingAt: 1.
    position := position + n!
----- Method: TextStream>>withAttribute:do: (in category 'as yet unclassified') -----
withAttribute: att do: strmBlock
    | pos1 val |
    pos1 := self position.
    val := strmBlock value.
    collection addAttribute: att from: pos1+1 to: self position.
    ^ val!
----- Method: TextStream>>withAttributes:do: (in category 'as yet unclassified') -----
withAttributes: attributes do: streamBlock 
    | pos1 val |
    pos1 := self position.
    val := streamBlock value.
    attributes do: [:attribute |
    	collection
    		addAttribute: attribute
    		from: pos1 + 1
    		to: self position].
    ^ val!
WriteStream subclass: #TranscriptStream
    instanceVariableNames: ''
    classVariableNames: 'AccessSema'
    poolDictionaries: ''
    category: 'Collections-Streams'!
!TranscriptStream commentStamp: '<historical>' prior: 0!
This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic.  Because it inherits from Stream, it is automatically compatible with code that is designe to write to streams.!
----- Method: TranscriptStream class>>buildWith: (in category 'toolbuilder') -----
buildWith: aBuilder
    ^(Smalltalk at: #Transcript) buildWith: aBuilder!
----- Method: TranscriptStream class>>initialize (in category 'class initialization') -----
initialize
self registerInFlapsRegistry.	!
----- Method: TranscriptStream class>>new (in category 'as yet unclassified') -----
new
    ^ self on: (String new: 1000)
"
INSTALLING:
TextCollector allInstances do:
    [:t | t breakDependents.
    t become: TranscriptStream new].
TESTING: (Execute this text in a workspace)
Do this first...
    tt := TranscriptStream new.
    tt openLabel: 'Transcript test 1'.
Then this will open a second view -- ooooh...
    tt openLabel: 'Transcript test 2'.
And finally make them do something...
    tt clear.
    [Sensor anyButtonPressed] whileFalse:
    	[1 to: 20 do: [:i | tt print: (2 raisedTo: i-1); cr; endEntry]].
"!
----- Method: TranscriptStream class>>newTranscript: (in category 'as yet unclassified') -----
newTranscript: aTextCollector 
    "Store aTextCollector as the value of the system global Transcript."
    Smalltalk at: #Transcript put: aTextCollector!
----- Method: TranscriptStream class>>openMorphicTranscript (in category 'as yet unclassified') -----
openMorphicTranscript
    "Have the current project's transcript open up as a morph"
^ToolBuilder open: self!
----- Method: TranscriptStream class>>registerInFlapsRegistry (in category 'class initialization') -----
registerInFlapsRegistry
    "Register the receiver in the system's flaps registry"
    self environment
    	at: #Flaps
    	ifPresent: [:cl | cl registerQuad: #(TranscriptStream		openMorphicTranscript	'Transcript'			'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.')
    					forFlapNamed: 'Tools']
!
----- Method: TranscriptStream class>>unload (in category 'class initialization') -----
unload
    "Unload the receiver from global registries"
self environment at: #Flaps ifPresent: [:cl |
    cl unregisterQuadsWithReceiver: self] !
----- Method: TranscriptStream class>>windowColorSpecification (in category 'window color') -----
windowColorSpecification
    "Answer a WindowColorSpec object that declares my preference"
^ WindowColorSpec classSymbol: self name wording: 'Transcript' brightColor: #lightOrange pastelColor: #paleOrange helpMessage: 'The system transcript'!
----- Method: TranscriptStream>>bs (in category 'stream extensions') -----
bs
    self position > 0 ifTrue: [^ self skip: -1].
    self changed: #bs!
----- Method: TranscriptStream>>buildWith: (in category 'toolbuilder') -----
buildWith: builder
    | windowSpec textSpec |
    windowSpec := builder pluggableWindowSpec new.
    windowSpec model: self.
    windowSpec label: 'Transcript'.
    windowSpec children: OrderedCollection new.
textSpec := builder pluggableTextSpec new.
    textSpec 
    	model: self;
    	menu: #codePaneMenu:shifted:;
    	frame: (0@0corner: 1@1).
    windowSpec children add: textSpec.
^builder build: windowSpec!
----- Method: TranscriptStream>>characterLimit (in category 'access') -----
characterLimit
    "Tell the views how much to retain on screen"
    ^ 20000!
----- Method: TranscriptStream>>clear (in category 'stream extensions') -----
clear
    "Clear all characters and redisplay the view"
    self changed: #clearText.
    self reset!
----- Method: TranscriptStream>>closeAllViews (in category 'initialization') -----
closeAllViews
    "Transcript closeAllViews"
self dependents do: 
    		[:d | 
    		(d isKindOf: PluggableTextView) 
    			ifTrue: [d topView controller closeAndUnscheduleNoTerminate].
    		(d isSystemWindow) ifTrue: [d delete]]!
----- Method: TranscriptStream>>codePaneMenu:shifted: (in category 'model protocol') -----
codePaneMenu: aMenu shifted: shifted
    "Note that unless we override perform:orSendTo:, PluggableTextController will respond to all menu items"
    ^ StringHolder basicNew codePaneMenu: aMenu shifted: shifted
!
----- Method: TranscriptStream>>endEntry (in category 'stream extensions') -----
endEntry
    "Display all the characters since the last endEntry, and reset the stream"
    self semaphore critical:[
    	self changed: #appendEntry.
    	self reset.
    ].!
----- Method: TranscriptStream>>flush (in category 'stream extensions') -----
flush
    self endEntry
!
----- Method: TranscriptStream>>open (in category 'initialization') -----
open
    | openCount |
    openCount := 0.
    self dependents do:
    	[:d | ((d isKindOf: PluggableTextView) or:
    		[d isKindOf: PluggableTextMorph]) ifTrue: [openCount := openCount + 1]].
    openCount = 0
    	ifTrue: [self openLabel: 'Transcript']
    	ifFalse: [self openLabel: 'Transcript #' , (openCount+1) printString]!
----- Method: TranscriptStream>>openLabel: (in category 'initialization') -----
openLabel: aString 
    "Open a window on this transcriptStream"
    ^ToolBuilder open: self label: aString!
----- Method: TranscriptStream>>pastEndPut: (in category 'stream extensions') -----
pastEndPut: anObject
    "If the stream reaches its limit, just output the contents and reset."
    self endEntry.
    ^ self nextPut: anObject!
----- Method: TranscriptStream>>perform:orSendTo: (in category 'model protocol') -----
perform: selector orSendTo: otherTarget
    "Selector was just chosen from a menu by a user.  If can respond, then
perform it on myself. If not, send it to otherTarget, presumably the
editPane from which the menu was invoked."
(self respondsTo: selector)
    	ifTrue: [^ self perform: selector]
    	ifFalse: [^ otherTarget perform: selector]!
----- Method: TranscriptStream>>release (in category 'model protocol') -----
release
self dependents do:
    	[:view | (view isMorph and: [view isInWorld not])
    				ifTrue: [self removeDependent: view]]!
----- Method: TranscriptStream>>semaphore (in category 'private') -----
semaphore
    ^AccessSema ifNil:[AccessSema := Semaphore forMutualExclusion]!
----- Method: TranscriptStream>>show: (in category 'stream extensions') -----
show: anObject  "TextCollector compatibility"
    self nextPutAll: anObject asString; endEntry!
----- Method: TranscriptStream>>step (in category 'model protocol') -----
step
    "Objects that may be models of SystemWindows need to respond to this, albeit vacuously"!
----- Method: WriteStream class>>on:from:to: (in category 'instance creation') -----
on: aCollection from: firstIndex to: lastIndex 
    "Answer an instance of me on a copy of the argument, aCollection, 
    determined by the indices firstIndex and lastIndex. Position the instance 
    at the beginning of the collection."
^self basicNew
    	on: aCollection
    	from: firstIndex
    	to: lastIndex!
----- Method: WriteStream class>>with: (in category 'instance creation') -----
with: aCollection 
    "Answer an instance of me on the argument, aCollection, positioned to 
    store objects at the end of aCollection."
^self basicNew with: aCollection!
----- Method: WriteStream class>>with:from:to: (in category 'instance creation') -----
with: aCollection from: firstIndex to: lastIndex 
    "Answer an instance of me on the subcollection of the argument, 
    aCollection, determined by the indices firstIndex and lastIndex. Position 
    the instance to store at the end of the subcollection."
^self basicNew with: (aCollection copyFrom: firstIndex to: lastIndex)!
----- Method: WriteStream>>braceArray (in category 'private') -----
braceArray
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
^ collection!
----- Method: WriteStream>>braceArray: (in category 'private') -----
braceArray: anArray
    "This method is used in compilation of brace constructs.
    It MUST NOT be deleted or altered."
collection := anArray.
    position := 0.
    readLimit := 0.
    writeLimit := anArray size.!
----- Method: WriteStream>>contents (in category 'accessing') -----
contents
readLimit := readLimit max: position.
    ^collection copyFrom: 1 to: position!
----- Method: WriteStream>>cr (in category 'character writing') -----
cr
    "Append a return character to the receiver."
self nextPut: Character cr!
----- Method: WriteStream>>crtab (in category 'character writing') -----
crtab
    "Append a return character, followed by a single tab character, to the 
    receiver."
self nextPut: Character cr.
    self nextPut: Character tab!
----- Method: WriteStream>>crtab: (in category 'character writing') -----
crtab: anInteger 
    "Append a return character, followed by anInteger tab characters, to the 
    receiver."
self nextPut: Character cr.
    anInteger timesRepeat: [self nextPut: Character tab]!
----- Method: WriteStream>>ensureASpace (in category 'character writing') -----
ensureASpace
    "Append a space character to the receiver IFF there is not one on the end."
self ensureEndsWith: Character space!
----- Method: WriteStream>>ensureEndsWith: (in category 'accessing') -----
ensureEndsWith: anObject
    "Append anObject to the receiver IFF there is not one on the end."
(position > 0 and: [(collection at: position) = anObject]) ifTrue: [^self].
    self nextPut: anObject!
----- Method: WriteStream>>ensureNoSpace (in category 'character writing') -----
ensureNoSpace
    "If there is not one on the end, remove it."
(position > 0 and: [(collection at: position) = Character space]) 
    	ifTrue: [self skip: -1].!
----- Method: WriteStream>>flush (in category 'file open/close') -----
flush!
----- Method: WriteStream>>growTo: (in category 'private') -----
growTo: anInteger
" anInteger is the required minimal new size of the collection "
    | oldSize grownCollection newSize |
    oldSize := collection size.
     newSize := anInteger + (oldSize // 4 max: 20).
    grownCollection := collection class new: newSize.
    collection := grownCollection replaceFrom: 1 to: oldSize with: collection startingAt: 1.
    writeLimit := collection size.
!
----- Method: WriteStream>>next (in category 'accessing') -----
next
self shouldNotImplement!
----- Method: WriteStream>>next:putAll:startingAt: (in category 'accessing') -----
next: anInteger putAll: aCollection startingAt: startIndex
    "Store the next anInteger elements from the given collection."
| newEnd |
    collection class == aCollection class ifFalse:
    	[^ super next: anInteger putAll: aCollection startingAt: startIndex].
newEnd := position + anInteger.
    newEnd > writeLimit ifTrue:
    	[self growTo: newEnd + 10].
collection replaceFrom: position+1 to: newEnd  with: aCollection startingAt: startIndex.
    position := newEnd.
^aCollection!
----- Method: WriteStream>>nextChunkPut: (in category 'fileIn/Out') -----
nextChunkPut: aString
    "Append the argument, aString, to the receiver, doubling embedded terminators."
| i remainder terminator |
    terminator := $!!.
    remainder := aString.
    [(i := remainder indexOf: terminator) = 0] whileFalse:
    	[self nextPutAll: (remainder copyFrom: 1 to: i).
    	self nextPut: terminator.  "double imbedded terminators"
    	remainder := remainder copyFrom: i+1 to: remainder size].
    self nextPutAll: remainder.
    aString includesUnifiedCharacter ifTrue: [
    	self nextPut: terminator.
    	self nextPutAll: ']lang['.
    	aString writeLeadingCharRunsOn: self.
    ].
    self nextPut: terminator.
!
----- Method: WriteStream>>nextChunkPutWithStyle: (in category 'fileIn/Out') -----
nextChunkPutWithStyle: aStringOrText
    "Append the argument, aText, to the receiver, doubling embedded terminators.  Put out one chunk for the string and one for the style runs.  Mark the style with ]style[."
aStringOrText isString ifTrue: [^ self nextChunkPut: aStringOrText].
    aStringOrText runs coalesce.
    aStringOrText unembellished ifTrue: [^ self nextChunkPut: aStringOrText asString].
self nextChunkPut: aStringOrText asString.
    self cr; nextPutAll: ']style['.
    self nextChunkPut: 
    	(String streamContents: [:strm | 
    		aStringOrText runs writeScanOn: strm]).
!
----- Method: WriteStream>>nextPut: (in category 'accessing') -----
nextPut: anObject 
    "Primitive. Insert the argument at the next position in the Stream
    represented by the receiver. Fail if the collection of this stream is not an
    Array or a String. Fail if the stream is positioned at its end, or if the
    position is out of bounds in the collection. Fail if the argument is not
    of the right type for the collection. Optional. See Object documentation
    whatIsAPrimitive."
<primitive: 66>
    ((collection class == ByteString) and: [
    	anObject isCharacter and:[anObject isOctetCharacter not]]) ifTrue: [
    		collection := (WideString from: collection).
    		^self nextPut: anObject.
    ].
    position >= writeLimit
    	ifTrue: [^ self pastEndPut: anObject]
    	ifFalse: 
    		[position := position + 1.
    		^collection at: position put: anObject]!
----- Method: WriteStream>>nextPutAll: (in category 'accessing') -----
nextPutAll: aCollection
| newEnd |
    collection class == aCollection class ifFalse:
    	[^ super nextPutAll: aCollection ].
newEnd := position + aCollection size.
    newEnd > writeLimit ifTrue:
    	[self growTo: newEnd + 10].
collection replaceFrom: position+1 to: newEnd  with: aCollection startingAt: 1.
    position := newEnd.!
----- Method: WriteStream>>nextPutKeyword:withArg: (in category 'character writing') -----
nextPutKeyword: keyword withArg: argValue
    "Emit a keyword/value pair in the alternate syntax"
self nextPutAll: (keyword copyWithout: $:);
    	nextPut: $(;
    	store: argValue;
    	nextPut: $)!
----- Method: WriteStream>>on: (in category 'private') -----
on: aCollection
super on: aCollection.
    readLimit := 0.
    writeLimit := aCollection size!
----- Method: WriteStream>>on:from:to: (in category 'private') -----
on: aCollection from: firstIndex to: lastIndex
| len |
    collection := aCollection.
    readLimit := 
    	writeLimit := lastIndex > (len := collection size)
    					ifTrue: [len]
    					ifFalse: [lastIndex].
    position := firstIndex <= 1
    			ifTrue: [0]
    			ifFalse: [firstIndex - 1]!
----- Method: WriteStream>>pastEndPut: (in category 'private') -----
pastEndPut: anObject
    "Grow the collection by doubling the size, but keeping the growth between 20 and 1000000.
    Then put <anObject> at the current write position."
collection := collection grownBy: ((collection size max: 20) min: 1000000).
    writeLimit := collection size.
    collection at: (position := position + 1) put: anObject.
    ^ anObject!
----- Method: WriteStream>>peekLast (in category 'character writing') -----
peekLast
    "Return that item just put at the end of the stream"
^ position > 0 
    	ifTrue: [collection at: position]
    	ifFalse: [nil]!
----- Method: WriteStream>>position: (in category 'positioning') -----
position: anInteger 
    "Refer to the comment in PositionableStream|position:."
readLimit := readLimit max: position.
    super position: anInteger!
----- Method: WriteStream>>reset (in category 'positioning') -----
reset 
    "Refer to the comment in PositionableStream|reset."
readLimit := readLimit max: position.
    position := 0!
----- Method: WriteStream>>resetToStart (in category 'positioning') -----
resetToStart
    readLimit := position := 0.!
----- Method: WriteStream>>setToEnd (in category 'positioning') -----
setToEnd 
    "Refer to the comment in PositionableStream|setToEnd."
readLimit := readLimit max: position.
    super setToEnd.!
----- Method: WriteStream>>size (in category 'accessing') -----
size
^readLimit := readLimit max: position!
----- Method: WriteStream>>space (in category 'character writing') -----
space
    "Append a space character to the receiver."
self nextPut: Character space!
----- Method: WriteStream>>space: (in category 'character writing') -----
space: anInteger 
    "Append anInteger space characters to the receiver."
anInteger timesRepeat: [self space]!
----- Method: WriteStream>>store: (in category 'printing') -----
store: anObject 
    "Have anObject print on the receiver for purposes of rereading."
anObject storeOn: self!
----- Method: WriteStream>>tab (in category 'character writing') -----
tab
    "Append a tab character to the receiver."
self nextPut: Character tab!
----- Method: WriteStream>>tab: (in category 'character writing') -----
tab: anInteger 
    "Append anInteger tab characters to the receiver."
anInteger timesRepeat: [self tab]!
----- Method: WriteStream>>timeStamp (in category 'fileIn/Out') -----
timeStamp
    "Append the current time to the receiver as a String."
    self nextChunkPut:	"double string quotes and !!s"
    	(String streamContents: [:s | SmalltalkImage current timeStamp: s]) printString.
    self cr!
----- Method: WriteStream>>with: (in category 'private') -----
with: aCollection
super on: aCollection.
    position := readLimit := writeLimit := aCollection size!
----- Method: WriteStream>>withAttribute:do: (in category 'private') -----
withAttribute: att do: strmBlock 
    "No-op here is overriden in TextStream for font emphasis"
    ^ strmBlock value!
----- Method: WriteStream>>withAttributes:do: (in category 'private') -----
withAttributes: attributes do: strmBlock 
    "No-op here is overriden in TextStream for font emphasis"
    ^ strmBlock value!
Stream subclass: #SharedQueue2
    instanceVariableNames: 'monitor items'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Sequenceable'!
!SharedQueue2 commentStamp: 'ls 6/25/2005 13:48' prior: 0!
An implementation of a shared queue based on class Monitor.  Clients may may place items on the queue using nextPut: or remove them using methods like next or nextOrNil.  Items are removed in first-in first-out (FIFO) order.  It is safe for multiple threads to access the same shared queue, which is why this is a "shared" queue.
[monitor] is used to synchronize access from multiple threads.
[items] is an ordered collection holding the items that are in the queue.  New items are added  at the end, and old items are removed from the beginning.
All methods must hold the monitor while they run.
!
----- Method: SharedQueue2 class>>new (in category 'instance creation') -----
new
    ^self basicNew initialize!
----- Method: SharedQueue2>>initialize (in category 'initializing') -----
initialize
    monitor := Monitor new.
    items := OrderedCollection new.
!
----- Method: SharedQueue2>>isEmpty (in category 'size') -----
isEmpty
    ^monitor critical: [ items isEmpty ]!
----- Method: SharedQueue2>>next (in category 'accessing') -----
next
    ^monitor critical: [
    	monitor waitUntil: [ items isEmpty not ].
    	items removeFirst ]
!
----- Method: SharedQueue2>>nextOrNil (in category 'accessing') -----
nextOrNil
    ^monitor critical: [
    	items isEmpty ifTrue: [ nil ] ifFalse: [ items removeFirst ] ]!
----- Method: SharedQueue2>>nextOrNilSuchThat: (in category 'accessing') -----
nextOrNilSuchThat: aBlock
    "Answer the next object that satisfies aBlock, skipping any intermediate objects.
    If no such object has been queued, answer <nil> and leave me intact."
| index |
    ^monitor critical: [
    	index := items findFirst: aBlock.
    	index = 0 ifTrue: [
    		nil ]
    	ifFalse: [
    		items removeAt: index ] ].
!
----- Method: SharedQueue2>>nextPut: (in category 'accessing') -----
nextPut: item
    monitor critical: [
    	items addLast: item.
    	monitor signalAll.  ]
!
----- Method: SharedQueue2>>peek (in category 'accessing') -----
peek
    "Answer the object that was sent through the receiver first and has not 
    yet been received by anyone but do not remove it from the receiver. If 
    no object has been sent, return nil"
    ^monitor critical: [
    	items isEmpty ifTrue: [ nil ] ifFalse: [ items first ] ]
!
----- Method: SharedQueue2>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    monitor critical:
    	[items := items copy.
    	monitor := Monitor new]!
----- Method: SharedQueue2>>printOn: (in category 'printing') -----
printOn: aStream
    monitor critical: [
    	aStream 
    		nextPutAll: self class name;
    		nextPutAll: ' with ';
    		print: items size;
    	 	nextPutAll: ' items' ].!
----- Method: SharedQueue2>>size (in category 'size') -----
size
    ^monitor critical: [ items size ]!
----- Method: Stream class>>new (in category 'instance creation') -----
new
self error: 'Streams are created with on: and with:'!
----- Method: Stream>>atEnd (in category 'testing') -----
atEnd
    "Answer whether the receiver can access any more objects."
self subclassResponsibility!
----- Method: Stream>>basicNext (in category 'accessing') -----
basicNext
^ self next.
!
----- Method: Stream>>basicNextPut: (in category 'accessing') -----
basicNextPut: anObject
^ self nextPut: anObject!
----- Method: Stream>>basicNextPutAll: (in category 'accessing') -----
basicNextPutAll: aCollection
^ self nextPutAll: aCollection.
!
----- Method: Stream>>binary (in category 'accessing') -----
binary!
----- Method: Stream>>close (in category 'file open/close') -----
close!
----- Method: Stream>>closed (in category 'testing') -----
closed
    ^ false!
----- Method: Stream>>contents (in category 'accessing') -----
contents
    "Answer all of the contents of the receiver."
self subclassResponsibility!
----- Method: Stream>>dialect (in category 'alternate syntax') -----
dialect
^#ST80		"in case a regular stream is used to print parse nodes"!
----- Method: Stream>>do: (in category 'enumerating') -----
do: aBlock 
    "Evaluate aBlock for each of the objects accessible by receiver."
[self atEnd]
    	whileFalse: [aBlock value: self next]!
----- Method: Stream>>flush (in category 'accessing') -----
flush
    "Do nothing by default"!
----- Method: Stream>>isStream (in category 'testing') -----
isStream
    "Return true if the receiver responds to the stream protocol"
    ^true!
----- Method: Stream>>isTypeHTTP (in category 'testing') -----
isTypeHTTP
    ^false!
----- Method: Stream>>localName (in category 'accessing') -----
localName
    ^'a stream'!
----- Method: Stream>>next (in category 'accessing') -----
next
    "Answer the next object accessible by the receiver."
self subclassResponsibility!
----- Method: Stream>>next: (in category 'accessing') -----
next: anInteger 
    "Answer the next anInteger number of objects accessible by the receiver."
| aCollection |
    aCollection := OrderedCollection new.
    anInteger timesRepeat: [aCollection addLast: self next].
    ^aCollection!
----- Method: Stream>>next:put: (in category 'accessing') -----
next: anInteger put: anObject 
    "Make anObject be the next anInteger number of objects accessible by the 
    receiver. Answer anObject."
anInteger timesRepeat: [self nextPut: anObject].
    ^anObject!
----- Method: Stream>>nextMatchAll: (in category 'accessing') -----
nextMatchAll: aColl
    "Answer true if next N objects are the ones in aColl,
     else false.  Advance stream of true, leave as was if false."
    | save |
    save := self position.
    aColl do: [:each |
       (self next) = each ifFalse: [
            self position: save.
            ^ false]
        ].
    ^ true!
----- Method: Stream>>nextMatchFor: (in category 'accessing') -----
nextMatchFor: anObject 
    "Gobble the next object and answer whether it is equal to the argument, 
    anObject."
^anObject = self next!
----- Method: Stream>>nextPut: (in category 'accessing') -----
nextPut: anObject 
    "Insert the argument, anObject, as the next object accessible by the 
    receiver. Answer anObject."
self subclassResponsibility!
----- Method: Stream>>nextPutAll: (in category 'accessing') -----
nextPutAll: aCollection 
    "Append the elements of aCollection to the sequence of objects accessible 
    by the receiver. Answer aCollection."
aCollection do: [:v | self nextPut: v].
    ^aCollection!
----- Method: Stream>>nextWordsPutAll: (in category 'testing') -----
nextWordsPutAll: aCollection
    "Write the argument a word-like object in big endian format on the receiver.
    May be used to write other than plain word-like objects (such as ColorArray)."
    aCollection class isPointers | aCollection class isWords not 
    	ifTrue: [^self error: aCollection class name,' is not word-like'].
    1 to: aCollection basicSize do:[:i|
    	self nextNumber: 4 put: (aCollection basicAt: i).
    ].
    ^aCollection!
----- Method: Stream>>openReadOnly (in category 'accessing') -----
openReadOnly
    ^self!
----- Method: Stream>>print: (in category 'printing') -----
print: anObject
    "Have anObject print itself on the receiver."
anObject printOn: self!
----- Method: Stream>>printHtml: (in category 'printing') -----
printHtml: anObject
    anObject printHtmlOn: self!
----- Method: Stream>>printOn: (in category 'accessing') -----
printOn: stream
super printOn: stream.
    stream space.
    self contents printOn: stream.
!
----- Method: Stream>>readOnly (in category 'accessing') -----
readOnly
    ^self!
----- Method: Stream>>sleep (in category 'as yet unclassified') -----
sleep
"an FTP-based stream might close the connection here"!
----- Method: Stream>>upToEnd (in category 'accessing') -----
upToEnd
    "answer the remaining elements in the string"
    | elements |
    elements := OrderedCollection new.
    [ self atEnd ] whileFalse: [ 
    	elements add: self next ].
    ^elements!
----- Method: Stream>>withStyleFor:do: (in category 'alternate syntax') -----
withStyleFor: elementType do: aBlock
^aBlock value		"in case a regular stream is used to print parse nodes"
">>
(Compiler new compile: 'blah ^self' in: String notifying: nil ifFail: []) printString
<<"!
----- Method: Stream>>write: (in category 'filter streaming') -----
write:encodedObject
    ^encodedObject putOn:self.
!
Object subclass: #TextAttribute
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextAttribute commentStamp: 'tk 7/22/2002 18:33' prior: 0!
Tells a piece of text to be a certain way.
Select text, press Command-6, choose a attribute.  If selected text is of the form 
    Hi There<Smalltalk beep>
the part in angle brackets is saved for action, and the Hi There appears in the paragraph.  If selection has no angle brackets, use the whole thing as both the text and the action.
TextDoIt  --  eval as a Smalltalk expression (the part in angle brackets)
TextLink -- Show a method, class comment, class hierarchy, or class defintion.
    <Point extent:>, <Point Comment>, <Point Hierarchy>, or <Point Defintion> are what you type.
TextURL -- Show the web page. <www.disney.com>
These attributes of text need to be stored on the disk in a regular file-out.  It is done in this form: 	Hi There   
    in the text, and a Run containing   dSmalltalk beep;;
    Click here to see the extent:   
    in the text, and a Run containing   method LPoint extent:;
See RunArray class scanFrom: where decoding is done.
!
TextAttribute subclass: #TextAction
    instanceVariableNames: ''
    classVariableNames: 'Purple'
    poolDictionaries: ''
    category: 'Collections-Text'!
TextAction subclass: #PluggableTextAttribute
    instanceVariableNames: 'evalBlock'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!PluggableTextAttribute commentStamp: '<historical>' prior: 0!
An attribute which evaluates an arbitrary block when it is selected.!
----- Method: PluggableTextAttribute class>>evalBlock: (in category 'instance creation') -----
evalBlock: aBlock
    ^super new evalBlock: aBlock!
----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'clicking') -----
actOnClickFor: anObject
    evalBlock ifNil: [ ^self ].
    evalBlock numArgs = 0 ifTrue: [ evalBlock value.  ^true ].
    evalBlock numArgs = 1 ifTrue: [ evalBlock value: anObject.  ^true ].
    self error: 'evalBlock should have 0 or 1 arguments'!
----- Method: PluggableTextAttribute>>evalBlock: (in category 'initialization') -----
evalBlock: aBlock
    evalBlock := aBlock!
----- Method: TextAction class>>initialize (in category 'as yet unclassified') -----
initialize   "TextAction initialize"
    Purple := Color r: 0.4 g: 0 b: 1.0!
----- Method: TextAction>>analyze: (in category 'as yet unclassified') -----
analyze: aString
    "Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection).  Does not return self!!.  May be of the form:
3+4
<3+4>
Click Here<3+4>
<3+4>Click Here
"
    "Obtain the showing text and the instructions"
    | b1 b2 trim param show |
    b1 := aString indexOf: $<.
    b2 := aString indexOf: $>.
    (b1 < b2) & (b1 > 0) ifFalse: ["only one part"
    	param := self validate: aString.
    	param ifNil: [ ^{ nil. nil } ].
    	^ Array with: param with: (param size = 0 ifTrue: [nil] ifFalse: [param])].
    "Two parts"
    trim := aString withBlanksTrimmed.
    (trim at: 1) == $< 
    	ifTrue: [(trim last) == $>
    		ifTrue: ["only instructions" 
    			param := self validate: (aString copyFrom: b1+1 to: b2-1).
    			show := param size = 0 ifTrue: [nil] ifFalse: [param]]
    		ifFalse: ["at the front"
    			param := self validate: (aString copyFrom: b1+1 to: b2-1).
    			show := param size = 0 ifTrue: [nil] 
    					ifFalse: [aString copyFrom: b2+1 to: aString size]]]
    	ifFalse: [(trim last) == $>
    		ifTrue: ["at the end"
    			param := self validate: (aString copyFrom: b1+1 to: b2-1).
    			show := param size = 0 ifTrue: [nil] 
    					ifFalse: [aString copyFrom: 1 to: b1-1]]
    		ifFalse: ["Illegal -- <> has text on both sides"
    			show := nil]].
    ^ Array with: param with: show
!
----- Method: TextAction>>couldDeriveFromPrettyPrinting (in category 'as yet unclassified') -----
couldDeriveFromPrettyPrinting
    ^ false!
----- Method: TextAction>>dominatedByCmd0 (in category 'as yet unclassified') -----
dominatedByCmd0
    "Cmd-0 should turn off active text"
    ^ true!
----- Method: TextAction>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Set the emphasis for text display"
    scanner textColor: Purple!
----- Method: TextAction>>info (in category 'as yet unclassified') -----
info
    ^ 'no hidden info'!
----- Method: TextAction>>mayActOnClick (in category 'as yet unclassified') -----
mayActOnClick
^ true!
----- Method: TextAction>>validate: (in category 'as yet unclassified') -----
validate: aString
    "any format is OK with me"
    ^ aString!
TextAction subclass: #TextDoIt
    instanceVariableNames: 'evalString'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
----- Method: TextDoIt class>>evalString: (in category 'as yet unclassified') -----
evalString: str
    ^ self new evalString: str!
----- Method: TextDoIt class>>scanFrom: (in category 'as yet unclassified') -----
scanFrom: strm
    "read a doit in the funny format used by Text styles on files. d10 factorial;;  end with two semicolons"
| pos end doit |
    pos := strm position.
    [strm skipTo: $;. strm peek == $;] whileFalse.
    end := strm position - 1.
    strm position: pos.
    doit := strm next: end-pos.
    strm skip: 2.  ";;"
    ^ self evalString: doit!
----- Method: TextDoIt>>actOnClickFor: (in category 'as yet unclassified') -----
actOnClickFor: anObject
    "Note: evalString gets evaluated IN THE CONTEXT OF anObject
     -- meaning that self and all instVars are accessible"
    Compiler evaluate: evalString for: anObject logged: false.
    ^ true !
----- Method: TextDoIt>>analyze: (in category 'as yet unclassified') -----
analyze: aString
| list |
    list := super analyze: aString.
    evalString := list at: 1.
    ^ list at: 2!
----- Method: TextDoIt>>evalString: (in category 'as yet unclassified') -----
evalString: str
    evalString := str !
----- Method: TextDoIt>>info (in category 'as yet unclassified') -----
info
    ^ evalString!
----- Method: TextDoIt>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $d; nextPutAll: evalString; nextPutAll: ';;'!
TextDoIt subclass: #TextPrintIt
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
----- Method: TextPrintIt>>actOnClickFor:in:at:editor: (in category 'as yet unclassified') -----
actOnClickFor: anObject in: aParagraph at: clickPoint editor: editor
    "Note: evalString gets evaluated IN THE CONTEXT OF anObject
     -- meaning that self and all instVars are accessible"
    | result range index |
    result := Compiler evaluate: evalString for: anObject logged: false.
    result := ' ', result printString,' '.
    "figure out where the attribute ends in aParagraph"
    index := (aParagraph characterBlockAtPoint: clickPoint) stringIndex.
    range := aParagraph text rangeOf: self startingAt: index.
    editor selectFrom: range last+1 to: range last.
    editor zapSelectionWith: result.
    editor selectFrom: range last to: range last + result size.
    ^ true !
----- Method: TextPrintIt>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $P; nextPutAll: evalString; nextPutAll: ';;'!
TextAction subclass: #TextLink
    instanceVariableNames: 'classAndMethod'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
----- Method: TextLink class>>scanFrom: (in category 'as yet unclassified') -----
scanFrom: strm
    "read a link in the funny format used by Text styles on files. LPoint +;LPoint Comment;"
^ self new classAndMethod: (strm upTo: $;)!
----- Method: TextLink>>actOnClickFor: (in category 'as yet unclassified') -----
actOnClickFor: aMessageSet
    "Add to the end of the list.  'aClass selector', 'aClass Comment', 'aClass Definition', 'aClass Hierarchy' are the formats allowed."
aMessageSet addItem: classAndMethod.
    ^ true!
----- Method: TextLink>>analyze: (in category 'as yet unclassified') -----
analyze: aString
| list |
    list := super analyze: aString.
    classAndMethod := list at: 1.
    ^ list at: 2!
----- Method: TextLink>>analyze:with: (in category 'as yet unclassified') -----
analyze: aString with: nonMethod
    "Initalize this attribute holder with a piece text the user typed into a paragraph.  Returns the text to emphesize (may be different from selection)  Does not return self!!.  nonMethod is what to show when clicked, i.e. the last part of specifier (Comment, Definition, or Hierarchy).  May be of the form:
Point
<Point>
Click Here<Point>
<Point>Click Here
"
    "Obtain the showing text and the instructions"
    | b1 b2 trim |
    b1 := aString indexOf: $<.
    b2 := aString indexOf: $>.
    (b1 < b2) & (b1 > 0) ifFalse: ["only one part"
    	classAndMethod := self validate: aString, ' ', nonMethod.
    	^ classAndMethod ifNotNil: [aString]].
    "Two parts"
    trim := aString withBlanksTrimmed.
    (trim at: 1) == $< 
    	ifTrue: [(trim last) == $>
    		ifTrue: ["only instructions" 
    			classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
    			^ classAndMethod ifNotNil: [classAndMethod]]
    		ifFalse: ["at the front"
    			classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
    			^ classAndMethod ifNotNil: [aString copyFrom: b2+1 to: aString size]]]
    	ifFalse: [(trim last) == $>
    		ifTrue: ["at the end"
    			classAndMethod := self validate: (aString copyFrom: b1+1 to: b2-1), ' ', nonMethod.
    			^ classAndMethod ifNotNil: [aString copyFrom: 1 to: b1-1]]
    		ifFalse: ["Illegal -- <> has text on both sides"
    			^ nil]]
!
----- Method: TextLink>>classAndMethod: (in category 'as yet unclassified') -----
classAndMethod: aString
    classAndMethod := aString!
----- Method: TextLink>>info (in category 'as yet unclassified') -----
info
    ^ classAndMethod!
----- Method: TextLink>>validate: (in category 'as yet unclassified') -----
validate: specString
    "Can this string be decoded to be Class space Method (or Comment, Definition, Hierarchy)? If so, return it in valid format, else nil"
| list first mid last |
    list := specString findTokens: ' 	.|'.
    list isEmpty ifTrue: [ ^nil ].
    last := list last.
    last first isUppercase ifTrue: [
    	(#('Comment' 'Definition' 'Hierarchy') includes: last) ifFalse: [^ nil].
    	"Check for 'Rectangle Comment Comment' and remove last one"
    	(list at: list size - 1 ifAbsent: [^nil]) = last ifTrue: [list := list allButLast]].
    list size > 3 ifTrue: [^ nil].
    list size < 2 ifTrue: [^ nil].
    Symbol hasInterned: list first ifTrue: [:sym | first := sym].
    first ifNil: [^ nil].
    Smalltalk at: first ifAbsent: [^ nil].
    mid := list size = 3 
    	ifTrue: [(list at: 2) = 'class' ifTrue: ['class '] ifFalse: [^ nil]]
    	ifFalse: [''].
    "OK if method name is not interned -- may not be defined yet"
    ^ first, ' ', mid, last!
----- Method: TextLink>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $L; nextPutAll: classAndMethod; nextPut: $;!
TextAction subclass: #TextURL
    instanceVariableNames: 'url'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
TextURL subclass: #TextSqkPageLink
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextSqkPageLink commentStamp: '<historical>' prior: 0!
I represent a link to either a SqueakPage in a BookMorph, or a regular url.  See TextMorphEditor changeEmphasis:.  
!
----- Method: TextSqkPageLink>>actOnClickFor: (in category 'as yet unclassified') -----
actOnClickFor: textMorph
    "I represent a link to either a SqueakPage in a BookMorph, or a regular url"
| book |
    ((url endsWith: '.bo') or: [url endsWith: '.sp']) ifFalse: [
    	^ super actOnClickFor: textMorph].
    book := textMorph ownerThatIsA: BookMorph.
    book ifNotNil: [book goToPageUrl: url].
    "later handle case of page being in another book, not this one"
    ^ true!
----- Method: TextSqkPageLink>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $q; nextPutAll: url; nextPut: $;!
TextURL subclass: #TextSqkProjectLink
    instanceVariableNames: ''
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
----- Method: TextSqkProjectLink>>actOnClickFor: (in category 'as yet unclassified') -----
actOnClickFor: textMorph
Project enterIfThereOrFind: url.
    ^ true!
----- Method: TextSqkProjectLink>>analyze: (in category 'as yet unclassified') -----
analyze: aString
^url := aString!
----- Method: TextSqkProjectLink>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $p; nextPutAll: url; nextPut: $;!
----- Method: TextURL class>>scanFrom: (in category 'as yet unclassified') -----
scanFrom: strm
    "read a link in the funny format used by Text styles on files. Rhttp://www.disney.com;"
^ self new url: (strm upTo: $;)!
----- Method: TextURL>>actOnClickFor: (in category 'as yet unclassified') -----
actOnClickFor: anObject
    "Do what you can with this URL.  Later a web browser."
| response m |
(url beginsWith: 'sqPr://') ifTrue: [
    	ProjectLoading thumbnailFromUrl: (url copyFrom: 8 to: url size).
    	^self		"should not get here, but what the heck"
    ].
    "if it's a web browser, tell it to jump"
    anObject isWebBrowser
    	ifTrue: [anObject jumpToUrl: url. ^ true]
    	ifFalse: [((anObject respondsTo: #model) and: [anObject model isWebBrowser])
    			ifTrue: [anObject model jumpToUrl: url. ^ true]].
"if it's a morph, see if it is contained in a web browser"
    	(anObject isKindOf: Morph) ifTrue: [
    		m := anObject.
    		[ m ~= nil ] whileTrue: [
    			(m isWebBrowser) ifTrue: [
    				m  jumpToUrl: url.
    				^true ].
    			(m hasProperty: #webBrowserView) ifTrue: [
    				m model jumpToUrl: url.
    				^true ].
    			m := m owner. ]
    	].
"no browser in sight.  ask if we should start a new browser"
    ((self confirm: 'open a browser to view this URL?' translated) and: [WebBrowser default notNil]) ifTrue: [
    	WebBrowser default openOnUrl: url.
    	^ true ].
"couldn't display in a browser.  Offer to put up just the source"
response := (UIManager default 
    			chooseFrom: (Array with: 'View web page as source' translated
    								with: 'Cancel' translated)
    			title:  'Couldn''t find a web browser. View\page as source?' withCRs translated).
    response = 1 ifTrue: [HTTPSocket httpShowPage: url].
    ^ true!
----- Method: TextURL>>analyze: (in category 'as yet unclassified') -----
analyze: aString
| list |
    list := super analyze: aString.
    url := list at: 1.
    ^ list at: 2!
----- Method: TextURL>>info (in category 'as yet unclassified') -----
info
    ^ url!
----- Method: TextURL>>url: (in category 'as yet unclassified') -----
url: aString
    url := aString!
----- Method: TextURL>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $R; nextPutAll: url; nextPut: $;!
----- Method: TextAttribute>>actOnClickFor: (in category 'as yet unclassified') -----
actOnClickFor: model
    "Subclasses may override to provide, eg, hot-spot actions"
    ^ false!
----- Method: TextAttribute>>actOnClickFor:in: (in category 'as yet unclassified') -----
actOnClickFor: model in: aParagraph
    ^self actOnClickFor: model!
----- Method: TextAttribute>>actOnClickFor:in:at: (in category 'as yet unclassified') -----
actOnClickFor: model in: aParagraph at: clickPoint
    ^self actOnClickFor: model in: aParagraph!
----- Method: TextAttribute>>actOnClickFor:in:at:editor: (in category 'as yet unclassified') -----
actOnClickFor: model in: aParagraph at: clickPoint editor: editor
    ^self actOnClickFor: model in: aParagraph at: clickPoint!
----- Method: TextAttribute>>anchoredMorph (in category 'as yet unclassified') -----
anchoredMorph
    "If one hides here, return it"
    ^nil!
----- Method: TextAttribute>>closeHtmlOn: (in category 'html') -----
closeHtmlOn: aStream 
    "put on the given stream the tag to close the html  
    representation of the receiver"
    self subclassResponsibility!
----- Method: TextAttribute>>couldDeriveFromPrettyPrinting (in category 'as yet unclassified') -----
couldDeriveFromPrettyPrinting
    "Answer whether the receiver is a kind of attribute that could have been generated by doing polychrome pretty-printing of a method without functional text attributes."
^ true!
----- Method: TextAttribute>>dominatedByCmd0 (in category 'as yet unclassified') -----
dominatedByCmd0
    "Subclasses may override if cmd-0 should turn them off"
    ^ false!
----- Method: TextAttribute>>dominates: (in category 'as yet unclassified') -----
dominates: another
    "Subclasses may override condense multiple attributes"
    ^ false!
----- Method: TextAttribute>>emphasisCode (in category 'as yet unclassified') -----
emphasisCode
    "Subclasses may override to add bold, italic, etc"
    ^ 0!
----- Method: TextAttribute>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Subclasses may override to set, eg, font, color, etc"!
----- Method: TextAttribute>>forFontInStyle:do: (in category 'as yet unclassified') -----
forFontInStyle: aTextStyle do: aBlock
    "No action is the default.  Overridden by font specs"!
----- Method: TextAttribute>>isKern (in category 'testing') -----
isKern
    ^false!
----- Method: TextAttribute>>mayActOnClick (in category 'as yet unclassified') -----
mayActOnClick
    "Subclasses may override to provide, eg, hot-spot actions"
    ^ false!
----- Method: TextAttribute>>mayBeExtended (in category 'as yet unclassified') -----
mayBeExtended
    "A quality that may be overridden by subclasses, such as TextAnchors, that really only apply to a single character"
    ^ true!
----- Method: TextAttribute>>oldEmphasisCode: (in category 'as yet unclassified') -----
oldEmphasisCode: default
    "Allows running thorugh possibly multiple attributes
    and getting the emphasis out of any that has an emphasis (font number)"
    ^ default!
----- Method: TextAttribute>>openHtmlOn: (in category 'html') -----
openHtmlOn: aStream 
    "put on the given stream the tag to open the html  
    representation of the receiver"
    self subclassResponsibility!
----- Method: TextAttribute>>reset (in category 'as yet unclassified') -----
reset
    "Allow subclasses to prepare themselves for merging attributes"!
----- Method: TextAttribute>>set (in category 'as yet unclassified') -----
set
    "Respond true to include this attribute (as opposed to, eg, a bold
    emphasizer that is clearing the property"
    ^ true!
TextAttribute subclass: #TextColor
    instanceVariableNames: 'color'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextColor commentStamp: '<historical>' prior: 0!
A TextColor encodes a text color change applicable over a given range of text.!
----- Method: TextColor class>>black (in category 'constants') -----
black
    ^ self new color: Color black!
----- Method: TextColor class>>blue (in category 'constants') -----
blue
    ^ self new color: Color blue!
----- Method: TextColor class>>color: (in category 'instance creation') -----
color: aColor
    ^ self new color: aColor!
----- Method: TextColor class>>cyan (in category 'constants') -----
cyan
    ^ self new color: Color cyan!
----- Method: TextColor class>>gray (in category 'constants') -----
gray
    ^ self new color: Color gray!
----- Method: TextColor class>>green (in category 'constants') -----
green
    ^ self new color: Color green!
----- Method: TextColor class>>magenta (in category 'constants') -----
magenta
    ^ self new color: Color magenta!
----- Method: TextColor class>>red (in category 'constants') -----
red
    ^ self new color: Color red!
----- Method: TextColor class>>scanFrom: (in category 'instance creation') -----
scanFrom: strm
    "read a color in the funny format used by Text styles on files. c125000255 or cblue;"
| r g b |
    strm peek isDigit
    	ifTrue:
    		[r := (strm next: 3) asNumber.
    		g := (strm next: 3) asNumber.
    		b := (strm next: 3) asNumber.
    		^ self color: (Color r: r g: g b: b range: 255)].
    "A name of a color"
    ^ self color: (Color perform: (strm upTo: $;) asSymbol)!
----- Method: TextColor class>>white (in category 'constants') -----
white 
    ^ self new color: Color white!
----- Method: TextColor class>>yellow (in category 'constants') -----
yellow
    ^ self new color: Color yellow!
----- Method: TextColor>>= (in category 'comparing') -----
= other 
    ^ (other class == self class) 
    	and: [other color = color]!
----- Method: TextColor>>closeHtmlOn: (in category 'html') -----
closeHtmlOn: aStream 
    "put on the given stream the tag to close the html  
    representation of the receiver"
    aStream nextPutAll: '</font>'!
----- Method: TextColor>>color (in category 'accessing') -----
color
    ^ color!
----- Method: TextColor>>color: (in category 'accessing') -----
color: aColor
    color := aColor!
----- Method: TextColor>>dominates: (in category 'scanning') -----
dominates: other
    ^ other class == self class!
----- Method: TextColor>>emphasizeScanner: (in category 'scanning') -----
emphasizeScanner: scanner
    "Set the emphasis for text display"
    scanner textColor: color!
----- Method: TextColor>>hash (in category 'comparing') -----
hash
    ^ color hash!
----- Method: TextColor>>openHtmlOn: (in category 'html') -----
openHtmlOn: aStream 
    "put on the given stream the tag to open the html  
    representation of the receiver"
    aStream nextPutAll: '<font color="#' , color printHtmlString , '">'!
----- Method: TextColor>>printOn: (in category 'printing') -----
printOn: aStream
    super printOn: aStream.
    aStream nextPutAll: ' code: '; print: color!
----- Method: TextColor>>writeScanOn: (in category 'scanning') -----
writeScanOn: strm
    "Two formats.  c125000255 or cblue;"
| nn str |
    strm nextPut: $c.
    (nn := color name) ifNotNil: [
    	(self class respondsTo: nn) ifTrue: [
    		^ strm nextPutAll: nn; nextPut: $;]].
    (Array with: color red with: color green with: color blue) do: [:float |
    	str := '000', (float * 255) asInteger printString.
    	strm nextPutAll: (str copyFrom: str size-2 to: str size)]!
TextAttribute subclass: #TextEmphasis
    instanceVariableNames: 'emphasisCode setMode'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextEmphasis commentStamp: '<historical>' prior: 0!
A TextEmphasis, encodes a characteristic applicable to all fonts.  The encoding is as follows:
    1	bold
    2	itallic
    4	underlined
    8	narrow
    16	struck out!
----- Method: TextEmphasis class>>bold (in category 'as yet unclassified') -----
bold
    ^ self new emphasisCode: 1!
----- Method: TextEmphasis class>>italic (in category 'as yet unclassified') -----
italic
    ^ self new emphasisCode: 2!
----- Method: TextEmphasis class>>narrow (in category 'as yet unclassified') -----
narrow
    ^ TextKern kern: -1!
----- Method: TextEmphasis class>>normal (in category 'as yet unclassified') -----
normal
    ^ self new emphasisCode: 0!
----- Method: TextEmphasis class>>struckOut (in category 'as yet unclassified') -----
struckOut
    ^ self new emphasisCode: 16!
----- Method: TextEmphasis class>>underlined (in category 'as yet unclassified') -----
underlined
    ^ self new emphasisCode: 4!
----- Method: TextEmphasis>>= (in category 'as yet unclassified') -----
= other 
    ^ (other class == self class) 
    	and: [other emphasisCode = emphasisCode]!
----- Method: TextEmphasis>>closeHtmlOn: (in category 'html') -----
closeHtmlOn: aStream 
    "put on the given stream the tag to close the html  
    representation of the receiver"
    emphasisCode = 1
    	ifTrue: [aStream nextPutAll: '</b>'].
    emphasisCode = 2
    	ifTrue: [aStream nextPutAll: '</i>'].
    emphasisCode = 4
    	ifTrue: [aStream nextPutAll: '</u>']!
----- Method: TextEmphasis>>dominatedByCmd0 (in category 'as yet unclassified') -----
dominatedByCmd0
    "Cmd-0 should turn off emphasis"
    ^ true!
----- Method: TextEmphasis>>dominates: (in category 'as yet unclassified') -----
dominates: other
    (emphasisCode = 0 and: [other dominatedByCmd0]) ifTrue: [^ true].
    ^ (other class == self class)
    	and: [emphasisCode = other emphasisCode]!
----- Method: TextEmphasis>>emphasisCode (in category 'as yet unclassified') -----
emphasisCode
    ^ emphasisCode!
----- Method: TextEmphasis>>emphasisCode: (in category 'as yet unclassified') -----
emphasisCode: int
    emphasisCode := int.
    setMode := true!
----- Method: TextEmphasis>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Set the emphasist for text scanning"
    scanner addEmphasis: emphasisCode!
----- Method: TextEmphasis>>hash (in category 'as yet unclassified') -----
hash
    "#hash is re-implemented because #= is re-implemented"
    ^emphasisCode hash
!
----- Method: TextEmphasis>>openHtmlOn: (in category 'html') -----
openHtmlOn: aStream 
    "put on the given stream the tag to open the html  
    representation of the receiver"
    emphasisCode = 1
    	ifTrue: [aStream nextPutAll: '<b>'].
    emphasisCode = 2
    	ifTrue: [aStream nextPutAll: '<i>'].
    emphasisCode = 4
    	ifTrue: [aStream nextPutAll: '<u>']!
----- Method: TextEmphasis>>printOn: (in category 'as yet unclassified') -----
printOn: strm
    super printOn: strm.
    strm nextPutAll: ' code: '; print: emphasisCode!
----- Method: TextEmphasis>>set (in category 'as yet unclassified') -----
set
    ^ setMode and: [emphasisCode ~= 0]!
----- Method: TextEmphasis>>turnOff (in category 'as yet unclassified') -----
turnOff
    setMode := false!
----- Method: TextEmphasis>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
emphasisCode = 1 ifTrue: [strm nextPut: $b].
    emphasisCode = 2 ifTrue: [strm nextPut: $i].
    emphasisCode = 0 ifTrue: [strm nextPut: $n].
    emphasisCode = 16 ifTrue: [strm nextPut: $=].
    emphasisCode = 4 ifTrue: [strm nextPut: $u].!
TextAttribute subclass: #TextFontChange
    instanceVariableNames: 'fontNumber'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextFontChange commentStamp: '<historical>' prior: 0!
A TextFontChange encodes a font change applicable over a given range of text.  The font number is interpreted relative to the textStyle governing display of this text.!
----- Method: TextFontChange class>>defaultFontChange (in category 'as yet unclassified') -----
defaultFontChange
    "Answer a TextFontChange that represents the default font"
^ self new fontNumber: TextStyle default defaultFontIndex!
----- Method: TextFontChange class>>font1 (in category 'as yet unclassified') -----
font1
    ^ self new fontNumber: 1!
----- Method: TextFontChange class>>font2 (in category 'as yet unclassified') -----
font2
    ^ self new fontNumber: 2!
----- Method: TextFontChange class>>font3 (in category 'as yet unclassified') -----
font3
    ^ self new fontNumber: 3!
----- Method: TextFontChange class>>font4 (in category 'as yet unclassified') -----
font4
    ^ self new fontNumber: 4!
----- Method: TextFontChange class>>fontNumber: (in category 'as yet unclassified') -----
fontNumber: n
    ^ self new fontNumber: n!
----- Method: TextFontChange>>= (in category 'as yet unclassified') -----
= other 
    ^ (other class == self class) 
    	and: [other fontNumber = fontNumber]!
----- Method: TextFontChange>>closeHtmlOn: (in category 'html') -----
closeHtmlOn: aStream 
    "put on the given stream the tag to close the html  
    representation of the receiver"
    | font |
    font := TextStyle default fontAt: fontNumber.
    font closeHtmlOn: aStream!
----- Method: TextFontChange>>dominates: (in category 'as yet unclassified') -----
dominates: other
    ^ other isKindOf: TextFontChange!
----- Method: TextFontChange>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Set the font for text display"
    scanner setFont: fontNumber!
----- Method: TextFontChange>>fontNumber (in category 'as yet unclassified') -----
fontNumber
    ^ fontNumber!
----- Method: TextFontChange>>fontNumber: (in category 'as yet unclassified') -----
fontNumber: int
    fontNumber := int!
----- Method: TextFontChange>>forFontInStyle:do: (in category 'as yet unclassified') -----
forFontInStyle: aTextStyle do: aBlock
    aBlock value: (aTextStyle fontAt: fontNumber)!
----- Method: TextFontChange>>hash (in category 'as yet unclassified') -----
hash
    "#hash is re-implemented because #= is re-implemented"
    ^fontNumber hash!
----- Method: TextFontChange>>openHtmlOn: (in category 'html') -----
openHtmlOn: aStream 
    "put on the given stream the tag to open the html  
    representation of the receiver"
    | font |
    font := TextStyle default fontAt: fontNumber.
    font openHtmlOn: aStream!
----- Method: TextFontChange>>printOn: (in category 'as yet unclassified') -----
printOn: strm
    super printOn: strm.
    strm nextPutAll: ' font: '; print: fontNumber!
----- Method: TextFontChange>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $f.
    fontNumber printOn: strm.!
TextFontChange subclass: #TextFontReference
    instanceVariableNames: 'font'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextFontReference commentStamp: '<historical>' prior: 0!
A TextFontReference encodes a font change applicable over a given range of text.  The font reference is absolute:  unlike a TextFontChange, it is independent of the textStyle governing display of this text.!
----- Method: TextFontReference class>>toFont: (in category 'as yet unclassified') -----
toFont: aFont
    ^ self new toFont: aFont!
----- Method: TextFontReference>>= (in category 'comparing') -----
= other 
    ^ (other class == self class) 
    	and: [other font = font]!
----- Method: TextFontReference>>couldDeriveFromPrettyPrinting (in category 'as yet unclassified') -----
couldDeriveFromPrettyPrinting
    ^ false!
----- Method: TextFontReference>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Set the actual font for text display"
    scanner setActualFont: font!
----- Method: TextFontReference>>font (in category 'as yet unclassified') -----
font
^ font!
----- Method: TextFontReference>>forFontInStyle:do: (in category 'as yet unclassified') -----
forFontInStyle: aTextStyle do: aBlock
    aBlock value: font!
----- Method: TextFontReference>>hash (in category 'comparing') -----
hash
    "#hash is re-implemented because #= is re-implemented"
    ^font hash!
----- Method: TextFontReference>>printOn: (in category 'comparing') -----
printOn: aStream
    aStream nextPutAll: 'a TextFontReference(';
    	print: font;
    	nextPut: $)!
----- Method: TextFontReference>>toFont: (in category 'as yet unclassified') -----
toFont: aFont
font := aFont!
----- Method: TextFontReference>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $F.
    strm nextPutAll: font familyName; nextPut: $#.
    font height printOn: strm.!
TextAttribute subclass: #TextIndent
    instanceVariableNames: 'amount'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextIndent commentStamp: '<historical>' prior: 0!
create a hanging indent. !
----- Method: TextIndent class>>amount: (in category 'instance creation') -----
amount: amount
    "create a TextIndent which will indent by the given amount.  Currently this is a number of tabs, but may change in the futur"
    ^super new amount: amount!
----- Method: TextIndent class>>example (in category 'example') -----
example
    "TextIndent example"
    | text pg |
"create an example text with some indentation"
    text := 'abcdao euoaeuo aeuo aeuoaeu o aeuoeauefgh bcd efghi'  asText.
    text addAttribute: (TextColor red)  from: 3 to: 8.
    text addAttribute: (TextIndent amount: 1) from: 1 to: 2.
    text addAttribute: (TextIndent amount: 2) from: 20 to: 35.
"stick it in a paragraph and display it"
    pg := text asParagraph.
    pg compositionRectangle: (0@0 extent: 100@200).
    pg textStyle alignment: 2.
    pg displayAt: 0@0.
!
----- Method: TextIndent class>>tabs: (in category 'instance creation') -----
tabs: numTabs
    "create an indentation by the given number of tabs"
    ^self amount: numTabs!
----- Method: TextIndent>>amount (in category 'access') -----
amount
    "number of tab spaces to indent by"
    ^amount!
----- Method: TextIndent>>amount: (in category 'access') -----
amount: anInteger
    "change the number of tabs to indent by"
    amount := anInteger!
----- Method: TextIndent>>dominates: (in category 'condensing') -----
dominates: anAttribute
    ^(self class == anAttribute class)!
----- Method: TextIndent>>emphasizeScanner: (in category 'setting indentation') -----
emphasizeScanner: scanner
    scanner indentationLevel: amount!
----- Method: TextIndent>>printOn: (in category 'printing') -----
printOn: aStream
    super printOn: aStream.
    aStream nextPutAll: ' amount: '.
    amount printOn: aStream!
TextAttribute subclass: #TextKern
    instanceVariableNames: 'kern active'
    classVariableNames: ''
    poolDictionaries: ''
    category: 'Collections-Text'!
!TextKern commentStamp: '<historical>' prior: 0!
A TextKern encodes a kerning change applicable over a given range of text.  Positive values of kern spread letters out, negative kern will cause them to overlap more.  Note that kerns other than 0 will display somewhat slower, as kerning is not yet supported in the text scanning primitive. !
----- Method: TextKern class>>kern: (in category 'as yet unclassified') -----
kern: kernValue
    ^ self new kern: kernValue!
----- Method: TextKern>>= (in category 'as yet unclassified') -----
= other 
    ^ (other class == self class) 
    	and: [other kern = kern]!
----- Method: TextKern>>couldDeriveFromPrettyPrinting (in category 'as yet unclassified') -----
couldDeriveFromPrettyPrinting
    ^ false!
----- Method: TextKern>>dominatedByCmd0 (in category 'as yet unclassified') -----
dominatedByCmd0
    "Cmd-0 should turn off kerning"
    ^ true!
----- Method: TextKern>>dominates: (in category 'as yet unclassified') -----
dominates: other
    "NOTE: The use of active in this code is specific to its use in the method
    	Text class addAttribute: att toArray: others"
    (active and: [other class == self class and: [other kern + kern = 0]])
    	ifTrue: [active := false.  ^ true].  "can only dominate once"
    ^ false!
----- Method: TextKern>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Augment (or diminish) the kerning offset for text display"
    scanner addKern: kern!
----- Method: TextKern>>hash (in category 'as yet unclassified') -----
hash
    "#hash is re-implemented because #= is re-implemented"
    ^kern hash!
----- Method: TextKern>>isKern (in category 'testing') -----
isKern
    ^true!
----- Method: TextKern>>kern (in category 'as yet unclassified') -----
kern
    ^ kern!
----- Method: TextKern>>kern: (in category 'as yet unclassified') -----
kern: kernValue
    kern := kernValue.
    self reset.!
----- Method: TextKern>>reset (in category 'as yet unclassified') -----
reset
    active := true!
----- Method: TextKern>>set (in category 'as yet unclassified') -----
set
    ^ active!
----- Method: TextKern>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
kern > 0 ifTrue: [
    	1 to: kern do: [:kk | strm nextPut: $+]].
    kern < 0 ifTrue: [
    	1 to: 0-kern do: [:kk | strm nextPut: $-]].!
Object subclass: #LimitingLineStreamWrapper
    instanceVariableNames: 'stream line limitingBlock position'
    classVariableNames: ''
    poolDictionaries: 'TextConstants'
    category: 'Collections-Streams'!
!LimitingLineStreamWrapper commentStamp: '<historical>' prior: 0!
I'm a wrapper for a stream optimized for line-by-line access using #nextLine. My instances can be nested.
I read one line ahead. Reading terminates when the stream ends, or if the limitingBlock evaluated with the line answers true. To skip the delimiting line for further reading use #skipThisLine.
Character-based reading (#next) is permitted, too. Send #updatePosition when switching from line-based reading.
See examples at the class side.
--bf 2/19/1999 12:52!
----- Method: LimitingLineStreamWrapper class>>example1 (in category 'examples') -----
example1
    "LimitingLineStreamWrapper example1"
    "Separate chunks of text delimited by a special string"
    | inStream msgStream messages |
    inStream := self exampleStream.
    msgStream := LimitingLineStreamWrapper on: inStream delimiter: 'From '.
    messages := OrderedCollection new.
    [inStream atEnd] whileFalse: [
    	msgStream skipThisLine.
    	messages add: msgStream upToEnd].
    ^messages
    		!
----- Method: LimitingLineStreamWrapper class>>example2 (in category 'examples') -----
example2
    "LimitingLineStreamWrapper example2"
    "Demo nesting wrappers - get header lines from some messages"
    | inStream msgStream headers headerStream |
    inStream := self exampleStream.
    msgStream := LimitingLineStreamWrapper on: inStream delimiter: 'From '.
    headers := OrderedCollection new.
    [inStream atEnd] whileFalse: [
    	msgStream skipThisLine. "Skip From"
    	headerStream := LimitingLineStreamWrapper on: msgStream delimiter: ''.
    	headers add: headerStream linesUpToEnd.
    	[msgStream nextLine isNil] whileFalse. "Skip Body"
    ].
    ^headers
    		!
----- Method: LimitingLineStreamWrapper class>>exampleStream (in category 'examples') -----
exampleStream
    ^ReadStream on:
'From me@somewhere
From: me
To: you
Subject: Test
Test
...
From you@elsewhere
From: you
To: me
Subject: Re: test
okay
'!
----- Method: LimitingLineStreamWrapper class>>on:delimiter: (in category 'instance creation') -----
on: aStream delimiter: aString
^self new setStream: aStream delimiter: aString
!
----- Method: LimitingLineStreamWrapper>>atEnd (in category 'testing') -----
atEnd
^line isNil or: [limitingBlock value: line]!
----- Method: LimitingLineStreamWrapper>>close (in category 'stream protocol') -----
close
    ^stream close!
----- Method: LimitingLineStreamWrapper>>delimiter: (in category 'accessing') -----
delimiter: aString
    "Set limitBlock to check for a delimiting string. Be unlimiting if nil"
self limitingBlock: (aString caseOf: {
    	[nil] -> [[:aLine | false]].
    	[''] -> [[:aLine | aLine size = 0]]
    } otherwise: [[:aLine | aLine beginsWith: aString]])
!
----- Method: LimitingLineStreamWrapper>>lastLineRead (in category 'accessing') -----
lastLineRead
    "Return line last read. At stream end, this is the boundary line or nil"
^ line!
----- Method: LimitingLineStreamWrapper>>limitingBlock: (in category 'accessing') -----
limitingBlock: aBlock
    "The limitingBlock is evaluated with a line to check if this line terminates the stream"
limitingBlock := aBlock fixTemps.
    self updatePosition!
----- Method: LimitingLineStreamWrapper>>linesUpToEnd (in category 'accessing') -----
linesUpToEnd
| elements ln |
    elements := OrderedCollection new.
    [(ln := self nextLine) isNil] whileFalse: [ 
    	elements add: ln].
    ^elements!
----- Method: LimitingLineStreamWrapper>>next (in category 'accessing') -----
next
    "Provide character-based access"
position isNil ifTrue: [^nil].
    position < line size ifTrue: [^line at: (position := position + 1)].
    line := stream nextLine.
    self updatePosition.
    ^ Character cr!
----- Method: LimitingLineStreamWrapper>>nextLine (in category 'accessing') -----
nextLine
| thisLine |
    self atEnd ifTrue: [^nil].
    thisLine := line.
    line := stream nextLine.
    ^thisLine
!
----- Method: LimitingLineStreamWrapper>>peekLine (in category 'accessing') -----
peekLine
self atEnd ifTrue: [^nil].
    ^ line!
----- Method: LimitingLineStreamWrapper>>printOn: (in category 'printing') -----
printOn: aStream
super printOn: aStream.
    aStream nextPutAll: ' on '.
    stream printOn: aStream!
----- Method: LimitingLineStreamWrapper>>setStream:delimiter: (in category 'private') -----
setStream: aStream delimiter: aString
stream := aStream.
    line := stream nextLine.
    self delimiter: aString.	"sets position"
!
----- Method: LimitingLineStreamWrapper>>skipThisLine (in category 'accessing') -----
skipThisLine
line := stream nextLine.
    self updatePosition.
!
----- Method: LimitingLineStreamWrapper>>upToEnd (in category 'accessing') -----
upToEnd
| ln |
    ^String streamContents: [:strm |
    	[(ln := self nextLine) isNil] whileFalse: [ 
    		strm nextPutAll: ln; cr]]!
----- Method: LimitingLineStreamWrapper>>updatePosition (in category 'accessing') -----
updatePosition
    "Call this before doing character-based access"
position := self atEnd ifFalse: [0]!
ArrayedCollection subclass: #Text
    instanceVariableNames: 'string runs'
    classVariableNames: ''
    poolDictionaries: 'TextConstants'
    category: 'Collections-Text'!
!Text commentStamp: '<historical>' prior: 0!
I represent a character string that has been marked with abstract changes in character appearance. Actual display is performed in the presence of a TextStyle which indicates, for each abstract code, an actual font to be used.  A Text associates a set of TextAttributes with each character in its character string.  These attributes may be font numbers, emphases such as bold or italic, or hyperling actions.  Font numbers are interpreted relative to whatever textStyle appears, along with the text, in a Paragraph.  Since most characters have the same attributes as their neighbors, the attributes are stored in a RunArray for efficiency.  Each of my instances has
    string		a String
    runs		a RunArray!
----- Method: Text class>>addAttribute:toArray: (in category 'private') -----
addAttribute: att toArray: others 
    "Add a new text attribute to an existing set"
    "NOTE: The use of reset and set in this code is a specific
    hack for merging TextKerns."
    att reset.
    ^ Array streamContents:
    	[:strm | others do:
    		[:other | (att dominates: other) ifFalse: [strm nextPut: other]].
    	att set ifTrue: [strm nextPut: att]]!
----- Method: Text class>>fromString: (in category 'instance creation') -----
fromString: aString 
    "Answer an instance of me whose characters are those of the argument, aString."
^ self string: aString attributes:  #()!
----- Method: Text class>>fromUser (in category 'instance creation') -----
fromUser
    "Answer an instance of me obtained by requesting the user to type a string."
    "Text fromUser"
^ self fromString:
    	(UIManager default request: 'Enter text followed by carriage return')
!
----- Method: Text class>>initTextConstants (in category 'class initialization') -----
initTextConstants 
    "Initialize constants shared by classes associated with text display, e.g., 
    Space, Tab, Cr, Bs, ESC."
    	"1/24/96 sw: in exasperation and confusion, changed cmd-g mapping from 231 to 232 to see if I could gain any relief?!!"
| letter varAndValue tempArray width |
    "CtrlA..CtrlZ, Ctrla..Ctrlz"
    letter := $A.
    #(		212 230 228 196 194 226 241 243 214 229 200 217 246 
    		245 216 202 210 239 211 240 197 198 209 215 242 231
     		1 166 228 132 130 12 232 179 150 165 136 153 182 
    		14 15 138 17 18 19 11 21 134 145 151 178 167 ) do:
    	[:kbd |
    	TextConstants at: ('Ctrl', letter asSymbol) asSymbol put: kbd asCharacter.
    	letter := letter == $Z ifTrue: [$a] ifFalse: [(letter asciiValue + 1) asCharacter]].
varAndValue := #(
    	Space	32
    	Tab		9
    	CR		13
    	Enter	3
    	BS		8
    	BS2		158
    	ESC		160
    	Clear 	173
    ).
varAndValue size odd ifTrue: [self error: 'unpaired text constant'].
    (2 to: varAndValue size by: 2) do:
    	[:i | TextConstants at: (varAndValue at: i - 1) put: (varAndValue at: i) asCharacter].
varAndValue := #(
    	CtrlDigits 			(159 144 143 128 127 129 131 180 149 135)
    	CtrlOpenBrackets	(201 7 218 249 219 15)
    		"lparen gottn by ctrl-:= = 201; should be 213 but can't type that on Mac"
"location of non-character stop conditions"
    	EndOfRun	257
    	CrossedX	258
"values for alignment"
    	LeftFlush	0
    	RightFlush	1
    	Centered	2
    	Justified	3
"subscripts for a marginTabsArray tuple"
    	LeftMarginTab	1
    	RightMarginTab	2
"font faces"
    	Basal	0
    	Bold	1
    	Italic	2
"in case font doesn't have a width for space character"
    		"some plausible numbers-- are they the right ones?"
    	DefaultSpace			4
    	DefaultTab				24
    	DefaultLineGrid			16
    	DefaultBaseline			12
    	DefaultFontFamilySize	3	"basal, bold, italic"
    ).
varAndValue size odd ifTrue: [self error: 'unpaired text constant'].
    (2 to: varAndValue size by: 2) do:
    	[:i | TextConstants at: (varAndValue at: i - 1) put: (varAndValue at: i)].
TextConstants at: #DefaultRule	put: Form over.
    TextConstants at: #DefaultMask	put: Color black.
width := Display width max: 720.
    tempArray := Array new: width // DefaultTab.
    1 to: tempArray size do:
    	[:i | tempArray at: i put: DefaultTab * i].
    TextConstants at: #DefaultTabsArray put: tempArray.
    tempArray := Array new: (width // DefaultTab) // 2.
    1 to: tempArray size do:
    	[:i | tempArray at: i put: (Array with: (DefaultTab*i) with: (DefaultTab*i))].
    TextConstants at: #DefaultMarginTabsArray put: tempArray.
"Text initTextConstants "!
----- Method: Text class>>initialize (in category 'class initialization') -----
initialize	"Text initialize"
    "Initialize constants shared by classes associated with text display."
TextConstants at: #CaretForm put:
    			(Form extent: 16@5
    				fromArray: #(2r001100e26 2r001100e26 2r011110e26 2r111111e26 2r110011e26)
    				offset: -3@0).
    self initTextConstants!
----- Method: Text class>>new: (in category 'instance creation') -----
new: stringSize
^self fromString: (String new: stringSize)!
----- Method: Text class>>streamContents: (in category 'instance creation') -----
streamContents: blockWithArg 
    | stream |
    stream := TextStream on: (self new: 400).
    blockWithArg value: stream.
    ^ stream contents!
----- Method: Text class>>string:attribute: (in category 'instance creation') -----
string: aString attribute: att
    "Answer an instance of me whose characters are aString.
    att is a TextAttribute."
^self string: aString attributes: (Array with: att)!
----- Method: Text class>>string:attributes: (in category 'instance creation') -----
string: aString attributes: atts
    "Answer an instance of me whose characters are those of aString.
    atts is an array of TextAttributes."
^self string: aString runs: (RunArray new: aString size withAll: atts)!
----- Method: Text class>>string:emphasis: (in category 'instance creation') -----
string: aString emphasis: emphasis
    "This is an old method that is mainly used by old applications"
emphasis isNumber ifTrue:
    	[self halt: 'Numeric emphasis is not supported in Squeak'.
    	"But if you proceed, we will do our best to give you what you want..."
    	^ self string: aString runs: (RunArray new: aString size withAll: 
    		(Array with: (TextFontChange new fontNumber: emphasis)))].
    ^ self string: aString attributes: emphasis!
----- Method: Text class>>string:runs: (in category 'private') -----
string: aString runs: anArray
^self basicNew setString: aString setRuns: anArray!
----- Method: Text>>= (in category 'comparing') -----
= other
    "Am I equal to the other Text or String?  
    ***** Warning ***** Two Texts are considered equal if they have the same characters in them.  They might have completely different emphasis, fonts, sizes, text actions, or embedded morphs.  If you need to find out if one is a true copy of the other, you must do (text1 = text2 and: [text1 runs = text2 runs])."
other isText ifTrue:	["This is designed to run fast even for megabytes"
    			^ string == other string or: [string = other string]].
    other isString ifTrue: [^ string == other or: [string = other]].
    ^ false!
----- Method: Text>>addAttribute: (in category 'emphasis') -----
addAttribute: att 
    ^ self addAttribute: att from: 1 to: self size!
----- Method: Text>>addAttribute:from:to: (in category 'emphasis') -----
addAttribute: att from: start to: stop 
    "Set the attribute for characters in the interval start to stop."
    runs :=  runs copyReplaceFrom: start to: stop
    		with: ((runs copyFrom: start to: stop)
    			mapValues:
    			[:attributes | Text addAttribute: att toArray: attributes])
!
----- Method: Text>>alignmentAt:ifAbsent: (in category 'emphasis') -----
alignmentAt: characterIndex ifAbsent: aBlock
    | attributes emph |
    self size = 0 ifTrue: [^aBlock value].
    emph := nil.
    attributes := runs at: characterIndex.
    attributes do:[:att | (att isKindOf: TextAlignment) ifTrue:[emph := att]].
    ^ emph ifNil: aBlock ifNotNil:[emph alignment]!
----- Method: Text>>allBold (in category 'emphasis') -----
allBold 
    "Force this whole text to be bold."
    string size = 0 ifTrue: [^self].
    self makeBoldFrom: 1 to: string size!
----- Method: Text>>append: (in category 'accessing') -----
append: stringOrText
self replaceFrom: string size + 1
    			to: string size with: stringOrText!
----- Method: Text>>asDisplayText (in category 'converting') -----
asDisplayText
    "Answer a DisplayText whose text is the receiver."
^DisplayText text: self!
----- Method: Text>>asNumber (in category 'converting') -----
asNumber
    "Answer the number created by interpreting the receiver as the textual 
    representation of a number."
^string asNumber!
----- Method: Text>>asOctetStringText (in category 'converting') -----
asOctetStringText
string class == WideString ifTrue: [
    	^ self class string: string asOctetString runs: self runs copy.
    ].
    ^self.
!
----- Method: Text>>asParagraph (in category 'converting') -----
asParagraph
    "Answer a Paragraph whose text is the receiver."
^Paragraph withText: self!
----- Method: Text>>asString (in category 'converting') -----
asString
    "Answer a String representation of the textual receiver."
^string!
----- Method: Text>>asStringOrText (in category 'converting') -----
asStringOrText	
    "Answer the receiver itself."
^self!
----- Method: Text>>asText (in category 'converting') -----
asText	
    "Answer the receiver itself."
^self!
----- Method: Text>>asUrl (in category 'converting') -----
asUrl
    ^self asString asUrl!
----- Method: Text>>asUrlRelativeTo: (in category 'converting') -----
asUrlRelativeTo: aUrl
    ^self asString asUrlRelativeTo: aUrl!
----- Method: Text>>askIfAddStyle:req: (in category 'attributes') -----
askIfAddStyle: priorMethod req: requestor
    "Ask the user if we have a complex style (i.e. bold) for the first time"
    | tell answ old |
    (Preferences browseWithPrettyPrint)
    	ifTrue: [self couldDeriveFromPrettyPrinting ifTrue: [^ self asString]].
    self runs coalesce.
    self unembellished ifTrue: [^ self asString].
    priorMethod ifNotNil: [old := priorMethod getSourceFromFile].
    (old == nil or: [old unembellished])
    	ifTrue:
    		[tell := 'This method contains style for the first time (e.g. bold or colored text).
Do you really want to save the style info?'.
    		answ := (UIManager default 
    					chooseFrom: #('Save method with style' 'Save method simply')
    					title: tell).
    		answ = 2 ifTrue: [^ self asString]]!
----- Method: Text>>at: (in category 'accessing') -----
at: index
^string at: index!
----- Method: Text>>at:put: (in category 'accessing') -----
at: index put: character
^string at: index put: character!
----- Method: Text>>attributesAt: (in category 'emphasis') -----
attributesAt: characterIndex 
    "Answer the code for characters in the run beginning at characterIndex."
    "NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this"
    | attributes |
    self size = 0
    	ifTrue: [^ Array with: (TextFontChange new fontNumber: 1)].  "null text tolerates access"
    attributes := runs at: characterIndex.
    ^ attributes!
----- Method: Text>>attributesAt:do: (in category 'emphasis') -----
attributesAt: characterIndex do: aBlock
    "Answer the code for characters in the run beginning at characterIndex."
    "NB: no senders any more (supplanted by #attributesAt:forStyle: but retained for the moment in order not to break user code that may exist somewhere that still calls this"
    self size = 0 ifTrue:[^self].
    (runs at: characterIndex) do: aBlock!
----- Method: Text>>attributesAt:forStyle: (in category 'emphasis') -----
attributesAt: characterIndex forStyle: aTextStyle
    "Answer the code for characters in the run beginning at characterIndex."
    | attributes |
    self size = 0
    	ifTrue: [^ Array with: (TextFontChange new fontNumber: aTextStyle defaultFontIndex)].  "null text tolerates access"
    attributes := runs at: characterIndex.
    ^ attributes!
----- Method: Text>>basicType (in category 'attributes') -----
basicType
    "Answer a symbol representing the inherent type I hold"
"Number String Boolean player collection sound color etc"
    ^ #Text!
----- Method: Text>>closeHtmlAttributes:on: (in category 'html') -----
closeHtmlAttributes: anArray on: aStream 
    anArray
    	do: [:each | each closeHtmlOn: aStream].!
----- Method: Text>>copyFrom:to: (in category 'copying') -----
copyFrom: start to: stop 
    "Answer a copied subrange of the receiver."
| realStart realStop |
    stop > self size
    	ifTrue: [realStop := self size]		"handle selection at end of string"
    	ifFalse: [realStop := stop].
    start < 1
    	ifTrue: [realStart := 1]			"handle selection before start of string"
    	ifFalse: [realStart := start].
    ^Text 
    	string: (string copyFrom: realStart to: realStop)
    	runs: (runs copyFrom: realStart to: realStop)!
----- Method: Text>>copyReplaceFrom:to:with: (in category 'copying') -----
copyReplaceFrom: start to: stop with: aTextOrString
| txt |
    txt := aTextOrString asText.	"might be a string"
    ^self class 
             string: (string copyReplaceFrom: start to: stop with: txt string)
             runs: (runs copyReplaceFrom: start to: stop with: txt runs)
!
----- Method: Text>>copyReplaceTokens:with: (in category 'copying') -----
copyReplaceTokens: oldSubstring with: newSubstring 
    "Replace all occurrences of oldSubstring that are surrounded
    by non-alphanumeric characters"
    ^ self copyReplaceAll: oldSubstring with: newSubstring asTokens: true
    "'File asFile Files File''s File' copyReplaceTokens: 'File' with: 'Snick'"!
----- Method: Text>>couldDeriveFromPrettyPrinting (in category 'attributes') -----
couldDeriveFromPrettyPrinting
    "Return true if the receiver has any TextAttributes that are functional rather than simply appearance-related"
    runs values do:
    	[:emphArray | emphArray do:
    		[:emph | emph couldDeriveFromPrettyPrinting ifFalse: [^ false]]].
    ^ true!
----- Method: Text>>deepCopy (in category 'copying') -----
deepCopy
^ self copy "Both string and runs are assumed to be read-only"!
----- Method: Text>>embeddedMorphs (in category 'accessing') -----
embeddedMorphs
    "return the list of morphs embedded in me"
| morphs |
    morphs := IdentitySet new.
    runs withStartStopAndValueDo: 
    		[:start :stop :attribs | 
    		attribs 
    			do: [:attrib | attrib anchoredMorph ifNotNil: [morphs add: attrib anchoredMorph]]].
    ^morphs select: [:m | m isMorph]!
----- Method: Text>>embeddedMorphsFrom:to: (in category 'accessing') -----
embeddedMorphsFrom: start to: stop 
    "return the list of morphs embedded in me"
| morphs |
    morphs := IdentitySet new.
    runs 
    	runsFrom: start
    	to: stop
    	do: 
    		[:attribs | 
    		attribs 
    			do: [:attr | attr anchoredMorph ifNotNil: [morphs add: attr anchoredMorph]]].
    ^morphs select: [:m | m isMorph]!
----- Method: Text>>emphasisAt: (in category 'emphasis') -----
emphasisAt: characterIndex
    "Answer the fontfor characters in the run beginning at characterIndex."
    | attributes emph |
    self size = 0 ifTrue: [^ 0].	"null text tolerates access"
    emph := 0.
    attributes := runs at: characterIndex.
    attributes do: 
    	[:att | emph := emph bitOr: att emphasisCode].
    ^ emph
    !
----- Method: Text>>find: (in category 'emphasis') -----
find: attribute
    "Return the first interval over which this attribute applies"
    | begin end |
    begin := 0.
    runs withStartStopAndValueDo:
    	[:start :stop :attributes |
    	(attributes includes: attribute)
    		ifTrue: [begin = 0 ifTrue: [begin := start].
    				end := stop]
    		ifFalse: [begin > 0 ifTrue: [^ begin to: end]]].
    begin > 0 ifTrue: [^ begin to: end].
    ^ nil!
----- Method: Text>>findString:startingAt: (in category 'accessing') -----
findString: aString startingAt: start 
    "Answer the index of subString within the receiver, starting at index 
    start. If the receiver does not contain subString, answer 0."
^string findString: aString asString startingAt: start!
----- Method: Text>>findString:startingAt:caseSensitive: (in category 'accessing') -----
findString: aString startingAt: start caseSensitive: caseSensitive
    "Answer the index of subString within the receiver, starting at index 
    start. If the receiver does not contain subString, answer 0."
^string findString: aString asString startingAt: start caseSensitive: caseSensitive!
----- Method: Text>>fontAt:withStyle: (in category 'emphasis') -----
fontAt: characterIndex withStyle: aTextStyle
    "Answer the fontfor characters in the run beginning at characterIndex."
    | attributes font |
    self size = 0 ifTrue: [^ aTextStyle defaultFont].	"null text tolerates access"
    attributes := runs at: characterIndex.
    font := aTextStyle defaultFont.  "default"
    attributes do: 
    	[:att | att forFontInStyle: aTextStyle do: [:f | font := f]].
    ^ font!
----- Method: Text>>fontNumberAt: (in category 'emphasis') -----
fontNumberAt: characterIndex 
    "Answer the fontNumber for characters in the run beginning at characterIndex."
    | attributes fontNumber |
    self size = 0 ifTrue: [^1].	"null text tolerates access"
    attributes := runs at: characterIndex.
    fontNumber := 1.
    attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [fontNumber := att fontNumber]].
    ^ fontNumber
    !
----- Method: Text>>hash (in category 'comparing') -----
hash
    "#hash is implemented, because #= is implemented.  We are now equal to a string with the same characters.  Hash must reflect that."
^ string hash!
----- Method: Text>>howManyMatch: (in category 'comparing') -----
howManyMatch: aString
^ self string howManyMatch: aString!
----- Method: Text>>isText (in category 'comparing') -----
isText
    ^ true!
----- Method: Text>>isoToSqueak (in category 'converting') -----
isoToSqueak
    ^self "no longer needed"!
----- Method: Text>>lineCount (in category 'accessing') -----
lineCount
^ string lineCount!
----- Method: Text>>macToSqueak (in category 'converting') -----
macToSqueak
    "Convert the receiver from MacRoman to Squeak encoding"
    ^ self class new setString: string macToSqueak setRuns: runs copy!
----- Method: Text>>makeBoldFrom:to: (in category 'emphasis') -----
makeBoldFrom: start to: stop
^ self addAttribute: TextEmphasis bold from: start to: stop!
----- Method: Text>>makeSelectorBold (in category 'emphasis') -----
makeSelectorBold
    "For formatting Smalltalk source code, set the emphasis of that portion of 
    the receiver's string that parses as a message selector to be bold."
| parser i |
    string size = 0 ifTrue: [^ self].
    i := 0.
    [(string at: (i := i + 1)) isSeparator] whileTrue.
    (string at: i) = $[ ifTrue: [^ self].  "block, no selector"
    [(parser := Compiler parserClass new) parseSelector: string] on: Error do: [^ self].
    self makeBoldFrom: 1 to: (parser endOfLastToken min: string size)!
----- Method: Text>>makeSelectorBoldIn: (in category 'emphasis') -----
makeSelectorBoldIn: aClass
    "For formatting Smalltalk source code, set the emphasis of that portion of 
    the receiver's string that parses as a message selector to be bold."
| parser |
    string size = 0 ifTrue: [^self].
    (parser := aClass parserClass new) parseSelector: string.
    self makeBoldFrom: 1 to: (parser endOfLastToken min: string size)!
----- Method: Text>>openHtmlAttributes:on: (in category 'html') -----
openHtmlAttributes: anArray on: aStream 
    anArray
    	do: [:each | each openHtmlOn: aStream ]!
----- Method: Text>>postCopy (in category 'copying') -----
postCopy
    super postCopy.
    string := string copy.
    runs := runs copy!
----- Method: Text>>prepend: (in category 'accessing') -----
prepend: stringOrText
self replaceFrom: 1 to: 0 with: stringOrText!
----- Method: Text>>printHtmlOn: (in category 'html') -----
printHtmlOn: aStream 
    self runs
    	withStartStopAndValueDo: [:start :stop :attributes | 
    		| att str | 
    		att := self attributesAt: start.
    		str := self string copyFrom: start to: stop.
    		""
    		self openHtmlAttributes: att on: aStream.
    		self printStringHtml: str on: aStream.
self closeHtmlAttributes: att on: aStream]!
----- Method: Text>>printHtmlString (in category 'html') -----
printHtmlString
    "answer a string whose characters are the html representation 
    of the receiver"
    | html |
    html := String new writeStream.
    self printHtmlOn: html.
    ^ html contents!
----- Method: Text>>printOn: (in category 'printing') -----
printOn: aStream
    self printNameOn: aStream.
    aStream nextPutAll: ' for '; print: string!
----- Method: Text>>printStringHtml:on: (in category 'html') -----
printStringHtml: aString on: aStream 
    | html |
    html := aString.
    ""
    html := html copyReplaceAll: '&' with: '&amp;'.
    html := html copyReplaceAll: '>' with: '&gt;'.
    html := html copyReplaceAll: '<' with: '&lt;'.
    ""
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬®¬šŠÖ' with: '&aacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬®¬š¬©' with: '&eacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬®¬¶Šë' with: '&iacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬®¬¶Šü' with: '&oacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬®¬¶¬ö' with: '&uacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬®¬š¬±' with: '&ntilde;'.
    ""
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬¬¶Š±' with: '&Aacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬¬š¬¢' with: '&Eacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬¬¶Šº' with: '&Iacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬¬š¬Æ' with: '&Oacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬¬šŠ©' with: '&Uacute;'.
    html := html copyReplaceAll: '¬š¬®¬š¬é¬š¬¬š¬·' with: '&Ntilde;'.
    ""
    html := html copyReplaceAll: '
' with: '<br>
'.
    html := html copyReplaceAll: '	' with: '&nbsp;&nbsp;&nbsp;&nbsp;'.
    ""
    aStream nextPutAll: html!
----- Method: Text>>rangeOf:startingAt: (in category 'accessing') -----
rangeOf: attribute startingAt: index
"Answer an interval that gives the range of attribute at index position  index. An empty interval with start value index is returned when the attribute is not present at position index.  "
   ^string size = 0
      ifTrue: [index to: index - 1]
     ifFalse: [runs rangeOf: attribute startingAt: index]!
----- Method: Text>>removeAttribute:from:to: (in category 'emphasis') -----
removeAttribute: att from: start to: stop 
    "Remove the attribute over the interval start to stop."
    runs :=  runs copyReplaceFrom: start to: stop
    		with: ((runs copyFrom: start to: stop)
    			mapValues:
    			[:attributes | attributes copyWithout: att])
!
----- Method: Text>>removeAttributesThat:replaceAttributesThat:by: (in category 'converting') -----
removeAttributesThat: removalBlock replaceAttributesThat: replaceBlock by: convertBlock
    "Enumerate all attributes in the receiver. Remove those passing removalBlock and replace those passing replaceBlock after converting it through convertBlock"
    | added removed new |
    "Deliberately optimized for the no-op default."
    added := removed := nil.
    runs withStartStopAndValueDo: [ :start :stop :attribs | 
    	attribs do: [ :attrib |
    		(removalBlock value: attrib) ifTrue:[
    			removed ifNil:[removed := WriteStream on: #()].
    			removed nextPut: {start. stop. attrib}.
    		] ifFalse:[
    			(replaceBlock value: attrib) ifTrue:[
    				removed ifNil:[removed := WriteStream on: #()].
    				removed nextPut: {start. stop. attrib}.
    				new := convertBlock value: attrib.
    				added ifNil:[added := WriteStream on: #()].
    				added nextPut: {start. stop. new}.
    			].
    		].
    	].
    ].
    (added == nil and:[removed == nil]) ifTrue:[^self].
    "otherwise do the real work"
    removed ifNotNil:[removed contents do:[:spec|
    	self removeAttribute: spec last from: spec first to: spec second]].
    added ifNotNil:[added contents do:[:spec|
    	self addAttribute: spec last from: spec first to: spec second]].!
----- Method: Text>>replaceFrom:to:with: (in category 'accessing') -----
replaceFrom: start to: stop with: aText
| txt |
    txt := aText asText.	"might be a string"
    string := string copyReplaceFrom: start to: stop with: txt string.
    runs := runs copyReplaceFrom: start to: stop with: txt runs!
----- Method: Text>>replaceFrom:to:with:startingAt: (in category 'converting') -----
replaceFrom: start to: stop with: replacement startingAt: repStart 
    "This destructively replaces elements from start to stop in the receiver starting at index, repStart, in replacementCollection. Do it to both the string and the runs."
| rep newRepRuns |
    rep := replacement asText.	"might be a string"
    string replaceFrom: start to: stop with: rep string startingAt: repStart.
    newRepRuns := rep runs copyFrom: repStart to: repStart + stop - start.
    runs := runs copyReplaceFrom: start to: stop with: newRepRuns!
----- Method: Text>>reversed (in category 'converting') -----
reversed
"Answer a copy of the receiver with element order reversed."
^ self class string: string reversed runs: runs reversed.
"  It is assumed that  self size = runs size  holds. "!
----- Method: Text>>runLengthFor: (in category 'emphasis') -----
runLengthFor: characterIndex 
    "Answer the count of characters remaining in run beginning with 
    characterIndex."
    self size = 0 ifTrue:[^0]. "null tolerates access"
    ^runs runLengthAt: characterIndex!
----- Method: Text>>runs (in category 'private') -----
runs
^runs!
----- Method: Text>>runs: (in category 'accessing') -----
runs: anArray
runs := anArray!
----- Method: Text>>setString:setRuns: (in category 'private') -----
setString: aString setRuns: anArray
string := aString.
    runs := anArray!
----- Method: Text>>setString:setRunsChecking: (in category 'private') -----
setString: aString setRunsChecking: aRunArray
    "Check runs and do the best you can to make them fit..."
string := aString.
    "check the runs"
    aRunArray ifNil: [^ aString asText].
    (aRunArray isKindOf: RunArray) ifFalse: [^ aString asText].
    aRunArray runs size = aRunArray values size ifFalse: [^ aString asText].
    (aRunArray values includes: #()) ifTrue: [^ aString asText].	"not allowed?"
    aRunArray size = aString size ifFalse: [^ aString asText].
    
    runs := aRunArray.!
----- Method: Text>>size (in category 'accessing') -----
size
^string size!
----- Method: Text>>squeakToIso (in category 'converting') -----
squeakToIso
    ^self "no longer needed"!
----- Method: Text>>squeakToMac (in category 'converting') -----
squeakToMac
    "Convert the receiver from Squeak to MacRoman encoding"
    ^ self class new setString: string squeakToMac setRuns: runs copy!
----- Method: Text>>storeOn: (in category 'printing') -----
storeOn: aStream
aStream nextPutAll: '(Text string: ';
    	store: string;
    	nextPutAll: ' runs: ';
    	store: runs;
    	nextPut: $)!
----- Method: Text>>string (in category 'accessing') -----
string
    "Answer the string representation of the receiver."
^string!
----- Method: Text>>unembellished (in category 'attributes') -----
unembellished 
    "Return true if the only emphases are the default font and bold"
    | font1 bold |
    font1 := TextFontChange defaultFontChange.
    bold := TextEmphasis bold.
    Preferences ignoreStyleIfOnlyBold ifFalse:
    	["Ignore font1 only or font1-bold followed by font1-plain"
    	^ (runs values = (Array with: (Array with: font1)))
    	or: [runs values = (Array with: (Array with: font1 with: bold)
    							with: (Array with: font1))]].
"If preference is set, then ignore any combo of font1 and bold"
    runs withStartStopAndValueDo:
    	[:start :stop :emphArray |
    	emphArray do:
    		[:emph | (font1 = emph or: [bold = emph]) ifFalse: [^ false]]].
    ^ true!
----- Method: Text>>withSqueakLineEndings (in category 'converting') -----
withSqueakLineEndings
    "Answer a copy of myself in which all sequences of <CR><LF> or <LF> have been changed to <CR>"
    | newText |
    (string includes: Character lf) ifFalse: [ ^self copy ].
    newText := self copyReplaceAll: String crlf with: String cr asTokens: false.
    (newText asString includes: Character lf) ifFalse: [ ^newText ].
    ^newText copyReplaceAll: String lf with: String cr asTokens: false.!
TextAttribute subclass: #TextAlignment
    instanceVariableNames: 'alignment'
    classVariableNames: ''
    poolDictionaries: 'TextConstants'
    category: 'Collections-Text'!
----- Method: TextAlignment class>>alignmentSymbol: (in category 'as yet unclassified') -----
alignmentSymbol: alignmentCode
    ^#(leftFlush rightFlush centered justified) at: (alignmentCode + 1)!
----- Method: TextAlignment class>>centered (in category 'instance creation') -----
centered
    ^self new alignment: Centered!
----- Method: TextAlignment class>>justified (in category 'instance creation') -----
justified
    ^self new alignment: Justified!
----- Method: TextAlignment class>>leftFlush (in category 'instance creation') -----
leftFlush
    ^self new alignment: LeftFlush!
----- Method: TextAlignment class>>rightFlush (in category 'instance creation') -----
rightFlush
    ^self new alignment: RightFlush!
----- Method: TextAlignment>>= (in category 'as yet unclassified') -----
= other 
    ^ (other class == self class) 
    	and: [other alignment = alignment]!
----- Method: TextAlignment>>alignment (in category 'as yet unclassified') -----
alignment
    ^alignment!
----- Method: TextAlignment>>alignment: (in category 'as yet unclassified') -----
alignment: aNumber
    alignment := aNumber.!
----- Method: TextAlignment>>dominates: (in category 'as yet unclassified') -----
dominates: other
    "There can be only one..."
    ^self class == other class!
----- Method: TextAlignment>>emphasizeScanner: (in category 'as yet unclassified') -----
emphasizeScanner: scanner
    "Set the emphasist for text scanning"
    scanner setAlignment: alignment.!
----- Method: TextAlignment>>hash (in category 'as yet unclassified') -----
hash
    "#hash is re-implemented because #= is re-implemented"
    ^ alignment hash!
----- Method: TextAlignment>>writeScanOn: (in category 'as yet unclassified') -----
writeScanOn: strm
strm nextPut: $a.
    alignment printOn: strm.!

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

[Pkg] The Inbox: Collections-ul.163.mcz