cowan@marob.masa.com (John Cowan) (07/27/90)
"
Purposes of BUGFIX.ST:
1) Fixes bugs in Object>>objectDeepCopy
and Object>>objectShallowCopy.
2) Converts various methods in Collection classes to use
new methods emptyCopy and emptyCopy: when making new
collections. These methods produce a copy of an existing
collection that contains no elements, but otherwise
preserves all attributes (for example, the sortBlock of
a SortedCollection).
3) Provides a few useful Collection methods that don't fit
elsewhere (see individual method definitions for explanations):
Collection>>maximum:
Collection>>minimum:
IndexedCollection>>decode
IndexedCollection>>encode
IndexedCollection>>identityIndexOf:
IndexedCollection>>identityIndexOf:ifAbsent:
IndexedCollection>>nextIndexOf:from:to:
IndexedCollection>>prevIndexOf:from:to:
IndexedCollection>>replaceAll:with:
IndexedCollection>>replaceAll:with:from:to:
Interval>>first
Interval>>last
4) Fixes the relational operations in class String
to prevent bogus comparisons between Strings and Magnitudes.
5) Fixes FileDialog>>nameFieldEnter to allow a full
pathname to be entered into a file dialog box.
"
! Object methods !
objectDeepCopy
"Answer a copy of the receiver with shallow
copies of each instance variable."
| copy aClass instanceVars |
aClass := self class.
aClass isVariable
ifTrue: [
instanceVars := self basicSize.
copy := aClass basicNew: instanceVars]
ifFalse: [
instanceVars := 0.
copy := aClass basicNew].
aClass isPointers
ifTrue: [
1 to: instanceVars + aClass instSize do: [ :index |
copy instVarAt: index
put: (self instVarAt: index) copy]]
ifFalse: [
1 to: instanceVars do: [ :index |
copy basicAt: index
put: (self basicAt: index)]].
^copy! !
! Object methods !
objectShallowCopy
"Answer a copy of the receiver which shares
the receiver instance variables."
| answer aClass size |
aClass := self class.
aClass isVariable
ifTrue: [
size := self basicSize.
answer := aClass basicNew: size]
ifFalse: [
size := 0.
answer := aClass basicNew].
aClass isPointers
ifTrue: [
1 to: size + aClass instSize do: [ :index |
answer instVarAt: index
put: (self instVarAt: index)]]
ifFalse: [
1 to: size do: [ :index |
answer basicAt: index
put: (self basicAt: index)]].
^answer! !
! Collection methods !
collect: aBlock
"For each element in the receiver, evaluate aBlock with
that element as the argument. Answer a new collection
containing the results as its elements from the aBlock
evaluations."
| answer |
answer := self emptyCopy.
self do: [ :element |
answer add: (aBlock value: element)].
^answer! !
! Collection methods !
deepCopy
"Answer a copy of the receiver with shallow
copies of each element."
| answer |
answer := self emptyCopy.
self do: [:element |
answer add: element copy].
^answer! !
! Collection methods !
emptyCopy
"Answer a copy of the receiver, containing no elements but
otherwise sharing all instance properties."
^self species new.! !
! Collection methods !
emptyCopy: newSize
"Answer a copy of the receiver with a size (or initial size)
of newSize, containing no elements but
otherwise sharing all instance properties."
^self species new: newSize.! !
! Collection methods !
maximum: aBlock
"Answer the maximum element of the receiver. aBlock
is defined as for SortedCollection: it specifies the
less-than-or-equal-to relation. Answer nil for an empty
collection."
| answer noAnswerYet |
noAnswerYet := true.
self do: [ :elem |
noAnswerYet ifTrue:
[answer := elem.
noAnswerYet := false.]
ifFalse:
[(aBlock value: elem value: answer) ifFalse:
[answer := elem]]].
^answer! !
! Collection methods !
minimum: aBlock
"Answer the minimum element of the receiver. aBlock
is defined as for SortedCollection: it specifies the
less-than-or-equal-to relation. Answer nil for an empty
collection."
| answer noAnswerYet |
noAnswerYet := true.
self do: [ :elem |
noAnswerYet ifTrue:
[answer := elem.
noAnswerYet := false.]
ifFalse:
[(aBlock value: elem value: answer) ifTrue:
[answer := elem]]].
^answer! !
! Collection methods !
select: aBlock
"For each element in the receiver, evaluate
aBlock with that element as the argument.
Answer a new collection containing those elements
of the receiver for which aBlock evaluates to true."
| answer |
answer := self emptyCopy.
self do: [ :element |
(aBlock value: element)
ifTrue: [answer add: element]].
^answer! !
! Collection methods !
shallowCopy
"Answer a copy of the receiver which shares
the receiver elements."
^(self emptyCopy)
addAll: self;
yourself! !
! IndexedCollection methods !
, aCollection
"Answer a new collection containing the elements
of the receiver followed by the the elements of
aCollection."
| answer size1 size2 |
size1 := self size.
size2 := size1 + aCollection size.
answer := self emptyCopy: size2.
answer
replaceFrom: 1
to: size1
with: self
startingAt: 1.
answer
replaceFrom: size1 + 1
to: size2
with: aCollection
startingAt: 1.
^answer! !
! IndexedCollection methods !
copyFrom: start to: stop
"Answer a new collection containing the elements
of the receiver indexed from start through stop."
| size |
size := stop - start + 1.
^(self emptyCopy: size)
replaceFrom: 1
to: size
with: self
startingAt: start! !
! IndexedCollection methods !
decode: anIndexedCollection
"Decode the digits of anIndexedCollection
according to the (compound) base specified
by the receiver. Answer an Integer.
If the receiver is too short, the first element
is replicated as needed."
| diff answer baseVector |
diff := anIndexedCollection size - self size.
diff = 0 ifTrue:
[baseVector := self]
ifFalse:
[baseVector := Array new: diff.
baseVector atAllPut: (self at: 1).
baseVector := baseVector, self].
answer := 0.
baseVector with: anIndexedCollection do: [ :base :digit |
answer := (answer * base) + digit].
^answer! !
! IndexedCollection methods !
encode: anInteger
"Encode anInteger according to the (compound)
base specified by the receiver. Answer an
Array of Integers."
| answer integer digit |
answer := WriteStream on: Array new.
integer := anInteger.
self reverseDo: [ :base |
base = 0 ifTrue:
[answer nextPut: integer.
^answer contents reversed]
ifFalse:
[answer nextPut: integer \\ base.
integer := integer // base]].
^answer contents reversed! !
! IndexedCollection methods !
grow
"Answer the receiver expanded in
size to accomodate more elements."
| size new |
size := self size.
new := self emptyCopy: size + self growSize.
new replaceFrom: 1 to: self size with: self.
self become: new! !
! IndexedCollection methods !
identityIndexOf: anObject
"Answer the index position of the element identical
to anObject in the receiver. If no such element
is found, answer zero."
^self
indexOf: anObject
ifAbsent: [^0]! !
! IndexedCollection methods !
identityIndexOf: anObject ifAbsent: aBlock
"Answer the index position of the element identical
to anObject in the receiver. If no such element
is found, evaluate aBlock (without any arguments)."
| index size |
size := self size.
index := 1.
[index <= size]
whileTrue: [
(self at: index) == anObject
ifTrue: [^index].
index := index + 1].
^aBlock value! !
! IndexedCollection methods !
nextIndexOf: anElement from: startIndex to: stopIndex
"Answer the next index of anElement within
the receiver between startIndex and stopIndex.
If the receiver does not contain anElement, answer 0."
startIndex to: stopIndex do: [:i |
(self at: i) = anElement fTrue: [^i]].
^0! !
! IndexedCollection methods !
prevIndexOf: anElement from: startIndex to: stopIndex
"Answer the next index of anElement within
the receiver between startIndex and stopIndex.
If the receiver does not contain anElement, answer 0."
stopIndex to: startIndex by: -1 do: [:i |
(self at: i) = anElement fTrue: [^i]].
^0! !
! IndexedCollection methods !
replaceAll: sourceElement with: destElement
"Replace all occurances of sourceElement
with destElement within the receiver"
^self replaceAll: sourceElement with: destElement
from: 1 to: self size! !
! IndexedCollection methods !
replaceAll: sourceElement with: destElement from: startIndex to: stopIndex
"Replace all occurances of sourceElement
with destElement within the given range."
| index |
index := startIndex - 1 .
[(index := self
nextIndexOf: sourceElement
from: index + 1
to: stopIndex) == nil] whileFalse:
[self at: index put: destElement]! !
! IndexedCollection methods !
swap: oneIndex with: anotherIndex
"Swap element at oneIndex with element at
anotherIndex."
| temp |
temp := self at: oneIndex.
self at: oneIndex put: (self at: anotherIndex).
self at: anotherIndex put: temp.! !
! FixedSizeCollection methods !
collect: aBlock
"For each element in the receiver, evaluate
aBlock with that element as the argument.
Answer a collection containing the results
from the aBlock evaluations as its elements."
| answer index size |
size := self size.
answer := OrderedCollection new: size.
index := 1.
[index > size]
whileFalse: [
answer add: (aBlock value: (self at: index)).
index := index + 1].
^(self emptyCopy: size)
replaceFrom: 1
to: size
with: answer! !
! FixedSizeCollection methods !
copyReplaceFrom: start to: stop with: aCollection
"Answer a collection containing the elements
of the receiver with entries indexed from
start through stop being replaced by the
elements of aCollection."
| answer size1 size2 |
size1 := aCollection size.
size2 := self size + size1 - (stop - start + 1).
answer := self emptyCopy: size2.
answer
replaceFrom: 1
to: start - 1
with: self
startingAt: 1.
answer
replaceFrom: start
to: start + size1 - 1
with: aCollection.
^answer
replaceFrom: start + size1
to: size2
with: self
startingAt: stop + 1! !
! FixedSizeCollection methods !
select: aBlock
"For each element in the receiver, evaluate
aBlock with that element as the argument.
Answer a collection containing those elements
of the receiver for which aBlock evaluates to
true."
| answer index size anObject |
size := self size.
answer := OrderedCollection new: size.
index := 1.
[index > size]
whileFalse: [
anObject := self at: index.
(aBlock value: anObject)
ifTrue: [answer add: anObject].
index := index + 1].
size := answer size.
^(self emptyCopy: size)
replaceFrom: 1
to: size
with: answer! !
! Interval methods !
first
"Answer the first element of the Interval."
^beginning! !
! Interval methods !
last
"Answer the last element of the Interval."
^end! !
! Interval methods !
printOn: aStream
"Display terse version of receiver on aStream."
beginning printOn: aStream.
aStream nextPutAll: ' to: '.
end printOn: aStream.
increment ~= 1 ifTrue:
[aStream nextPutAll: ' by: '.
increment printOn: aStream]! !
! String methods !
< aString
"Answer true if the receiver is before
aString, else answer false. The comparison
is not case sensitive."
(aString isKindOf: String) ifFalse: [^self badComparison].
^(aString "asString" <= self) not! !
! String methods !
<= aString
"Answer true if the receiver is before
or equal to aString, else answer false.
The comparison is not case sensitive."
<primitive: 56>
(aString isKindOf: String) ifFalse: [^self badComparison].
^self primitiveFailed! !
! String methods !
>= aString
"Answer true if the receiver is after
or equal to aString, else answer false.
The comparison is not case sensitive."
(aString isKindOf: String) ifFalse: [^self badComparison].
^aString <= self! !
! String methods !
badComparison
"Private - Signal an error."
^self error: 'Cannot compare strings and magnitudes'! !
! OrderedCollection methods !
copyFrom: beginning to: end
"Answer an OrderedCollection containing the
elements of the receiver from index position
beginning through index position end."
| answer |
(answer := self emptyCopy: self size)
startPosition: 1
endPosition: end - beginning + 1.
^answer
replaceFrom: 1
to: end - beginning + 1
with: self
startingAt: beginning! !
! SortedCollection methods !
copyFrom: beginning to: end
"Answer a SortedCollection containing the
elements of the receiver from index position
beginning through index position end."
| answer |
answer := self emptyCopy: self size.
beginning to: end do: [:i |
answer add: (self at: i)].
^answer! !
! SortedCollection methods !
emptyCopy
"Answer a new SortedCollection with a default number of elements,
with the same sort block as the receiver."
| answer |
answer := super emptyCopy.
answer sortBlock: sortBlock.
^answer! !
! SortedCollection methods !
emptyCopy: size
"Answer a new SortedCollection with size elements,
with the same sort block as the receiver."
| answer |
answer := super emptyCopy: size.
answer sortBlock: sortBlock.
^answer! !
! Set methods !
grow
"Private - Answer the receiver expanded
to accomodate more elements."
| aSet |
aSet := self emptyCopy: contents size * 4 // 3 + 10.
self do: [ :element | aSet add: element].
contents := aSet contents! !
! Dictionary methods !
associationsSelect: aBlock
"For each key/value pair in the receiver, evaluate
aBlock with the association as the argument.
Answer a new object containing those key/value pairs
for which aBlock evaluates to true."
| answer |
answer := self emptyCopy.
self associationsDo: [ :each |
(aBlock value: each)
ifTrue: [answer add: each]].
^answer! !
! Dictionary methods !
deepCopy
"Answer a copy of the receiver with shallow
copies of each element."
| answer |
answer := self emptyCopy.
self associationsDo: [:element |
answer add: element copy].
^answer! !
! Dictionary methods !
select: aBlock
"For each key/value pair in the receiver, evaluate
aBlock with the value part of the pair as the argument.
Answer a new object containing those key/value pairs
for which aBlock evaluates to true."
| answer |
answer := self emptyCopy.
self associationsDo: [ :each |
(aBlock value: each value)
ifTrue: [answer add: each]].
^answer! !
! Dictionary methods !
shallowCopy
"Answer a copy of the receiver which shares
the receiver elements."
| answer |
answer := self emptyCopy.
self associationsDo: [:element |
answer add: element].
^answer! !
! MethodDictionary methods !
removeKey: aSymbol ifAbsent: aBlock
"Answer aSymbol. Remove entry with key
aSymbol from the receiver. If
aSymbol is not a key of the receiver,
evaluate aBlock (with no arguments).
Flush the method cache."
| aDictionary intState |
(self includesKey: aSymbol)
ifFalse: [^aBlock value].
aDictionary := self emptyCopy.
Removing := true.
self keysDo: [ :aKey |
aKey == aSymbol
ifFalse: [
aDictionary
at: aKey put: (self at: aKey)]].
intState := Process enableInterrupts: false.
contents := aDictionary contents.
elementCount := aDictionary size.
Process enableInterrupts: intState.
self flushFromCache: aSymbol.
Removing := false.
^aSymbol! !
! Stream methods !
next: anInteger
"Answer the next anInteger number of items from
the receiver, returned in a collection of the
same species as the collection being streamed
over."
| aStream |
aStream := WriteStream on:
(collection emptyCopy: anInteger).
anInteger timesRepeat: [
aStream nextPut: self next].
^aStream contents! !
! Stream methods !
reverseContents
"Answer a collection of the same species as the
receiver collection, with the contents in
reverse order."
| aStream savePosition |
collection class isVariable
ifTrue: [
aStream := WriteStream on:
(collection emptyCopy: self readLimit)]
ifFalse: [
aStream := WriteStream on:
(collection copy)].
savePosition := self position.
self readLimit - 1 to: 0 by: -1 do: [ :i |
self position: i.
aStream nextPut: self next].
self position: savePosition.
^aStream contents! !
! WriteStream methods !
grow
"Private - Answer the receiver expanded
to accomodate more elements."
| size new |
size := collection size * 4 // 3 + 10.
new := collection emptyCopy: size.
new replaceFrom: 1
to: collection size
with: collection.
collection := new! !
! FileStream methods !
copyFrom: first to: last
"Answer a String containing the characters of the
receiver stream from positions first to last."
| string savePosition index putIndex number size |
string := collection emptyCopy: last - first + 1.
savePosition := self position.
size := file size.
putIndex := 1.
index := first.
[index <= last]
whileTrue: [
index > size
ifTrue: [^self error: 'copy beyond end of file'].
self position: index - 1.
number := (last min: pageStart + readLimit - 1)
- index + 1.
string
replaceFrom: putIndex
to: putIndex + number - 1
with: collection
startingAt: position + 1.
putIndex := putIndex + number.
index := index + number].
self position: savePosition.
^string! !
! FileStream methods !
copyFrom: first to: last into: aByteObject
"Copy the characters of the receiver stream
from positions first to last into an object
containing bytes."
| string savePosition index putIndex number size |
string := collection emptyCopy: last - first + 1.
savePosition := self position.
size := file size.
putIndex := 1.
index := first.
[index <= last]
whileTrue: [
index > size
ifTrue: [^self error: 'copy beyond end of file'].
self position: index - 1.
number := (last min: pageStart + readLimit - 1)
- index + 1.
aByteObject
replaceFrom: putIndex
to: putIndex + number - 1
with: collection
startingAt: position + 1.
putIndex := putIndex + number.
position := position + number.
index := index + number]! !
! FileDialog methods !
nameFieldEnter
"Private - The user pressed Enter key. Check
for wildcard in the name field, answer true if
there is one (indicating the box shouldn't be
closed, else answer false.
Splits logic added to work if user types a full pathname
rather than a simple filename."
| splits newDirectory |
name := self queryItemText: (ItemIds at: 'nameField').
splits := File splitPath: name in: directory.
newDirectory := Directory pathName:
(String with: (splits at: 1) with: $:),
(splits at: 2).
name := splits at: 3.
self setItemText: (ItemIds at: 'nameField') string: name.
newDirectory = directory ifFalse: [
directory := newDirectory.
self fillDirList].
(name includes: $*) ifTrue: [
self fillFileList.
PMWindowLibrary
setFocus: HwndDesktop
hwnd: (handle windowFromID: (ItemIds at: 'nameField')).
^true].
^false! !
--
cowan@marob.masa.com (aka ...!hombre!marob!cowan)
e'osai ko sarji la lojban