[squeak-dev] The Inbox: Collections-cmm.1020.mczcommits at source.squeak.org commits at source.squeak.orgThu Jul 14 14:11:59 UTC 2022
A new version of Collections was added to project The Inbox: http://source.squeak.org/inbox/Collections-cmm.1020.mcz ==================== Summary ==================== Name: Collections-cmm.1020 Author: cmm Time: 13 July 2022, 9:16:12.177315 pm UUID: 4a9e11ba-f983-4c7b-b701-ddabf2f10c73 Ancestors: Collections-cmm.1019 In addition to ascii letters and numbers, let #format: accept _/-.,!@#$%^&*()[]=;: in the token names. There is no performance hit thanks to the use of a new CharacterSet. =============== Diff against Collections-cmm.1019 =============== Item was removed: - (PackageInfo named: 'Collections') preamble: '"Use of the Spur FloatArray>>at:[put:] prims requires at least VMMaker.oscog.2778" - - Smalltalk vmVMMakerVersion < 2778 ifTrue: - [Warning signal: ''This virtual machine is too old to support correct versions of the FloatArray>>at:[put:] primitives 238 and 239. FloatArray subclasses will not behave correctly and FloatArray[64]Test tests will fail. Please upgrade your VM. You may continue and upgrade later or abort and upgrade now.'']'! Item was removed: - SystemOrganization addCategory: #'Collections-Abstract'! - SystemOrganization addCategory: #'Collections-Arrayed'! - SystemOrganization addCategory: #'Collections-Cache'! - SystemOrganization addCategory: #'Collections-Exceptions'! - SystemOrganization addCategory: #'Collections-Heap'! - SystemOrganization addCategory: #'Collections-Sequenceable'! - SystemOrganization addCategory: #'Collections-SortFunctions'! - 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'! Item was removed: - ArrayedCollection variableSubclass: #Array - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !Array commentStamp: '<historical>' prior: 0! - I present an ArrayedCollection whose elements are objects.! Item was removed: - ----- 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) - ! Item was removed: - ----- Method: Array class>>empty (in category 'instance creation') ----- - empty - "A canonicalized empty Array instance." - ^ #()! Item was removed: - ----- 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:" - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: Array>>allLiteralsDo: (in category 'literals') ----- - allLiteralsDo: aBlock - - "I am a literal." - aBlock value: self. - - "All my elements are literals." - self do: [:each | each allLiteralsDo: aBlock].! Item was removed: - ----- Method: Array>>asArray (in category 'converting') ----- - asArray - "Answer with the receiver itself." - - ^ self! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Array>>byteEncode: (in category 'filter streaming') ----- - byteEncode:aStream - aStream writeArray:self. - ! Item was removed: - ----- Method: Array>>copyWithDependent: (in category 'copying') ----- - copyWithDependent: newElement - self size = 0 ifTrue:[^DependentsArray with: newElement]. - ^self copyWith: newElement! Item was removed: - ----- Method: Array>>elementsExchangeIdentityWith: (in category 'converting') ----- - elementsExchangeIdentityWith: otherArray - "This primitive performs a bulk mutation, causing all pointers to the elements of the - receiver 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 error: ec> - ec == #'no modification' ifTrue: - [^self modificationForbiddenFor: otherArray becomeSelector: #elementsExchangeIdentityWith:]. - ec == #'bad receiver' ifTrue: - [^self error: 'receiver must be of class Array']. - ec == #'bad argument' ifTrue: - [^self error: (otherArray class == Array - ifFalse: ['arg must be of class Array'] - ifTrue: ['receiver and argument must have the same size'])]. - ec == #'inappropriate operation' ifTrue: - [^self error: 'can''t become immediates such as SmallIntegers or Characters']. - ec == #'object is pinned' ifTrue: - [^self error: 'can''t become pinned objects']. - ec == #'insufficient object memory' ifTrue: - [| maxRequired | - "In Spur, two-way become may involve making each pair of objects into a forwarder into a copy of the other. - So if become fails with #'insufficient object memory', garbage collect, and if necessary, grow memory." - maxRequired := (self detectSum: [:obj | obj class byteSizeOfInstanceOfSize: obj basicSize]) - + (otherArray detectSum: [:obj | obj class byteSizeOfInstanceOfSize: obj basicSize]). - (Smalltalk garbageCollectMost < maxRequired - and: [Smalltalk garbageCollect < maxRequired]) ifTrue: - [Smalltalk growMemoryByAtLeast: maxRequired]. - ^self elementsExchangeIdentityWith: otherArray]. - self primitiveFailed! Item was removed: - ----- Method: Array>>elementsForwardIdentityAndHashTo: (in category 'converting') ----- - elementsForwardIdentityAndHashTo: otherArray - "This primitive performs a bulk mutation, causing all pointers to the elements of the receiver to be replaced by pointers to the corresponding elements of otherArray. - NOTE THAT the #identityHash of the objects in otherArray are changed, so that hashed structures that contain such objects MUST BE rehashed while structures that contain objects from the receiver are still properly indexed. See implementors of #rehash." - <primitive: 72 error: ec> - ec == #'no modification' ifTrue: - [^self modificationForbiddenFor: otherArray becomeSelector: #elementsForwardIdentityAndHashTo:]. - ec == #'bad receiver' ifTrue: - [^self error: 'receiver must be of class Array']. - ec == #'bad argument' ifTrue: - [^self error: (otherArray class == Array - ifFalse: ['arg must be of class Array'] - ifTrue: ['receiver and argument must have the same size'])]. - ec == #'inappropriate operation' ifTrue: - [^self error: 'can''t become immediates such as SmallIntegers or Characters']. - ec == #'object is pinned' ifTrue: - [^self error: 'can''t become pinned objects']. - ec == #'insufficient object memory' ifTrue: - [self error: 'The virtual machine is out-of-date. Please upgrade.']. - self primitiveFailed! Item was removed: - ----- Method: Array>>elementsForwardIdentityTo: (in category 'converting') ----- - elementsForwardIdentityTo: otherArray - "This primitive performs a bulk mutation, causing all pointers to the elements of the - receiver to be replaced by pointers to the corresponding elements of otherArray. - NOTE THAT the #identityHash of the objects in the receiver are changed, so that hashed structures that contain such objects MUST BE rehashed while structures that contain objects from otherArray are still properly indexed. See implementors of #rehash." - <primitive: 248 error: ec> - ec == #'no modification' ifTrue: - [^self modificationForbiddenFor: otherArray becomeSelector: #elementsForwardIdentityTo:]. - ec == #'bad receiver' ifTrue: - [^self error: 'receiver must be of class Array']. - ec == #'bad argument' ifTrue: - [^self error: (otherArray class == Array - ifFalse: ['arg must be of class Array'] - ifTrue: ['receiver and argument must have the same size'])]. - ec == #'inappropriate operation' ifTrue: - [^self error: 'can''t become immediates such as SmallIntegers or Characters']. - ec == #'object is pinned' ifTrue: - [^self error: 'can''t become pinned objects']. - ec == #'insufficient object memory' ifTrue: - [self error: 'The virtual machine is out-of-date. Please upgrade.']. - self primitiveFailed! Item was removed: - ----- Method: Array>>elementsForwardIdentityTo:copyHash: (in category 'converting') ----- - elementsForwardIdentityTo: otherArray copyHash: copyHash - "This primitive performs a bulk mutation, causing all pointers to the elements of the - receiver to be replaced by pointers to the corresponding elements of otherArray. - If copyHash is true, the identityHashes remain with the pointers rather than with the - objects so that the objects in the receiver should still be properly indexed in any - existing hashed structures after the mutation. If copyHash is false, then the hashes - of the objects in otherArray remain unchanged. If you know what you're doing this - may indeed be what you want." - <primitive: 249 error: ec> - ec == #'no modification' ifTrue: - [^self modificationForbiddenFor: otherArray argument: copyHash becomeSelector: #elementsForwardIdentityTo:copyHash:]. - ec == #'bad receiver' ifTrue: - [^self error: 'receiver must be of class Array']. - ec == #'bad argument' ifTrue: - [^self error: (otherArray class == Array - ifFalse: ['arg must be of class Array'] - ifTrue: ['receiver and argument must have the same size'])]. - ec == #'inappropriate operation' ifTrue: - [^self error: 'can''t become immediates such as SmallIntegers or Characters']. - ec == #'object is pinned' ifTrue: - [^self error: 'can''t become pinned objects']. - self primitiveFailed! Item was removed: - ----- Method: Array>>evalStrings (in category 'converting') ----- - evalStrings - "Allows you to construct literal arrays. - #(true false nil '5 at 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" - - - ^ self collect: [:each | | it | - 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]! Item was removed: - ----- Method: Array>>isArray (in category 'testing') ----- - isArray - ^true! Item was removed: - ----- Method: Array>>isLiteral (in category 'testing') ----- - isLiteral - - ^self class == Array and: [ - self isLiteralIfContainedBy: IdentitySet new ]! Item was removed: - ----- Method: Array>>isLiteralIfContainedBy: (in category 'testing') ----- - isLiteralIfContainedBy: parents - " Answer whether the receiver has a literal text form recognized by the compiler. Precondition: the receiver is an instance of Array. " - - (parents includes: self) ifTrue: [ ^false ]. - parents add: self. - 1 to: self size do: [ :index | - | element | - element := self at: index. - (element class == Array - ifTrue: [ element isLiteralIfContainedBy: parents ] - ifFalse: [ element isLiteral ]) ifFalse: [ ^false ] ]. - parents remove: self. - ^true! Item was removed: - ----- Method: Array>>literalEqual: (in category 'literals') ----- - 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! Item was removed: - ----- Method: Array>>modificationForbiddenFor:argument:becomeSelector: (in category 'read-only objects') ----- - modificationForbiddenFor: otherArray argument: argument becomeSelector: retrySelector - "Raise a ModificationForbidden error for an attempt to modify a read-only object through a become operation." - ^(ModificationForbidden new - mirror: self - object: otherArray - index: nil - newValue: argument - resumptionValue: self - retrySelector: retrySelector) signal! Item was removed: - ----- Method: Array>>modificationForbiddenFor:becomeSelector: (in category 'read-only objects') ----- - modificationForbiddenFor: otherArray becomeSelector: retrySelector - "Raise a ModificationForbidden error for an attempt to modify a read-only object through a become operation." - ^(BinaryModificationForbidden new - mirror: self - object: otherArray - index: nil - newValue: nil - resumptionValue: self - retrySelector: retrySelector) signal! Item was removed: - ----- 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! Item was removed: - ----- Method: Array>>preMultiplyByMatrix: (in category 'arithmetic') ----- - preMultiplyByMatrix: m - "Answer m+*self where m is a Matrix." - m columnCount = self size ifFalse: [self error: 'dimensions do not conform']. - ^(1 to: m rowCount) collect: [:row | - | s | - s := 0. - 1 to: self size do: [:k | s := (m at: row at: k) * (self at: k) + s]. - s]! Item was removed: - ----- Method: Array>>printAsBraceFormOn: (in category 'printing') ----- - printAsBraceFormOn: aStream - aStream nextPut: ${. - self do: [:el | el printOn: aStream] separatedBy: [ aStream nextPutAll: ' . ']. - aStream nextPut: $}! Item was removed: - ----- Method: Array>>printAsLiteralOn: (in category 'printing') ----- - printAsLiteralOn: aStream - aStream nextPut: $#; nextPut: $(. - self do: [:each| each printAsLiteralOn: aStream] separatedBy: [aStream space]. - aStream nextPut: $) - ! Item was removed: - ----- Method: Array>>printOn: (in category 'printing') ----- - printOn: aStream - self class == Array ifFalse: - [^super printOn: aStream]. - self shouldBePrintedAsLiteral - ifTrue: [self printAsLiteralOn: aStream] - ifFalse: [self printAsBraceFormOn: aStream]! Item was removed: - ----- 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! Item was removed: - ----- Method: Array>>shouldBePrintedAsLiteral (in category 'testing') ----- - shouldBePrintedAsLiteral - - ^self class == Array - and: [self shouldBePrintedAsLiteralVisiting: (IdentitySet new: 8)]! Item was removed: - ----- Method: Array>>shouldBePrintedAsLiteralVisiting: (in category 'testing') ----- - shouldBePrintedAsLiteralVisiting: aSet - self class == Array ifFalse: - [^false]. - (aSet includes: self) ifTrue: - [^false]. - aSet add: self. - ^self allSatisfy: [:each | each shouldBePrintedAsLiteralVisiting: aSet]! Item was removed: - ----- Method: Array>>sorted: (in category 'sorting') ----- - sorted: aSortBlockOrNil - "Return a new sequenceable collection which contains the same elements as self but its elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if the first element should preceed the second one. If aSortBlock is nil then <= is used for comparison." - - ^self copy sort: aSortBlockOrNil! Item was removed: - ----- Method: Array>>storeOn: (in category 'printing') ----- - storeOn: aStream - "Use the literal form if possible." - self shouldBePrintedAsLiteral - ifTrue: [self printAsLiteralOn: aStream] - ifFalse: [super storeOn: aStream]! Item was removed: - 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.! Item was removed: - ----- Method: ArrayedCollection class>>isAbstract (in category 'testing') ----- - isAbstract - ^self = ArrayedCollection! Item was removed: - ----- Method: ArrayedCollection class>>new (in category 'instance creation') ----- - new - "Answer a new instance of me, with size = 0." - - ^self new: 0! Item was removed: - ----- 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! Item was removed: - ----- 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 - "! Item was removed: - ----- 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 or: [ self isWords not ]) ifTrue: [ ^self ]. - 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)! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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 four 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: ArrayedCollection>>add: (in category 'adding') ----- - add: newObject - self shouldNotImplement! Item was removed: - ----- Method: ArrayedCollection>>asSortedArray (in category 'converting') ----- - asSortedArray - self isSorted ifTrue: [^ self asArray]. - ^ super asSortedArray! Item was removed: - ----- Method: ArrayedCollection>>byteSize (in category 'objects from disk') ----- - byteSize - ^self basicSize * self bytesPerBasicElement - ! Item was removed: - ----- 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." - | bytesPerElementOrZero | - bytesPerElementOrZero := #[0 0 0 0 0 0 0 0 8 4 4 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] at: self class instSpec. - ^bytesPerElementOrZero = 0 - ifTrue: [Smalltalk wordSize] - ifFalse: [bytesPerElementOrZero]! Item was removed: - ----- Method: ArrayedCollection>>bytesPerElement (in category 'objects from disk') ----- - bytesPerElement - | bytesPerElementOrZero | - bytesPerElementOrZero := #[0 0 0 0 0 0 0 0 8 4 4 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1] at: self class instSpec. - ^bytesPerElementOrZero = 0 - ifTrue: [Smalltalk wordSize] - ifFalse: [bytesPerElementOrZero]! Item was removed: - ----- Method: ArrayedCollection>>defaultElement (in category 'private') ----- - defaultElement - - ^nil! Item was removed: - ----- Method: ArrayedCollection>>fillFrom:with: (in category 'private') ----- - fillFrom: aCollection with: aBlock - "Evaluate aBlock with each of aCollections's elements as the argument. - Collect the resulting values into self. Answer self." - - | index | - index := 0. - aCollection do: [ :each | - self at: (index := index + 1) put: (aBlock value: each) ]! Item was removed: - ----- Method: ArrayedCollection>>flattenOnStream: (in category 'filter streaming') ----- - flattenOnStream: aStream - aStream writeArrayedCollection: self! Item was removed: - ----- Method: ArrayedCollection>>inject:into: (in category 'enumerating') ----- - inject: anObject into: aBlock - "Optimized for speed. See super." - - | result | - result := anObject. - 1 to: self size do: [:i | result := aBlock value: result value: (self at: i)]. - ^result! Item was removed: - ----- Method: ArrayedCollection>>isEmpty (in category 'testing') ----- - isEmpty - ^self size = 0! Item was removed: - ----- Method: ArrayedCollection>>isSorted (in category 'sorting') ----- - isSorted - "Return true if the receiver is sorted by #<=." - - ^self isSortedBetween: 1 and: self size! Item was removed: - ----- Method: ArrayedCollection>>isSortedBetween:and: (in category 'sorting') ----- - isSortedBetween: startIndex and: endIndex - "Return true if the receiver is sorted by #<= between startIndex and endIndex." - - | previousElement | - endIndex < startIndex ifTrue: [ ^true ]. - previousElement := self at: startIndex. - startIndex + 1 to: endIndex do: [ :index | - | element | - element := self at: index. - previousElement <= element ifFalse: [ ^false ]. - previousElement := element ]. - ^true! Item was removed: - ----- Method: ArrayedCollection>>isSortedBy: (in category 'sorting') ----- - isSortedBy: aSortBlockOrNil - "Return true if the receiver is sorted by aSortBlockOrNil. Use #<= for comparison if aSortBlockOrNil is nil." - - ^self isSortedBy: aSortBlockOrNil between: 1 and: self size! Item was removed: - ----- Method: ArrayedCollection>>isSortedBy:between:and: (in category 'sorting') ----- - isSortedBy: aSortBlockOrNil between: startIndex and: endIndex - "Return true if the receiver is sorted by aSortBlockOrNil between startIndex and endIndex. Use #<= for comparison if aSortBlockOrNil is nil." - - | previousElement | - aSortBlockOrNil ifNil: [ ^self isSortedBetween: startIndex and: endIndex ]. - endIndex < startIndex ifTrue: [ ^true ]. - previousElement := self at: startIndex. - startIndex + 1 to: endIndex do: [ :index | - | element | - element := self at: index. - (aSortBlockOrNil value: previousElement value: element) ifFalse: [ ^false ]. - previousElement := element ]. - ^true! Item was removed: - ----- 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 - ifNil: [ val1 <= val2 ] - ifNotNil: [ 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. - val2 := self atWrap: (i2 := i2 + 1) ] ]. - - "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]! Item was removed: - ----- 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." - - | size | - (size := self size) <= 1 ifTrue: [^ self]. "nothing to do" - startIndex = stopIndex ifTrue: [^ self]. - 1 <= startIndex ifFalse: [ self errorSubscriptBounds: startIndex ]. - stopIndex <= size ifFalse: [ self errorSubscriptBounds: stopIndex ]. - startIndex < stopIndex ifFalse: [ self errorSubscriptBounds: startIndex ]. - self shallowCopy - mergeSortFrom: startIndex - to: stopIndex - into: self - by: aBlock! Item was removed: - ----- Method: ArrayedCollection>>mergeSortFrom:to:into:by: (in category 'sorting') ----- - mergeSortFrom: firstIndex to: lastIndex into: destination by: aBlock - "Private. Split the range to be sorted in half, sort each half, and - merge the two half-ranges into destination." - - | n firstObject lastObject | - "Precondition: firstIndex <= lastIndex, self and destination contain the same elements between firstIndex and lastIndex inclusively but not necessarily in the same order" - (n := lastIndex - firstIndex) <= 1 ifTrue: [ "Handle 1 and 2 sized ranges directly." - n = 0 ifTrue: [ ^self ]. - firstObject := self at: firstIndex. - lastObject := self at: lastIndex. - (aBlock - ifNil: [ firstObject <= lastObject ] - ifNotNil: [ aBlock value: firstObject value: lastObject ]) - ifFalse: [ - destination - at: lastIndex put: firstObject; - at: firstIndex put: lastObject ] - ifTrue: [ - destination - at: lastIndex put: lastObject; - at: firstIndex put: firstObject ]. - ^self ]. - n := firstIndex + lastIndex // 2. - destination mergeSortFrom: firstIndex to: n into: self by: aBlock. - destination mergeSortFrom: n + 1 to: lastIndex into: self by: aBlock. - self mergeFirst: firstIndex middle: n last: lastIndex into: destination by: aBlock! Item was removed: - ----- Method: ArrayedCollection>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - | tally | - tally := 0. - 1 to: self size do: [ :index | - (self at: index) = anObject ifTrue: [ tally := tally + 1 ] ]. - ^tally! Item was removed: - ----- Method: ArrayedCollection>>quickSort (in category 'sorting') ----- - quickSort - "Sort elements of self to be nondescending according to #<= using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." - - self quickSortFrom: 1 to: self size by: nil! Item was removed: - ----- Method: ArrayedCollection>>quickSort: (in category 'sorting') ----- - quickSort: sortBlock - "Sort elements of self to be nondescending according to sortBlock using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." - - self quickSortFrom: 1 to: self size by: sortBlock! Item was removed: - ----- Method: ArrayedCollection>>quickSortFrom:to:by: (in category 'sorting') ----- - quickSortFrom: from to: to by: sortBlock - "Sort elements i through j of self to be nondescending according to sortBlock using an in-place quicksort with simple median-of-three partitioning with guaranteed O(log(n)) space usage." - - | dij k l temp i j di dj n ij | - i := from. - j := to. - [ - - "The prefix d means the data at that index." - "Sort di,dj." - di := self at: i. - dj := self at: j. - (sortBlock ifNil: [ di <= dj ] ifNotNil: [ sortBlock value: di value: dj ]) ifFalse: [ - self at: i put: dj; at: j put: di. temp := dj. dj := di. di := temp "swap di with dj" ]. - (n := j + 1 - i) <= 2 ifTrue: [ ^self ]. - "More than two elements." - dij := self at: (ij := i + j // 2). "ij is the midpoint of i and j. Sort di,dij,dj. Make dij be their median." - (sortBlock ifNil: [ di <= dij ] ifNotNil: [ sortBlock value: di value: dij ]) - ifTrue: [ - (sortBlock ifNil: [ dij <= dj ] ifNotNil: [ sortBlock value: dij value: dj ]) ifFalse: [ - "swap dij with dj, we don't need the value of the variable dj anymore" - self at: j put: dij; at: ij put: dj. dij := dj ] ] - ifFalse: [ - "swap di with dij, we don't need the value of the variable di anymore" - self at: i put: dij; at: ij put: di. dij := di ]. - n = 3 ifTrue: [ ^self ]. - "More than three elements." - "Find k and l such that i<k<l<j and 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. - [ - [ k <= (l := l - 1) and: [ - sortBlock ifNil: [ dij <= (self at: l) ] ifNotNil: [ sortBlock value: dij value: (self at: l) ] ] ] whileTrue. "i.e. while dl succeeds dij" - [ (k := k + 1) <= l and: [ - sortBlock ifNil: [ (self at: k) <= dij ] ifNotNil: [ sortBlock value: (self at: k) value: dij ] ] ] whileTrue. "i.e. while dij succeeds dk" - k <= l ] whileTrue: [ temp := self at: k. self at: k put: (self at: l); at: l put: temp. ]. - "Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk through dj. Sort the larger segment in this method and call another quicksort for the smaller segment. This ensures O(log(n)) space usage." - i < l - ifFalse: [ - k < j - ifFalse: [ ^self ] - ifTrue: [ i := k ] ] - ifTrue: [ - k < j - ifFalse: [ j := l ] - ifTrue: [ - l - i < (j - k) - ifTrue: [ - self quickSortFrom: i to: l by: sortBlock. - i := k ] - ifFalse: [ - self quickSortFrom: k to: j by: sortBlock. - j := l ] ] ] ] repeat! Item was removed: - ----- Method: ArrayedCollection>>removeAll (in category 'removing') ----- - removeAll - - self shouldNotImplement! Item was removed: - ----- 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]. - Smalltalk isLittleEndian - ifTrue: - [Bitmap - swapBytesIn: self - from: 1 - to: self basicSize]! Item was removed: - ----- Method: ArrayedCollection>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - <primitive: 62> - ^ self basicSize! Item was removed: - ----- Method: ArrayedCollection>>sort (in category 'sorting') ----- - sort - "Sort this array into ascending order using the '<=' operator." - - self sort: nil! Item was removed: - ----- 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. - If aSortBlock is nil then <= is used for comparison." - - self - mergeSortFrom: 1 - to: self size - by: aSortBlock! Item was removed: - ----- 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! Item was removed: - ----- 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: $)! Item was removed: - ----- 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.! Item was removed: - ----- 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 or: [ self class isWords not ]) ifTrue: [ ^self ]. - aStream nextInt32Put: self basicSize. - aStream nextWordsPutAll: self.! Item was removed: - ----- 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 or: [ self class isWords not ]) ifTrue: [ ^self ]. - aStream nextPutAllWordArray: self! Item was removed: - Object subclass: #Ascii85Converter - instanceVariableNames: 'dataStream stringStream number85 tupleSize binary' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! - - !Ascii85Converter commentStamp: 'topa 7/10/2016 20:57' prior: 0! - I convert between binary data and an Ascii85 text representation of PostScript and PDF fame. - I am a little bit more efficient (~25% overhead) than Base64 (~30% overhead). - - Instance Variables - binary: <Boolean> - Tells whether to decode to binary data or characters - dataStream: <PositionableStream> - The data stream to decode to or encode from (Typically does not contain Ascii85) - stringStream: <PositionableStream> - The text stream to decode from or encode to (Always contains Ascii85) - number85: <Integer> - Decoder state, accumulated read number in base85 - tupleSize: <SmallInteger> - Number of bytes read into number85 already - - 'Hello, World' ascii85Encoded. - - '<~87cURD]htuF_+us~>' ascii85Decoded. - ! Item was removed: - ----- Method: Ascii85Converter class>>decode:as: (in category 'convenience') ----- - decode: aStringOrStream as: contentsClass - - ^ contentsClass streamContents: - [:out | self decode: aStringOrStream to: out]! Item was removed: - ----- Method: Ascii85Converter class>>decode:to: (in category 'convenience') ----- - decode: aStringOrStream to: outStream - - ^ (self stringStream: aStringOrStream readStream dataStream: outStream) - decode! Item was removed: - ----- Method: Ascii85Converter class>>decodeToBytes: (in category 'convenience') ----- - decodeToBytes: aStringOrStream - " Analogous to Base64MimeConverter>>#mimeDecodeToBytes:" - | expectedSize | - expectedSize := aStringOrStream size * 4 // 5. - ^ (ByteArray new: expectedSize streamContents: - [:stream | - (self stringStream: aStringOrStream readStream dataStream: stream) - decodeToByteArray]) readStream! Item was removed: - ----- Method: Ascii85Converter class>>decodeToChars: (in category 'convenience') ----- - decodeToChars: aStringOrStream - " Analogous to Base64MimeConverter>>#mimeDecodeToChars:" - | expectedSize | - expectedSize := aStringOrStream size * 4 // 5. - ^ (String new: expectedSize streamContents: - [:stream | self decode: aStringOrStream to: stream]) readStream! Item was removed: - ----- Method: Ascii85Converter class>>encode: (in category 'convenience') ----- - encode: aCollectionOrStream - - ^ String streamContents: - [:out | self encode: aCollectionOrStream to: out]! Item was removed: - ----- Method: Ascii85Converter class>>encode:to: (in category 'convenience') ----- - encode: aCollectionOrStream to: outStream - - ^ (self stringStream: outStream dataStream: aCollectionOrStream readStream) - encode! Item was removed: - ----- Method: Ascii85Converter class>>stringStream:dataStream: (in category 'instance creation') ----- - stringStream: aStream dataStream: anotherStream - - ^ self new - stringStream: aStream; - dataStream: anotherStream; - yourself! Item was removed: - ----- Method: Ascii85Converter>>ascii (in category 'accessing') ----- - ascii - - binary := false.! Item was removed: - ----- Method: Ascii85Converter>>binary (in category 'accessing') ----- - binary - - binary := true.! Item was removed: - ----- Method: Ascii85Converter>>dataStream (in category 'accessing') ----- - dataStream - - ^dataStream! Item was removed: - ----- Method: Ascii85Converter>>dataStream: (in category 'accessing') ----- - dataStream: anObject - - dataStream := anObject.! Item was removed: - ----- Method: Ascii85Converter>>decode (in category 'conversion') ----- - decode - - self readBOD ifFalse: [^ self dataStream]. - - [self stringStream atEnd] whileFalse: [ - self stringStream skipSeparators. - self readEOD ifTrue: [^ self endDecode]. "<--- End of data" - - self decodeChar: self stringStream next ifFail: [^ self dataStream]]. - "actually, should not reach, but our failure condition is returning the stream, anyway" - ^ self dataStream! Item was removed: - ----- Method: Ascii85Converter>>decodeChar:ifFail: (in category 'conversion') ----- - decodeChar: char ifFail: failBlock - - char = $z ifTrue: [^ self decodeZIfFail: failBlock]. - - (char between: $!! and: $u) ifFalse: [^ failBlock value]. - - self incrementTupleSize. - self incrementNumber85: char asInteger - 33 * (self pow85 at: self tupleSize). - self tupleSize = 5 ifTrue: - [self isBinary - ifTrue: [self writeBytes255: self number85 atMax: 4] - ifFalse: [self writeChars255: self number85 atMax: 4]. - self resetDecoderState]! Item was removed: - ----- Method: Ascii85Converter>>decodeToByteArray (in category 'conversion') ----- - decodeToByteArray - - self binary. - ^ self decode! Item was removed: - ----- Method: Ascii85Converter>>decodeZIfFail: (in category 'conversion') ----- - decodeZIfFail: failBlock - - self tupleSize ~= 0 ifTrue: [^ failBlock value]. - self dataStream next: 4 put: (self isBinary ifTrue: [0] ifFalse: [Character null]). - ! Item was removed: - ----- Method: Ascii85Converter>>encode (in category 'conversion') ----- - encode - - | lineLength | - - lineLength := 0. - self stringStream nextPutAll: '<~'. - [self dataStream atEnd] whileFalse: [ - | raw data out | - lineLength >= 74 ifTrue: [self stringStream cr. lineLength := 0]. - out := 5. - raw := (self dataStream next: 4) asByteArray. - raw size < 4 ifTrue: - [out := raw size + 1. - raw := raw, (self padOfSize: 4 - raw size)]. - data := raw unsignedLongAt: 1 bigEndian: true. - data = 0 - ifTrue: [self stringStream nextPut: $z. lineLength := lineLength + 1] - ifFalse: [self write85: data atMax: out. lineLength := lineLength + out]]. - self stringStream nextPutAll: '~>'. - ^ self stringStream - ! Item was removed: - ----- Method: Ascii85Converter>>endDecode (in category 'private') ----- - endDecode - - self tupleSize > 0 ifTrue: - [self incrementNumber85: (self pow85 at: self tupleSize). - self isBinary - ifTrue: [self writeBytes255: self number85 atMax: self tupleSize - 1] - ifFalse: [self writeChars255: self number85 atMax: self tupleSize - 1]]. - ^ self dataStream! Item was removed: - ----- Method: Ascii85Converter>>incrementNumber85: (in category 'private') ----- - incrementNumber85: aNumber - - number85 := number85 + aNumber. - - ! Item was removed: - ----- Method: Ascii85Converter>>incrementTupleSize (in category 'private') ----- - incrementTupleSize - - tupleSize := tupleSize + 1. - ! Item was removed: - ----- Method: Ascii85Converter>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - self ascii. - self resetDecoderState.! Item was removed: - ----- Method: Ascii85Converter>>isBinary (in category 'testing') ----- - isBinary - - ^ binary! Item was removed: - ----- Method: Ascii85Converter>>number85 (in category 'accessing') ----- - number85 - - ^ number85! Item was removed: - ----- Method: Ascii85Converter>>padOfSize: (in category 'private') ----- - padOfSize: anInteger - - anInteger = 1 ifTrue: [ ^#[0] ]. - anInteger = 2 ifTrue: [ ^#[0 0] ]. - anInteger = 3 ifTrue: [ ^#[0 0 0] ]. - self error: 'Should not reach'! Item was removed: - ----- Method: Ascii85Converter>>pow85 (in category 'private') ----- - pow85 - - ^ #(52200625 614125 7225 85 1) "{85*85*85*85 . 85*85*85 . 85*85 . 85. 1}"! Item was removed: - ----- Method: Ascii85Converter>>readBOD (in category 'private') ----- - readBOD - - self stringStream skipSeparators. - self stringStream peek = $< ifFalse: [^ false] ifTrue: - [self stringStream next. "ignore" - self stringStream peek = $~ ifFalse: [^ false] ifTrue: - [self stringStream next "ignore"]]. - ^ true! Item was removed: - ----- Method: Ascii85Converter>>readEOD (in category 'private') ----- - readEOD - - self stringStream skipSeparators. - self stringStream peek = $~ ifFalse: [^ false] ifTrue: - [self stringStream next. "ignore" - self stringStream peek = $> ifFalse: [^ false] ifTrue: - [self stringStream next "ignore"]]. - ^ true! Item was removed: - ----- Method: Ascii85Converter>>resetDecoderState (in category 'private') ----- - resetDecoderState - - number85 := 0. - tupleSize := 0. - ! Item was removed: - ----- Method: Ascii85Converter>>stringStream (in category 'accessing') ----- - stringStream - - ^ stringStream! Item was removed: - ----- Method: Ascii85Converter>>stringStream: (in category 'accessing') ----- - stringStream: anObject - - stringStream := anObject.! Item was removed: - ----- Method: Ascii85Converter>>tupleSize (in category 'accessing') ----- - tupleSize - - ^ tupleSize! Item was removed: - ----- Method: Ascii85Converter>>write85:atMax: (in category 'writing') ----- - write85: anInteger atMax: aNumber - - | c1 c2 c3 c4 c5 remain | - remain := anInteger. - c5 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. - c4 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. - c3 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. - c2 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. - c1 := (remain \\ 85 + 33) asCharacter. remain := remain // 85. - aNumber > 0 ifTrue: [self stringStream nextPut: c1. - aNumber > 1 ifTrue: [self stringStream nextPut: c2. - aNumber > 2 ifTrue: [self stringStream nextPut: c3. - aNumber > 3 ifTrue: [self stringStream nextPut: c4. - aNumber > 4 ifTrue: [self stringStream nextPut: c5]]]]]. - ! Item was removed: - ----- Method: Ascii85Converter>>writeBytes255:atMax: (in category 'writing') ----- - writeBytes255: anInteger atMax: aNumber - - (aNumber between: 1 and: 4) ifFalse: [^ self error: 'Unexpected byte count']. - 4 to: (5 - aNumber) by: -1 do: - [:index | self dataStream nextPut: (anInteger digitAt: index)]. - ! Item was removed: - ----- Method: Ascii85Converter>>writeChars255:atMax: (in category 'writing') ----- - writeChars255: anInteger atMax: aNumber - - (aNumber between: 1 and: 4) ifFalse: [^ self error: 'Unexpected byte count']. - 4 to: (5 - aNumber) by: -1 do: - [:index | self dataStream nextPut: (anInteger digitAt: index) asCharacter]. - ! Item was removed: - 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.! Item was removed: - ----- 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." - - ^self basicNew key: newKey value: newValue! Item was removed: - ----- Method: Association>>= (in category 'comparing') ----- - = anAssociation - - ^ super = anAssociation and: [value = anAssociation value]! Item was removed: - ----- Method: Association>>analogousCodeTo: (in category 'comparing') ----- - analogousCodeTo: anObject - "For MethodProperties comparison." - ^anObject isVariableBinding - and: [key = anObject key - and: [value = anObject value]]! Item was removed: - ----- Method: Association>>byteEncode: (in category 'filter streaming') ----- - byteEncode: aStream - aStream writeAssocation:self.! Item was removed: - ----- Method: Association>>hash (in category 'comparing') ----- - hash - "Hash is reimplemented because = is implemented. - The super implementation is used to avoid hashing the value - which can be extremely expensive." - ^super hash! Item was removed: - ----- 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! Item was removed: - ----- Method: Association>>key:value: (in category 'accessing') ----- - key: aKey value: anObject - "Store the arguments as the variables of the receiver." - - key := aKey. - value := anObject! Item was removed: - ----- Method: Association>>printOn: (in category 'printing') ----- - printOn: aStream - | arrow | - super printOn: aStream. - "If the key is a binary selector and we don't use whitespace, we will stream (key, '->') asSymbol." - arrow := (key isSymbol and: [key isBinary]) ifTrue: [' -> '] ifFalse: ['->']. - aStream nextPutAll: arrow. - value printOn: aStream! Item was removed: - ----- Method: Association>>storeOn: (in category 'printing') ----- - storeOn: aStream - | arrow | - "Store in the format (key->value)" - aStream nextPut: $(. - key storeOn: aStream. - "If the key is a binary selector and we don't use whitespace, we will stream (key, '->') asSymbol." - arrow := (key isSymbol and: [key isBinary]) ifTrue: [' -> '] ifFalse: ['->']. - aStream nextPutAll: arrow. - value storeOn: aStream. - aStream nextPut: $)! Item was removed: - ----- Method: Association>>value (in category 'accessing') ----- - value - "Answer the value of the receiver." - - ^value! Item was removed: - ----- Method: Association>>value: (in category 'accessing') ----- - value: anObject - "Store the argument, anObject, as the value of the receiver." - - value := anObject! Item was removed: - 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! Item was removed: - ----- 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 new: 10! Item was removed: - ----- Method: AttributedTextStream class>>new: (in category 'instance creation') ----- - new: n - - ^self basicNew - initialize: n; - yourself! Item was removed: - ----- Method: AttributedTextStream>>contents (in category 'accessing') ----- - contents - | ans | - currentRun > 0 ifTrue:[ - attributeValues nextPut: currentAttributes. - attributeRuns nextPut: currentRun. - currentRun := 0]. - ans := Text string: characters contents runs: - (RunArray runs: attributeRuns contents values: attributeValues contents). - ^ans! Item was removed: - ----- Method: AttributedTextStream>>cr (in category 'character writing') ----- - cr - "Append a carriage return character to the receiver." - - self nextPut: Character cr! Item was removed: - ----- Method: AttributedTextStream>>crlf (in category 'character writing') ----- - crlf - "Append a carriage return and a line feed to the receiver." - - self nextPut: Character cr; nextPut: Character lf! Item was removed: - ----- Method: AttributedTextStream>>currentAttributes (in category 'accessing') ----- - currentAttributes - "return the current attributes" - ^currentAttributes! Item was removed: - ----- Method: AttributedTextStream>>currentAttributes: (in category 'accessing') ----- - currentAttributes: newAttributes - "set the current attributes" - (currentRun > 0 and:[currentAttributes ~= newAttributes]) ifTrue:[ - attributeRuns nextPut: currentRun. - attributeValues nextPut: currentAttributes. - currentRun := 0. - ]. - currentAttributes := newAttributes. - ! Item was removed: - ----- Method: AttributedTextStream>>initialize: (in category 'initialize-release') ----- - initialize: n - - super initialize. - characters := (String new: n) writeStream. - currentAttributes := #(). - currentRun := 0. - attributeValues := (Array new: (n min: 10)) writeStream. - attributeRuns := (Array new: (n min: 10)) writeStream! Item was removed: - ----- Method: AttributedTextStream>>lf (in category 'character writing') ----- - lf - "Append a line feed character to the receiver." - - self nextPut: Character lf! Item was removed: - ----- Method: AttributedTextStream>>next:putAll:startingAt: (in category 'accessing') ----- - next: anInteger putAll: aString startingAt: startIndex - - "add an entire string with the same attributes" - anInteger > 0 ifFalse: [ ^aString ]. - currentRun := currentRun + anInteger. - ^characters - next: anInteger - putAll: aString - startingAt: startIndex! Item was removed: - ----- Method: AttributedTextStream>>nextPut: (in category 'accessing') ----- - nextPut: aChar - currentRun := currentRun + 1. - ^characters nextPut: aChar! Item was removed: - ----- Method: AttributedTextStream>>nextPutAll: (in category 'accessing') ----- - nextPutAll: aString - "add an entire string with the same attributes" - currentRun := currentRun + aString size. - ^characters nextPutAll: aString.! Item was removed: - ----- Method: AttributedTextStream>>size (in category 'accessing') ----- - size - "number of characters in the stream so far" - ^characters size! Item was removed: - ----- Method: AttributedTextStream>>withAttribute:do: (in category 'accessing') ----- - withAttribute: attribute do: aBlock - - ^self withAttributes: { attribute } do: aBlock! Item was removed: - ----- Method: AttributedTextStream>>withAttributes:do: (in category 'accessing') ----- - withAttributes: attributes do: aBlock - - | previousAttributes | - previousAttributes := currentAttributes. - [ - self currentAttributes: attributes. - aBlock value ] - ensure: [ self currentAttributes: previousAttributes ]! Item was removed: - 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.! Item was removed: - ----- Method: Bag class>>contentsClass (in category 'instance creation') ----- - contentsClass - ^Dictionary! Item was removed: - ----- Method: Bag class>>new (in category 'instance creation') ----- - new - ^ self new: 4! Item was removed: - ----- Method: Bag class>>new: (in category 'instance creation') ----- - new: nElements - ^ super new setContents: (self contentsClass new: nElements)! Item was removed: - ----- 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 - "! Item was removed: - ----- 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 - - ! Item was removed: - ----- Method: Bag>>add: (in category 'adding') ----- - add: newObject - "Include newObject as one of the receiver's elements. Answer newObject." - - ^ self add: newObject withOccurrences: 1! Item was removed: - ----- 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! Item was removed: - ----- Method: Bag>>asBag (in category 'converting') ----- - asBag - ^ self! Item was removed: - ----- Method: Bag>>asSet (in category 'converting') ----- - asSet - "Answer a set with the elements of the receiver." - - ^ contents keys asSet! Item was removed: - ----- Method: Bag>>at: (in category 'accessing') ----- - at: index - self errorNotKeyed! Item was removed: - ----- Method: Bag>>at:put: (in category 'accessing') ----- - at: index put: anObject - self errorNotKeyed! Item was removed: - ----- 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]! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Bag>>includes: (in category 'testing') ----- - includes: anObject - "Refer to the comment in Collection|includes:." - - ^contents includesKey: anObject! Item was removed: - ----- Method: Bag>>max (in category 'math functions') ----- - max - "Answer the maximum value in the collection. This optimized version only looks at each unique value once." - ^contents keys inject: contents keys anyOne into: [:max :each | max max: each] - ! Item was removed: - ----- Method: Bag>>min (in category 'math functions') ----- - min - "Answer the minimum value in the collection. This optimized version only looks at each unique value once." - ^contents keys inject: contents keys anyOne into: [:min :each | min min: each] - ! Item was removed: - ----- Method: Bag>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - ^contents at: anObject ifAbsent: 0! Item was removed: - ----- Method: Bag>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - contents := contents copy! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Bag>>setContents: (in category 'private') ----- - setContents: aDictionary - contents := aDictionary! Item was removed: - ----- Method: Bag>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - | tally | - tally := 0. - contents do: [:each | tally := tally + each]. - ^ tally! Item was removed: - ----- 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! Item was removed: - ----- Method: Bag>>sortedElements (in category 'accessing') ----- - sortedElements - "Answer with a collection of elements with counts, sorted by element." - - ^contents associations - sort; - yourself! Item was removed: - ----- Method: Bag>>sum (in category 'math functions') ----- - sum - "Faster than the superclass implementation when you hold many instances of the same value (which you probably do, otherwise you wouldn't be using a Bag)." - - | sum first | - first := true. - contents keysAndValuesDo: [ :value :count | - first - ifTrue: [ sum := value * count. first := false ] - ifFalse: [ sum := sum + (value * count) ] ]. - first ifTrue: [ self errorEmptyCollection ]. - ^sum! Item was removed: - ----- Method: Bag>>valuesAndCounts (in category 'accessing') ----- - valuesAndCounts - - ^ contents! Item was removed: - MimeConverter subclass: #Base64MimeConverter - instanceVariableNames: 'data multiLine' - 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.! Item was removed: - ----- Method: Base64MimeConverter class>>decodeInteger: (in category 'convenience') ----- - 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! Item was removed: - ----- Method: Base64MimeConverter class>>encodeInteger: (in category 'convenience') ----- - encodeInteger: int - | strm | - "Encode an integer of any length and return the MIME string" - - strm := WriteStream on: (ByteArray new: int digitLength). - 1 to: int digitLength do: [:ii | strm nextPut: (int digitAt: ii)]. - ^ ((self mimeEncode: strm readStream) contents) copyUpTo: $= "remove padding"! Item was removed: - ----- Method: Base64MimeConverter class>>initialize (in category 'class initialization') ----- - initialize - - FromCharTable := Array new: 256. "nils" - ToCharTable := ($A to: $Z) , ($a to: $z) , ($0 to: $9) , '+/'. - ToCharTable keysAndValuesDo: [:ind :char | - FromCharTable at: char asciiValue + 1 put: ind - 1].! Item was removed: - ----- Method: Base64MimeConverter class>>mimeDecodeToBytes: (in category 'convenience') ----- - mimeDecodeToBytes: aStream - "Return a ReadStream 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: (WriteStream on: (ByteArray new: aStream size * 3 // 4)). - me mimeDecodeToByteArray. - ^ me dataStream readStream! Item was removed: - ----- Method: Base64MimeConverter class>>mimeDecodeToChars: (in category 'convenience') ----- - 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: (WriteStream on: (String new: aStream size * 3 // 4)). - me mimeDecode. - ^ me dataStream readStream! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncode: (in category 'convenience') ----- - 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." - ^self mimeEncode: aStream multiLine: true atStart: true! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncode:multiLine: (in category 'convenience') ----- - mimeEncode: aStream multiLine: aBool - "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." - - ^self mimeEncode: aStream multiLine: aBool atStart: true! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncode:multiLine:atStart: (in category 'private - convenience') ----- - mimeEncode: aStream multiLine: aBool atStart: resetInput - "Return a ReadStream 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 | - resetInput ifTrue:[aStream position: 0]. - me := self new dataStream: aStream. - me multiLine: aBool. - me mimeStream: (WriteStream on: (String new: aStream size + 20 * 4 // 3)). - me mimeEncode. - ^ me mimeStream readStream! Item was removed: - ----- Method: Base64MimeConverter class>>mimeEncodeContinue: (in category 'private - convenience') ----- - mimeEncodeContinue: 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." - ^self mimeEncode: aStream multiLine: true atStart: false! Item was removed: - ----- 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. Return 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! Item was removed: - ----- 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. Return 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! Item was removed: - ----- 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: [ - (multiLine and:[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]. - - ! Item was removed: - ----- Method: Base64MimeConverter>>multiLine (in category 'accessing') ----- - multiLine - "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" - ^multiLine! Item was removed: - ----- Method: Base64MimeConverter>>multiLine: (in category 'accessing') ----- - multiLine: aBool - "Determines whether we allow multi-line encodings (the default) or force everything into a single line (for use with URLs etc. where the continuation marker and the line break cause problems)" - multiLine := aBool! Item was removed: - ----- 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, ..." - ] repeat! Item was removed: - MimeConverter subclass: #Bit7MimeConverter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! Item was removed: - ----- Method: Bit7MimeConverter>>mimeDecode (in category 'conversion') ----- - mimeDecode - - dataStream nextPutAll: mimeStream upToEnd. - ^ dataStream! Item was removed: - ----- Method: Bit7MimeConverter>>mimeEncode (in category 'conversion') ----- - mimeEncode - - | character | - [dataStream atEnd] whileFalse: [ - character := dataStream next. - self assert: character asciiValue < 128. - mimeStream nextPut: character]. - - ^ mimeStream! Item was removed: - Collection subclass: #Bitset - instanceVariableNames: 'bytes tally' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! - - !Bitset commentStamp: 'ul 8/22/2015 00:52' prior: 0! - I implement Bitsets, which are dictionary-like data structures mapping 0-1 values to integers between 0 and capacity-1, or in another way they are set-like data structures which can include values between 0 and capacity-1. - I implement three different kind of APIs, each corresponding to a way of thinking about this data structure: - - A Set-like API with #add:, #remove: and #includes: - - A Dictionary-like API with #at:, #at:put: - - And a bit-manipulation API with #bitAt:, #clearBitAt: and #setBitAt:. - - Instance Variables - bytes: <ByteArray> - tally: <Integer> - - bytes - - a ByteArray which holds the values for each integer key. Each byte holds 8 values. - - tally - - the number of objects in this set, or the number or 1 values in this dictionary. - ! Item was removed: - ----- Method: Bitset class>>initializedInstance (in category 'instance creation') ----- - initializedInstance - - ^ self new: 0! Item was removed: - ----- Method: Bitset class>>new (in category 'instance creation') ----- - new - - self error: 'Use #new: instead.'! Item was removed: - ----- Method: Bitset class>>new: (in category 'instance creation') ----- - new: capacity - - ^self basicNew initialize: capacity! Item was removed: - ----- Method: Bitset>>= (in category 'comparing') ----- - = anObject - - self species == anObject species ifFalse: [ ^false ]. - anObject size = tally ifFalse: [ ^false ]. - ^anObject bytes = bytes! Item was removed: - ----- Method: Bitset>>add: (in category 'adding') ----- - add: anInteger - "Add anInteger to this set. Return anInteger." - - self setBitAt: anInteger. - ^anInteger! Item was removed: - ----- Method: Bitset>>at: (in category 'accessing') ----- - at: anInteger - - ^self bitAt: anInteger - ! Item was removed: - ----- Method: Bitset>>at:put: (in category 'accessing') ----- - at: anInteger put: aBit - - ^self bitAt: anInteger put: aBit - ! Item was removed: - ----- Method: Bitset>>bitAt: (in category 'bit manipulation') ----- - bitAt: anInteger - "Return the bit corresponding to anInteger." - - ^((bytes at: (anInteger bitShift: -3) + 1) bitShift: 0 - (anInteger bitAnd: 7)) bitAnd: 1 - ! Item was removed: - ----- Method: Bitset>>bitAt:put: (in category 'bit manipulation') ----- - bitAt: anInteger put: aBit - "Set the value corresponding to anInteger to aBit. Return the new value." - - aBit caseOf: { - [ 0 ] -> [ self clearBitAt: anInteger ]. - [ 1 ] -> [ self setBitAt: anInteger ] }. - ^aBit - - ! Item was removed: - ----- Method: Bitset>>bytes (in category 'private') ----- - bytes - - ^bytes! Item was removed: - ----- Method: Bitset>>capacity (in category 'accessing') ----- - capacity - "Return the highest integer this collection can store plus one." - - ^bytes size * 8! Item was removed: - ----- Method: Bitset>>clearBitAt: (in category 'bit manipulation') ----- - clearBitAt: anInteger - "Set the value corresponding to anInteger to 0. Return true if the value wasn't 0." - - | index value mask newValue | - index := (anInteger bitShift: -3) + 1. - value := bytes at: index. - mask := 1 bitShift: (anInteger bitAnd: 7). - (newValue := (value bitOr: mask) - mask) = value ifTrue: [ ^false ]. - bytes at: index put: newValue. - tally := tally - 1. - ^true - ! Item was removed: - ----- Method: Bitset>>do: (in category 'enumerating') ----- - do: aBlock - "Evaluate aBlock with each integer which has its bit set to 1." - - | byte byteOffset lowBits remainingBits | - remainingBits := tally. - lowBits := Integer lowBitPerByteTable. - 1 to: bytes size do: [ :index | - 1 <= remainingBits ifFalse: [ ^self ]. - (byte := bytes at: index) = 0 ifFalse: [ - byteOffset := (index bitShift: 3) - 9. "- 8 - 1 to make it -1 based." - [ - aBlock value: (lowBits at: byte) + byteOffset. "byteOffset is -1 based, lowBits is 1-based." - remainingBits := remainingBits - 1. - "Eliminate the low bit and loop if there're any remaning bits set." - (byte := byte bitAnd: byte - 1) = 0 ] whileFalse ] ]! Item was removed: - ----- Method: Bitset>>hash (in category 'comparing') ----- - hash - "#hash is implemented, because #= is implemented." - - ^(self species hash bitXor: tally hashMultiply) bitXor: bytes hash! Item was removed: - ----- Method: Bitset>>includes: (in category 'testing') ----- - includes: anInteger - - anInteger isInteger ifFalse: [ ^false ]. - -1 < anInteger ifFalse: [ ^false ]. - anInteger < self capacity ifFalse: [ ^false ]. - ^(self bitAt: anInteger) = 1! Item was removed: - ----- Method: Bitset>>initialize: (in category 'private') ----- - initialize: capacity - "Capacity is expected to be a non-negative, multiple-of-eight integer." - - bytes := ByteArray new: capacity // 8. - tally := 0! Item was removed: - ----- Method: Bitset>>isEmpty (in category 'testing') ----- - isEmpty - ^tally = 0! Item was removed: - ----- Method: Bitset>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - (self includes: anObject) ifTrue: [ ^1 ]. - ^0! Item was removed: - ----- Method: Bitset>>postCopy (in category 'copying') ----- - postCopy - "Copy bytes as well." - - bytes := bytes copy! Item was removed: - ----- Method: Bitset>>printElementsOn:separatedBy: (in category 'printing') ----- - printElementsOn: aStream separatedBy: delimiter - "Overridden to always inform about the entire set of bits." - - (0 to: self capacity-1) - do: [:index | aStream print: (self bitAt: index)] - separatedBy: [aStream nextPutAll: delimiter asString].! Item was removed: - ----- Method: Bitset>>remove:ifAbsent: (in category 'removing') ----- - remove: anInteger ifAbsent: absentBlock - - (self clearBitAt: anInteger) ifTrue: [ ^anInteger ]. - ^absentBlock value! Item was removed: - ----- Method: Bitset>>removeAll (in category 'removing') ----- - removeAll - - tally = 0 ifTrue: [ ^self ]. - bytes atAllPut: 0. "Unlike most #removeAll implementations, we don't allocate a new ByteArray here, because this is a bit more efficient. The VM would have to fill the new array with zeroes anyway." - tally := 0! Item was removed: - ----- Method: Bitset>>setBitAt: (in category 'bit manipulation') ----- - setBitAt: anInteger - "Set the value corresponding to anInteger to 1. Return true if the value wasn't 1." - - | index value newValue | - index := (anInteger bitShift: -3) + 1. - value := bytes at: index. - (newValue := (1 bitShift: (anInteger bitAnd: 7)) bitOr: value) = value ifTrue: [ ^false ]. - bytes at: index put: newValue. - tally := tally + 1. - ^true! Item was removed: - ----- Method: Bitset>>size (in category 'accessing') ----- - size - "Return the number of 1 values in this collection." - - ^tally! Item was removed: - ----- Method: BlockClosure>>asSortFunction (in category '*Collections-SortFunctions-converting') ----- - asSortFunction - "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used" - - self numArgs = 1 ifTrue: [^PropertySortFunction property: self]. - self numArgs = 2 ifTrue: [^CollatorBlockFunction usingBlock: self]. - - self error: 'Cant be converted to sort function. It should has one or two args' ! Item was removed: - ----- Method: BlockClosure>>ascending (in category '*Collections-SortFunctions-converting') ----- - ascending - "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of sending <=> to those will be used." - - ^self asSortFunction! Item was removed: - ----- Method: BlockClosure>>collatedBy: (in category '*Collections-SortFunctions-converting') ----- - collatedBy: aSortFunction - "Return a SortFunction around the receiver. If the receiver is a 2 arg block, it is assumed it will do the collation directly itself, returning -1, 0, or 1. If the receiver is a one arg block, it will be evaluated for each a and b and of the sort input, and the result of using aSortFunction on those will be used" - - self numArgs = 1 ifTrue: [^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction]. - self error: 'Cant be converted to sort function. It should hava one arg' ! Item was removed: - ----- Method: BlockClosure>>descending (in category '*Collections-SortFunctions-converting') ----- - descending - "Opposite direction as ascending." - - ^self asSortFunction reversed! Item was removed: - UnsignedIntegerArray 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. - ! Item was removed: - ----- Method: ByteArray class>>empty (in category 'instance creation') ----- - empty - "A canonicalized empty ByteArray instance." - ^ #[]! Item was removed: - ----- 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" - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - - ^String stringHash: aByteArray initialHash: speciesHash! Item was removed: - ----- Method: ByteArray class>>readHexFrom: (in category 'instance creation') ----- - readHexFrom: aString - "Create a byte array from a hexadecimal representation" - ^(self new: aString size // 2) readHexFrom: aString readStream! Item was removed: - ----- Method: ByteArray>>asByteArray (in category 'converting') ----- - asByteArray - ^ self! Item was removed: - ----- 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! Item was removed: - ----- Method: ByteArray>>asWideString (in category 'accessing') ----- - asWideString - - ^ WideString fromByteArray: self. - ! Item was removed: - ----- Method: ByteArray>>ascii85Encoded (in category 'converting') ----- - ascii85Encoded - "Encode the receiver as Ascii85" - "'Hello World' asByteArray ascii85Encoded" - - ^ (Ascii85Converter encode: self readStream) contents! Item was removed: - ----- Method: ByteArray>>base64Encoded (in category 'converting') ----- - base64Encoded - "Encode the receiver as base64" - "'Hello World' asByteArray base64Encoded" - ^(Base64MimeConverter mimeEncode: self readStream) contents! Item was removed: - ----- Method: ByteArray>>byteAt: (in category 'accessing') ----- - byteAt: index - <primitive: 60> - ^ super at: index! Item was removed: - ----- Method: ByteArray>>byteAt:put: (in category 'accessing') ----- - byteAt: index put: value - <primitive: 61> - ^ super at: index put: value! Item was removed: - ----- 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! Item was removed: - ----- Method: ByteArray>>defaultElement (in category 'private') ----- - defaultElement - - ^0! Item was removed: - ----- 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 * 1.0 "reduce to SmallFloat64 if possible"! Item was removed: - ----- 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! Item was removed: - ----- Method: ByteArray>>hash (in category 'comparing') ----- - hash - "#hash is implemented, because #= is implemented" - - ^self hashWithInitialHash: self species hash! Item was removed: - ----- Method: ByteArray>>hashWithInitialHash: (in category 'private') ----- - hashWithInitialHash: speciesHash - "Answer the hash of a byte-indexed array, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - - ^String stringHash: self initialHash: speciesHash! Item was removed: - ----- Method: ByteArray>>hex (in category 'converting') ----- - hex - "Answer a hexa decimal representation of the receiver" - | string v index map | - map := '0123456789abcdef'. - string := String new: self size * 2. "hex" - index := 0. - 1 to: self size do:[:i| - v := self at: i. - string at: (index := index + 1) put: (map at: (v bitShift: -4) + 1). - string at: (index := index + 1) put: (map at: (v bitAnd: 15) + 1). - ]. - ^string! Item was removed: - ----- Method: ByteArray>>indexOf:startingAt: (in category 'accessing') ----- - indexOf: anInteger startingAt: start - - anInteger isInteger ifFalse: [ ^0 ]. - 0 <= anInteger ifFalse: [ ^0 ]. - anInteger <= 255 ifFalse: [ ^0 ]. - ^ByteString indexOfAscii: anInteger inString: self startingAt: start! Item was removed: - ----- Method: ByteArray>>isLiteral (in category 'testing') ----- - isLiteral - "so that #(1 #[1 2 3] 5) prints itself" - ^self class == ByteArray! Item was removed: - ----- Method: ByteArray>>long64At:bigEndian: (in category 'platform independent access') ----- - long64At: index bigEndian: bigEndian - "Return a 64-bit signed integer quantity starting from the given byte index." - - | value | - value := self unsignedLong64At: index bigEndian: bigEndian. - value digitLength < 8 ifTrue: [ ^value ]. - (value digitAt: 8) < 16r80 ifTrue: [ ^value ]. - ^value - 16r10000000000000000! Item was removed: - ----- Method: ByteArray>>long64At:put:bigEndian: (in category 'platform independent access') ----- - long64At: index put: value bigEndian: bigEndian - "Store a 64-bit signed integer quantity starting from the given byte index." - - ^self - unsignedLong64At: index - put: (value negative - ifFalse: [ value ] - ifTrue: [ value + 16r10000000000000000 ]) - bigEndian: bigEndian! Item was removed: - ----- Method: ByteArray>>longAt:bigEndian: (in category 'platform independent access') ----- - longAt: index bigEndian: bigEndian - "Return a 32-bit integer quantity starting from the given byte index. Use #normalize where necessary to ensure compatibility with non-30-bit SmallIntegers." - - | byte result | - bigEndian ifFalse: [ - (byte := self at: index + 3) <= 16r7F ifTrue: [ "Is the result non-negative?" - byte <= 16r3F ifTrue: [ - ^(((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index) ]. - ^(LargePositiveInteger new: 4) - replaceFrom: 1 - to: 4 - with: self - startingAt: index; - normalize ]. - "Negative" - byte >= 16rC0 ifTrue: [ - ^-1 - (((((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitXor: 16rFFFFFF) bitShift: 8) + ((self at: index) bitXor: 16rFF)) ]. - (result := LargeNegativeInteger new: 4) - digitAt: 4 put: ((self at: index + 3) bitXor: 16rFF); - digitAt: 3 put: ((self at: index + 2) bitXor: 16rFF); - digitAt: 2 put: ((self at: index + 1) bitXor: 16rFF). - (byte := ((self at: index) bitXor: 16rFF) + 1) <= 16rFF ifTrue: [ - ^result - digitAt: 1 put: byte; - normalize ]. - ^result - digitAt: 1 put: 16rFF; - - 1 "It's tempting to do the subtraction in a loop to avoid the LargeInteger creation, but it's actually slower than this." ]. - (byte := self at: index) <= 16r7F ifTrue: [ "Is the result non-negative?" - byte <= 16r3F ifTrue: [ - ^(((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 3) ]. - ^(LargePositiveInteger new: 4) - digitAt: 1 put: (self at: index + 3); - digitAt: 2 put: (self at: index + 2); - digitAt: 3 put: (self at: index + 1); - digitAt: 4 put: byte; - normalize ]. - "Negative" - 16rC0 <= byte ifTrue: [ - ^-1 - (((((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitXor: 16rFFFFFF) bitShift: 8) + ((self at: index + 3) bitXor: 16rFF)) ]. - (result := LargeNegativeInteger new: 4) - digitAt: 4 put: (byte bitXor: 16rFF); - digitAt: 3 put: ((self at: index + 1) bitXor: 16rFF); - digitAt: 2 put: ((self at: index + 2) bitXor: 16rFF). - (byte := ((self at: index + 3) bitXor: 16rFF) + 1) <= 16rFF ifTrue: [ - ^result - digitAt: 1 put: byte; - normalize ]. - ^result - digitAt: 1 put: 16rFF; - - 1 "It's tempting to do the subtraction in a loop to avoid the LargeInteger creation, but it's actually slower than this."! Item was removed: - ----- Method: ByteArray>>longAt:put:bigEndian: (in category 'platform independent access') ----- - longAt: index put: value bigEndian: bigEndian - "Store a 32-bit signed integer quantity starting from the given byte index" - - | v v2 | - value isLarge ifTrue: [ - bigEndian ifFalse: [ - value positive ifTrue: [ - self - replaceFrom: index - to: index + 3 - with: value - startingAt: 1. - ^value ]. - v := 0. - [ v <= 3 and: [ (v2 := ((value digitAt: v + 1) bitXor: 16rFF) + 1) = 16r100 ] ] whileTrue: [ - self at: index + v put: 0. - v := v + 1 ]. - self at: index + v put: v2. - v := v + 1. - [ v <= 3 ] whileTrue: [ - self at: index + v put: ((value digitAt: (v := v + 1)) bitXor: 16rFF) ]. - ^value ]. - value positive ifTrue: [ - self - at: index put: (value digitAt: 4); - at: index + 1 put: (value digitAt: 3); - at: index + 2 put: (value digitAt: 2); - at: index + 3 put: (value digitAt: 1). - ^value ]. - v := 3. - [ 0 <= v and: [ (v2 := ((value digitAt: 4 - v) bitXor: 16rFF) + 1) = 16r100 ] ] whileTrue: [ - self at: index + v put: 0. - v := v - 1 ]. - self at: index + v put: v2. - [ 0 <= (v := v - 1) ] whileTrue: [ - self at: index + v put: ((value digitAt: 4 - v) bitXor: 16rFF) ]. - ^value ]. - v := value bitShift: -24. - 0 <= (v := (v bitAnd: 16r7F) - (v bitAnd: 16r80)) ifFalse: [ - v := v + 16r100 ]. - bigEndian ifFalse: [ - self - at: index put: (value bitAnd: 16rFF); - at: index + 1 put: ((value bitShift: -8) bitAnd: 16rFF); - at: index + 2 put: ((value bitShift: -16) bitAnd: 16rFF); - at: index + 3 put: v. - ^value ]. - self - at: index put: v; - at: index + 1 put: ((value bitShift: -16) bitAnd: 16rFF); - at: index + 2 put: ((value bitShift: -8) bitAnd: 16rFF); - at: index + 3 put: (value bitAnd: 16rFF). - ^value! Item was removed: - ----- Method: ByteArray>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - | tally | - anObject isInteger ifFalse: [ ^0 ]. - anObject negative ifTrue: [ ^0 ]. - anObject > 255 ifTrue: [ ^0 ]. - tally := 0. - 1 to: self size do: [ :index | - (self at: index) = anObject ifTrue: [ tally := tally + 1 ] ]. - ^tally! Item was removed: - ----- Method: ByteArray>>printAsLiteralOn: (in category 'printing') ----- - printAsLiteralOn: aStream - aStream nextPut: $#; nextPut: $[. - self do: [:each| each storeOn: aStream] - separatedBy: [aStream nextPut: $ ]. - aStream nextPut: $]! Item was removed: - ----- Method: ByteArray>>printOn: (in category 'printing') ----- - printOn: aStream - self shouldBePrintedAsLiteral ifFalse: - [super printOn: aStream. - aStream space]. - self printAsLiteralOn: aStream! Item was removed: - ----- Method: ByteArray>>putOn: (in category 'streaming') ----- - putOn: aStream - - aStream nextPutAll: self - ! Item was removed: - ----- Method: ByteArray>>readHexFrom: (in category 'initialize') ----- - readHexFrom: aStream - "Initialize the receiver from a hexadecimal string representation" - - 1 to: self size do: - [:i| | n v1 v2 | - n := aStream next asInteger. - v1 := n > 57 "$9 asInteger = 57" - ifTrue: - [n > 96 "$a asInteger 97" - ifTrue: [n - 87] - ifFalse: [n > 64 "$A asInteger = 65" - ifTrue: [n - 55] - ifFalse: [-1]]] - ifFalse: [n - 48]. "$0 asInteger = 48" - (v1 between: 0 and: 15) ifFalse: [^self error: 'Hex digit expected']. - n := aStream next asInteger. - v2 := n > 57 "$9 asInteger = 57" - ifTrue: - [n > 96 "$a asInteger 97" - ifTrue: [n - 87] - ifFalse: [n > 64 "$A asInteger = 65" - ifTrue: [n - 55] - ifFalse: [-1]]] - ifFalse: [n - 48]. "$0 asInteger = 48" - (v2 between: 0 and: 15) ifFalse: [^self error: 'Hex digit expected']. - self at: i put: (v1 bitShift: 4) + v2] - - "Proof that our filter selects only hexadecimal characters: - (0 to: 255) - select: - [:n| - (n > 57 - ifTrue: - [n > 96 - ifTrue: [n - 87] - ifFalse: [n > 64 - ifTrue: [n - 55] - ifFalse: [-1]]] - ifFalse: [n - 48]) between: 0 and: 15] - thenCollect: - [:n| Character value: n]"! Item was removed: - ----- 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> - replacement isString - ifFalse: - [super replaceFrom: start to: stop with: replacement startingAt: repStart] - ifTrue: - [ "use String>>byteAt: to mimic prim 105" - | index repOff | - repOff := repStart - start. - index := start - 1. - [(index := index + 1) <= stop] - whileTrue: [self at: index put: (replacement byteAt: repOff + index)]] - ! Item was removed: - ----- Method: ByteArray>>shortAt:bigEndian: (in category 'platform independent access') ----- - shortAt: index bigEndian: bigEndian - "Return a 16-bit signed integer quantity starting from the given byte index" - - | result | - result := bigEndian - ifFalse: [ ((self at: index + 1) bitShift: 8) + (self at: index) ] - ifTrue: [ ((self at: index) bitShift: 8) + (self at: index + 1) ]. - result < 16r8000 ifTrue: [ ^result ]. - ^result - 16r10000! Item was removed: - ----- Method: ByteArray>>shortAt:put:bigEndian: (in category 'platform independent access') ----- - shortAt: index put: value bigEndian: bigEndian - "Store a 16-bit signed integer quantity starting from the given byte index" - - | unsignedValue | - (unsignedValue := value) < 0 ifTrue: [ - unsignedValue := unsignedValue + 16r10000 ]. - bigEndian ifFalse: [ - self - at: index + 1 put: (unsignedValue bitShift: -8); - at: index put: (unsignedValue bitAnd: 16rFF). - ^value ]. - self - at: index put: (unsignedValue bitShift: -8); - at: index + 1 put: (unsignedValue bitAnd: 16rFF). - ^value! Item was removed: - ----- Method: ByteArray>>signedByteAt: (in category 'platform independent access') ----- - signedByteAt: index - "Answer an 8-bit signed integer quantity from the given byte index." - <primitive: 165> - | byte | - (byte := self at: index) <= 16r7F ifTrue: [ ^byte ]. - ^byte - 16r100! Item was removed: - ----- Method: ByteArray>>signedByteAt:put: (in category 'platform independent access') ----- - signedByteAt: index put: anInteger - "Store an 8-bit signed integer quantity at the given byte index." - <primitive: 166> - anInteger >= 0 ifTrue: [ ^self at: index put: anInteger ]. - self at: index put: anInteger + 16r100. - ^anInteger! Item was removed: - ----- Method: ByteArray>>storeOn: (in category 'printing') ----- - storeOn: aStream - self shouldBePrintedAsLiteral - ifTrue: [self printAsLiteralOn: aStream] - ifFalse: [super storeOn: aStream]! Item was removed: - ----- Method: ByteArray>>unsignedLong64At:bigEndian: (in category 'platform independent access') ----- - unsignedLong64At: index bigEndian: bigEndian - "Return a 64-bit unsigned integer quantity starting from the given byte index. Use #normalize where necessary to ensure compatibility with non-30-bit SmallIntegers." - - | byte | - SmallInteger maxVal > 1073741823 ifTrue: - [bigEndian - ifTrue: "64-bit SmallIntegers have a 3 bit tag and a sign bit, so the most positive value has 16rF as its top byte." - [(byte := self at: index) <= 16rF ifTrue: - [^((((((((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 3)) bitShift: 8) - + (self at: index + 4) bitShift: 8) + (self at: index + 5) bitShift: 8) + (self at: index + 6) bitShift: 8) + (self at: index + 7)]] - ifFalse: - [(byte := self at: index + 7) <= 16rF ifTrue: - [^((((((((byte bitShift: 8) + (self at: index + 6) bitShift: 8) + (self at: index + 5) bitShift: 8) + (self at: index + 4)) bitShift: 8) - + (self at: index + 3) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index)]]]. - bigEndian ifFalse: [ - (byte := self at: index + 7) = 0 ifFalse: [ - ^(LargePositiveInteger new: 8) - replaceFrom: 1 to: 8 with: self startingAt: index; - normalize ]. - (byte := self at: index + 6) = 0 ifFalse: [ - ^(LargePositiveInteger new: 7) - replaceFrom: 1 to: 7 with: self startingAt: index; - normalize ]. - (byte := self at: index + 5) = 0 ifFalse: [ - ^(LargePositiveInteger new: 6) - replaceFrom: 1 to: 6 with: self startingAt: index; - normalize ]. - (byte := self at: index + 4) = 0 ifFalse: [ - ^(LargePositiveInteger new: 5) - replaceFrom: 1 to: 5 with: self startingAt: index; - normalize ]. - (byte := self at: index + 3) <= 16r3F ifFalse: [ - ^(LargePositiveInteger new: 4) - replaceFrom: 1 to: 4 with: self startingAt: index; - normalize ]. - ^(((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index) ]. - (byte := self at: index) = 0 ifFalse: [ - ^(LargePositiveInteger new: 8) - digitAt: 1 put: (self at: index + 7); - digitAt: 2 put: (self at: index + 6); - digitAt: 3 put: (self at: index + 5); - digitAt: 4 put: (self at: index + 4); - digitAt: 5 put: (self at: index + 3); - digitAt: 6 put: (self at: index + 2); - digitAt: 7 put: (self at: index + 1); - digitAt: 8 put: byte; - normalize ]. - (byte := self at: index + 1) = 0 ifFalse: [ - ^(LargePositiveInteger new: 7) - digitAt: 1 put: (self at: index + 7); - digitAt: 2 put: (self at: index + 6); - digitAt: 3 put: (self at: index + 5); - digitAt: 4 put: (self at: index + 4); - digitAt: 5 put: (self at: index + 3); - digitAt: 6 put: (self at: index + 2); - digitAt: 7 put: byte; - normalize ]. - (byte := self at: index + 2) = 0 ifFalse: [ - ^(LargePositiveInteger new: 6) - digitAt: 1 put: (self at: index + 7); - digitAt: 2 put: (self at: index + 6); - digitAt: 3 put: (self at: index + 5); - digitAt: 4 put: (self at: index + 4); - digitAt: 5 put: (self at: index + 3); - digitAt: 6 put: byte; - normalize ]. - (byte := self at: index + 3) = 0 ifFalse: [ - ^(LargePositiveInteger new: 5) - digitAt: 1 put: (self at: index + 7); - digitAt: 2 put: (self at: index + 6); - digitAt: 3 put: (self at: index + 5); - digitAt: 4 put: (self at: index + 4); - digitAt: 5 put: byte; - normalize ]. - (byte := self at: index + 4) <= 16r3F ifFalse: [ - ^(LargePositiveInteger new: 4) - digitAt: 1 put: (self at: index + 7); - digitAt: 2 put: (self at: index + 6); - digitAt: 3 put: (self at: index + 5); - digitAt: 4 put: byte; - normalize ]. - ^(((byte bitShift: 8) + (self at: index + 5) bitShift: 8) + (self at: index + 6) bitShift: 8) + (self at: index + 7)! Item was removed: - ----- Method: ByteArray>>unsignedLong64At:put:bigEndian: (in category 'platform independent access') ----- - unsignedLong64At: index put: value bigEndian: bigEndian - "Store a 64-bit unsigned integer quantity starting from the given byte index" - - | i j | - value isLarge ifTrue: [ - i := value digitLength. - bigEndian ifFalse: [ - self - replaceFrom: index - to: index + i - 1 - with: value - startingAt: 1; - replaceFrom: index + i - to: index + 7 - with: #[0 0 0 0 0 0 0 0] - startingAt: 1. - ^value ]. - j := index + 8. - i <= 7 ifTrue: [ - self - replaceFrom: index - to: j - i - 1 - with: #[0 0 0 0 0 0 0 0] - startingAt: 1 ]. - [ 1 <= i ] whileTrue: [ - self at: j - i put: (value digitAt: i). - i := i - 1 ]. - ^value ]. - bigEndian ifFalse: [ - j := index - 1. - i := value. - [ 1 <= i ] whileTrue: [ - self at: (j := j + 1) put: (i bitAnd: 16rFF). - i := i bitShift: -8 ]. - self replaceFrom: j + 1 - to: index + 7 - with: #[0 0 0 0 0 0 0 0] - startingAt: 1. - ^value ]. - j := index + 8. - i := value. - [ 1 <= i ] whileTrue: [ - self at: (j := j - 1) put: (i bitAnd: 16rFF). - i := i bitShift: -8 ]. - self replaceFrom: index - to: j - 1 - with: #[0 0 0 0 0 0 0 0] - startingAt: 1. - ^value! Item was removed: - ----- Method: ByteArray>>unsignedLongAt:bigEndian: (in category 'platform independent access') ----- - unsignedLongAt: index bigEndian: bigEndian - "Return a 32-bit unsigned integer quantity starting from the given byte index. Use #normalize where necessary to ensure compatibility with non-30-bit SmallIntegers." - | byte | - bigEndian ifTrue: - [((byte := self at: index) <= 16r3F - or: [SmallInteger maxVal > 1073741823]) ifTrue: - [^(((byte bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 3)]. - ^(LargePositiveInteger new: 4) - digitAt: 1 put: (self at: index + 3); - digitAt: 2 put: (self at: index + 2); - digitAt: 3 put: (self at: index + 1); - digitAt: 4 put: byte; - normalize]. - ((byte := self at: index + 3) <= 16r3F - or: [SmallInteger maxVal > 1073741823]) ifTrue: - [^(((byte bitShift: 8) + (self at: index + 2) bitShift: 8) + (self at: index + 1) bitShift: 8) + (self at: index)]. - ^(LargePositiveInteger new: 4) - replaceFrom: 1 to: 4 with: self startingAt: index; - normalize! Item was removed: - ----- Method: ByteArray>>unsignedLongAt:put:bigEndian: (in category 'platform independent access') ----- - unsignedLongAt: index put: value bigEndian: bigEndian - "Store a 32-bit unsigned integer quantity starting from the given byte index" - - value isLarge - ifTrue: [ - bigEndian ifFalse: [ - self - replaceFrom: index - to: index + 3 - with: value - startingAt: 1. - ^value ]. - self - at: index put: (value digitAt: 4); - at: index + 1 put: (value digitAt: 3); - at: index + 2 put: (value digitAt: 2); - at: index +3 put: (value digitAt: 1) ] - ifFalse: [ - bigEndian ifFalse: [ - self - at: index put: (value bitAnd: 16rFF); - at: index + 1 put: ((value bitShift: -8) bitAnd: 16rFF); - at: index + 2 put: ((value bitShift: -16) bitAnd: 16rFF); - at: index + 3 put: (value bitShift: -24). - ^value ]. - self - at: index put: (value bitShift: -24); - at: index + 1 put: ((value bitShift: -16) bitAnd: 16rFF); - at: index + 2 put: ((value bitShift: -8) bitAnd: 16rFF); - at: index + 3 put: (value bitAnd: 16rFF) ]. - ^value! Item was removed: - ----- Method: ByteArray>>unsignedShortAt:bigEndian: (in category 'platform independent access') ----- - unsignedShortAt: index bigEndian: bigEndian - "Return a 16-bit unsigned integer quantity starting from the given byte index" - - bigEndian ifFalse: [ ^((self at: index + 1) bitShift: 8) + (self at: index) ]. - ^((self at: index) bitShift: 8) + (self at: index + 1) - ! Item was removed: - ----- Method: ByteArray>>unsignedShortAt:put:bigEndian: (in category 'platform independent access') ----- - unsignedShortAt: index put: value bigEndian: bigEndian - "Store a 16-bit unsigned integer quantity starting from the given byte index" - - bigEndian ifFalse: [ - self - at: index + 1 put: (value bitShift: -8); - at: index put: (value bitAnd: 16rFF). - ^value ]. - self - at: index put: (value bitShift: -8); - at: index+1 put: (value bitAnd: 16rFF). - ^value! Item was removed: - CharacterSet subclass: #ByteCharacterSet - instanceVariableNames: 'tally' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! - - !ByteCharacterSet commentStamp: '<historical>' prior: 0! - A set of characters. Lookups for inclusion are very fast.! Item was removed: - ----- Method: ByteCharacterSet class>>allCharacters (in category 'instance creation') ----- - allCharacters - "return a set containing all byte characters" - - ^ self fromMap: (ByteArray new: 256 withAll: 1)! Item was removed: - ----- Method: ByteCharacterSet class>>fromMap: (in category 'instance creation') ----- - fromMap: aByteArray - - ^self basicNew fromMap: aByteArray! Item was removed: - ----- Method: ByteCharacterSet>>= (in category 'comparing') ----- - = anObject - - self species == anObject species ifFalse: [ ^false ]. - anObject size = tally ifFalse: [ ^false ]. - ^self byteArrayMap = anObject byteArrayMap! Item was removed: - ----- Method: ByteCharacterSet>>add: (in category 'adding') ----- - add: aCharacter - "I automatically become a WideByteCharacterSet if you add a wide character to myself" - - | index | - (index := aCharacter asInteger + 1) <= 256 ifFalse: [ - | wide | - wide := WideCharacterSet new. - wide addAll: self. - wide add: aCharacter. - self becomeForward: wide. - ^aCharacter ]. - (byteArrayMap at: index) = 1 ifFalse: [ - byteArrayMap at: index put: 1. - tally := tally + 1 ]. - ^aCharacter! Item was removed: - ----- Method: ByteCharacterSet>>asString (in category 'conversion') ----- - asString - "Convert the receiver into a String" - - ^String new: self size streamContents:[:s| - self do:[:ch| s nextPut: ch]. - ].! Item was removed: - ----- Method: ByteCharacterSet>>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" - ^byteArrayMap! Item was removed: - ----- Method: ByteCharacterSet>>do: (in category 'enumerating') ----- - do: aBlock - "evaluate aBlock with each character in the set" - - | index | - tally >= 128 ifTrue: [ "dense" - index := 0. - [ (index := index + 1) <= 256 ] whileTrue: [ - (byteArrayMap at: index) = 1 ifTrue: [ - aBlock value: (Character value: index - 1) ] ]. - ^self ]. - "sparse" - index := 0. - [ (index := byteArrayMap indexOf: 1 startingAt: index + 1) = 0 ] whileFalse: [ - aBlock value: (Character value: index - 1) ]. - ! Item was removed: - ----- Method: ByteCharacterSet>>enumerationCost (in category 'private') ----- - enumerationCost - "Low cost. I do not hold more than 256 characters." - - ^10! Item was removed: - ----- Method: ByteCharacterSet>>fromMap: (in category 'initialize-release') ----- - fromMap: aByteArray - byteArrayMap := aByteArray. - tally := aByteArray count: [:e | e = 1]! Item was removed: - ----- Method: ByteCharacterSet>>hasWideCharacters (in category 'testing') ----- - hasWideCharacters - ^false! Item was removed: - ----- Method: ByteCharacterSet>>hash (in category 'comparing') ----- - hash - ^self byteArrayMap hash! Item was removed: - ----- Method: ByteCharacterSet>>includesCode: (in category 'testing') ----- - includesCode: anInteger - anInteger > 255 ifTrue: [ ^false ]. - ^(byteArrayMap at: anInteger + 1) > 0! Item was removed: - ----- Method: ByteCharacterSet>>initialize (in category 'initialize-release') ----- - initialize - byteArrayMap := ByteArray new: 256. - tally := 0! Item was removed: - ----- Method: ByteCharacterSet>>isEmpty (in category 'testing') ----- - isEmpty - ^tally = 0! Item was removed: - ----- Method: ByteCharacterSet>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - byteArrayMap := byteArrayMap copy! Item was removed: - ----- Method: ByteCharacterSet>>remove: (in category 'removing') ----- - remove: aCharacter - - ^self remove: aCharacter ifAbsent: aCharacter! Item was removed: - ----- Method: ByteCharacterSet>>remove:ifAbsent: (in category 'removing') ----- - remove: aCharacter ifAbsent: aBlock - - | index | - (index := aCharacter asciiValue + 1) <= 256 ifFalse: [ ^aBlock value ]. - (byteArrayMap at: index) = 0 ifTrue: [ ^aBlock value ]. - byteArrayMap at: index put: 0. - tally := tally - 1. - ^aCharacter! Item was removed: - ----- Method: ByteCharacterSet>>removeAll (in category 'removing') ----- - removeAll - - byteArrayMap atAllPut: 0. - tally := 0! Item was removed: - ----- Method: ByteCharacterSet>>size (in category 'accessing') ----- - size - - ^tally! Item was removed: - ----- Method: ByteCharacterSet>>wideCharacterMap (in category 'private') ----- - wideCharacterMap - "used for comparing with WideByteCharacterSet" - - | wide | - wide := WideCharacterSet new. - wide addAll: self. - ^wide wideCharacterMap! Item was removed: - String variableByteSubclass: #ByteString - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Strings'! - - !ByteString commentStamp: '<historical>' prior: 0! - This class represents the array of 8 bit wide characters. - ! Item was removed: - ----- 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'> - <var: #string1 declareC: 'unsigned char *string1'> - <var: #string2 declareC: 'unsigned char *string2'> - <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]. - ! Item was removed: - ----- Method: ByteString class>>findFirstInString:inSet:startingAt: (in category 'primitives') ----- - findFirstInString: aString inSet: inclusionMap startingAt: start - | i stringSize | - <primitive: 'primitiveFindFirstInString' module: 'MiscPrimitivePlugin'> - <var: #aString declareC: 'unsigned char *aString'> - <var: #inclusionMap declareC: 'char *inclusionMap'> - - inclusionMap size ~= 256 ifTrue: [ ^0 ]. - - i := start. - stringSize := aString size. - [ i <= stringSize and: [ (inclusionMap at: (aString basicAt: i) + 1) = 0 ] ] whileTrue: [ - i := i + 1 ]. - - i > stringSize ifTrue: [ ^0 ]. - ^i! Item was removed: - ----- Method: ByteString class>>indexOfAscii:inString:startingAt: (in category 'primitives') ----- - indexOfAscii: anInteger inString: aString startingAt: start - - | stringSize | - <primitive: 'primitiveIndexOfAsciiInString' module: 'MiscPrimitivePlugin'> - <var: #aString type: #'unsigned char *'> - - stringSize := aString size. - start to: stringSize do: [:pos | - (aString basicAt: pos) = anInteger ifTrue: [^ pos]]. - - ^ 0! Item was removed: - ----- Method: ByteString class>>stringHash:initialHash: (in category 'primitives') ----- - stringHash: aString initialHash: speciesHash - "Answer the hash of a byte-indexed string, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - - ^super stringHash: aString initialHash: speciesHash! Item was removed: - ----- 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'> - <var: #table declareC: 'unsigned char *table'> - <var: #aString declareC: 'unsigned char *aString'> - - start to: stop do: [ :i | - aString at: i put: (table at: (aString basicAt: i) + 1) ]! Item was removed: - ----- Method: ByteString>>applyLanguageInformation: (in category 'accessing') ----- - applyLanguageInformation: aLanguage - "Overwritten because the receiver has latin-1 encoding and thus needs no extra language information applied." - ! Item was removed: - ----- 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! Item was removed: - ----- Method: ByteString>>asIntegerSigned: (in category 'converting') ----- - asIntegerSigned: signed - "Return the first decimal integer I can find or nil." - - | index integerValue result size negative | - (size := self size) <= 16 ifFalse: [ ^super asIntegerSigned: signed ]. - "Find the first character between $0 and $9." - index := 0. - [ - (index := index + 1) <= size ifFalse: [ ^nil "There are no digits in this string." ]. - (integerValue := self basicAt: index) <= 47 "$0 asInteger - 1" - or: [ 58 "$9 asInteger + 1" <= integerValue ] ] whileTrue. - "Check the sign." - negative := signed and: [ 2 <= index and: [ (self at: index - 1) == $- ] ]. - "Parse the number." - result := integerValue - 48 "$0 asInteger". - [ (index := index + 1) <= size - and: [ (integerValue := self basicAt: index) <= 57 "$9 asInteger" - and: [ 48 "$0 asInteger" <= integerValue ] ] ] whileTrue: [ - result := result * 10 + integerValue - 48 ]. - negative ifTrue: [ ^result negated ]. - ^result! Item was removed: - ----- Method: ByteString>>asOctetString (in category 'converting') ----- - asOctetString - - ^ self. - ! Item was removed: - ----- 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)! Item was removed: - ----- 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, or the Character's code is outside the 0-255 range, or if the receiver - is read-only. Essential. See Object documentation whatIsAPrimitive." - - <primitive: 64 error: ec> - aCharacter isCharacter ifFalse: - [^self errorImproperStore]. - index isInteger - ifTrue: - [ec == #'no modification' ifTrue: - [^thisContext modificationForbiddenFor: self at: index putCharacter: aCharacter]. - aCharacter isOctetCharacter ifFalse: "Convert to WideString" - [self becomeForward: (WideString from: self). - ^self at: index put: aCharacter]. - self errorSubscriptBounds: index] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- Method: ByteString>>byteAt: (in category 'accessing') ----- - byteAt: index - <primitive: 60> - ^(self at: index) asciiValue! Item was removed: - ----- Method: ByteString>>byteAt:put: (in category 'accessing') ----- - byteAt: index put: value - <primitive: 61> - self at: index put: value asCharacter. - ^value! Item was removed: - ----- Method: ByteString>>byteSize (in category 'accessing') ----- - byteSize - ^self size! Item was removed: - ----- Method: ByteString>>canBeToken (in category 'testing') ----- - canBeToken - "Optimized version for the common case." - - ^ (self findSubstring: '~' in: self startingAt: 1 matchTable: Tokenish) = 0 - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: ByteString>>convertFromSystemString (in category 'converting') ----- - convertFromSystemString - - | readStream writeStream converter | - readStream := self readStream. - writeStream := String new writeStream. - converter := Locale currentPlatform systemConverter. - converter ifNil: [^ self]. - [readStream atEnd] whileFalse: [ - writeStream nextPut: (converter nextFromStream: readStream)]. - ^ writeStream contents - ! Item was removed: - ----- 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'> - <var: #key type: #'unsigned char *'> - <var: #body type: #'unsigned char *'> - <var: #matchTable type: #'unsigned char *'> - - key size = 0 ifTrue: [^ 0]. - (start max: 1) to: body size - key size + 1 do: - [:startIndex | - index := 1. - [(matchTable at: (body basicAt: startIndex+index-1) + 1) - = (matchTable at: (key basicAt: index) + 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 - "! Item was removed: - ----- Method: ByteString>>hashWithInitialHash: (in category 'private') ----- - hashWithInitialHash: speciesHash - "Answer the hash of a byte-indexed string, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - - ^super hashWithInitialHash: speciesHash! Item was removed: - ----- Method: ByteString>>indexOfAnyOf:startingAt: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start - "Use double dispatching for speed" - ^aCollection findFirstInByteString: self startingAt: start! Item was removed: - ----- Method: ByteString>>isByteString (in category 'testing') ----- - isByteString - "Answer whether the receiver is a ByteString" - ^true! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: ByteString>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - | tally | - anObject isCharacter ifFalse: [ ^0 ]. - anObject asInteger > 255 ifTrue: [ ^0 ]. - tally := 0. - 1 to: self size do: [ :index | - (self at: index) == anObject ifTrue: [ tally := tally + 1 ] ]. - ^tally! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: ByteString>>squeakToUtf8 (in category 'converting') ----- - squeakToUtf8 - "Convert the given string (self) to UTF-8 from Squeak's internal representation." - - ^UTF8TextConverter encodeByteString: self! Item was removed: - ----- Method: ByteString>>substrings (in category 'converting') ----- - substrings - "Answer an array of the substrings that compose the receiver." - - ^Array streamContents: [ :stream | - | end start | - end := 1. - "find one substring each time through this loop" - [ "find the beginning of the next substring" - (start := self - indexOfAnyOf: CharacterSet nonSeparators - startingAt: end) = 0 ] - whileFalse: [ - "find the end" - end := self - indexOfAnyOf: CharacterSet separators - startingAt: start - ifAbsent: [ self size + 1 ]. - stream nextPut: (self copyFrom: start to: end - 1) ] ]! Item was removed: - ----- Method: ByteString>>utf8ToSqueak (in category 'converting') ----- - utf8ToSqueak - "Convert the given string (self) from UTF-8 to Squeak's internal representation." - - ^UTF8TextConverter decodeByteString: self - ! Item was removed: - Symbol variableByteSubclass: #ByteSymbol - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Strings'! - - !ByteSymbol commentStamp: '<historical>' prior: 0! - This class represents the symbols containing 8bit characters.! Item was removed: - ----- Method: ByteSymbol class>>findFirstInString:inSet:startingAt: (in category 'primitives') ----- - findFirstInString: aString inSet: inclusionMap startingAt: start - ^ByteString findFirstInString: aString inSet: inclusionMap startingAt: start! Item was removed: - ----- Method: ByteSymbol class>>indexOfAscii:inString:startingAt: (in category 'primitives') ----- - indexOfAscii: anInteger inString: aString startingAt: start - ^ByteString indexOfAscii: anInteger inString: aString startingAt: start! Item was removed: - ----- Method: ByteSymbol class>>stringHash:initialHash: (in category 'primitives') ----- - stringHash: aString initialHash: speciesHash - "Answer the hash of a byte-indexed string, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - - ^super stringHash: aString initialHash: speciesHash! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: ByteSymbol>>asOctetString (in category 'converting') ----- - asOctetString - ^ self! Item was removed: - ----- 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)! Item was removed: - ----- Method: ByteSymbol>>at:put: (in category 'accessing') ----- - at: anInteger put: anObject - "You cannot modify the receiver." - self errorNoModification! Item was removed: - ----- Method: ByteSymbol>>byteAt: (in category 'accessing') ----- - byteAt: index - <primitive: 60> - ^(self at: index) asciiValue! Item was removed: - ----- Method: ByteSymbol>>byteAt:put: (in category 'accessing') ----- - byteAt: anInteger put: anObject - "You cannot modify the receiver." - self errorNoModification! Item was removed: - ----- Method: ByteSymbol>>byteSize (in category 'accessing') ----- - byteSize - ^self size! Item was removed: - ----- Method: ByteSymbol>>canBeToken (in category 'testing') ----- - canBeToken - "Optimized version for the common case." - - | index | - index := 0. - [ (index := self findSubstring: '~' in: self startingAt: index + 1 matchTable: Tokenish) = 0 ] - whileFalse: [ - (self at: index) == $_ ifFalse: [ ^false ] ]. - ^true - ! Item was removed: - ----- 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! Item was removed: - ----- Method: ByteSymbol>>hashWithInitialHash: (in category 'private') ----- - hashWithInitialHash: speciesHash - "Answer the hash of a byte-indexed string, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - <primitive: 'primitiveStringHash' module: 'MiscPrimitivePlugin'> - - ^super hashWithInitialHash: speciesHash! Item was removed: - ----- Method: ByteSymbol>>indexOfAnyOf:startingAt: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start - "Use double dispatching for speed" - ^aCollection findFirstInByteString: self startingAt: start! Item was removed: - ----- Method: ByteSymbol>>isByteString (in category 'testing') ----- - isByteString - "Answer whether the receiver is a ByteString" - ^true! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: ByteSymbol>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - | tally | - anObject isCharacter ifFalse: [ ^0 ]. - anObject asInteger > 255 ifTrue: [ ^0 ]. - tally := 0. - 1 to: self size do: [ :index | - (self at: index) == anObject ifTrue: [ tally := tally + 1 ] ]. - ^tally! Item was removed: - ----- Method: ByteSymbol>>species (in category 'accessing') ----- - species - "Answer the preferred class for reconstructing the receiver." - ^ByteString - ! Item was removed: - ComposedSortFunction subclass: #ChainedSortFunction - instanceVariableNames: 'nextFunction' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !ChainedSortFunction commentStamp: 'nice 11/7/2017 22:14' prior: 0! - I add to my parent the idea of a "next" function to use when two objects are equal by my primary sort function. - - Usage - - SortFunctions can be chained together in primary, secondary, tertiary, etc order using the comma method. Consider a sequence of customer objects, where each customer object responds to the messages firstName, lastName, and age. If we want to sort them lastName first, then firstName, and finally oldest first, we would use an expression like: - - customers sort: #lastName ascending, #firstName ascending, #age descending - - As noted in my super's comment, unary symbols or single arg blocks can be used. One can omit the the ascending methods on arguments (not the receiver), it will default blocks or symbols to be ascending if none is specified. In other words, the above expression could be simplified slightly as - - customers sort: #lastName ascending, #firstName, #age descending - - (note the missing ascending on the #firstName argument) - - Instance Variables - baseSortFunction <SortFunction> the primary SortFunction to collate given objects - next Function <SortFunction> the next SortFunction to evaluate in the event primary collation results are equal values! Item was removed: - ----- Method: ChainedSortFunction class>>startWith:then: (in category 'instance creation') ----- - startWith: aSortFunction then: nextSortFunction - ^self new - baseSortFunction: aSortFunction; - nextFunction: nextSortFunction! Item was removed: - ----- Method: ChainedSortFunction>>, (in category 'converting') ----- - , aSortFunction - - ^self class startWith: baseSortFunction then: nextFunction , aSortFunction! Item was removed: - ----- Method: ChainedSortFunction>>= (in category 'comparing') ----- - = anObject - "Answer whether the receiver and anObject represent the same object." - - self == anObject - ifTrue: [ ^ true ]. - self class = anObject class - ifFalse: [ ^ false ]. - ^ baseSortFunction = anObject baseSortFunction - and: [ nextFunction = anObject nextFunction ]! Item was removed: - ----- Method: ChainedSortFunction>>collate:with: (in category 'evaluating') ----- - collate: anObject1 with: anObject2 - "If the result of current function is 0, then pass on to the next function to work it out" - - | result | - result := baseSortFunction collate: anObject1 with: anObject2. - ^result isZero - ifTrue: [nextFunction collate: anObject1 with: anObject2.] - ifFalse: [result]! Item was removed: - ----- Method: ChainedSortFunction>>hash (in category 'comparing') ----- - hash - "Answer an integer value that is related to the identity of the receiver." - - ^ super hash + nextFunction hash! Item was removed: - ----- Method: ChainedSortFunction>>nextFunction (in category 'accessing') ----- - nextFunction - ^nextFunction! Item was removed: - ----- Method: ChainedSortFunction>>nextFunction: (in category 'accessing') ----- - nextFunction: aSortFunction - nextFunction := aSortFunction! Item was removed: - Magnitude immediateSubclass: #Character - instanceVariableNames: '' - classVariableNames: 'AlphaNumericMask ClassificationTable DigitBit DigitValues LetterMask LowercaseBit UppercaseBit' - poolDictionaries: '' - category: 'Collections-Strings'! - - !Character commentStamp: 'mt 3/10/2022 15:35' prior: 0! - I represent a character by storing its associated Unicode code point as an unsigned 30-bit value. Characters are created uniquely, so that all instances of a particular Unicode are identical. My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values. - - Here is my bit layout (1-based, check via #asInteger and #bitAt:): - 1..21 Unicode code point (i.e., 0 to: 16r1FFFFF, valid up to 16r10FFFF) - 22 Reserved - 23..30 User data (1 byte, see below about #leadingChar or "encoding tag") - 31..32 VM-specific (i.e., tagged pointers, not accessible from image) - - The integer value of my instances you can observe in the image can thus range from 0 up to 16r3FFFFFFF. The two highest bits are not accessible. (For simplicity, we just assume those are at the higher end. The VM can also choose to use the two lowest bits, which does not change the in-image perspective.) - - *** - - I. About Character Encoding - - In the early days of Squeak, the bits in each character had the single-byte MacRoman encoding. There was only ByteString, no WideString. The VM (primitives/plugins) provided user-input values in MacRoman, the fonts expected MacRoman for glyph mapping, and source code was stored (.changes, .sources, .st, .cs) in MacRoman. The most prominent non-ASCII character was probably the #annotationSeparator ($· MacRoman code point 225). - - With the release of Squeak 3.8 in June 2005, support for multilingualization (m17n) was added. There were now various text converters (e.g., UTF8TextConverter) and an extensible mechanism to decode platform-specific encodings for Squeak. Since byte streams from files or sockets can have any encoding, the relevant ones concerned user/keyboard input, file paths/names, the platform clipboard, and source code. See the following (sub-)classes: - - - TextConverter - - KeyboardInputInterpreter - - ClipboardInterpreter - - Squeak's internal encoding changed from MacRoman to Latin-1 (i.e., ISO 8859-1), the helper #macToSqueak was introduced, and the #annotationSeparator now had the code point 183 (via SqueakV39.sources). Since the release of Squeak 3.9 in March 2008, both .sources and .changes files have been using the UTF8TextConverter. So, actually, Squeaks character encoding was now plain Unicode code points, which includes Latin-1 for code points 0 to 255 (and ASCII from 0 to 127). - - Older VMs provided MacRoman encoding on all supported platforms. Keyboard input, file paths, clipboard contents. With the introduction of Unicode to Squeak, VMs could now be able to provide Unicode code points (e.g., #win32VMUsesUnicode). However, VMs may just have passed on platform-specifc encodings into the image such as X11 or Windows on a Japanese platform. In that case, Squeak needs to be aware of how to decode that content to get plain Unicode code points. Read more about LanguageEnvironment below. - - - II. Unicode and Han Unification, the "Leading Char" - - As the Unicode standard states, a Unicode code point does not carry the language information. This is a challenge for languages called CJK[V] (i.e., Chinese, Japanese, Korean, [Vietnamese]). Since the characters of those languages are unified and given the same code point, it is not possible to derive language-specific rules for text composition and display directly from characters. - - With the release of Squeak 3.8 and its m17n support, some of the higher bits in each character were used to denote language information. Each time, platform content was decoded (e.g., via UTF8TextConverter), each character was tagged with the currently known LanguageEnvironment via Unicode class >> value: or Character class >> #leadingChar:code:. That tag is known as "encoding tag" or #leadingChar. - - Now, the #leadingChar offers language information that can be used in text composition and display. For example, the (soft) line-break rules in Japanese are not based on whitespace but other characters. See JapaneseEnvironment class >> #isBreakableAt:in:. Also, the concept of "font sets" (see StrikeFontSet and TTCFontSet) uses the tag to select a specific (limited-range) font during text display. See TTCFontSet >> #widthOf: as an example. - - The leading char 0 denotes a language without language-specific information. For historic reasons, this implies a rule set for text composition and display suitable for Western languages. Also, any text converter that processes Latin-1 (i.e., code point < 256) will not set its own leading character so that ByteString can still be used in such situations. For example, the Japanese leading char 5 and a Latin-1 character $a would otherwise result in "(5 << 22) + 97" and thus produce a WideString instead of a more compact ByteString. - - See also: - Unicode class >> #value: - Character class >> #leadingChar:code: - Character >> #leadingChar - Character >> #charCode - - You can browse all senders of 16r3FFFFF to learn about how performance can be improved when working with characters that have a leading char 0. - - - III. Language Environment - - At any given point in time, Squeak has a single, system-wide (i.e., global) language environment. Such a language environment drives the selection of platform-specific content convertes as well as language-specific rules for text composition and display. Each environment has its own #leadingChar, which can be used to tag characters to then find your way back during character-specific operations such as the ones in CharacterScanner. It can also be used to find the correct glyph in a font set (i.e., StrikeFontSet or TTCFontSet). - - In theory, the language environment could be the place where users are informed about missing fonts to display text in a certain language. There is basic support for that via #isFontAvailable and #installFont. Yet, those paths do not scan the current platform for available fonts but only a remote location in the Internet (i.e., #fontDownloadUrls). - - Note that LanguageEnvironment is part of the "Multilingual" package. Applications should therefore use the Locale interface to only depend on the "System" package. - - See: - Locale >> #leadingChar - String >> #applyLanguageInformation: - Text >> #applyLanguageInformation: - - Also note that "language translation" via a NaturalLanguageTranslator is a mechanism independent of language environments and content encoding. That is, for example, your (platform) locale may be "ja-JP" (Japanese/JAPAN) and your environment be JapaneseEnvironment, but your translation still into English (en-US) or German (de-DE) if you prefer that. - - - IV. Chunk Format, ]lang[ tag, and UTF8 .sources/.changes - - Most source code can be expressed with the printable portion of ASCII, that is, code points from 32 to 126. Non-printable control characters can be accessed via selected class-side methods on Character such as "Character cr" and "Character tab" and even "Character space." Only a few go up to code point 255, and even fewer beyond that. All of this is fine since source code files are encoded in UTF8. - - See - Unicode class >> #browseMethodsWithNonAsciiEncoding - Unicode class >> #browseMethodsWithLeadingCharEncoding - - Now, it may happen that some methods store, for example, literal strings that have their #leadingChar set. This affects string comparison (#=), which cannot ignore the leading char for performance reasons. For example, JapaneseEnvironment class >> #isBreakableAt:in: configures the CompositionScanner only when tagged a WideString is composed. One cannot easily see this but exploring the method's literals will reveal it. - - UTF8 encoding can only handle Unicode code points and will thus discard the Squeak-specific leading char (or language information). For Squeak's chunk (i.e., source code) format, similar to the ]style[ tag for storing stand-off text attributes for a string, the language information is stored in a ]lang[ tag for all different ranges in the source string. Consequently, reading source code that has tagged characters will work. - - BE AWARE THAT the systems current #leadingChar may differ from what is stored in source code (literals). That is, the UTF8TextConverter will apply the system's leading char via Unicode class >> value: but that will then be overwritten when the ]lang[ tag is parsed from the chunk. You will not remove these tags by accident with simple insert/remove edits BUT involving the clipboard will often trigger UTF8 conversion and then reset all leading chars on paste. - - - V. Future Work (as of March 2022) - - The use of #leadingChar entails somewhat high maintenance costs. For its currently known use cases -- namely text composition and font selection -- it is simply not worth the effort and not even necessary. - First, text composition can easily be configured through TextStyle and TextAttribute. While the defaults may reside in the system-wide LanguageEnvironment, TextStyle can be specific to an application (or text field), and TextAttribute (maybe a new TextLanguage) can specify language per range like HTML/CSS does it. A quick check whether a certain code point is affected (e.g., cp > 255 or "is in CJK Unified Ideographs" ...) might help with performance. - Second, font selection needs to be more sophisticated than per language. There are fallback fonts, symbol fonts, language-specific fonts. Any font stack must be modeled on the basis of Unicode code points (and Unicode blocks), not a Squeak-specific encoding tag or leading char. - - There are several decoding-specific helpers in very generic places: - - Character >> #asUnicode - - Character >> #isTraditionalDomestic - - WideString >> #isUnicodeStringWithCJK - - WideString >> #includesUnifiedCharacter - - WideString >> #mutateJISX0208StringToUnicode - - WideSymbol >> #mutateJISX0208StringToUnicode - - I think those should be moved to the few places they are actually needed, which is around TextConverter. - - Note that both StrikeFontSet and TTCFontSet are considered "legacy" at this point. Their use is discouraged even though they have not been deprecated along with #leadingChar yet and should work as usual. - - Also note that if we would add a Utf8String (besides ByteString and WideString) in the future, it would not be possible any more to store user data such as the #leadingChar for the characters in such strings. This extra info can only be hold in WideString.! Item was removed: - ----- 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] as: String - ! Item was removed: - ----- 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 - - ! Item was removed: - ----- Method: Character class>>alphabet (in category 'constants') ----- - alphabet - "($a to: $z) as: String" - - ^ 'abcdefghijklmnopqrstuvwxyz' copy! Item was removed: - ----- Method: Character class>>arrowDown (in category 'accessing untypeable characters') ----- - arrowDown - ^ self value: 31! Item was removed: - ----- Method: Character class>>arrowLeft (in category 'accessing untypeable characters') ----- - arrowLeft - ^ self value: 28! Item was removed: - ----- Method: Character class>>arrowRight (in category 'accessing untypeable characters') ----- - arrowRight - ^ self value: 29! Item was removed: - ----- Method: Character class>>arrowUp (in category 'accessing untypeable characters') ----- - arrowUp - ^ self value: 30! Item was removed: - ----- Method: Character class>>backspace (in category 'accessing untypeable characters') ----- - backspace - "Answer the Character representing a backspace." - - ^self value: 8! Item was removed: - ----- Method: Character class>>characterForColumnBreak (in category 'accessing untypeable characters') ----- - characterForColumnBreak - "use a newPage to split columns in character scanners" - ^self newPage! Item was removed: - ----- Method: Character class>>codePoint: (in category 'instance creation') ----- - codePoint: integer - "Return a character whose encoding value is integer. - For ansi compability." - ^self value: integer! Item was removed: - ----- Method: Character class>>constantNameFor: (in category 'private') ----- - constantNameFor: aCharacter - ^ self constantNames - detect: [ :each | (self perform: each) = aCharacter ] - ifNone: [ nil ].! Item was removed: - ----- Method: Character class>>constantNames (in category 'private') ----- - constantNames - ^ #( backspace delete return lf enter delete escape null space tab arrowDown arrowUp arrowLeft arrowRight end home pageDown pageUp euro insert )! Item was removed: - ----- Method: Character class>>cr (in category 'accessing untypeable characters') ----- - cr - "Answer the Character representing a carriage return." - - ^self value: 13! Item was removed: - ----- Method: Character class>>delete (in category 'accessing untypeable characters') ----- - delete - ^ self value: 127! Item was removed: - ----- 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." - - | n | - n := x asInteger. - ^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])! Item was removed: - ----- Method: Character class>>end (in category 'accessing untypeable characters') ----- - end - ^ self value: 4! Item was removed: - ----- Method: Character class>>enter (in category 'accessing untypeable characters') ----- - enter - "Answer the Character representing enter." - - ^self value: 3! Item was removed: - ----- Method: Character class>>escape (in category 'accessing untypeable characters') ----- - escape - "Answer the ASCII ESC character" - - ^self value: 27! Item was removed: - ----- Method: Character class>>euro (in category 'accessing untypeable characters') ----- - euro - "The Euro currency sign, that E with two dashes. The code point is a official unicode ISO/IEC-10646-1" - - ^self value: 16r20AC! Item was removed: - ----- Method: Character class>>home (in category 'accessing untypeable characters') ----- - home - ^ self value: 1! Item was removed: - ----- Method: Character class>>initialize (in category 'class initialization') ----- - initialize - "Character initialize" - - self - initializeClassificationTable; - initializeDigitValues! Item was removed: - ----- 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 and digits of characters with - - bits 0-7: The lower case value of this character or 0, if its greater than 255. - - bits 8-15: The upper case value of this character or 0, if its greater than 255. - - bit 16: lowercase bit (isLowercase == true) - - bit 17: uppercase bit (isUppercase == true) - - bit 18: digit bit (isDigit == true)" - " self initializeClassificationTable " - - | encodedCharSet newClassificationTable | - "Base the table on the EncodedCharset of these characters' leadingChar - 0." - encodedCharSet := EncodedCharSet charsetAt: 0. - - LowercaseBit := 1 bitShift: 16. - UppercaseBit := 1 bitShift: 17. - DigitBit := 1 bitShift: 18. - - "Initialize the letter mask (e.g., isLetter == true)" - LetterMask := LowercaseBit bitOr: UppercaseBit. - - "Initialize the alphanumeric mask (e.g. isAlphaNumeric == true)" - AlphaNumericMask := LetterMask bitOr: DigitBit. - - "Initialize the table based on encodedCharSet." - newClassificationTable := WordArray new: 256. - 0 to: 255 do: [ :code | - | isLowercase isUppercase isDigit lowercaseCode uppercaseCode value | - isLowercase := encodedCharSet isLowercaseCode: code. - isUppercase := encodedCharSet isUppercaseCode: code. - isDigit := encodedCharSet isDigitCode: code. - lowercaseCode := encodedCharSet toLowercaseCode: code. - lowercaseCode > 255 ifTrue: [ lowercaseCode := 0 ]. - uppercaseCode := encodedCharSet toUppercaseCode: code. - uppercaseCode > 255 ifTrue: [ uppercaseCode := 0 ]. - value := (uppercaseCode bitShift: 8) + lowercaseCode. - isLowercase ifTrue: [ value := value bitOr: LowercaseBit ]. - isUppercase ifTrue: [ value := value bitOr: UppercaseBit ]. - isDigit ifTrue: [ value := value bitOr: DigitBit ]. - newClassificationTable at: code + 1 put: value ]. - ClassificationTable := newClassificationTable! Item was removed: - ----- Method: Character class>>initializeDigitValues (in category 'class initialization') ----- - initializeDigitValues - "Initialize the well known digit value of ascii characters. - Note that the DigitValues table is 1-based while ascii values are 0-based, thus the offset +1." - - | newDigitValues | - newDigitValues := Array new: 256 withAll: -1. - "the digits" - 0 to: 9 do: [:i | newDigitValues at: 48 + i + 1 put: i]. - "the uppercase letters" - 10 to: 35 do: [:i | newDigitValues at: 55 + i + 1 put: i]. - "the lowercase letters" - 10 to: 35 do: [:i | newDigitValues at: 87 + i + 1 put: i]. - DigitValues := newDigitValues! Item was removed: - ----- Method: Character class>>insert (in category 'accessing untypeable characters') ----- - insert - ^ self value: 5! Item was removed: - ----- Method: Character class>>leadingChar:code: (in category 'instance creation') ----- - leadingChar: leadChar code: code - - code <= 16rFF ifTrue: [ ^ self value: code "ascii or latin-1" ]. - code > 16r1FFFFF ifTrue: [ self error: 'code is out of range' ]. - - leadChar = 0 ifTrue: [ ^ self value: code "no language info" ]. - leadChar > 16rFF ifTrue: [ self error: 'lead is out of range' ]. - - ^ self value: (leadChar bitShift: 22) + code! Item was removed: - ----- Method: Character class>>lf (in category 'accessing untypeable characters') ----- - lf - "Answer the Character representing a linefeed." - - ^self value: 10! Item was removed: - ----- Method: Character class>>linefeed (in category 'accessing untypeable characters') ----- - linefeed - "Answer the Character representing a linefeed." - - ^self value: 10! Item was removed: - ----- Method: Character class>>nbsp (in category 'accessing untypeable characters') ----- - nbsp - "non-breakable space" - - ^self value: 160! Item was removed: - ----- Method: Character class>>new (in category 'instance creation') ----- - new - "Creating new characters is not allowed." - - self error: 'cannot create new characters'! Item was removed: - ----- Method: Character class>>newPage (in category 'accessing untypeable characters') ----- - newPage - "Answer the Character representing a form feed." - - ^self value: 12! Item was removed: - ----- Method: Character class>>null (in category 'accessing untypeable characters') ----- - null - ^ self value: 0! Item was removed: - ----- Method: Character class>>pageDown (in category 'accessing untypeable characters') ----- - pageDown - ^ self value: 12! Item was removed: - ----- Method: Character class>>pageUp (in category 'accessing untypeable characters') ----- - pageUp - ^ self value: 11! Item was removed: - ----- Method: Character class>>return (in category 'accessing untypeable characters') ----- - return - "Answer the Character representing a carriage return." - - ^self value: 13! Item was removed: - ----- Method: Character class>>separators (in category 'instance creation') ----- - separators - "Answer a collection of the standard ASCII separator characters." - - ^ { Character value: 32. "space" - Character value: 13. "cr" - Character value: 9. "tab" - Character value: 10. "line feed" - Character value: 12. "form feed" - Character value: 1. "start of heading" - } as: String! Item was removed: - ----- Method: Character class>>space (in category 'accessing untypeable characters') ----- - space - "Answer the Character representing a space." - - ^self value: 32! Item was removed: - ----- Method: Character class>>startOfHeader (in category 'accessing untypeable characters') ----- - startOfHeader - - ^ self value: 1 ! Item was removed: - ----- Method: Character class>>tab (in category 'accessing untypeable characters') ----- - tab - "Answer the Character representing a tab." - - ^self value: 9! Item was removed: - ----- Method: Character class>>value: (in category 'instance creation') ----- - value: anInteger - "Answer the Character whose value is anInteger." - <primitive: 170> - ^self primitiveFailed! Item was removed: - ----- Method: Character>>< (in category 'comparing') ----- - < aCharacter - "Answer true if the receiver's value < aCharacter's value." - - ^self asInteger < aCharacter asInteger! Item was removed: - ----- Method: Character>><= (in category 'comparing') ----- - <= aCharacter - "Answer true if the receiver's value <= aCharacter's value." - - ^self asInteger <= aCharacter asInteger! Item was removed: - ----- Method: Character>>= (in category 'comparing') ----- - = aCharacter - "Primitive. Answer if the receiver and the argument are the - same object (have the same object pointer). Optional. See - Object documentation whatIsAPrimitive." - <primitive: 110> - ^self == aCharacter! Item was removed: - ----- Method: Character>>> (in category 'comparing') ----- - > aCharacter - "Answer true if the receiver's value > aCharacter's value." - - ^self asInteger > aCharacter asInteger! Item was removed: - ----- Method: Character>>>= (in category 'comparing') ----- - >= aCharacter - "Answer true if the receiver's value >= aCharacter's value." - - ^self asInteger >= aCharacter asInteger! Item was removed: - ----- Method: Character>>adaptToNumber:andSend: (in category 'converting') ----- - adaptToNumber: rcvr andSend: selector - "If I am involved in arithmetic with a number, convert me to an integer." - - ^ rcvr perform: selector with: self asInteger! Item was removed: - ----- Method: Character>>asCharacter (in category 'converting') ----- - asCharacter - "Answer the receiver itself." - - ^self! Item was removed: - ----- Method: Character>>asInteger (in category 'converting') ----- - asInteger - "Answer the receiver's character code." - <primitive: 171> - ^self primitiveFailed! Item was removed: - ----- Method: Character>>asLowercase (in category 'converting') ----- - asLowercase - "Answer the receiver's matching lowercase Character." - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - | result | - (result := (ClassificationTable at: integerValue + 1) bitAnd: 16rFF) > 0 - ifTrue: [ ^self class value: result ] ]. - ^self class value: (self encodedCharSet toLowercaseCode: integerValue)! Item was removed: - ----- Method: Character>>asString (in category 'converting') ----- - asString - ^ String with: self! Item was removed: - ----- Method: Character>>asSymbol (in category 'converting') ----- - asSymbol - "Answer a Symbol consisting of the receiver as the only element." - - ^Symbol intern: self asString! Item was removed: - ----- Method: Character>>asText (in category 'converting') ----- - asText - ^ self asString asText! Item was removed: - ----- Method: Character>>asUnicode (in category 'converting') ----- - asUnicode - "Answer the unicode encoding of the receiver. Use this method only in a TextConverter or similar. Maybe we should move this out of Character because it is very specific to the point in time where external content is decoded into Unicode code points. See senders. The indirection via #leadingChar and #encodedCharSet is unnecessarily complicated." - - | integerValue | - (integerValue := self asInteger) <= 16r3FFFFF ifTrue: [ ^integerValue ]. - ^self encodedCharSet convertToUnicode: (integerValue bitAnd: 16r3FFFFF) - ! Item was removed: - ----- Method: Character>>asUppercase (in category 'converting') ----- - asUppercase - "Answer the receiver's matching uppercase Character." - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - | result | - (result := ((ClassificationTable at: integerValue + 1) bitShift: -8) bitAnd: 16rFF) > 0 - ifTrue: [ ^self class value: result ] ]. - ^self class value: (self encodedCharSet toUppercaseCode: integerValue)! Item was removed: - ----- Method: Character>>asciiValue (in category 'accessing') ----- - asciiValue - "Answer the receiver's character code. - This will be ascii for characters with value <= 127, - and Unicode for those with higher values." - <primitive: 171> - ^self primitiveFailed! Item was removed: - ----- Method: Character>>canBeGlobalVarInitial (in category 'testing') ----- - canBeGlobalVarInitial - - ^self encodedCharSet canBeGlobalVarInitial: self! Item was removed: - ----- Method: Character>>canBeIdentifierInitial (in category 'testing') ----- - canBeIdentifierInitial - ^ self == $_ or: [self isLetter]! Item was removed: - ----- Method: Character>>canBeNonGlobalVarInitial (in category 'testing') ----- - canBeNonGlobalVarInitial - - ^self encodedCharSet canBeNonGlobalVarInitial: self - ! Item was removed: - ----- Method: Character>>charCode (in category 'accessing') ----- - charCode - "Drop the #leadingChar. See #leadingChar:code:." - - ^ self asInteger bitAnd: 16r3FFFFF! Item was removed: - ----- Method: Character>>codePoint (in category 'accessing') ----- - codePoint - "Return the encoding value of the receiver. Until we stop supporting #leadingChar, we must forward to #charCode not #asInteger to get actual Unicode code points." - - ^ self charCode! Item was removed: - ----- Method: Character>>deepCopy (in category 'copying') ----- - deepCopy - "Answer the receiver, because Characters are unique." - ^self! Item was removed: - ----- 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." - - | integerValue | - (integerValue := self asInteger) > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self]. - ^DigitValues at: integerValue + 1! Item was removed: - ----- Method: Character>>encodedCharSet (in category 'accessing') ----- - encodedCharSet - - self asInteger <= 16r3FFFFF ifTrue: [ ^Unicode ]. "Shortcut" - ^EncodedCharSet charsetAt: self leadingChar - ! Item was removed: - ----- Method: Character>>hash (in category 'comparing') ----- - hash - "Hash is reimplemented because = is implemented. - Answer the receiver's character code." - <primitive: 171> - ^self primitiveFailed! Item was removed: - ----- Method: Character>>hex (in category 'printing') ----- - hex - ^self asInteger printStringBase: 16! Item was removed: - ----- Method: Character>>identityHash (in category 'comparing') ----- - identityHash - "Answer the receiver's character code." - <primitive: 171> - ^self primitiveFailed! Item was removed: - ----- Method: Character>>isAlphaNumeric (in category 'testing') ----- - isAlphaNumeric - "Answer whether the receiver is a letter or a digit." - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - ^((ClassificationTable at: integerValue + 1) bitAnd: AlphaNumericMask) > 0 ]. - ^self encodedCharSet isAlphaNumeric: self! Item was removed: - ----- Method: Character>>isAscii (in category 'testing') ----- - isAscii - - ^self asInteger < 128! Item was removed: - ----- Method: Character>>isCharacter (in category 'testing') ----- - isCharacter - - ^ true. - ! Item was removed: - ----- Method: Character>>isDigit (in category 'testing') ----- - isDigit - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - ^((ClassificationTable at: integerValue + 1) bitAnd: DigitBit) > 0 ]. - ^self encodedCharSet isDigit: self. - ! Item was removed: - ----- Method: Character>>isLetter (in category 'testing') ----- - isLetter - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - ^((ClassificationTable at: integerValue + 1) bitAnd: LetterMask) > 0 ]. - ^self encodedCharSet isLetter: self! Item was removed: - ----- Method: Character>>isLiteral (in category 'testing') ----- - isLiteral - - ^true! Item was removed: - ----- Method: Character>>isLowercase (in category 'testing') ----- - isLowercase - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - ^((ClassificationTable at: integerValue + 1) bitAnd: LowercaseBit) > 0 ]. - ^self encodedCharSet isLowercase: self. - ! Item was removed: - ----- Method: Character>>isOctetCharacter (in category 'testing') ----- - isOctetCharacter - - ^ self asInteger < 256. - ! Item was removed: - ----- 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)]]! Item was removed: - ----- 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." - - | integerValue | - (integerValue := self asInteger) > 32 ifTrue: [ ^false ]. - integerValue - caseOf: { - [ 32 "space" ] -> [ ^true ]. - [ 9 "tab" ] -> [ ^true ]. - [ 13 "cr"] -> [ ^true ]. - [ 10 "line feed" ] -> [ ^true ]. - [ 12 "form feed"] -> [ ^true ]. - [ 1 "start of heading"] -> [ ^true ] } - otherwise: [ ^false ]! Item was removed: - ----- Method: Character>>isSpecial (in category 'testing') ----- - isSpecial - "Answer whether the receiver is one of the special characters" - - ^'+-/\*~<>=@,%|&?!!' includes: self! Item was removed: - ----- 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." - ^ (self encodedCharSet isKindOf: LanguageEnvironment class) not! Item was removed: - ----- Method: Character>>isUppercase (in category 'testing') ----- - isUppercase - - | integerValue | - (integerValue := self asInteger) > 255 ifFalse: [ - ^((ClassificationTable at: integerValue + 1) bitAnd: UppercaseBit) > 0 ]. - ^self encodedCharSet isUppercase: self. - ! Item was removed: - ----- 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! Item was removed: - ----- Method: Character>>isoToSqueak (in category 'converting') ----- - isoToSqueak - - self flag: #deprecated. - ^self "no longer needed"! Item was removed: - ----- Method: Character>>leadingChar (in category 'accessing') ----- - leadingChar - "Answer the value of the 8 highest bits which is used to identify the language. - This is mostly used for east asian languages CJKV as a workaround against unicode han-unification." - ^ self asInteger bitShift: -22! Item was removed: - ----- Method: Character>>macToSqueak (in category 'converting') ----- - macToSqueak - "Convert the receiver from MacRoman to Squeak encoding" - | asciiValue | - self asInteger < 128 ifTrue: [^ self]. - self asInteger > 255 ifTrue: [^ self]. - asciiValue := #[ - 196 197 199 201 209 214 220 225 224 226 228 227 229 231 233 232 "80-8F" - 234 235 237 236 238 239 241 243 242 244 246 245 250 249 251 252 "90-9F" - 134 176 162 163 167 149 182 223 174 169 153 180 168 128 198 216 "A0-AF" - 129 177 138 141 165 181 142 143 144 154 157 170 186 158 230 248 "B0-BF" - 191 161 172 166 131 173 178 171 187 133 160 192 195 213 140 156 "C0-CF" - 150 151 147 148 145 146 247 179 255 159 185 164 139 155 188 189 "D0-DF" - 135 183 130 132 137 194 202 193 203 200 205 206 207 204 211 212 "E0-EF" - 190 210 218 219 217 208 136 152 175 215 221 222 184 240 253 254 ] "F0-FF" - at: self asInteger - 127. - ^ Character value: asciiValue.! Item was removed: - ----- Method: Character>>nextObject (in category 'system primitives') ----- - nextObject - "Characters are immediate objects, and, as such, do not have successors in object memory." - - self shouldNotImplement ! Item was removed: - ----- 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] - ! Item was removed: - ----- Method: Character>>printAsLiteralOn: (in category 'printing') ----- - printAsLiteralOn: aStream - aStream nextPut: $$; nextPut: self! Item was removed: - ----- Method: Character>>printOn: (in category 'printing') ----- - printOn: aStream - | integerValue | - ((integerValue := self asInteger) > 32 and: [integerValue ~= 127]) ifTrue: - [^self printAsLiteralOn: aStream]. - (self class constantNameFor: self) - ifNotNil: [ :name | aStream nextPutAll: self class name; space; nextPutAll: name ] - ifNil: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: integerValue ]! Item was removed: - ----- Method: Character>>sameAs: (in category 'comparing') ----- - sameAs: aCharacter - "Answer whether the receiver is equal to aCharacter, ignoring case" - - self == aCharacter ifTrue: [ ^true ]. - ^self asLowercase == aCharacter asLowercase! Item was removed: - ----- Method: Character>>shallowCopy (in category 'copying') ----- - shallowCopy - "Answer the receiver, because Characters are unique." - ^self! Item was removed: - ----- Method: Character>>shouldBePrintedAsLiteral (in category 'testing') ----- - shouldBePrintedAsLiteral - - | integerValue | - (integerValue := self asInteger) < 33 ifTrue: [ ^false ]. - 255 < integerValue ifTrue: [ ^false ]. - ^integerValue ~= 127! Item was removed: - ----- Method: Character>>shouldBePrintedAsLiteralVisiting: (in category 'testing') ----- - shouldBePrintedAsLiteralVisiting: aSet - - ^self shouldBePrintedAsLiteral! Item was removed: - ----- Method: Character>>squeakToIso (in category 'converting') ----- - squeakToIso - - self flag: #deprecated. - ^self "no longer needed"! Item was removed: - ----- Method: Character>>squeakToMac (in category 'converting') ----- - squeakToMac - "Convert the receiver from Squeak to MacRoman encoding." - self asInteger < 128 ifTrue: [^ self]. - self asInteger > 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: self asInteger - 127) - ! Item was removed: - ----- Method: Character>>storeBinaryOn: (in category 'printing') ----- - storeBinaryOn: aStream - "Store the receiver on a binary (file) stream" - - | integerValue | - (integerValue := self asInteger) < 256 - ifTrue: [ aStream basicNextPut: self ] - ifFalse: [ aStream nextInt32Put: integerValue ]! Item was removed: - ----- Method: Character>>storeDataOn: (in category 'object fileIn') ----- - storeDataOn: aDataStream - " Store characters in reference-like way, with value like instvar. - This is compatible with various Squeak Memory Systems" - - aDataStream - beginInstance: self class - size: 1; - nextPut: self asInteger! Item was removed: - ----- 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." - - self shouldBePrintedAsLiteral ifTrue: - [^self printAsLiteralOn: aStream]. - (self class constantNameFor: self) ifNotNil: [ :name | - aStream nextPutAll: self class name; space; nextPutAll: name. - ^self ]. - aStream - nextPut: $(; nextPutAll: self class name; - nextPutAll: ' value: '; print: self asInteger; nextPut: $)! Item was removed: - ----- Method: Character>>to: (in category 'converting') ----- - to: other - "Answer with a collection in ascii order -- $a to: $z" - ^ (self asInteger to: other asciiValue) - collect: [:ascii | Character value: ascii] - as: String! Item was removed: - ----- Method: Character>>tokenish (in category 'testing') ----- - tokenish - "Answer whether the receiver is a valid token-character--letter, digit, or colon." - - self == $_ ifTrue: [ ^Scanner prefAllowUnderscoreSelectors ]. - ^self == $: or: [ self isAlphaNumeric ]! Item was removed: - ----- Method: Character>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - "Answer the receiver, because Characters are unique." - ^self! Item was removed: - Collection subclass: #CharacterSet - instanceVariableNames: 'byteArrayMap' - classVariableNames: 'Ascii CrLf NonAscii NonSeparators Separators' - poolDictionaries: '' - category: 'Collections-Support'! - - !CharacterSet commentStamp: 'nice 11/17/2019 12:26' prior: 0! - A set of characters. Lookups for inclusion are very fast. - CharacterSet is the abstract class that is visible to the outside world. - Subclasses should be considered as implementation details.! Item was removed: - ----- Method: CharacterSet class>>allCharacters (in category 'instance creation') ----- - allCharacters - "return a set containing all characters" - - ^ self empty complement! Item was removed: - ----- Method: CharacterSet class>>ascii (in category 'accessing') ----- - ascii - "return a set containing all the ASCII characters" - - ^Ascii ifNil: [ Ascii := self newFrom: ((1 to: 127) collect: [:code | code asCharacter]) ]! Item was removed: - ----- Method: CharacterSet class>>cleanUp: (in category 'initialize-release') ----- - cleanUp: aggressive - - CrLf := NonSeparators := Separators := Ascii := NonAscii := nil! Item was removed: - ----- Method: CharacterSet class>>crlf (in category 'accessing') ----- - crlf - - ^CrLf ifNil: [ CrLf := self with: Character cr with: Character lf ]! Item was removed: - ----- Method: CharacterSet class>>empty (in category 'instance creation') ----- - empty - "return an empty set of characters" - ^self new! Item was removed: - ----- Method: CharacterSet class>>isAbstract (in category 'testing') ----- - isAbstract - ^self = CharacterSet! Item was removed: - ----- Method: CharacterSet class>>new (in category 'instance creation') ----- - new - self = CharacterSet ifTrue: [^ByteCharacterSet new]. - ^super new! Item was removed: - ----- Method: CharacterSet class>>newFrom: (in category 'instance creation') ----- - newFrom: aCollection - | newCollection | - newCollection := self new. - newCollection addAll: aCollection. - ^newCollection! Item was removed: - ----- Method: CharacterSet class>>nonAscii (in category 'accessing') ----- - nonAscii - "return a set containing all the non ASCII characters" - - ^NonAscii ifNil: [ NonAscii := self ascii complement ]! Item was removed: - ----- Method: CharacterSet class>>nonSeparators (in category 'accessing') ----- - nonSeparators - "return a set containing everything but the whitespace characters" - - ^NonSeparators ifNil: [ - NonSeparators := self separators complement ]! Item was removed: - ----- Method: CharacterSet class>>separators (in category 'accessing') ----- - separators - "return a set containing just the whitespace characters" - - ^Separators ifNil: [ Separators := self newFrom: Character separators ]! Item was removed: - ----- Method: CharacterSet class>>withAll: (in category 'instance creation') ----- - withAll: aCollection - "Create a new CharacterSet containing all the characters from aCollection." - - ^self newFrom: aCollection! Item was removed: - ----- Method: CharacterSet>>any: (in category 'accessing') ----- - any: numberOfElements - - ^ self any: numberOfElements as: Array! Item was removed: - ----- Method: CharacterSet>>any:as: (in category 'accessing') ----- - any: numberOfElements as: aClass - - self canBeEnumerated - ifTrue: [^ super any: numberOfElements as: aClass] - ifFalse: [self shouldNotImplement]! Item was removed: - ----- Method: CharacterSet>>as: (in category 'converting') ----- - as: otherClass - otherClass = CharacterSet ifTrue: [^self]. - ^super as: otherClass! Item was removed: - ----- Method: CharacterSet>>byteArrayMap (in category 'accessing') ----- - 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" - ^byteArrayMap ifNil: [byteArrayMap := self createByteArrayMap]! Item was removed: - ----- Method: CharacterSet>>byteComplement (in category 'converting') ----- - byteComplement - "return a character set containing precisely the single byte characters the receiver does not" - - ^ ByteCharacterSet fromMap: (self byteArrayMap collect: [:i | 1 - i])! Item was removed: - ----- Method: CharacterSet>>canBeEnumerated (in category 'testing') ----- - canBeEnumerated - ^true! Item was removed: - ----- Method: CharacterSet>>complement (in category 'converting') ----- - complement - "return a character set containing precisely the characters the receiver does not" - - ^CharacterSetComplement of: self copy! Item was removed: - ----- Method: CharacterSet>>createByteArrayMap (in category 'private') ----- - createByteArrayMap - ^ (0 to: 255) - collect: [:i | (self includesCode: i) ifTrue: [1] ifFalse: [0]] - as: ByteArray! Item was removed: - ----- Method: CharacterSet>>enumerationCost (in category 'private') ----- - enumerationCost - "Answer an integer giving a scale of cost, especially for do: loops." - - ^self subclassResponsibility! Item was removed: - ----- Method: CharacterSet>>findFirstInByteString:startingAt: (in category 'enumerating') ----- - findFirstInByteString: aByteString startingAt: startIndex - "Double dispatching: since we know this is a ByteString, we can use a superfast primitive using a ByteArray map with 0 slots for byte characters not included and 1 for byte characters included in the receiver." - ^ByteString - findFirstInString: aByteString - inSet: self byteArrayMap - startingAt: startIndex! Item was removed: - ----- Method: CharacterSet>>includes: (in category 'testing') ----- - includes: anObject - anObject isCharacter ifFalse: [ ^false ]. - ^self includesCode: anObject asInteger! Item was removed: - ----- Method: CharacterSet>>includesCode: (in category 'testing') ----- - includesCode: anInteger - ^self subclassResponsibility! Item was removed: - ----- Method: CharacterSet>>intersection: (in category 'enumerating') ----- - intersection: aCollection - (self species = aCollection species and: [aCollection enumerationCost < self enumerationCost]) ifTrue: [^aCollection intersection: self]. - ^ self select: [:each | aCollection includes: each]! Item was removed: - ----- Method: CharacterSet>>isCharacters: (in category 'testing') ----- - isCharacters: aCollection - "Answer whether this collection contains characters" - ^self species = aCollection species or: [aCollection isString or: [aCollection allSatisfy: [:e | e isCharacter]]]! Item was removed: - ----- Method: CharacterSet>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - (self includes: anObject) ifTrue: [ ^1 ]. - ^0! Item was removed: - ----- Method: CharacterSet>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - byteArrayMap := byteArrayMap copy! Item was removed: - ----- Method: CharacterSet>>removeAll (in category 'removing') ----- - removeAll - self becomeForward: ByteCharacterSet new! Item was removed: - ----- Method: CharacterSet>>species (in category 'private') ----- - species - ^CharacterSet! Item was removed: - ----- Method: CharacterSet>>union: (in category 'enumerating') ----- - union: aCollection - (self isCharacters: aCollection) ifFalse: [^super union: aCollection]. - (self species = aCollection species and: [aCollection enumerationCost > self enumerationCost]) ifTrue: [^aCollection union: self]. - ^self copy addAll: aCollection; yourself! Item was removed: - CharacterSet subclass: #CharacterSetComplement - instanceVariableNames: 'absent' - 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! Item was removed: - ----- Method: CharacterSetComplement class>>of: (in category 'instance creation') ----- - of: aCharacterSet - "answer the complement of aCharacterSet" - - ^ self new complement: aCharacterSet! Item was removed: - ----- 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 ]! Item was removed: - ----- Method: CharacterSetComplement>>add: (in category 'adding') ----- - add: aCharacter - "a character is present if not absent, so adding a character is removing it from the absent" - - (absent includes: aCharacter) - ifTrue: - [byteArrayMap := nil. - absent remove: aCharacter]. - ^ aCharacter! Item was removed: - ----- Method: CharacterSetComplement>>canBeEnumerated (in category 'testing') ----- - canBeEnumerated - ^false! Item was removed: - ----- Method: CharacterSetComplement>>complement (in category 'converting') ----- - complement - "return a character set containing precisely the characters the receiver does not" - - ^absent copy! Item was removed: - ----- Method: CharacterSetComplement>>complement: (in category 'initialize-release') ----- - complement: aCharacterSet - "initialize with the complement" - - byteArrayMap := nil. - absent := aCharacterSet. - ! Item was removed: - ----- Method: CharacterSetComplement>>do: (in category 'enumerating') ----- - do: aBlock - "evaluate aBlock with each character in the set. - don't do it, there are too many..." - - self shouldNotImplement! Item was removed: - ----- Method: CharacterSetComplement>>enumerationCost (in category 'private') ----- - enumerationCost - "The maximum cost. I can't even do: loops, it's too expensive." - - ^100! Item was removed: - ----- Method: CharacterSetComplement>>hasWideCharacters (in category 'testing') ----- - hasWideCharacters - "This is a guess that absent is not holding each and every possible wideCharacter..." - - ^true! Item was removed: - ----- Method: CharacterSetComplement>>hash (in category 'comparing') ----- - hash - ^ absent hash bitXor: self class hash! Item was removed: - ----- Method: CharacterSetComplement>>includesCode: (in category 'testing') ----- - includesCode: anInteger - (absent includesCode: anInteger) ifTrue: [ ^false ]. - ^true! Item was removed: - ----- Method: CharacterSetComplement>>intersection: (in category 'enumerating') ----- - intersection: aCollection - aCollection class = self class ifTrue: [^(self complement union: aCollection complement) complement]. - ^(aCollection intersection: self) as: CharacterSet! Item was removed: - ----- Method: CharacterSetComplement>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - absent := absent copy! Item was removed: - ----- 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.! Item was removed: - ----- Method: CharacterSetComplement>>reject: (in category 'enumerating') ----- - reject: aBlock - ^LazyCharacterSet including: [:c | (absent includes: c) not and: [(aBlock value: c) not]]! Item was removed: - ----- Method: CharacterSetComplement>>remove: (in category 'removing') ----- - remove: aCharacter - "This means aCharacter is now absent from myself. - It must be added to my absent." - - byteArrayMap := nil. - ^absent add: aCharacter! Item was removed: - ----- Method: CharacterSetComplement>>remove:ifAbsent: (in category 'removing') ----- - remove: aCharacter ifAbsent: aBlock - (self includes: aCharacter) ifFalse: [^aBlock value]. - ^self remove: aCharacter! Item was removed: - ----- Method: CharacterSetComplement>>select: (in category 'enumerating') ----- - select: aBlock - ^LazyCharacterSet including: [:c | (absent includes: c) not and: [aBlock value: c]]! Item was removed: - ----- 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.! Item was removed: - ----- Method: CharacterSetComplement>>union: (in category 'enumerating') ----- - union: aCollection - aCollection class = self class ifTrue: [^(self complement intersection: aCollection complement) complement]. - (self isCharacters: aCollection) ifFalse: [^super union: aCollection]. - ^(absent reject: [:e | aCollection includes: e]) complement! Item was removed: - SortFunction subclass: #CollatorBlockFunction - instanceVariableNames: 'collatorBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !CollatorBlockFunction commentStamp: 'nice 11/5/2017 22:57' prior: 0! - A CollatorBlockFunction is a special SortFunction using a dyadic block to collate objects. - - Instance Variables - - collator <Block> a dyadic block that must return a -1, 0, or 1.! Item was removed: - ----- Method: CollatorBlockFunction class>>usingBlock: (in category 'instance creation') ----- - usingBlock: twoArgsBlock - ^self new - collatorBlock: twoArgsBlock! Item was removed: - ----- Method: CollatorBlockFunction>>= (in category 'comparing') ----- - = anObject - "Answer whether the receiver and anObject represent the same object." - - self == anObject - ifTrue: [ ^ true ]. - self class = anObject class - ifFalse: [ ^ false ]. - ^collatorBlock = anObject collatorBlock! Item was removed: - ----- Method: CollatorBlockFunction>>collate:with: (in category 'evaluating') ----- - collate: anObject1 with: anObject2 - - ^collatorBlock value: anObject1 value: anObject2 ! Item was removed: - ----- Method: CollatorBlockFunction>>collatorBlock (in category 'accessing') ----- - collatorBlock - ^collatorBlock! Item was removed: - ----- Method: CollatorBlockFunction>>collatorBlock: (in category 'accessing') ----- - collatorBlock: aBlock - collatorBlock := aBlock! Item was removed: - ----- Method: CollatorBlockFunction>>hash (in category 'comparing') ----- - hash - "Answer an integer value that is related to the identity of the receiver." - - ^ collatorBlock hash! Item was removed: - Object subclass: #Collection - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Abstract'! - - !Collection commentStamp: '<historical>' prior: 0! - I am the abstract superclass of all classes that represent a group of elements.! Item was removed: - ----- Method: Collection class>>initialize (in category 'class initialization') ----- - initialize - "Set up a Random number generator to be used by atRandom when the - user does not feel like creating his own Random generator." - - Smalltalk addToStartUpList: self! Item was removed: - ----- Method: Collection class>>isAbstract (in category 'testing') ----- - isAbstract - ^self = Collection! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection class>>with: (in category 'instance creation') ----- - with: anObject - "Answer an instance of me containing anObject." - - ^ self new - add: anObject; - yourself! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>* (in category 'arithmetic') ----- - * arg - - ^ arg adaptToCollection: self andSend: #*! Item was removed: - ----- Method: Collection>>+ (in category 'arithmetic') ----- - + arg - - ^ arg adaptToCollection: self andSend: #+! Item was removed: - ----- Method: Collection>>, (in category 'copying') ----- - , aCollection - - ^ self copy addAll: aCollection asCollection; yourself! Item was removed: - ----- Method: Collection>>- (in category 'arithmetic') ----- - - arg - - ^ arg adaptToCollection: self andSend: #-! Item was removed: - ----- Method: Collection>>/ (in category 'arithmetic') ----- - / arg - - ^ arg adaptToCollection: self andSend: #/! Item was removed: - ----- Method: Collection>>// (in category 'arithmetic') ----- - // arg - - ^ arg adaptToCollection: self andSend: #//! Item was removed: - ----- Method: Collection>>\\ (in category 'arithmetic') ----- - \\ arg - - ^ arg adaptToCollection: self andSend: #\\! Item was removed: - ----- Method: Collection>>abs (in category 'math functions') ----- - abs - "Absolute value of all elements in the collection" - ^ self collect: [:a | a abs]! Item was removed: - ----- 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]! Item was removed: - ----- 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]! Item was removed: - ----- 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]! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>add:withOccurrences: (in category 'adding') ----- - add: newObject withOccurrences: anInteger - "Add newObject anInteger times to the receiver. Do nothing if anInteger is less than one. Answer newObject." - - anInteger timesRepeat: [self add: newObject]. - ^ newObject! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>addAllFirstTo: (in category 'adding') ----- - addAllFirstTo: anOrderedCollection - "Add all of my elements to the beginning of anOrderedCollection" - - self do: [ :each | anOrderedCollection addFirst: each ]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>any: (in category 'accessing') ----- - any: numberOfElements - - ^ self any: numberOfElements as: self species! Item was removed: - ----- Method: Collection>>any:as: (in category 'accessing') ----- - any: numberOfElements as: aClass - "Enumerate this collection and return the specified number of elements. Signals an error if this collection has not enough elements." - - | index result | - index := 0. - result := aClass new: numberOfElements. - - result fillFrom: self with: [:each | - (index := index + 1) > numberOfElements - ifTrue: [^ result] - ifFalse: [each]]. - - index = numberOfElements - ifFalse: [self error: 'Not enough elements in this collection.']. - - ^ result! Item was removed: - ----- 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 do: [:each | ^ each]. - self errorEmptyCollection! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>arcCos (in category 'math functions') ----- - arcCos - ^self collect: [:each | each arcCos]! Item was removed: - ----- Method: Collection>>arcSin (in category 'math functions') ----- - arcSin - ^self collect: [:each | each arcSin]! Item was removed: - ----- Method: Collection>>arcTan (in category 'math functions') ----- - arcTan - ^self collect: [:each | each arcTan]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>asBag (in category 'converting') ----- - asBag - "Answer a Bag whose elements are the elements of the receiver." - - ^ Bag withAll: self! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>asCollection (in category 'converting') ----- - asCollection - - ^ self! Item was removed: - ----- Method: Collection>>asCommaString (in category 'printing - obsolete') ----- - asCommaString - "Return collection printed as 'a, b, c' " - - self flag: #deprecate. - ^ self asArray joinSeparatedBy: ', ' - ! Item was removed: - ----- Method: Collection>>asCommaStringAnd (in category 'printing - obsolete') ----- - asCommaStringAnd - "Return collection printed as 'a, b and c' " - - self flag: #deprecate. - ^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ' and '] - ! Item was removed: - ----- Method: Collection>>asIdentitySet (in category 'converting') ----- - asIdentitySet - ^(IdentitySet new: self size) addAll: self; yourself! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>asSet (in category 'converting') ----- - asSet - "Answer a Set whose elements are the unique elements of the receiver." - - ^ Set withAll: self! Item was removed: - ----- 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! Item was removed: - ----- 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. - Use #sorted: if you don't really need a SortedCollection, but a sorted collection!!" - - ^self as: SortedCollection! Item was removed: - ----- 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. - Use #sorted: if you don't really need a SortedCollection, but a sorted collection!!" - - | aSortedCollection | - aSortedCollection := SortedCollection new: self size. - aSortedCollection sortBlock: aSortBlock. - aSortedCollection addAll: self. - ^ aSortedCollection! Item was removed: - ----- Method: Collection>>asStringOn:delimiter: (in category 'printing - obsolete') ----- - asStringOn: aStream delimiter: delimString - - self flag: #deprecate. - ^ self asArray joinOn: aStream separatedBy: delimString! Item was removed: - ----- Method: Collection>>asStringOn:delimiter:last: (in category 'printing - obsolete') ----- - 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 | - self flag: #deprecate. - - n := 1. - sz := self size. - self do: [:elem | - n := n + 1. - aStream nextPutAll: elem asString] - separatedBy: [ - aStream nextPutAll: (n = sz ifTrue: [lastDelimString] ifFalse: [delimString])]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>atRandom (in category 'accessing') ----- - atRandom - "Answer a random element of the receiver. Uses the process-local random number generator. Causes an error if self has no elements." - - ^self atRandom: ThreadSafeRandom value - - "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) - "! Item was removed: - ----- Method: Collection>>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." - - | randomIndex index | - self emptyCheck. - randomIndex := aGenerator nextInt: self size. - index := 1. - self do: [ :each | - index = randomIndex ifTrue: [ ^each ]. - index := index + 1 ]! Item was removed: - ----- Method: Collection>>average (in category 'math functions') ----- - average - ^ self sum / self size! Item was removed: - ----- Method: Collection>>capacity (in category 'accessing') ----- - capacity - "Answer the current capacity of the receiver." - - ^ self size! Item was removed: - ----- Method: Collection>>ceiling (in category 'math functions') ----- - ceiling - ^ self collect: [:a | a ceiling]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>collect:as: (in category 'enumerating') ----- - collect: aBlock as: aClass - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect the resulting values into an instance of aClass. Answer the resulting collection." - - ^(aClass new: self size) fillFrom: self with: aBlock! Item was removed: - ----- Method: Collection>>collect:into: (in category 'enumerating') ----- - collect: aBlock into: aCollection - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect the resulting values into aCollection. Answer aCollection." - - ^aCollection fillFrom: self with: aBlock! Item was removed: - ----- Method: Collection>>collect:thenDo: (in category 'enumerating') ----- - collect: collectBlock thenDo: doBlock - "Utility method to improve readability." - ^ (self collect: collectBlock) do: doBlock! Item was removed: - ----- Method: Collection>>collect:thenSelect: (in category 'enumerating') ----- - collect: collectBlock thenSelect: selectBlock - "Utility method to improve readability." - - ^ (self collect: collectBlock) select: selectBlock! Item was removed: - ----- Method: Collection>>contains: (in category 'testing') ----- - contains: aBlock - "VW compatibility" - ^self anySatisfy: aBlock! Item was removed: - ----- Method: Collection>>contents (in category 'filter streaming') ----- - contents - ^ self! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>copyWithDependent: (in category 'copying') ----- - copyWithDependent: newElement - "Answer a new collection with newElement added (as last - element if sequenceable)." - ^self copyWith: newElement! Item was removed: - ----- 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 - "! Item was removed: - ----- 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]! Item was removed: - ----- Method: Collection>>cos (in category 'math functions') ----- - cos - ^self collect: [:each | each cos]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>degreeCos (in category 'math functions') ----- - degreeCos - ^self collect: [:each | each degreeCos]! Item was removed: - ----- Method: Collection>>degreeSin (in category 'math functions') ----- - degreeSin - ^self collect: [:each | each degreeSin]! Item was removed: - ----- 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. If there is - no such element, raise an error." - - ^ self - detect: aBlock - ifFound: [:element | element] - ifNone: [self errorNotFound: aBlock]! Item was removed: - ----- Method: Collection>>detect:ifFound: (in category 'enumerating') ----- - detect: aBlock ifFound: foundBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - Answer the first element for which aBlock evaluates to true. If there is - no such element, return nil." - - ^ self - detect: aBlock - ifFound: foundBlock - ifNone: nil! Item was removed: - ----- Method: Collection>>detect:ifFound:ifNone: (in category 'enumerating') ----- - detect: aBlock ifFound: foundBlock ifNone: exceptionBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - If there is any element for which aBlock evaluates to true, then evaluate - foundBlock with that element and answer the result of that foundBlock. - If aBlock does never evaluate to true, evaluate exceptionBlock, which - may or may not raise an error." - - self do: [:each | (aBlock value: each) ifTrue: [^ foundBlock value: each]]. - ^ exceptionBlock value - ! Item was removed: - ----- 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 there is - no such element, evaluate exceptionBlock." - - ^ self - detect: aBlock - ifFound: [:element | element] - ifNone: exceptionBlock! Item was removed: - ----- 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 | - self do: [:each | | val | - maxValue - ifNotNil: [ - (val := aBlock value: each) > maxValue - ifTrue: [ - maxElement := each. - maxValue := val ] ] - ifNil: [ - "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! Item was removed: - ----- 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 | - self do: [:each | | val | - minValue - ifNotNil: [ - (val := aBlock value: each) < minValue - ifTrue: [ - minElement := each. - minValue := val ] ] - ifNil: [ - "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! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>difference: (in category 'set logic') ----- - difference: aCollection - "Answer the set theoretic difference of two collections." - - ^ self reject: [:each | aCollection includes: each]! Item was removed: - ----- Method: Collection>>do: (in category 'enumerating') ----- - do: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument." - - self subclassResponsibility! Item was removed: - ----- Method: Collection>>do:displayingProgress: (in category 'enumerating') ----- - do: aBlock displayingProgress: aStringOrBlock - "Enumerate aBlock displaying progress information. - If the argument is a string, use a static label for the process. - If the argument is a block, evaluate it with the element to retrieve the label. - Smalltalk allClasses - do:[:aClass| (Delay forMilliseconds: 1) wait] - displayingProgress: 'Processing...'. - Smalltalk allClasses - do:[:aClass| (Delay forMilliseconds: 1) wait] - displayingProgress:[:aClass| 'Processing ', aClass name]. - " - ^self do: aBlock displayingProgress: aStringOrBlock every: 20! Item was removed: - ----- Method: Collection>>do:displayingProgress:every: (in category 'enumerating') ----- - do: aBlock displayingProgress: aStringOrBlock every: msecs - "Enumerate aBlock displaying progress information. - If the argument is a string, use a static label for the process. - If the argument is a block, evaluate it with the element to retrieve the label. - The msecs argument ensures that updates happen at most every msecs. - Example: - Smalltalk allClasses - do:[:aClass| (Delay forMilliseconds: 1) wait] - displayingProgress:[:aClass| 'Processing ', aClass name] - every: 0. - Smalltalk allClasses - do:[:aClass| (Delay forMilliseconds: 1) wait] - displayingProgress:[:aClass| 'Processing ', aClass name] - every: 100. - " - | size labelBlock count oldLabel lastUpdate | - labelBlock := aStringOrBlock isString - ifTrue:[[:item| aStringOrBlock]] - ifFalse:[aStringOrBlock]. - oldLabel := nil. - count := lastUpdate := 0. - size := self size. - '' displayProgressFrom: 0 to: size during:[:bar | - self do:[:each| | newLabel | - "Special handling for first and last element" - (count = 0 or:[count+1 = size - or:[(Time millisecondsSince: lastUpdate) >= msecs]]) ifTrue:[ - bar value: count. - oldLabel = (newLabel := (labelBlock value: each) ifNil:[oldLabel]) ifFalse:[ - ProgressNotification signal: '' extra: (oldLabel := newLabel). - ]. - lastUpdate := Time millisecondClockValue. - ]. - aBlock value: each. - count := count + 1. - ]]! Item was removed: - ----- 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]! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Collection>>emptyCheck (in category 'private') ----- - emptyCheck - - self isEmpty ifTrue: [self errorEmptyCollection]! Item was removed: - ----- Method: Collection>>errorDifferentSize (in category 'private') ----- - errorDifferentSize - - ^ self error: 'Other collection must be the same size' translated! Item was removed: - ----- Method: Collection>>errorEmptyCollection (in category 'private') ----- - errorEmptyCollection - - ^ self error: 'This collection is empty' translated! Item was removed: - ----- Method: Collection>>errorKeyNotFound: (in category 'private') ----- - errorKeyNotFound: key - "Signal KeyNotFound error" - ^(KeyNotFound key: key) signal! Item was removed: - ----- Method: Collection>>errorNoMatch (in category 'private') ----- - errorNoMatch - - ^ self error: 'Collection sizes do not match' translated! Item was removed: - ----- Method: Collection>>errorNotFound: (in category 'private') ----- - errorNotFound: anObject - "anObject was not found in this collection, raise appropriate error." - - ^(NotFound object: anObject) signal! Item was removed: - ----- Method: Collection>>errorNotKeyed (in category 'private') ----- - errorNotKeyed - - self error: ('Instances of {1} do not respond to keyed accessing messages.' translated format: {self class name}) - ! Item was removed: - ----- Method: Collection>>exp (in category 'math functions') ----- - exp - ^self collect: [:each | each exp]! Item was removed: - ----- Method: Collection>>fillFrom:with: (in category 'private') ----- - fillFrom: aCollection with: aBlock - "Evaluate aBlock with each of aCollections's elements as the argument. - Collect the resulting values into self. Answer self." - - aCollection do: [ :each | - self add: (aBlock value: each) ]! Item was removed: - ----- Method: Collection>>findFirstInByteString:startingAt: (in category 'enumerating') ----- - findFirstInByteString: aByteString startingAt: start - "Find the index of first character starting at start in aByteString that is included in the receiver. - Default is to use a naive algorithm. - Subclasses might want to implement a more efficient scheme" - - start to: aByteString size do: - [:index | - (self includes: (aByteString at: index)) ifTrue: [^ index]]. - ^ 0! Item was removed: - ----- Method: Collection>>flattenOnStream: (in category 'filter streaming') ----- - flattenOnStream: aStream - ^ aStream writeCollection: self! Item was removed: - ----- Method: Collection>>floor (in category 'math functions') ----- - floor - ^ self collect: [:a | a floor]! Item was removed: - ----- Method: Collection>>fold: (in category 'enumerating') ----- - fold: binaryBlock - "Evaluate the block with the first two elements of the receiver, - then with the result of the first evaluation and the next element, - and so on. Answer the result of the final evaluation. If the receiver - is empty, raise an error. If the receiver has a single element, answer - that element." - "#('if' 'it' 'is' 'to' 'be' 'it' 'is' 'up' 'to' 'me') fold: [:a :b | a, ' ', b]" - - ^self reduce: binaryBlock! Item was removed: - ----- Method: Collection>>gather: (in category 'enumerating') ----- - gather: aBlock - ^ Array streamContents: - [:stream | - self do: [:ea | stream nextPutAll: (aBlock value: ea)]]! Item was removed: - ----- Method: Collection>>groupBy: (in category 'enumerating') ----- - groupBy: keyBlock - "Like in SQL operation - Split the recievers contents into collections of elements for which keyBlock returns the same results, and return them." - - | result | - result := Dictionary new. - self do: [ :each | - | key | - key := keyBlock value: each. - (result at: key ifAbsentPut: [ OrderedCollection new ]) - add: each ]. - ^result! Item was removed: - ----- 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." - - ^(self groupBy: keyBlock) select: selectBlock! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>histogramOf: (in category 'converting') ----- - histogramOf: aBlock - - ^ self collect: aBlock as: Bag! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>ifEmpty: (in category 'testing') ----- - ifEmpty: aBlock - "Evaluate aBlock if I'm empty, return myself otherwise." - - self isEmpty ifTrue: [^ aBlock value].! Item was removed: - ----- 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, evalualte it with myself as its argument. See also #ifEmpty:ifNotEmptyDo:." - - self isEmpty ifTrue: [^ emptyBlock value]. - ^ notEmptyBlock cull: self! Item was removed: - ----- 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 value ]. - ^notEmptyBlock value: self! Item was removed: - ----- Method: Collection>>ifNotEmpty: (in category 'testing') ----- - ifNotEmpty: aBlock - "Evaluate aBlock if I'm not empty, return myself otherwise. If aBlock has an argument, evaluate it with myself as its argument. See also #ifNotEmptyDo:." - - self isEmpty ifFalse: [^ aBlock cull: self].! Item was removed: - ----- 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, evaluate it with myself as its argument. See also #ifNotEmptyDo:ifEmpty:." - - self isEmpty ifFalse: [^notEmptyBlock cull: self]. - ^ emptyBlock value! Item was removed: - ----- Method: Collection>>ifNotEmptyDo: (in category 'testing') ----- - ifNotEmptyDo: aBlock - "Evaluate the given block with the receiver as its argument." - - self isEmpty ifFalse: [^ aBlock value: self]. - ! Item was removed: - ----- 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 ]. - ^emptyBlock value! Item was removed: - ----- Method: Collection>>includes: (in category 'testing') ----- - includes: anObject - "Answer whether anObject is one of the receiver's elements." - - ^ self anySatisfy: [:each | each = anObject]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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'"! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>intersection: (in category 'set logic') ----- - intersection: aCollection - "Answer the set theoretic intersection of two collections." - - ^ self select: [:each | aCollection includes: each]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>isEmpty (in category 'testing') ----- - isEmpty - "Answer whether the receiver contains any elements. - This implementation uses the do: block rather than - self size = 0 since size may be implemented in terms - of do:, and hence is slow for all but very small collections." - - self do: [:element | ^false]. - ^true! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>isOfSameSizeCheck: (in category 'private') ----- - isOfSameSizeCheck: otherCollection - - otherCollection size = self size ifFalse: [self errorDifferentSize]! Item was removed: - ----- Method: Collection>>isSequenceable (in category 'testing') ----- - isSequenceable - ^ false! Item was removed: - ----- Method: Collection>>isZero (in category 'testing') ----- - isZero - "Answer whether the receiver is zero" - ^ false! Item was removed: - ----- Method: Collection>>ln (in category 'math functions') ----- - ln - ^self collect: [:each | each ln]! Item was removed: - ----- Method: Collection>>log (in category 'math functions') ----- - log - ^ self collect: [:each | each log]! Item was removed: - ----- Method: Collection>>log2 (in category 'math functions') ----- - log2 - ^ self collect: [:each | each log2]! Item was removed: - ----- Method: Collection>>max (in category 'math functions') ----- - max - "Answer the maximum value in the collection. The collection must be non-empty and contain 'compatible' Magnitudes (eg: don't try this with a collection containing both Dates and Characters)." - ^ self inject: self anyOne into: [:max :each | max max: each]! Item was removed: - ----- Method: Collection>>min (in category 'math functions') ----- - min - "Answer the minimum value in the collection. The collection must be non-empty and contain 'compatible' Magnitudes (eg: don't try this with a collection containing both Dates and Characters)." - ^ self inject: self anyOne into: [:min :each | min min: each]! Item was removed: - ----- Method: Collection>>minMax (in category 'math functions') ----- - minMax - "Scans for minimum and maximum in one pass returning the results as a two-element array" - | min max | - min := max := self anyOne. - self do: [ :each | - min := min min: each. - max := max max: each ]. - ^ Array with: min with: max! Item was removed: - ----- Method: Collection>>name (in category 'printing') ----- - name - - ^ String streamContents: [:stream | - self printNameOn: stream]! Item was removed: - ----- Method: Collection>>negated (in category 'math functions') ----- - negated - "Negated value of all elements in the collection" - ^ self collect: [:a | a negated]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>notEmpty (in category 'testing') ----- - notEmpty - "Answer whether the receiver contains any elements." - - ^ self isEmpty not! Item was removed: - ----- Method: Collection>>occurrencesOf: (in category 'enumerating') ----- - 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! Item was removed: - ----- Method: Collection>>printElementsOn: (in category 'printing') ----- - printElementsOn: aStream - - aStream nextPut: $(. - - self - printElementsOn: aStream - separatedBy: String space. - - aStream nextPut: $).! Item was removed: - ----- Method: Collection>>printElementsOn:separatedBy: (in category 'printing') ----- - printElementsOn: aStream separatedBy: delimiter - "Do not use #print: on the delemiter to have more control over the output. Strings get quoted, Characters get prefixed, etc." - - self - do: [:element | aStream print: element] - separatedBy: [aStream nextPutAll: delimiter asString].! Item was removed: - ----- Method: Collection>>printNameOn: (in category 'printing') ----- - printNameOn: aStream - super printOn: aStream! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>printOn:delimiter: (in category 'printing - obsolete') ----- - printOn: aStream delimiter: delimString - - self flag: #deprecated. - self - printElementsOn: aStream - separatedBy: delimString.! Item was removed: - ----- Method: Collection>>printOn:delimiter:last: (in category 'printing - obsolete') ----- - 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 | - self flag: #deprecated. - 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]]! Item was removed: - ----- Method: Collection>>raisedTo: (in category 'arithmetic') ----- - raisedTo: arg - - ^ arg adaptToCollection: self andSend: #raisedTo:! Item was removed: - ----- Method: Collection>>range (in category 'math functions') ----- - range - ^ self max - self min! Item was removed: - ----- Method: Collection>>reciprocal (in category 'math functions') ----- - reciprocal - "Return the reciever full of reciprocated elements" - ^ self collect: [:a | a reciprocal]! Item was removed: - ----- Method: Collection>>reduce: (in category 'enumerating') ----- - reduce: binaryBlock - "Apply the argument, binaryBlock cumulatively to the elements of the receiver. - For sequenceable collections the elements will be used in order, for unordered - collections the order is unspecified." - - | first nextValue | - first := true. - self do: [ :each | - first - ifTrue: [ nextValue := each. first := false ] - ifFalse: [ nextValue := binaryBlock value: nextValue value: each ] ]. - first ifTrue: [ self errorEmptyCollection ]. - ^nextValue! Item was removed: - ----- 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]! Item was removed: - ----- Method: Collection>>reject:thenDo: (in category 'enumerating') ----- - reject: rejectBlock thenDo: doBlock - "Utility method to improve readability." - ^ (self reject: rejectBlock) do: doBlock! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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].! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Collection>>roundTo: (in category 'math functions') ----- - roundTo: quantum - ^self collect: [ :ea | ea roundTo: quantum ]! Item was removed: - ----- Method: Collection>>rounded (in category 'math functions') ----- - rounded - ^ self collect: [:a | a rounded]! Item was removed: - ----- 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! Item was removed: - ----- Method: Collection>>select:thenCollect: (in category 'enumerating') ----- - select: selectBlock thenCollect: collectBlock - "Utility method to improve readability." - - ^ (self select: selectBlock) collect: collectBlock! Item was removed: - ----- Method: Collection>>select:thenDo: (in category 'enumerating') ----- - select: selectBlock thenDo: doBlock - "Utility method to improve readability." - ^ (self select: selectBlock) do: doBlock! Item was removed: - ----- Method: Collection>>sign (in category 'math functions') ----- - sign - ^self collect: [:each | each sign]! Item was removed: - ----- Method: Collection>>sin (in category 'math functions') ----- - sin - ^self collect: [:each | each sin]! Item was removed: - ----- Method: Collection>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - | tally | - tally := 0. - self do: [:each | tally := tally + 1]. - ^ tally! Item was removed: - ----- Method: Collection>>sorted (in category 'sorting') ----- - sorted - "Return a new sequenceable collection which contains the same elements as self but its elements are sorted in ascending order using the #'<=' operator." - - ^self sorted: nil! Item was removed: - ----- Method: Collection>>sorted: (in category 'sorting') ----- - sorted: aSortBlockOrNil - "Return a new sequenceable collection which contains the same elements as self but its elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if the first element should preceed the second one. If aSortBlock is nil then <= is used for comparison." - - ^self asArray sort: aSortBlockOrNil! Item was removed: - ----- Method: Collection>>sortedSafely (in category 'sorting') ----- - sortedSafely - "A variation of #sorted that uses #compareSafely: instead of #<= to compare its elements. Thus, collections of arbitrary objects can be sorted, which usually involves an object's #printString. See implementors of #compareSafely:." - - ^ self sorted: [:x :y | x compareSafely: y]! Item was removed: - ----- Method: Collection>>sqrt (in category 'math functions') ----- - sqrt - ^ self collect: [:each | each sqrt]! Item was removed: - ----- Method: Collection>>squared (in category 'math functions') ----- - squared - ^ self collect: [:each | each * each]! Item was removed: - ----- 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: $)! Item was removed: - ----- Method: Collection>>sum (in category 'math functions') ----- - sum - "Compute the sum of all the elements in the receiver" - - ^self reduce:[:a :b| a + b]! Item was removed: - ----- Method: Collection>>symmetricDifference: (in category 'set logic') ----- - symmetricDifference: aCollection - "Answer the set theoretic symmetric difference of two collections." - - ^ (self difference: aCollection) union: (aCollection difference: self) - ! Item was removed: - ----- Method: Collection>>take: (in category 'accessing') ----- - take: maxNumberOfElements - "Returns maxNumberOfElements as a new collection (using my #species) or less if the collection is not large enough." - - ^ self any: (maxNumberOfElements min: self size)! Item was removed: - ----- Method: Collection>>tan (in category 'math functions') ----- - tan - ^self collect: [:each | each tan]! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: Collection>>truncated (in category 'math functions') ----- - truncated - ^ self collect: [:a | a truncated]! Item was removed: - ----- Method: Collection>>try: (in category 'enumerating') ----- - try: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." - - ^ self try: aBlock ignore: Error! Item was removed: - ----- Method: Collection>>try:ignore: (in category 'enumerating') ----- - try: aBlock ignore: exceptionOrExceptionSet - "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." - - ^ self - try: aBlock - ignore: exceptionOrExceptionSet - ifException: nil! Item was removed: - ----- Method: Collection>>try:ignore:ifException: (in category 'enumerating') ----- - try: aBlock ignore: exceptionOrExceptionSet ifException: unaryBlockOrNil - "Evaluate aBlock with each of the receiver's elements as the argument. On error, evaluate a block and/or continue." - - ^ self do: [:ea | - [aBlock value: ea] - on: exceptionOrExceptionSet - do: [:err | unaryBlockOrNil ifNotNil: [unaryBlockOrNil value: err]]]! Item was removed: - ----- Method: Collection>>try:ignore:logged: (in category 'enumerating') ----- - try: aBlock ignore: exceptionOrExceptionSet logged: aBoolean - "Evaluate aBlock with each of the receiver's elements as the argument. On error, skip that element and continue." - - ^ self - try: aBlock - ignore: exceptionOrExceptionSet - ifException: (aBoolean ifTrue: [[:err| Transcript showln: err messageText]])! Item was removed: - ----- Method: Collection>>union: (in category 'set logic') ----- - union: aCollection - "Answer the set theoretic union of two collections." - - ^ self asSet addAll: aCollection; yourself! Item was removed: - ----- Method: Collection>>write: (in category 'filter streaming') ----- - write: anObject - ^ self add: anObject! Item was removed: - RawBitsArray variableWordSubclass: #ColorArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !ColorArray commentStamp: 'nice 5/2/2020 17:11' prior: 0! - A ColorArray is an array of colors encoded on 32-bits. - - The encoding of colors follows the ARGB scheme. - See https://en.wikipedia.org/wiki/RGBA_color_model - - The color is decomposed into 4 channels of 8 bits (4 bytes) - - the most significant byte A is alpha channel which governs transparency - 0 means a completely transparent (invisible) color - 255 means an opaque color. - - the second most significant byte R encodes the level of red - the lower, the darker and/or least saturated - - the third most significant byte G encodes the level of green - - the least significant byte B encodes the level of blue - - Color white is encoded as 16rFFFFFFFF. - ((ColorArray with: Color white) basicAt: 1) hex. - For historical reasons, notice that Color black is encoded as a very dark blue 16rFF000001 rather than 16rFF000000. - ((ColorArray with: Color black) basicAt: 1) hex. - Other example of pure red, pure green and pure blue showing the bit position of those channels: - ((ColorArray with: Color red) basicAt: 1) hex. - ((ColorArray with: Color green) basicAt: 1) hex. - ((ColorArray with: Color blue) basicAt: 1) hex. - Color transparent is encoded as zero on all channels: - ((ColorArray with: Color transparent) basicAt: 1) hex.! Item was removed: - ----- Method: ColorArray>>asColorArray (in category 'converting') ----- - asColorArray - ^self! Item was removed: - ----- Method: ColorArray>>at: (in category 'accessing') ----- - at: index - ^(super at: index) asColorOfDepth: 32! Item was removed: - ----- Method: ColorArray>>at:put: (in category 'accessing') ----- - at: index put: aColor - ^super at: index put: (aColor pixelWordForDepth: 32).! Item was removed: - ----- Method: ColorArray>>bytesPerElement (in category 'converting') ----- - bytesPerElement - - ^4! Item was removed: - SortFunction subclass: #ComposedSortFunction - instanceVariableNames: 'baseSortFunction' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !ComposedSortFunction commentStamp: 'nice 11/7/2017 22:13' prior: 0! - A ComposedSortFunction is an abstract class wrapping over another SortFunction for the sake of composition. - - Subclasses have to define the composition behavior via collate:with: message. - - Instances variables: - baseSortFunction <SortFunction> the wrapped sort function! Item was removed: - ----- Method: ComposedSortFunction class>>on: (in category 'instance creation') ----- - on: aSortFunction - ^self new baseSortFunction: aSortFunction! Item was removed: - ----- Method: ComposedSortFunction>>= (in category 'comparing') ----- - = aSortFunction - self == aSortFunction ifTrue: [ ^true ]. - ^self class = aSortFunction class and: [ baseSortFunction = aSortFunction baseSortFunction ]! Item was removed: - ----- Method: ComposedSortFunction>>baseSortFunction (in category 'accessing') ----- - baseSortFunction - ^baseSortFunction! Item was removed: - ----- Method: ComposedSortFunction>>baseSortFunction: (in category 'accessing') ----- - baseSortFunction: aSortFunction - baseSortFunction := aSortFunction! Item was removed: - ----- Method: ComposedSortFunction>>hash (in category 'comparing') ----- - hash - ^baseSortFunction hash hashMultiply! Item was removed: - ----- Method: ComposedSortFunction>>initialize (in category 'initailize-release') ----- - initialize - super initialize. - baseSortFunction := self class default! Item was removed: - SortFunction subclass: #DefaultSortFunction - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !DefaultSortFunction commentStamp: 'nice 4/6/2019 15:08' prior: 0! - A DefaultSortFunction is a collator using the default three way compare <=> operator. - It is known to work on String and Magnitude. - - It is generally not usefull to create a new instance, and the recommended pattern is to use the single instance available by sending the message SortFunction default . - - For other objects that don't understand <=> it is necessary to use a custom SortFunction rather than the default one. - ! Item was removed: - ----- Method: DefaultSortFunction class>>initialize (in category 'class initialization') ----- - initialize - Default := self new! Item was removed: - ----- Method: DefaultSortFunction>>collate:with: (in category 'evaluating') ----- - collate: anObject with: anotherObject - ^anObject <=> anotherObject! Item was removed: - HashedCollection subclass: #Dictionary - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Unordered'! - - !Dictionary commentStamp: 'nice 8/26/2010 22:30' prior: 0! - A Dictionary is an unordered collection of values which are indexed by arbitrary keys. - A Dictionary is accessed via #at: and #at:put: messages like a SequenceableCollection, but instead of being Integer, the keys can be any object that responds to =. - - The = message is used to test for the existence of the key in the Dictionary. - If the key is absent, #at:put: adds a new entry to the Dictionary. - - (Dictionary new) - at: 'foo' put: 1; - at: 'bar' put: 8; - yourself. - - Each key is unique: storing another value with #at:put: at an already used key overwrites previously associated value. - - (Dictionary new) - at: 'bar' put: 4; - at: 'bar' put: 8; - at: 'bar'. - - The values are not necessarily unique, thus a Dictionary can also be seen as a sort of Bag with this respect. - - (Dictionary new) - at: 'foo' put: 8; - at: 'bar' put: 8; - yourself. - - If the key is absent, #at: raises an Error. An alternate block of code can be executed and its value returned in this case using #at:ifAbsent:. - See also #at:ifAbsentPut:. - - (Dictionary new) at: 'foo' ifAbsent: [nil]. - - Dictionary is implemented as a HashedCollection of Association (a value is associated to its key et vice et versa). - Being a HashedCollection enables fast random access indexed by keys. - Consequently, keys must respond to #hash (see super). - - BEWARE: as for every HashedCollection, it is better to not modify an object after it is used as a Dictionary key. The reason is that this might change the #hash code, making the Dictionary unable to find corresponding entry, or make two keys equal violating uniqueness. It's progammer responsibility to take care to not modify the keys, or eventually to send #rehash to the Dictionary if they ever happen to change. - - It is possible to grow or shrink a Dictionary using the messages #add: and #remove: with an Association parameter, however the prefered way to do so is using #at:put: and #removeKey:. - BEWARE: as for super, space reserved in internal storage array can grow but never shrink. - - For conveniency, it is also possible to create a Dictionary out of a Collection of associations, as for example in: - - {'foo' -> 1. 'bar' -> 8} as: Dictionary. - Dictionary withAll: {'foo' -> 1. 'bar' -> 8}. - Dictionary new addAll: {'foo' -> 1. 'bar' -> 8}; yourself. - - BEWARE: though a Sequence collection can be considered as a sequence of values with Integer keys (see #keysAndValuesDo: ), it cannot be converted into a Dictionary using these keys, and following message will fail: - - #('foo' 'bar') as: Dictionary. - - Enumerating a Dictionary with #do: will only enumerate the values, not the keys. - Remember, the order of evaluation is arbitrary and can change when you grow or shrink a Dictionary. - - ({'foo' -> 1. 'bar' -> 8} as: Dictionary) do: [:each | Transcript cr; show: each printString]. - - For enumerating keys and values, use #keysAndValuesDo:, or use #associationsDo: to enumerate the associations. - #select: #reject: #collect: will operate on values while preserving the keys and thus answer a new Dictionary. - - ({'foo' -> 1. 'bar' -> 8} as: Dictionary) collect: [:each | each squared]. - - The keys and values of a Dictionary can be extracted by sending #keys and #values message. - Though the keys are theoretically a Set and values a Bag, for efficiency reasons, these messages will both return an Array of keys - and an Array of values. A neat feature is that these messages are preserving the arbitrary storage order - in other words, (aDictionary values at: 3) is the value associated to key (aDictionary keys at: 3).! Item was removed: - ----- 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 copy]]. - ^ newDictionary - - " Dictionary newFrom: {1->#a. 2->#b. 3->#c} - {1->#a. 2->#b. 3->#c} as: Dictionary - Dictionary newFrom: {1->#a. 2->#b. 1->#c} - {1->#a. 2->#b. 1->#c} as: Dictionary - "! Item was removed: - ----- Method: Dictionary class>>newFromPairs: (in category 'instance creation') ----- - newFromPairs: anArray - - "Answer an instance of me associating (anArray at:i) to (anArray at: i+1) - 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}. "! Item was removed: - ----- Method: Dictionary>>= (in category 'comparing') ----- - = anObject - "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 == anObject ifTrue: [ ^true ]. - self species == anObject species ifFalse: [ ^false ]. - self size = anObject size ifFalse: [ ^false ]. - self associationsDo: [ :association | - (anObject at: association key ifAbsent: [ ^false ]) = association value - ifFalse: [ ^false ] ]. - ^true! Item was removed: - ----- Method: Dictionary>>add: (in category 'adding') ----- - add: anAssociation - - | index | - index := self scanFor: anAssociation key. - (array at: index) - ifNil: [ self atNewIndex: index put: anAssociation ] - ifNotNil: [ :element | element value: anAssociation value ]. - ^anAssociation! Item was removed: - ----- Method: Dictionary>>addAll: (in category 'adding') ----- - addAll: aCollection - "Include all the associations of aCollection as the receiver's elements. Answer - aCollection. Any collection containing associations can be used as argument." - - aCollection == self ifFalse: [ - aCollection associationsDo: [:assoc| self add: assoc]. - ]. - ^aCollection! Item was removed: - ----- Method: Dictionary>>associationAt: (in category 'accessing') ----- - associationAt: key - ^ self associationAt: key ifAbsent: [self errorKeyNotFound: key]! Item was removed: - ----- 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." - - ^(array at: (self scanFor: key)) ifNil: [ aBlock value ] - ! Item was removed: - ----- Method: Dictionary>>associationClass (in category 'accessing') ----- - associationClass - - ^Association! Item was removed: - ----- 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." - self flag: #environments. - - ^ self associationAt: aKey ifAbsent: [ - | existing | - (Undeclared includesKey: aKey) - ifTrue: - [existing := Undeclared associationAt: aKey. - Undeclared removeKey: aKey. - self add: existing] - ifFalse: - [self add: aKey -> false]]! Item was removed: - ----- 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 ] ]! Item was removed: - ----- Method: Dictionary>>associationsDo: (in category 'enumerating') ----- - associationsDo: aBlock - "Evaluate aBlock for each of the receiver's elements (key/value - associations)." - - tally = 0 ifTrue: [ ^self]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :element | - aBlock value: element ] ]! Item was removed: - ----- 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 copyEmpty. - self associationsDo: [ :each | - (aBlock value: each) ifTrue: [ newCollection add: each ] ]. - ^newCollection! Item was removed: - ----- Method: Dictionary>>at: (in category 'accessing') ----- - at: key - "Answer the value associated with the key." - - ^ self at: key ifAbsent: [self errorKeyNotFound: key]! Item was removed: - ----- 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." - - ^((array at: (self scanFor: key)) ifNil: [ aBlock ]) value "Blocks and Associations expect #value"! Item was removed: - ----- 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]! Item was removed: - ----- 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." - - ^(array at: (self scanFor: key)) ifNotNil: [:assoc| aBlock value: assoc value]! Item was removed: - ----- Method: Dictionary>>at:ifPresent:ifAbsent: (in category 'accessing') ----- - at: key ifPresent: oneArgBlock ifAbsent: absentBlock - "Lookup the given key in the receiver. If it is present, answer the - value of evaluating the oneArgBlock with the value associated - with the key, otherwise answer the value of absentBlock." - ^(array at: (self scanFor: key)) - ifNil: [absentBlock value] - ifNotNil: [:association| oneArgBlock value: association value]! Item was removed: - ----- Method: Dictionary>>at:ifPresent:ifAbsentPut: (in category 'accessing') ----- - at: key ifPresent: oneArgBlock ifAbsentPut: absentBlock - "Lookup the given key in the receiver. If it is present, answer the value of - evaluating oneArgBlock with the value associated with the key. Otherwise - add the value of absentBlock under the key, and answer that value." - - | index value | - index := self scanFor: key. - (array at: index) ifNotNil: - [:element| - ^oneArgBlock value: element value]. - value := absentBlock value. - self atNewIndex: index put: (self associationClass key: key value: value). - ^value! Item was removed: - ----- 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 - ! Item was removed: - ----- 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 | - index := self scanFor: key. - (array at: index) - ifNil: [ self atNewIndex: index put: (self associationClass key: key value: anObject) ] - ifNotNil: [ :association | association value: anObject ]. - ^anObject! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: Dictionary>>do: (in category 'enumerating') ----- - do: aBlock - - self valuesDo: aBlock! Item was removed: - ----- Method: Dictionary>>errorValueNotFound (in category 'private') ----- - errorValueNotFound - - ^ self error: 'Value not found' translated! Item was removed: - ----- Method: Dictionary>>fillFrom:with: (in category 'private') ----- - fillFrom: aCollection with: aBlock - "Evaluate aBlock with each of aCollections's elements as the argument. - Collect the resulting values into self. Answer self." - - aCollection isDictionary - ifFalse: [ - aCollection do: [ :element | - self add: (aBlock value: element) ] ] - ifTrue: [ - aCollection associationsDo: [ :association | - self at: association key put: (aBlock value: association value) ] ]! Item was removed: - ----- Method: Dictionary>>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 := array at: (index := index \\ array size + 1)) == nil ] whileFalse: [ - | newIndex | - (newIndex := self scanFor: element key) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: nil ] ]! Item was removed: - ----- Method: Dictionary>>flattenOnStream: (in category 'filter streaming') ----- - flattenOnStream:aStream - ^aStream writeDictionary:self. - ! Item was removed: - ----- Method: Dictionary>>includesAssociation: (in category 'testing') ----- - includesAssociation: anAssociation - ^ (self - associationAt: anAssociation key - ifAbsent: [ ^ false ]) value = anAssociation value - ! Item was removed: - ----- 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! Item was removed: - ----- Method: Dictionary>>includesKey: (in category 'testing') ----- - includesKey: key - "Answer whether the receiver has a key equal to the argument, key." - - (array at: (self scanFor: key)) ifNil: [ ^false ] ifNotNil: [ ^true ]! Item was removed: - ----- Method: Dictionary>>isDictionary (in category 'testing') ----- - isDictionary - ^true! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- Method: Dictionary>>keys (in category 'accessing') ----- - keys - "Answer an Array containing the receiver's keys." - - ^Array new: self size streamContents: [:s| self keysDo: [:key| s nextPut: key]]! Item was removed: - ----- Method: Dictionary>>keysAndValuesDo: (in category 'enumerating') ----- - keysAndValuesDo: aBlock - ^self associationsDo:[:assoc| - aBlock value: assoc key value: assoc value].! Item was removed: - ----- 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]! Item was removed: - ----- Method: Dictionary>>keysDo: (in category 'enumerating') ----- - keysDo: aBlock - "Evaluate aBlock for each of the receiver's keys." - - self associationsDo: [:association | aBlock value: association key]! Item was removed: - ----- Method: Dictionary>>keysInOrder (in category 'accessing') ----- - keysInOrder - "Answer the keys of the receiver in a particular sequence. This default is alphabetical, but subclasses like OrderedDictionary maintain their own sequence." - ^ self keysSortedSafely! Item was removed: - ----- Method: Dictionary>>keysSortedSafely (in category 'accessing') ----- - keysSortedSafely - - ^ self keys sortedSafely! Item was removed: - ----- 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 | - (anArray at: index) ifNotNil: [ :association | - array - at: (self scanForEmptySlotFor: association key) - put: association ] ]! Item was removed: - ----- Method: Dictionary>>postCopy (in category 'copying') ----- - postCopy - "Must copy the associations, or later store will affect both the - original and the copy" - - super postCopy. - array := array collect: [ :association | - association ifNotNil: [ association copy ] ]! Item was removed: - ----- Method: Dictionary>>printElementsOn: (in category 'printing') ----- - printElementsOn: aStream - aStream nextPut: $(. - self size > 100 - ifTrue: [aStream nextPutAll: 'size '. - self size printOn: aStream] - ifFalse: [self keysInOrder - do: [:key | aStream print: key; - nextPutAll: '->'; - print: (self at: key); - space]]. - aStream nextPut: $)! Item was removed: - ----- Method: Dictionary>>remove:ifAbsent: (in category 'removing') ----- - remove: anObject ifAbsent: exceptionBlock - - self shouldNotImplement! Item was removed: - ----- 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: key]! Item was removed: - ----- 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 ]. - tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: nil. - self fixCollisionsFrom: index. - ^association value! Item was removed: - ----- Method: Dictionary>>removeUnreferencedKeys (in category 'removing') ----- - removeUnreferencedKeys "Undeclared removeUnreferencedKeys" - - ^ self unreferencedKeys do: [:key | self removeKey: key].! Item was removed: - ----- Method: Dictionary>>replace: (in category 'enumerating') ----- - replace: aBlock - "Destructively replace the values in this Dictionary by applying aBlock, keeping the same keys. - Implementation note: subclasses not storing the key-value pairs as a list of Associations shall refine this method." - tally = 0 ifTrue: [ ^self]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :element | - element value: (aBlock value: element value) ] ]! Item was removed: - ----- 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 size | - index := start := anObject hash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ anObject = element key ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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! Item was removed: - ----- 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: $)! Item was removed: - ----- Method: Dictionary>>unreferencedKeys (in category 'removing') ----- - unreferencedKeys - "| uk | (Time millisecondsToRun: [uk := TextConstants unreferencedKeys]) -> uk" - - ^'Scanning for references . . .' - displayProgressFrom: 0 - to: Smalltalk classNames size * 2 - during: [ :bar | - | currentClass n associations referencedAssociations | - currentClass := nil. - n := 0. - associations := self associations asIdentitySet. - referencedAssociations := IdentitySet new: associations size. - self systemNavigation allSelectorsAndMethodsDo: [ :behavior :selector :method | - behavior == currentClass ifFalse: [ - currentClass := behavior. - bar value: (n := n + 1) ]. - method allLiteralsDo: [ :literal | - (literal isVariableBinding and: [ associations includes: literal ]) ifTrue: [ - referencedAssociations add: literal ] ] ]. - (associations reject: [ :assoc | referencedAssociations includes: assoc ]) collect: [ :assoc| assoc key ] ]! Item was removed: - ----- 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] ]! Item was removed: - ----- Method: Dictionary>>valuesDo: (in category 'enumerating') ----- - valuesDo: aBlock - "Evaluate aBlock for each of the receiver's values." - - self associationsDo: [:association | aBlock value: association value]! Item was removed: - ----- Method: Dictionary>>withKeysSorted: (in category 'sorting') ----- - withKeysSorted: aSortBlockOrNil - - | sorted | - sorted := OrderedDictionary new: self size. - (self keys sorted: aSortBlockOrNil) do: [:key | - sorted at: key put: (self at: key)]. - ^ sorted! Item was removed: - ----- Method: Dictionary>>withKeysSortedSafely (in category 'sorting') ----- - withKeysSortedSafely - - | sorted | - sorted := OrderedDictionary new: self size. - self keysSortedSafely do: [:key | sorted at: key put: (self at: key)]. - ^ sorted! Item was removed: - UnsignedIntegerArray variableDoubleByteSubclass: #DoubleByteArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !DoubleByteArray commentStamp: 'nice 5/10/2020 17:31' prior: 0! - A DoubleByteArrays store 16-bit unsigned Integer values in the range 0 to 65535.! Item was removed: - ----- Method: DoubleByteArray>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 2! Item was removed: - UnsignedIntegerArray variableDoubleWordSubclass: #DoubleWordArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !DoubleWordArray commentStamp: 'nice 5/10/2020 17:32' prior: 0! - A DoubleWordArrays store 64-bit unsigned Integer values.! Item was removed: - ----- Method: DoubleWordArray>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 8! Item was removed: - Error subclass: #EndOfStream - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Exceptions'! - - !EndOfStream commentStamp: '<historical>' prior: 0! - Signalled when ReadStream>>next encounters a premature end.! Item was removed: - ----- Method: EndOfStream>>defaultAction (in category 'handling') ----- - defaultAction - "Answer ReadStream>>next default reply." - - ^ nil! Item was removed: - ----- Method: EndOfStream>>isResumable (in category 'description') ----- - isResumable - "EndOfStream is resumable, so ReadStream>>next can answer" - - ^ true! Item was removed: - FloatArray variableWordSubclass: #Float32Array - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !Float32Array commentStamp: 'nice 5/10/2020 17:32' prior: 0! - A Float32Array store single precision IEEE 754 (32 bits) floating point numbers.! Item was removed: - ----- Method: Float32Array class>>fromFloat64Array: (in category 'instance creation') ----- - fromFloat64Array: aFloat64Array - ^(self new: aFloat64Array size) copyFromFloat64Array: aFloat64Array! Item was removed: - ----- Method: Float32Array>>= (in category 'comparing') ----- - = aFloatArray - <primitive: 'primitiveEqual' module: 'FloatArrayPlugin'> - ^super = aFloatArray! Item was removed: - ----- Method: Float32Array>>asFloat32Array (in category 'converting') ----- - asFloat32Array - ^self! Item was removed: - ----- Method: Float32Array>>asFloat64Array (in category 'converting') ----- - asFloat64Array - ^Float64Array fromFloatArray: self! Item was removed: - ----- Method: Float32Array>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 4! Item was removed: - ----- Method: Float32Array>>copyFromFloat64Array: (in category 'initialize-release') ----- - copyFromFloat64Array: aFloat64Array - "Destructively replace the elements of self with those of aFloat64Array" - <primitive: 'primitiveFromFloat64Array' module: 'FloatArrayPlugin'> - self isOfSameSizeCheck: aFloat64Array. - 1 to: self size do:[:i| self at: i put: (aFloat64Array at: i)].! Item was removed: - ----- Method: Float32Array>>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: 'primitiveDotProduct' module: 'FloatArrayPlugin'> - 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! Item was removed: - ----- Method: Float32Array>>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! Item was removed: - ----- Method: Float32Array>>normalize (in category 'arithmetic') ----- - normalize - "Unsafely normalize the receiver in-place (become a unit vector). - Div-by-Zero raised if len 0." - <primitive: 'primitiveNormalize' module: 'FloatArrayPlugin'> - self /= self length.! Item was removed: - ----- Method: Float32Array>>primAddArray: (in category 'primitives-plugin') ----- - primAddArray: floatArray - - <primitive: 'primitiveAddFloatArray' module: 'FloatArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was removed: - ----- Method: Float32Array>>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].! Item was removed: - ----- Method: Float32Array>>primDivArray: (in category 'primitives-plugin') ----- - primDivArray: floatArray - - <primitive: 'primitiveDivFloatArray' module: 'FloatArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was removed: - ----- Method: Float32Array>>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].! Item was removed: - ----- Method: Float32Array>>primMulArray: (in category 'primitives-plugin') ----- - primMulArray: floatArray - - <primitive: 'primitiveMulFloatArray' module: 'FloatArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was removed: - ----- Method: Float32Array>>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].! Item was removed: - ----- Method: Float32Array>>primSubArray: (in category 'primitives-plugin') ----- - primSubArray: floatArray - - <primitive: 'primitiveSubFloatArray' module: 'FloatArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].! Item was removed: - ----- Method: Float32Array>>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].! Item was removed: - ----- Method: Float32Array>>sum (in category 'primitives-plugin') ----- - sum - - <primitive: 'primitiveSum' module: 'FloatArrayPlugin'> - ^ super sum! Item was removed: - FloatArray variableDoubleWordSubclass: #Float64Array - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !Float64Array commentStamp: 'nice 5/10/2020 17:33' prior: 0! - A Float64Array store double precision IEEE 754 (64 bits) floating point numbers.! Item was removed: - ----- Method: Float64Array class>>fromFloatArray: (in category 'instance creation') ----- - fromFloatArray: aFloatArray - ^(self new: aFloatArray size) copyFromFloatArray: aFloatArray! Item was removed: - ----- Method: Float64Array>>= (in category 'comparing') ----- - = aFloat64Array - <primitive: 'primitiveEqual' module: 'Float64ArrayPlugin'> - ^super = aFloat64Array! Item was removed: - ----- Method: Float64Array>>asFloat32Array (in category 'converting') ----- - asFloat32Array - ^Float32Array fromFloat64Array: self! Item was removed: - ----- Method: Float64Array>>asFloat64Array (in category 'converting') ----- - asFloat64Array - ^self! Item was removed: - ----- Method: Float64Array>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 8! Item was removed: - ----- Method: Float64Array>>copyFromFloatArray: (in category 'initialize-release') ----- - copyFromFloatArray: aFloatArray - "Destructively replace the elements of self with those of aFloatArray" - <primitive: 'primitiveFromFloatArray' module: 'Float64ArrayPlugin'> - self isOfSameSizeCheck: aFloatArray. - 1 to: self size do:[:i| self at: i put: (aFloatArray at: i)].! Item was removed: - ----- Method: Float64Array>>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: 'primitiveDotProduct' module: 'Float64ArrayPlugin'> - 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! Item was removed: - ----- Method: Float64Array>>hash (in category 'comparing') ----- - hash - | result | - <primitive:'primitiveHashArray' module: 'Float64ArrayPlugin'> - result := 0. - 1 to: self size do:[:i| result := result + (self basicAt: i) ]. - ^result bitAnd: 16r1FFFFFFF! Item was removed: - ----- Method: Float64Array>>normalize (in category 'arithmetic') ----- - normalize - "Unsafely normalize the receiver in-place (become a unit vector). - Div-by-Zero raised if len 0." - <primitive: 'primitiveNormalize' module: 'Float64ArrayPlugin'> - self /= self length.! Item was removed: - ----- Method: Float64Array>>primAddArray: (in category 'primitives-plugin') ----- - primAddArray: floatArray - - <primitive: 'primitiveAddFloat64Array' module: 'Float64ArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) + (floatArray at: i)].! Item was removed: - ----- Method: Float64Array>>primAddScalar: (in category 'primitives-plugin') ----- - primAddScalar: scalarValue - - <primitive: 'primitiveAddScalar' module: 'Float64ArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) + scalarValue].! Item was removed: - ----- Method: Float64Array>>primDivArray: (in category 'primitives-plugin') ----- - primDivArray: floatArray - - <primitive: 'primitiveDivFloat64Array' module: 'Float64ArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) / (floatArray at: i)].! Item was removed: - ----- Method: Float64Array>>primDivScalar: (in category 'primitives-plugin') ----- - primDivScalar: scalarValue - - <primitive: 'primitiveDivScalar' module: 'Float64ArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) / scalarValue].! Item was removed: - ----- Method: Float64Array>>primMulArray: (in category 'primitives-plugin') ----- - primMulArray: floatArray - - <primitive: 'primitiveMulFloat64Array' module: 'Float64ArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) * (floatArray at: i)].! Item was removed: - ----- Method: Float64Array>>primMulScalar: (in category 'primitives-plugin') ----- - primMulScalar: scalarValue - - <primitive: 'primitiveMulScalar' module: 'Float64ArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) * scalarValue].! Item was removed: - ----- Method: Float64Array>>primSubArray: (in category 'primitives-plugin') ----- - primSubArray: floatArray - - <primitive: 'primitiveSubFloat64Array' module: 'Float64ArrayPlugin'> - self isOfSameSizeCheck: floatArray. - 1 to: self size do:[:i| self at: i put: (self at: i) - (floatArray at: i)].! Item was removed: - ----- Method: Float64Array>>primSubScalar: (in category 'primitives-plugin') ----- - primSubScalar: scalarValue - - <primitive: 'primitiveSubScalar' module: 'Float64ArrayPlugin'> - 1 to: self size do:[:i| self at: i put: (self at: i) - scalarValue].! Item was removed: - ----- Method: Float64Array>>sum (in category 'primitives-plugin') ----- - sum - - <primitive: 'primitiveSum' module: 'Float64ArrayPlugin'> - ^ super sum! Item was removed: - RawBitsArray subclass: #FloatArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !FloatArray commentStamp: 'nice 5/10/2020 16:57' prior: 0! - FloatArray is an abstract class for representing arrays of floating point values of some given precision. - Subclasses notably provide support for IEEE 754 single precision (32bits) and double precision (64) floats. - ! Item was removed: - ----- Method: FloatArray class>>basicNew: (in category 'instance creation') ----- - basicNew: anInteger - "For backward compatibility, create a 32bits FloatArray" - - self == FloatArray - ifTrue: [^Float32Array basicNew: anInteger]. - ^super basicNew: anInteger! Item was removed: - ----- Method: FloatArray>>* (in category 'arithmetic') ----- - * anObject - - ^self shallowCopy *= anObject! Item was removed: - ----- Method: FloatArray>>*= (in category 'arithmetic') ----- - *= anObject - ^anObject isNumber - ifTrue:[self primMulScalar: anObject asFloat] - ifFalse:[self primMulArray: anObject]! Item was removed: - ----- Method: FloatArray>>+ (in category 'arithmetic') ----- - + anObject - - ^self shallowCopy += anObject! Item was removed: - ----- Method: FloatArray>>+= (in category 'arithmetic') ----- - += anObject - ^anObject isNumber - ifTrue:[self primAddScalar: anObject asFloat] - ifFalse:[self primAddArray: anObject]! Item was removed: - ----- Method: FloatArray>>- (in category 'arithmetic') ----- - - anObject - - ^self shallowCopy -= anObject! Item was removed: - ----- Method: FloatArray>>-= (in category 'arithmetic') ----- - -= anObject - ^anObject isNumber - ifTrue:[self primSubScalar: anObject asFloat] - ifFalse:[self primSubArray: anObject]! Item was removed: - ----- Method: FloatArray>>/ (in category 'arithmetic') ----- - / anObject - - ^self shallowCopy /= anObject! Item was removed: - ----- Method: FloatArray>>/= (in category 'arithmetic') ----- - /= anObject - ^anObject isNumber - ifTrue:[self primDivScalar: anObject asFloat] - ifFalse:[self primDivArray: anObject]! Item was removed: - ----- 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). - ]. - - ! Item was removed: - ----- 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! Item was removed: - ----- Method: FloatArray>>asFloatArray (in category 'converting') ----- - asFloatArray - ^self! Item was removed: - ----- Method: FloatArray>>at: (in category 'accessing') ----- - at: index - "Answer the Float at index in the receiver. This method converts from either a 32-bit IEEE representation, - or a 64-bit IEEE representation to a Squeak Float object. Primitive. Optional." - <primitive: 238 error: ec> - ^self bytesPerElement = 4 - ifTrue: [Float fromIEEE32Bit: (self basicAt: index)] - ifFalse: [Float fromIEEE64Bit: (self basicAt: index)]! Item was removed: - ----- Method: FloatArray>>at:put: (in category 'accessing') ----- - at: index put: value - "Store the Float value at index in the receiver. This method converts from a Squeak Float object, - or an Integer, into either a 32-bit IEEE representation, or a 64-bit IEEE representation. Primitive. Optional." - <primitive: 239 error: ec> - value isFloat - ifTrue:[self basicAt: index put: (self bytesPerElement = 4 - ifTrue: [value asIEEE32BitWord] - ifFalse: [value asIEEE64BitWord])] - ifFalse: [self at: index put: value asFloat]. - ^value! Item was removed: - ----- Method: FloatArray>>defaultElement (in category 'accessing') ----- - defaultElement - "Return the default element of the receiver" - ^0.0! Item was removed: - ----- Method: FloatArray>>length (in category 'accessing') ----- - length - "Return the length of the receiver" - ^self squaredLength sqrt! Item was removed: - ----- Method: FloatArray>>negated (in category 'arithmetic') ----- - negated - - ^self shallowCopy *= -1! Item was removed: - ----- 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! Item was removed: - ----- Method: FloatArray>>squaredLength (in category 'accessing') ----- - squaredLength - "Return the squared length of the receiver" - ^self dot: self! Item was removed: - NonPointersOrderedCollection subclass: #FloatCollection - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !FloatCollection commentStamp: 'cmm 1/28/2013 19:49' prior: 0! - FloatCollctions store 32bit IEEE floating point numbers.! Item was removed: - ----- Method: FloatCollection>>arrayType (in category 'private') ----- - arrayType - ^ Float32Array! Item was removed: - ----- Method: FloatCollection>>asFloat32Array (in category 'converting') ----- - asFloat32Array - "Optimized version" - - ^array copyFrom: firstIndex to: lastIndex! Item was removed: - Stream subclass: #Generator - instanceVariableNames: 'block next continue home' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! - - !Generator commentStamp: 'eem 3/30/2017 17:31' prior: 0! - A Generator transforms callback interfaces into stream interfaces. - - When a producer algorithm provide results as callbacks (blocks) and a consumer algorithm expects streamable input, a Generator transforms one into the other, for example: - - | generator | - generator := Generator on: [:g| Integer primesUpTo: 100 do:[:prime| g yield: prime]]. - [generator atEnd] whileFalse:[Transcript show: generator next]. - - Instance Variables - block: <BlockClosure> The block associated with the generator. - continue: <Context> The continuation to return to. - home: <Context> The home (root) context of the activated block - next: <Object> The next object to return from the Generator.! Item was removed: - ----- Method: Generator class>>on: (in category 'instance creation') ----- - on: aBlock - ^ self basicNew initializeOn: aBlock! Item was removed: - ----- Method: Generator>>atEnd (in category 'testing') ----- - atEnd - "Answer whether the receiver can access any more objects." - - ^ continue isNil! Item was removed: - ----- Method: Generator>>close (in category 'accessing') ----- - close - "Close the receiving generator and unwind its ensure-blocks." - - continue ifNotNil:[continue unwindTo: home]. - continue := block := next := nil! Item was removed: - ----- Method: Generator>>contents (in category 'accessing') ----- - contents - "Answer the contents of this generator. Do not call this method on infinite generators." - - | stream | - stream := (Array new: 10) writeStream. - [ self atEnd ] - whileFalse: [ stream nextPut: self next ]. - ^ stream contents! Item was removed: - ----- Method: Generator>>fork (in category 'private') ----- - fork - | result | - home := thisContext. - block reentrant value: self. - thisContext swapSender: continue. - result := next. - continue := next := home := nil. - ^ result! Item was removed: - ----- Method: Generator>>initializeOn: (in category 'initialization') ----- - initializeOn: aBlock - block := aBlock. - self reset! Item was removed: - ----- Method: Generator>>next (in category 'accessing') ----- - next - "Generate and answer the next object in the receiver." - - ^ self atEnd ifFalse: [ - home swapSender: thisContext sender. - continue := thisContext swapSender: continue - ]! Item was removed: - ----- Method: Generator>>nextPut: (in category 'accessing') ----- - nextPut: anObject - "Add anObject into the generator. A synonym to #yield: and value:." - - | previous | - previous := next. - next := anObject. - continue := thisContext swapSender: continue. - ^ previous! Item was removed: - ----- Method: Generator>>peek (in category 'accessing') ----- - peek - "Answer the upcoming object of the receiver." - - ^ next! Item was removed: - ----- Method: Generator>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: self class name; nextPutAll: ' on: '; print: block! Item was removed: - ----- Method: Generator>>reset (in category 'public') ----- - reset - "Reset the generator, i.e., start it over" - continue ifNotNil:[continue unwindTo: home]. - next := nil. - continue := thisContext. - [ self fork ] value! Item was removed: - ----- Method: Generator>>size (in category 'accessing') ----- - size - "A generator does not know its size." - - ^ self shouldNotImplement! Item was removed: - ----- Method: Generator>>value: (in category 'public') ----- - value: anObject - "Allows passing generators as arguments to methods expecting blocks. - A synonym for #yield: / #nextPut:." - ^ self nextPut: anObject! Item was removed: - ----- Method: Generator>>yield: (in category 'public') ----- - yield: anObject - "Yield the next value to the consumer of the generator. - A synonym for #nextPut:" - ^ self nextPut: anObject! Item was removed: - Collection subclass: #HashedCollection - instanceVariableNames: 'tally array' - classVariableNames: 'GoodPrimes' - poolDictionaries: '' - category: 'Collections-Abstract'! - - !HashedCollection commentStamp: 'ul 4/12/2010 22:37' prior: 0! - I am an abstract collection of objects that implement hash and equality in a consitent way. This means that whenever two objects are equal, their hashes have to be equal too. If two objects are equal then I can only store one of them. Hashes are expected to be integers (preferably SmallIntegers). I also expect that the objects contained by me do not change their hashes. If that happens, hash invariants have to be re-established, which can be done by #rehash. - - Since I'm abstract, no instances of me should exist. My subclasses should implement #scanFor:, #fixCollisionsFrom: and #noCheckNoGrowFillFrom:. - - Instance Variables - array: <ArrayedCollection> (typically Array or WeakArray) - tally: <Integer> (non-negative) - - array - - An array whose size is a prime number, it's non-nil elements are the elements of the collection, 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 collection. The array size is always greater than this. - - Implementation details: - I implement a hash table which uses open addressing with linear probing as the method of collision resolution. Searching for an element or a free slot for an element is done by #scanFor: which should return the index of the slot in array corresponding to it's argument. When an element is removed #fixCollisionsFrom: should rehash all elements in array between the original index of the removed element, wrapping around after the last slot until reaching an empty slot. My maximum load factor (75%) is hardcoded in #atNewIndex:put:, so it can only be changed by overriding that method. When my load factor reaches this limit I replace my array with a larger one (see #grow) ensuring that my load factor will be less than or equal to 50%. The new array is filled by #noCheckNoGrowFillFrom: which should use #scanForEmptySlotFor: instead of #scanFor: for better performance. I do not shrink. - ! Item was removed: - ----- Method: HashedCollection class>>cleanUp: (in category 'initialize-release') ----- - cleanUp: aggressive - "Rehash all instances when cleaning aggressively" - - aggressive ifTrue: [ self compactAll ] - ! Item was removed: - ----- Method: HashedCollection class>>compactAll (in category 'initialize-release') ----- - compactAll - "HashedCollection compactAll" - - self allSubclassesDo: [ :each | each compactAllInstances ]! Item was removed: - ----- Method: HashedCollection class>>compactAllInstances (in category 'initialize-release') ----- - compactAllInstances - "Do not use #allInstancesDo: because #compact may create new instances. Ignore immutable instances." - - self allInstances do: [ :each | - each isReadOnlyObject ifFalse: [ each compact ] ]! Item was removed: - ----- Method: HashedCollection class>>goodPrimeAtLeast: (in category 'sizing') ----- - goodPrimeAtLeast: lowerLimit - "Answer the smallest good prime >= lowerlimit. - If lowerLimit is larger than the largest known good prime, just make it odd. - Use linear search, and exponential search to speed up cases when lowerLimit is small (<2500 and <100000, respectively). - Assume that there are goodPrimes greater than 100000." - - | highIndex midIndex lowIndex prime | - lowerLimit < 2500 ifTrue: [ - "Use linear search when the limit is small. The boundary is based on measurements." - highIndex := 1. - [ (GoodPrimes at: highIndex) < lowerLimit ] whileTrue: [ - highIndex := highIndex + 1 ]. - ^GoodPrimes at: highIndex ]. - lowerLimit < 100000 - ifTrue: [ - "Use exponential search when the limit is not too large. The boundary is based on measurements." - highIndex := 1. - [ (GoodPrimes at: highIndex) < lowerLimit ] whileTrue: [ - highIndex := highIndex * 2 ]. - lowIndex := highIndex // 2 + 1. "highIndex // 2 was smaller than lowerLimit" ] - ifFalse: [ - "Regular binary search." - lowIndex := 1. - highIndex := GoodPrimes size. - "Check whether the largest prime would fit" - (GoodPrimes at: highIndex) < lowerLimit ifTrue: [ - ^lowerLimit bitOr: 1 ]. ]. - [ highIndex - lowIndex <= 1 ] whileFalse: [ - midIndex := highIndex + lowIndex // 2. - prime := GoodPrimes at: midIndex. - lowerLimit < prime - ifTrue: [ highIndex := midIndex ] - ifFalse: [ - lowerLimit > prime - ifTrue: [ lowIndex := midIndex ] - ifFalse: [ ^prime ] ] ]. - (GoodPrimes at: lowIndex) >= lowerLimit ifTrue: [ ^GoodPrimes at: lowIndex ]. - ^GoodPrimes at: highIndex! Item was removed: - ----- Method: HashedCollection class>>goodPrimes (in category 'sizing') ----- - goodPrimes - "Answer a sorted array of prime numbers less than one billion that make good hash table sizes. See #initializeGoodPrimes." - - ^GoodPrimes ifNil: [ - self initializeGoodPrimes. - GoodPrimes ]! Item was removed: - ----- Method: HashedCollection class>>initialize (in category 'sizing') ----- - initialize - - self initializeGoodPrimes! Item was removed: - ----- Method: HashedCollection class>>initializeGoodPrimes (in category 'sizing') ----- - initializeGoodPrimes - "GoodPrimes is a sorted array of prime numbers less than one billion that make good hash table sizes. Should be expanded as needed. See comments below code." - - GoodPrimes := #(3 5 7 11 13 17 23 31 43 59 79 107 149 199 269 359 479 641 857 1151 1549 2069 - 2237 2423 2617 2797 2999 3167 3359 3539 3727 3911 - 4441 4787 5119 5471 5801 6143 6521 6827 7177 7517 7853 - 8783 9601 10243 10867 11549 12239 12919 13679 14293 15013 15731 - 17569 19051 20443 21767 23159 24611 25847 27397 28571 30047 31397 - 35771 38201 40841 43973 46633 48989 51631 54371 57349 60139 62969 - 70589 76091 80347 85843 90697 95791 101051 106261 111143 115777 120691 126311 - 140863 150523 160969 170557 181243 190717 201653 211891 221251 232591 242873 251443 - 282089 300869 321949 341227 362353 383681 401411 422927 443231 464951 482033 504011 - 562621 605779 647659 681607 723623 763307 808261 844709 886163 926623 967229 1014617 - 1121987 1201469 1268789 1345651 1429531 1492177 1577839 1651547 1722601 1800377 1878623 1942141 2028401 - 2242727 2399581 2559173 2686813 2836357 3005579 3144971 3283993 3460133 3582923 3757093 3903769 4061261 - 4455361 4783837 5068529 5418079 5680243 6000023 6292981 6611497 6884641 7211599 7514189 7798313 8077189 - 9031853 9612721 10226107 10745291 11338417 11939203 12567671 13212697 13816333 14337529 14938571 15595673 16147291 - 17851577 18993941 20180239 21228533 22375079 23450491 24635579 25683871 26850101 27921689 29090911 30153841 31292507 32467307 - 35817611 37983761 40234253 42457253 44750177 46957969 49175831 51442639 53726417 55954637 58126987 60365939 62666977 64826669 - 71582779 76039231 80534381 84995153 89500331 93956777 98470819 102879613 107400389 111856841 116365721 120819287 125246581 129732203 - 143163379 152076289 161031319 169981667 179000669 187913573 196826447 205826729 214748357 223713691 232679021 241591901 250504801 259470131 - 285162679 301939921 318717121 335494331 352271573 369148753 385926017 402603193 419480419 436157621 453034849 469712051 486589307 503366497 520043707 - 570475349 603929813 637584271 671138659 704693081 738247541 771801929 805356457 838910803 872365267 905919671 939574117 973128521 1006682977 1040137411 - 1073741833) - - "The above primes past 2069 were chosen carefully so that they do not interact badly with 1664525 (used by hashMultiply), and so that gcd(p, (256^k) +/- a) = 1, for 0<a<=32 and 0<k<=8. See Knuth's TAOCP for details." - - "The above primes also try to map the values of ((0 to: 4095) collect: [ :each | each << 18 \\ prime ]) sort to an equidistant sequence of numbers. This helps to avoid the collision of chains in identity-based hashed collections. To do that they were chosen to return a low value when the following block is evaluated with them as argument: - [ :prime | - | n slots cost optimalDistance | - n := 1 bitShift: 22. - slots := Array new: n + 1. - 0 to: n - 1 do: [ :ea | slots at: ea + 1 put: (ea bitShift: 8) \\ prime ]. - slots at: n + 1 put: prime. - slots sort. - cost := 0. - optimalDistance := prime // n. - 2 to: n + 1 do: [ :index | - | newCost | - newCost := optimalDistance - ((slots at: index) - (slots at: index - 1)). - newCost > cost ifTrue: [ cost := newCost ] ]. - result add: prime -> cost ] - - The shifts in the block relate to the numer of bits the #identityHash consists of (22) and the number of bits #scaledIdentityHash shifts it (8)"! Item was removed: - ----- Method: HashedCollection class>>isAbstract (in category 'testing') ----- - isAbstract - ^self = HashedCollection! Item was removed: - ----- Method: HashedCollection class>>new (in category 'instance creation') ----- - new - "Create a HashedCollection large enough to hold 3 different objects without growing." - - ^self basicNew initialize: 5 "For performance, inline the value 5 which would normally be returned by #sizeFor:."! Item was removed: - ----- Method: HashedCollection class>>new: (in category 'instance creation') ----- - new: numberOfElements - "Create a HashedCollection large enough to hold numberOfElements different objects without growing." - - ^self basicNew initialize: (numberOfElements <= 3 - ifFalse: [ self sizeFor: numberOfElements ] - ifTrue: [ "Inline values returned by #sizeFor: to ensure that #new: is not significantly slower than #new for small values." - numberOfElements < 3 - ifTrue: [ 3 ] - ifFalse: [ 5 ] ])! Item was removed: - ----- Method: HashedCollection class>>rehashAll (in category 'initialize-release') ----- - rehashAll - "HashedCollection rehashAll" - - self allSubclassesDo: [ :each | each rehashAllInstances ]! Item was removed: - ----- Method: HashedCollection class>>rehashAllInstances (in category 'initialize-release') ----- - rehashAllInstances - "Do not use #allInstancesDo: because #rehash may create new instances. Ignore immutable instances." - - self allInstances do: [ :each | - each isReadOnlyObject ifFalse: [ - each rehash ] ]! Item was removed: - ----- Method: HashedCollection class>>sizeFor: (in category 'sizing') ----- - sizeFor: numberOfElements - "Return a large enough prime (or odd if too large), the size of the internal array to hold numberOfElements with at most 75% load factor." - - ^self goodPrimeAtLeast: numberOfElements * 4 + 2 // 3 "Optimized version of (numberOfElements * 4 / 3) ceiling."! Item was removed: - ----- Method: HashedCollection>>add:withOccurrences: (in category 'adding') ----- - add: newObject withOccurrences: anInteger - "Add newObject anInteger times to the receiver. Do nothing if anInteger is less than one. Answer newObject." - - anInteger < 1 ifTrue: [ ^newObject ]. - ^self add: newObject "I can only store an object once." - ! Item was removed: - ----- Method: HashedCollection>>array (in category 'private') ----- - array - ^ array! Item was removed: - ----- Method: HashedCollection>>arrayType (in category 'private') ----- - arrayType - ^ Array! Item was removed: - ----- Method: HashedCollection>>atNewIndex:put: (in category 'private') ----- - atNewIndex: index put: anObject - - tally := tally + 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: anObject. - "Keep array at least 1/4 free for decent hash behavior" - array size * 3 < (tally * 4) ifTrue: [ self grow ]! Item was removed: - ----- Method: HashedCollection>>capacity (in category 'accessing') ----- - capacity - "Answer the current capacity of the receiver - aka the number of elements the receiver can hold without growing." - - ^ array size * 3 // 4! Item was removed: - ----- Method: HashedCollection>>comeFullyUpOnReload: (in category 'objects from disk') ----- - comeFullyUpOnReload: smartRefStream - "Symbols have new hashes in this image." - - self compact! Item was removed: - ----- Method: HashedCollection>>compact (in category 'private') ----- - compact - "Reduce the size of array so that the load factor will be ~75%." - - | newArraySize | - newArraySize := self class sizeFor: self slowSize. - array size = newArraySize ifFalse: [ - self growTo: newArraySize ]! Item was removed: - ----- Method: HashedCollection>>copyEmpty (in category 'copying') ----- - copyEmpty - "Answer an empty copy of this collection" - - "Note: this code could be moved to super" - - ^self species new! Item was removed: - ----- Method: HashedCollection>>errorNoFreeSpace (in category 'private') ----- - errorNoFreeSpace - - ^ self error: 'There is no free space in this collection!!' translated! Item was removed: - ----- Method: HashedCollection>>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." - - self subclassResponsibility! Item was removed: - ----- Method: HashedCollection>>grow (in category 'private') ----- - grow - "Grow the elements array and reinsert the old elements" - - self growTo: self growSize! Item was removed: - ----- Method: HashedCollection>>growSize (in category 'private') ----- - growSize - "Answer what my next higher table size should be" - - ^self class sizeFor: self slowSize * 2! Item was removed: - ----- Method: HashedCollection>>growTo: (in category 'private') ----- - growTo: anInteger - "Reallocate the elements array with the given size and reinsert the old elements. Do it even if the size of the array is the same as the argument because this method is also used to rehash the collection." - - | oldElements | - oldElements := array. - array := self arrayType new: anInteger. - self noCheckNoGrowFillFrom: oldElements! Item was removed: - ----- Method: HashedCollection>>initialize: (in category 'private') ----- - initialize: n - "Initialize array to an array size of n" - array := self arrayType new: n. - tally := 0! Item was removed: - ----- Method: HashedCollection>>isCompact (in category 'testing') ----- - isCompact - "Answer true if I have the smallest possible capacity to store the elements." - - ^array size = (self class sizeFor: self slowSize)! Item was removed: - ----- Method: HashedCollection>>isEmpty (in category 'testing') ----- - isEmpty - "For non-weak collections, we can use the tally to speed up the empty check. For weak collections, we must use the traditional way because the tally is unreliable. Also see #size vs. #slowSize." - - tally = 0 ifTrue: [ ^true ]. - ^array class isWeak and: [ super isEmpty ]! Item was removed: - ----- Method: HashedCollection>>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." - - self subclassResponsibility! Item was removed: - ----- Method: HashedCollection>>rehash (in category 'private') ----- - rehash - - self growTo: array size! Item was removed: - ----- Method: HashedCollection>>removeAll (in category 'removing') ----- - removeAll - "remove all elements from this collection. - Preserve the capacity" - - self initialize: array size! Item was removed: - ----- Method: HashedCollection>>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." - - self subclassResponsibility! Item was removed: - ----- Method: HashedCollection>>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 size | - index := start := anObject hash \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- Method: HashedCollection>>size (in category 'accessing') ----- - size - ^ tally! Item was removed: - ----- Method: HashedCollection>>slowSize (in category 'accessing') ----- - slowSize - "Answer an upper bound of the number of elements in this collection. For regular collections, this can simply be the value of tally, but for collections that cannot maintain an exact value, like current weak collections, this has to be calculated on the fly." - - ^tally! Item was removed: - ----- Method: HashedCollection>>someElement (in category 'accessing') ----- - someElement - - self deprecated: 'Use #anyOne'. - ^self anyOne! Item was removed: - ----- Method: HashedCollection>>union: (in category 'set logic') ----- - 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 - - ! Item was removed: - ----- Method: HashedCollection>>withIndexDo: (in category 'enumerating') ----- - withIndexDo: aBlock2 - "Support Set enumeration with a counter, even though not ordered" - | index | - index := 0. - self do: [:item | aBlock2 value: item value: (index := index+1)]! Item was removed: - Collection subclass: #Heap - instanceVariableNames: 'array tally sortBlock indexUpdateBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Heap'! - - !Heap commentStamp: 'ul 6/2/2016 23:45' prior: 0! - I implement a special data structure called Binary Heap [ https://en.wikipedia.org/wiki/Binary_heap ], which is the most commonly used variant of the Heap data structure [ https://en.wikipedia.org/wiki/Heap_%28data_structure%29 ]. - A Heap is a kind of binary tree stored in a linear array - see details after the instance variables description. - - Heaps are good at handling priority queues because: - 1) greatest priority element according to the sort block will be stored in first position and thus accessed in O(1) operations - 2) worse time for inserting or removing an element is in O(log n) operations, where n is the size of the Heap - Insertion/Removal times are more efficient than above upper bound, provided that: - a) Elements are only removed at the beginning - b) Elements are added with arbitrary sort order. - 3) there is no need to fully sort the Heap, which makes it more efficient than a SortedCollection - - The heap can be fully sorted by sending the message #sort. - Worse time for fully sorting the Heap is in O(n log n) operations, but this is rarely used a feature. - Remind that the Heap does not fully sort the collection if you don't ask. - Thus don't expect #do: and other iterators to enumerate elements according to the sortBlock order. - - 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. - - The Heap can be viewed as a binary tree (every node in the tree has at most two children). - The root is stored in first slot of internal array. - The children are stored in next two slots. - The children of children in next four slots. - etc... - For a node A of index i (1 based), the two children B1 and B2 are thus stored in indices (2*i) and (2*i+1). - Of course, the children indices must be less than the tally otherwise they are considered inexistent. - - The Heap does arrange to preserve the following invariant: - For any children B of a node A, A is sorted before B, in other words, (sortBlock value: A value: B) = true - This implies that the root is always the first element according to sort order. - - ! Item was removed: - ----- Method: Heap class>>new (in category 'instance creation') ----- - new - ^self new: 10! Item was removed: - ----- Method: Heap class>>new: (in category 'instance creation') ----- - new: n - ^super new setCollection: (Array new: n)! Item was removed: - ----- Method: Heap class>>on: (in category 'instance creation') ----- - on: anArray - "Create a new heap using anArray as the internal array" - - ^self on: anArray size: anArray size sortBlock: nil! Item was removed: - ----- Method: Heap class>>on:size: (in category 'instance creation') ----- - on: anArray size: size - "Create a new heap using the first size elements of anArray as the internal array" - - ^self - on: anArray - size: size - sortBlock: nil! Item was removed: - ----- Method: Heap class>>on:size:sortBlock: (in category 'instance creation') ----- - on: anArray size: size sortBlock: aBlockOrNil - "Create a new heap using the first size elements of anArray as the internal array and sorted by aBlockOrNil" - - anArray isArray ifFalse: [ self error: 'Array expected.' ]. - anArray size < size ifTrue: [ self error: 'size must not be larger than anArray size' ]. - ^super new - setCollection: anArray tally: size; - sortBlock: aBlockOrNil; - yourself! Item was removed: - ----- Method: Heap class>>sortBlock: (in category 'instance creation') ----- - sortBlock: aBlock - "Create a new heap sorted by the given block" - ^self new sortBlock: aBlock! Item was removed: - ----- Method: Heap class>>withAll: (in category 'instance creation') ----- - withAll: aCollection - "Create a new heap with all the elements from aCollection" - - ^self withAll: aCollection sortBlock: nil! Item was removed: - ----- Method: Heap class>>withAll:sortBlock: (in category 'instance creation') ----- - withAll: aCollection sortBlock: sortBlock - "Create a new heap with all the elements from aCollection, sorted by sortBlock" - - | array | - array := aCollection asArray. - array == aCollection ifTrue: [ array := array copy ]. - ^self on: array size: array size sortBlock: sortBlock! Item was removed: - ----- Method: Heap>>= (in category 'comparing') ----- - = anObject - "Heap are considered to be equal when they have the same sortBlock and the same elements. This method is expensive due to the sorted copies of the arrays. Try not to use it." - - self == anObject ifTrue: [ ^true ]. - anObject isHeap ifFalse: [ ^false ]. - anObject size = tally ifFalse: [ ^false ]. - anObject sortBlock = sortBlock ifFalse: [ ^false ]. - ^((array first: tally) sort: sortBlock) = ((anObject array first: tally) sort: sortBlock)! Item was removed: - ----- 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. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: anObject value: tally ]. - self upHeap: tally. - ^anObject! Item was removed: - ----- Method: Heap>>array (in category 'private') ----- - array - ^array! Item was removed: - ----- Method: Heap>>at: (in category 'accessing') ----- - at: index - "Return the element at the given position within the receiver" - - index > tally ifTrue: [ ^self errorSubscriptBounds: index ]. - ^array at: index! Item was removed: - ----- Method: Heap>>at:put: (in category 'accessing') ----- - at: index put: newObject - "Heaps are accessed with #add: not #at:put:" - ^self shouldNotImplement! Item was removed: - ----- Method: Heap>>capacity (in category 'accessing') ----- - capacity - "Answer the current capacity of the receiver." - - ^array size! Item was removed: - ----- Method: Heap>>collect: (in category 'enumerating') ----- - collect: aBlock - - ^(array first: tally) replace: aBlock! Item was removed: - ----- Method: Heap>>compact (in category 'growing') ----- - compact - "Remove any empty slots in the receiver." - - self isCompact ifTrue: [ ^self ]. - self growTo: self size.! Item was removed: - ----- Method: Heap>>copyEmpty (in category 'copying') ----- - copyEmpty - "Answer a copy of the receiver without any of the receiver's elements." - - ^self class sortBlock: sortBlock! Item was removed: - ----- 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)]! Item was removed: - ----- 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." - - | childIndex childValue index value | - index := anIndex. - value := array at: anIndex. - [ (childIndex := 2 * index) >= tally or: [ - "Select the child with the larger value. We know there are two children." - childValue := array at: childIndex. - (sortBlock - ifNil: [ (array at: childIndex + 1) <= childValue ] - ifNotNil: [ sortBlock value: (array at: childIndex + 1) value: childValue ]) - ifTrue: [ - childValue := array at: (childIndex := childIndex + 1) ]. - "Check if the value at index is at the right position." - sortBlock - ifNil: [ value <= childValue ] - ifNotNil: [ sortBlock value: value value: childValue ] ] ] - whileFalse: [ - "Move value downwards the tree." - array at: index put: childValue. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: childValue value: index ]. - "Contine from childIndex" - index := childIndex ]. - childIndex = tally ifTrue: [ "Special case: there's only one child." - "Check if the value at index is at the right position." - childValue := array at: childIndex. - (sortBlock - ifNil: [ value <= childValue ] - ifNotNil: [ sortBlock value: value value: childValue ]) - ifFalse: [ - "Move value downwards the tree." - array at: index put: childValue. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: childValue value: index ]. - "Contine from childIndex" - index := childIndex ] ]. - array at: index put: value. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]! Item was removed: - ----- 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." - - | childIndex index value | - index := anIndex. - value := array at: anIndex. - [ (childIndex := 2 * index) < tally ] whileTrue:[ - "Select the child with the larger value. We know there are two children." - (sortBlock - ifNil: [ (array at: childIndex + 1) <= (array at: childIndex) ] - ifNotNil: [ sortBlock value: (array at: childIndex + 1) value: (array at: childIndex) ]) - ifTrue: [ childIndex := childIndex + 1 ]. - array at: index put: (array at: childIndex). - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: index) value: index ]. - "and repeat at the next level" - index := childIndex ]. - childIndex = tally ifTrue: [ "Child with no sibling" - array at: index put: (array at: childIndex). - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: index) value: index ]. - index := childIndex ]. - array at: index put: value. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]. - self upHeap: index! Item was removed: - ----- Method: Heap>>first (in category 'accessing') ----- - first - "Return the first element in the receiver" - ^array at: 1! Item was removed: - ----- Method: Heap>>grow (in category 'growing') ----- - grow - "Become larger." - self growTo: self size + self growSize.! Item was removed: - ----- 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! Item was removed: - ----- Method: Heap>>growTo: (in category 'growing') ----- - growTo: newSize - "Grow to the requested size." - - | newArray | - newArray := Array new: (newSize max: tally). - newArray replaceFrom: 1 to: tally with: array startingAt: 1. - array := newArray! Item was removed: - ----- Method: Heap>>indexUpdateBlock: (in category 'accessing') ----- - indexUpdateBlock: aBlockOrNil - "aBlockOrNil is either nil or a two argument block. The first argument is the object whose index has changed in the heap, the second is the new index. The block will be evaluated whenever an element is moved in the heap's internal array. If you don't plan to remove elements by index (see #removeAt:), then you should not set this block." - - indexUpdateBlock := aBlockOrNil. - - ! Item was removed: - ----- Method: Heap>>isCompact (in category 'growing') ----- - isCompact - "Answer true if I have the smallest possible capacity to store the elements." - - ^array size = tally! Item was removed: - ----- Method: Heap>>isEmpty (in category 'testing') ----- - isEmpty - "Answer whether the receiver contains any elements." - ^tally = 0! Item was removed: - ----- Method: Heap>>isHeap (in category 'testing') ----- - isHeap - - ^ true! Item was removed: - ----- Method: Heap>>isValidHeap (in category 'testing') ----- - isValidHeap - - "Check the size first." - (tally between: 0 and: array size) ifFalse: [ ^false ]. - "Check the sort order between parent and child nodes." - 1 to: (tally bitShift: -1) do: [ :index | - | childIndex | - childIndex := 2 * index. - sortBlock - ifNil: [ (array at: index) <= (array at: childIndex) ifFalse: [ ^false ] ] - ifNotNil: [ (sortBlock value: (array at: index) value: (array at: childIndex)) ifFalse: [ ^false ] ]. - childIndex < tally ifTrue: [ - childIndex := childIndex + 1. - sortBlock - ifNil: [ (array at: index) <= (array at: childIndex) ifFalse: [ ^false ] ] - ifNotNil: [ (sortBlock value: (array at: index) value: (array at: childIndex)) ifFalse: [ ^false ] ] ] ]. - "Check for elements left in array after tally." - tally + 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ ^false ] ]. - ^true! Item was removed: - ----- Method: Heap>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - array := array copy! Item was removed: - ----- Method: Heap>>privateRemoveAt: (in category 'private') ----- - privateRemoveAt: index - "Remove the element at the given index and make sure the sorting order is okay. The value of index must not be larger than tally." - - | removed | - removed := array at: index. - index = tally ifTrue: [ - array at: index put: nil. - tally := tally - 1. - ^removed ]. - array - at: index put: (array at: tally); - at: tally put: nil. - tally := tally - 1. - 2 * index <= tally "The node at index has at least one child." - ifTrue: [ self downHeapSingle: index ] - ifFalse: [ self upHeap: index ]. - ^removed! Item was removed: - ----- Method: Heap>>privateReverseSort (in category 'private') ----- - privateReverseSort - "Arrange to have the array sorted in reverse order. - WARNING: this method breaks the heap invariants. It's up to the sender to restore them afterwards." - - | oldTally | - self deprecated: 'Use #sort if you want to sort.'. - oldTally := tally. - [tally > 1] whileTrue: - [array swap: 1 with: tally. - tally := tally - 1. - self downHeapSingle: 1]. - tally := oldTally! Item was removed: - ----- 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! Item was removed: - ----- Method: Heap>>removeAll (in category 'removing') ----- - removeAll - - array atAllPut: nil. - tally := 0! Item was removed: - ----- Method: Heap>>removeAt: (in category 'removing') ----- - removeAt: index - "Remove the element at the given index and make sure the sorting order is okay." - - index > tally ifTrue: [ self errorSubscriptBounds: index ]. - ^self privateRemoveAt: index! Item was removed: - ----- Method: Heap>>removeFirst (in category 'removing') ----- - removeFirst - "Remove the root element and make sure the sorting order is okay. Optimized version for the most common use case." - - | removed | - tally = 0 ifTrue: [ self errorSubscriptBounds: 1 ]. - removed := array at: 1. - array - at: 1 put: (array at: tally); - at: tally put: nil. - (tally := tally - 1) > 1 ifTrue: [ - "Root node has at least one child." - self downHeapSingle: 1 ]. - ^removed! Item was removed: - ----- Method: Heap>>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 | - newCollection := self copyEmpty. - 1 to: tally do: [ :index | - | element | - (aBlock value: (element := array at: index)) ifTrue: [ - newCollection add: element ] ]. - ^ newCollection! Item was removed: - ----- Method: Heap>>setCollection: (in category 'private') ----- - setCollection: aCollection - array := aCollection. - tally := 0.! Item was removed: - ----- Method: Heap>>setCollection:tally: (in category 'private') ----- - setCollection: aCollection tally: newTally - array := aCollection. - tally := newTally.! Item was removed: - ----- Method: Heap>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - ^ tally! Item was removed: - ----- Method: Heap>>sort (in category 'sorting') ----- - sort - "Fully sort the heap. This method preserves the heap invariants and can thus be sent safely" - - | start end element originalIndexUpdateBlock | - end := tally. - "Temporarly remove indexUpdateBlock to speed up sorting." - originalIndexUpdateBlock := indexUpdateBlock. - indexUpdateBlock := nil. - [ tally > 1 ] whileTrue: [ - element := array at: tally. - array - at: tally put: (array at: 1); - at: 1 put: element. - tally := tally - 1. - self downHeapSingle: 1 ]. - tally := end. - start := 1. - originalIndexUpdateBlock ifNil: [ - "The was no indexUpdateBlock; just reverse the elements" - [ start < end ] whileTrue: [ - element := array at: start. - array - at: start put: (array at: end); - at: end put: element. - start := start + 1. - end := end - 1 ]. - ^self ]. - "Restore indexUpdateBlock, reverse the elements and update the indices." - indexUpdateBlock := originalIndexUpdateBlock. - start := 1. - [ start < end ] whileTrue: [ - | endValue | - element := array at: start. - endValue := array at: end. - array - at: start put: endValue; - at: end put: element. - indexUpdateBlock - value: endValue value: start; - value: element value: end. - start := start + 1. - end := end - 1 ]. - start = end ifTrue: [ indexUpdateBlock value: (array at: start) value: start ]! Item was removed: - ----- Method: Heap>>sortBlock (in category 'accessing') ----- - sortBlock - ^sortBlock! Item was removed: - ----- Method: Heap>>sortBlock: (in category 'accessing') ----- - sortBlock: aBlock - - | oldIndexUpdateBlock | - sortBlock := aBlock. - "Restore the heap invariant." - tally <= 1 ifTrue: [ ^self ]. - oldIndexUpdateBlock := indexUpdateBlock. - indexUpdateBlock := nil. - (tally bitShift: -1) to: 1 by: -1 do: [ :index | self downHeap: index ]. - indexUpdateBlock := oldIndexUpdateBlock ifNil: [ ^self ]. - 1 to: tally do: [ :index | - indexUpdateBlock value: (array at: index) value: index ] - - ! Item was removed: - ----- Method: Heap>>upHeap: (in category 'private-heap') ----- - upHeap: anIndex - "Check the heap upwards for correctness starting at anIndex. - Everything below anIndex is ok." - - | index parentValue parentIndex value | - anIndex = 1 ifTrue: [ - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: (array at: 1) value: 1 ]. - ^self ]. - value := array at: (index := anIndex). - [ index > 1 and: [ - parentValue := array at: (parentIndex := index bitShift: -1). - sortBlock - ifNil: [ value <= parentValue ] - ifNotNil: [ sortBlock value: value value: parentValue ] ] ] - whileTrue: [ - array at: index put: parentValue. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: parentValue value: index ]. - index := parentIndex ]. - array at: index put: value. - indexUpdateBlock ifNotNil: [ indexUpdateBlock value: value value: index ]! Item was removed: - TextReadWriter subclass: #HtmlReadWriter - instanceVariableNames: 'count offset runStack runArray string breakLines' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! - - !HtmlReadWriter commentStamp: 'pre 8/29/2017 16:14' prior: 0! - A HtmlReadWriter is used to read a Text object from a string containing HTML or writing a Text object to a string with HTML tags representing the text attributes. - - It does two things currently: - 1) Setting text attributes on the beginning of tags, e.g. setting a bold text attribute when seeing a <b> tag. - 2) Changing the resulting string, e.g. replacing a <br> with a Character cr. - - The implementation works by pushing attributes on a stack on every opening tag. On the corresponding closing tag, the attribute is poped from the stack and stored in an array of attribute runs. From this array the final string is constructed. - - ## Notes on the implementation - - The final run array is completely constructed while parsing so it has to be correct with regard to the length of the runs. There is no consolidation except for merging neighboring runs which include the same attributes. - - The *count* variable is the position in the source string, the *offset* is the number of skipped characters, for example ones that denote a tag. - - The stack contains elements which are of the form: {text attributes. current start index. original start}! Item was removed: - ----- Method: HtmlReadWriter>>activateAttributesEnding:starting: (in category 'private') ----- - activateAttributesEnding: ending starting: starting - - starting - select: [:attribute | attribute shouldFormBlocks] - thenDo: [: attribute | - (ending includes: attribute) ifFalse: [self writeStartTagFor: attribute]]; - reject: [:attribute | attribute shouldFormBlocks] - thenDo: [: attribute | self writeStartTagFor: attribute].! Item was removed: - ----- Method: HtmlReadWriter>>addCharacter: (in category 'private') ----- - addCharacter: aCharacter - - string add: aCharacter. - count := count + 1.! Item was removed: - ----- Method: HtmlReadWriter>>addString: (in category 'private') ----- - addString: aString - - string addAll: aString. - count := count + aString size.! Item was removed: - ----- Method: HtmlReadWriter>>breakLines (in category 'accessing') ----- - breakLines - - ^ breakLines! Item was removed: - ----- Method: HtmlReadWriter>>breakLines: (in category 'accessing') ----- - breakLines: aBoolean - - breakLines := aBoolean! Item was removed: - ----- Method: HtmlReadWriter>>cr (in category 'stream emulation') ----- - cr - - self breakLines ifTrue: [stream nextPutAll: '<br>']. - ^ stream cr! Item was removed: - ----- Method: HtmlReadWriter>>deactivateAttributesEnding:starting: (in category 'private') ----- - deactivateAttributesEnding: ending starting: starting - - ending reversed - reject: [:attribute | attribute shouldFormBlocks] - thenDo: [: attribute | self writeEndTagFor: attribute]; - select: [:attribute | attribute shouldFormBlocks] - thenDo: [: attribute | - (starting includes: attribute) ifFalse: [self writeEndTagFor: attribute]].! Item was removed: - ----- Method: HtmlReadWriter>>httpGetImage: (in category 'private') ----- - httpGetImage: url - "To not add a direct dependency to WebClient, provide this hook for getting am image from an HTTP url. Maybe we can have this via an AppRegistry at some point. Maybe extend WebBrowser." - - (url beginsWith: 'code://') ifTrue: [ - "Same support for Smalltalk expressions as in TextURL >> #actOnClickFor:." - ^ ([Compiler evaluate: (url allButFirst: 7)] ifError: [nil]) - ifNotNil: [:object | object isForm ifTrue: [object] ifFalse: [nil]]]. - - (url beginsWith: 'data:') ifTrue: [ | data mediaType separator | - separator := url indexOf: $, ifAbsent: [^ nil]. - mediaType := url copyFrom: 6 to: separator - 1. - data := url allButFirst: separator. - data := (mediaType endsWith: ';base64') - ifTrue: [ - mediaType := mediaType allButLast: 7. - [Base64MimeConverter mimeDecodeToBytes: data readStream] ifError: [nil]] - ifFalse: [data asByteArray readStream]. - ^ [ImageReadWriter formFromStream: data] ifError: [nil]]. - - ^ (Smalltalk classNamed: 'WebClient') ifNotNil: [:client | - ([client httpGet: url] ifError: [nil]) ifNotNil: [:response | - response code = 200 ifFalse: [nil] ifTrue: [ - [Form fromBinaryStream: response content asByteArray readStream] - ifError: [nil]]]]! Item was removed: - ----- Method: HtmlReadWriter>>ignoredTags (in category 'accessing') ----- - ignoredTags - "Because we cannot process all of them." - - ^ #(body script table tr td ul ol li form select option input)! Item was removed: - ----- Method: HtmlReadWriter>>initialize (in category 'initialize-release') ----- - initialize - - super initialize. - self breakLines: true.! Item was removed: - ----- Method: HtmlReadWriter>>isTagIgnored: (in category 'testing') ----- - isTagIgnored: aTag - - | space t | - t := aTag copyWithoutAll: '</>'. - space := t indexOf: Character space. - t := space > 0 - ifTrue: [t copyFrom: 1 to: space - 1] - ifFalse: [t]. - ^ self ignoredTags includes: t! Item was removed: - ----- Method: HtmlReadWriter>>mapATag: (in category 'mapping') ----- - mapATag: aTag - - | result startIndex stopIndex attribute | - result := OrderedCollection new. - - "<a href=""http://google.de"">" - attribute := 'href'. - startIndex := aTag findString: attribute. - startIndex > 0 ifTrue: [ - startIndex := aTag findString: '"' startingAt: startIndex+attribute size. - startIndex > 0 - ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1] - ifFalse: [ - "URLs without quotes..." - startIndex := aTag findString: '=' startingAt: startIndex+attribute size. - stopIndex := aTag findString: '>' startingAt: startIndex+1]. - result add: (TextURL new url: (aTag copyFrom: startIndex+1 to: stopIndex-1))]. - - ^ result! Item was removed: - ----- Method: HtmlReadWriter>>mapAlignmentTag: (in category 'mapping') ----- - mapAlignmentTag: aTag - - | attributeStart | - " special html case ". - aTag = '<center>' ifTrue: [^ {TextAlignment centered}]. - - "<div align=justify> or <div align=""right"">" - attributeStart := aTag findString: 'align='. - attributeStart > 0 ifTrue: [ - | attributeRest | - attributeRest := aTag copyAfter: $=. - attributeRest first = $" ifTrue: [attributeRest := attributeRest allButFirst]. " quoted case " - ^ self mapAlignmentValue: (attributeRest findTokens: ' ">') first]. - ^ #()! Item was removed: - ----- Method: HtmlReadWriter>>mapAlignmentValue: (in category 'mapping') ----- - mapAlignmentValue: aString - - (aString = 'center' or: [aString = 'middle']) ifTrue: [^ {TextAlignment centered}]. - aString = 'left' ifTrue: [^ {TextAlignment leftFlush}]. - aString = 'right' ifTrue: [^ {TextAlignment rightFlush}]. - aString = 'justify' ifTrue: [^ {TextAlignment justified}]. - ^ #()! Item was removed: - ----- Method: HtmlReadWriter>>mapCloseCodeTag (in category 'mapping') ----- - mapCloseCodeTag - - | theDoIt | - theDoIt := runStack top first - detect: [:attribute | attribute isKindOf: TextDoIt] - ifNone: [^ self "nothing found, ignore"]. - theDoIt evalString: (String withAll: (string copyFrom: runStack top third to: string size)).! Item was removed: - ----- Method: HtmlReadWriter>>mapCodeTag (in category 'mapping') ----- - mapCodeTag - - ^ {TextDoIt new} "yet uninitialized"! Item was removed: - ----- Method: HtmlReadWriter>>mapContainerTag: (in category 'mapping') ----- - mapContainerTag: aTag - - | result styleStart styleEnd styleAttributes | - result := OrderedCollection new. - styleStart := (aTag findString: 'style="' ) + 7. - styleStart <= 7 ifTrue: [^#()]. - styleEnd := (aTag findString: '"' startingAt: styleStart) - 1. - styleAttributes := (aTag copyFrom: styleStart to: styleEnd) subStrings: ';'. - styleAttributes do: [:ea | |keyValue key value| - keyValue := (ea subStrings: ':') collect: [:s | s withBlanksTrimmed]. - key := keyValue first asLowercase. - value := keyValue second. - keyValue size = 2 ifTrue: [ - key = 'color' ifTrue: [result add: (TextColor color: (Color fromString: value))]. - (key beginsWith: 'font') ifTrue: [ - (value includesSubstring: 'bold') - ifTrue: [result add: TextEmphasis bold]. - (value includesSubstring: 'italic') - ifTrue: [result add: TextEmphasis italic]]]]. - ^ result! Item was removed: - ----- Method: HtmlReadWriter>>mapFontTag: (in category 'mapping') ----- - mapFontTag: aTag - - | result colorName fontFace fontSize | - result := OrderedCollection new. - - "<font color=""#00FFCC""> or <font color=""green"">" - "<font face=""Bitmap DejaVu Sans"" size=""12"">" - (#(color face size) collect: [:attribute | - | startIndex stopIndex | - startIndex := aTag findString: attribute. - startIndex > 0 ifTrue: [ - startIndex := aTag findString: '"' startingAt: startIndex+attribute size. - stopIndex := aTag findString: '"' startingAt: startIndex+1. - aTag copyFrom: startIndex+1 to: stopIndex-1]]) - in: [:values | - colorName := values first. - fontFace := values second. - fontSize := values third]. - - colorName ifNotNil: [ - result add: (TextColor color: (Color fromString: colorName))]. - (fontFace notNil or: [fontSize notNil]) ifTrue: [ - result add: (TextFontReference toFont: (StrikeFont familyName: (fontFace ifNil: [TextStyle defaultFont familyName]) pointSize: (fontSize ifNil: [TextStyle defaultFont pointSize])))]. - - ^ result! Item was removed: - ----- Method: HtmlReadWriter>>mapImgTag: (in category 'mapping') ----- - mapImgTag: aTag - - | result startIndex stopIndex attribute src form scaleFactor | - result := OrderedCollection new. - - "<img src=""https://squeak.org/img/downloads/image.png"">" - attribute := 'src'. - startIndex := aTag findString: attribute. - startIndex > 0 ifTrue: [ - startIndex := aTag findString: '"' startingAt: startIndex+attribute size. - startIndex > 0 - ifTrue: [stopIndex := aTag findString: '"' startingAt: startIndex+1] - ifFalse: [ - "URLs without quotes..." - startIndex := aTag findString: '=' startingAt: startIndex+attribute size. - stopIndex := aTag findString: '>' startingAt: startIndex+1]. - src := aTag copyFrom: startIndex+1 to: stopIndex-1. - form := (self httpGetImage: src) ifNil: [(Form dotOfSize: 12 color: Color veryLightGray)]. - (scaleFactor := RealEstateAgent scaleFactor) = 1.0 - ifFalse: [form := form scaledToSize: form extent * scaleFactor]. - result - add: form asTextAnchor; - add: (TextColor color: Color transparent)]. - ^ result! Item was removed: - ----- Method: HtmlReadWriter>>mapTagToAttribute: (in category 'mapping') ----- - mapTagToAttribute: aTag - - aTag = '<b>' ifTrue: [^ {TextEmphasis bold}]. - aTag = '<i>' ifTrue: [^ {TextEmphasis italic}]. - aTag = '<u>' ifTrue: [^ {TextEmphasis underlined}]. - aTag = '<s>' ifTrue: [^ {TextEmphasis struckOut}]. - aTag = '<code>' ifTrue: [^ self mapCodeTag]. - aTag = '<pre>' ifTrue: [self breakLines: false. ^ {}]. - (#('<div' '<span' '<center>' ) anySatisfy: [:ea | aTag beginsWith: ea]) - ifTrue: [^(self mapAlignmentTag: aTag) union: (self mapContainerTag: aTag)]. - (aTag beginsWith: '<font') ifTrue: [^ self mapFontTag: aTag]. - (aTag beginsWith: '<a') ifTrue: [^ self mapATag: aTag]. - (aTag beginsWith: '<img') ifTrue: [^ self mapImgTag: aTag]. - - "h1, h2, h3, ..." - (aTag second = $h and: [aTag third isDigit]) - ifTrue: [^ {TextEmphasis bold}]. - - ^ {}! Item was removed: - ----- Method: HtmlReadWriter>>nextPut: (in category 'stream emulation') ----- - nextPut: aCharacter - - ^ stream nextPut: aCharacter! Item was removed: - ----- Method: HtmlReadWriter>>nextPutAll: (in category 'stream emulation') ----- - nextPutAll: aCollection - - ^ stream nextPutAll: aCollection! Item was removed: - ----- Method: HtmlReadWriter>>nextPutText: (in category 'private') ----- - nextPutText: aText - - | previous | - previous := #(). - self activateAttributesEnding: #() starting: previous. "for consistency" - aText runs - withStartStopAndValueDo: [:start :stop :attributes | - self - deactivateAttributesEnding: previous starting: attributes; - activateAttributesEnding: previous starting: attributes; - writeContent: (aText string copyFrom: start to: stop). - previous := attributes]. - self deactivateAttributesEnding: previous starting: #().! Item was removed: - ----- Method: HtmlReadWriter>>nextText (in category 'private') ----- - nextText - - count := 0. - offset := 0. "To ignore characters in the input string that are used by tags." - - runStack := Stack new. - - runArray := RunArray new. - string := OrderedCollection new. - - "{text attributes. current start index. original start}" - runStack push: {OrderedCollection new. 1. 1}. - - [stream atEnd] whileFalse: [self processNextTag]. - self processRunStackTop. "Add last run." - - string := String withAll: string. - runArray coalesce. - - ^ Text - string: string - runs: runArray! Item was removed: - ----- Method: HtmlReadWriter>>processComment: (in category 'reading') ----- - processComment: aComment - ! Item was removed: - ----- Method: HtmlReadWriter>>processEmptyTag: (in category 'reading') ----- - processEmptyTag: aTag - - (aTag beginsWith: '<br') ifTrue: [ - self addCharacter: Character cr. - ^ self]. - - (aTag beginsWith: '<img') ifTrue:[ - ^ self processStartTag: aTag]. - - (self isTagIgnored: aTag) - ifTrue: [^ self]. - - "TODO... what?"! Item was removed: - ----- Method: HtmlReadWriter>>processEndTag: (in category 'reading') ----- - processEndTag: aTag - - | index tagName | - index := count - offset. - tagName := aTag copyFrom: 3 to: aTag size - 1. - - (self isTagIgnored: tagName) ifTrue: [^ self]. - - tagName = 'code' ifTrue: [self mapCloseCodeTag]. - tagName = 'pre' ifTrue: [self breakLines: true]. - - self processRunStackTop. - - runStack pop. - runStack top at: 2 put: index + 1.! Item was removed: - ----- Method: HtmlReadWriter>>processEndTagEagerly: (in category 'reading') ----- - processEndTagEagerly: aTag - "Not all tags need an end tag. Simulate that here." - - (aTag beginsWith: '<img') - ifTrue: [^ self processEndTag: '</img>'].! Item was removed: - ----- Method: HtmlReadWriter>>processHtmlEscape: (in category 'reading') ----- - processHtmlEscape: aString - | escapeSequence | - escapeSequence := aString copyFrom: 2 to: aString size - 1. - escapeSequence first = $# ifTrue: [^ self processHtmlEscapeNumber: escapeSequence allButFirst]. - (String htmlEntities at: (aString copyFrom: 2 to: aString size - 1) ifAbsent: []) - ifNotNil: [:char | - self addCharacter: char].! Item was removed: - ----- Method: HtmlReadWriter>>processHtmlEscapeNumber: (in category 'private') ----- - processHtmlEscapeNumber: aString - | number | - number := aString first = $x - ifTrue: [ '16r', aString allButFirst ] - ifFalse: [ aString ]. - self addCharacter: number asNumber asCharacter. - ! Item was removed: - ----- Method: HtmlReadWriter>>processNextTag (in category 'reading') ----- - processNextTag - - | tag htmlEscape lookForNewTag lookForHtmlEscape tagFound valid inComment inTagString | - lookForNewTag := true. - lookForHtmlEscape := false. - tagFound := false. - tag := OrderedCollection new. - htmlEscape := OrderedCollection new. - inComment := false. - inTagString := false. - - [stream atEnd not and: [tagFound not]] whileTrue: [ - | character | - character := stream next. - valid := (#(10 13) includes: character asciiValue) not. - count := count + 1. - - character = $< ifTrue: [lookForNewTag := false]. - character = $& ifTrue: [inComment ifFalse: [lookForHtmlEscape := true]]. - - lookForNewTag - ifTrue: [ - lookForHtmlEscape - ifFalse: [ - (valid or: [self breakLines not]) - ifTrue: [string add: character] - ifFalse: [offset := offset + 1]] - ifTrue: [valid ifTrue: [htmlEscape add: character]. offset := offset + 1]] - ifFalse: [valid ifTrue: [tag add: character]. offset := offset + 1]. - - "Toggle within tag string/text." - (character = $" and: [lookForNewTag not]) - ifTrue: [inTagString := inTagString not]. - - inComment := ((lookForNewTag not and: [tag size >= 4]) - and: [tag beginsWith: '<!!--']) - and: [(tag endsWith: '-->') not]. - - (((character = $> and: [inComment not]) and: [lookForNewTag not]) and: [inTagString not]) ifTrue: [ - lookForNewTag := true. - (tag beginsWith: '<!!--') - ifTrue: [self processComment: (String withAll: tag)] - ifFalse: [tag second ~= $/ - ifTrue: [ - (tag atLast: 2) == $/ - ifTrue: [self processEmptyTag: (String withAll: tag)] - ifFalse: [self processStartTag: (String withAll: tag)]] - ifFalse: [self processEndTag: (String withAll: tag)]]. - tagFound := true]. - - (((character = $; and: [lookForNewTag]) - and: [htmlEscape notEmpty]) and: [htmlEscape first = $&]) ifTrue: [ - lookForHtmlEscape := false. - self processHtmlEscape: (String withAll: htmlEscape). - htmlEscape := OrderedCollection new]]. - ! Item was removed: - ----- Method: HtmlReadWriter>>processRunStackTop (in category 'reading') ----- - processRunStackTop - "Write accumulated attributes to run array." - - | currentIndex start attrs | - currentIndex := count - offset. - start := runStack top second. - attrs := runStack top first. - runArray - add: attrs asArray - withOccurrences: currentIndex - start + 1.! Item was removed: - ----- Method: HtmlReadWriter>>processStartTag: (in category 'reading') ----- - processStartTag: aTag - - | index | - (self isTagIgnored: aTag) ifTrue: [^ self]. - - index := count - offset. - - aTag = '<br>' ifTrue: [ - self addCharacter: Character cr. - ^ self]. - - (aTag beginsWith: '<img') ifTrue: [ - self addString: Character startOfHeader asString. - offset := offset + 1. - index := index - 1]. - - self processRunStackTop. "To add all attributes before the next tag adds some." - - "Copy attr list and add new attr." - runStack push: ({runStack top first copy addAll: (self mapTagToAttribute: aTag); yourself. index + 1 . index + 1}). - - "For tags such as <img>, we should simulate the closing tag because there won't be any." - self processEndTagEagerly: aTag.! Item was removed: - ----- Method: HtmlReadWriter>>writeContent: (in category 'writing') ----- - writeContent: aString - - aString do: [:char | - (#(10 13) includes: char asciiValue) - ifTrue: [self cr] - ifFalse: [char = Character tab - ifTrue: [self nextPutAll: ' '] - ifFalse: [(String htmlEntities keyAtValue: char ifAbsent: []) - ifNil: [self nextPut: char] - ifNotNil: [:escapeSequence | - self - nextPut: $&; - nextPutAll: escapeSequence; - nextPut: $;]]]].! Item was removed: - ----- Method: HtmlReadWriter>>writeEndTagFor: (in category 'writing') ----- - writeEndTagFor: aTextAttribute - - [aTextAttribute closeHtmlOn: self] - on: MessageNotUnderstood do: []! Item was removed: - ----- Method: HtmlReadWriter>>writeStartTagFor: (in category 'writing') ----- - writeStartTagFor: aTextAttribute - - [aTextAttribute openHtmlOn: self] - on: MessageNotUnderstood do: [].! Item was removed: - 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. - ! Item was removed: - ----- Method: IdentityBag class>>contentsClass (in category 'instance creation') ----- - contentsClass - ^IdentityDictionary! Item was removed: - 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.! Item was removed: - ----- Method: IdentityDictionary>>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." - - ^self keyAtIdentityValue: value ifAbsent: exceptionBlock! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ element key == anObject ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - Set subclass: #IdentitySet - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Unordered'! - - !IdentitySet commentStamp: 'nice 8/26/2010 22:00' 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 identical: - - ('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 - ! Item was removed: - ----- Method: IdentitySet>>asIdentitySet (in category 'converting') ----- - asIdentitySet - ^self! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ element enclosedSetElement == anObject ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - SignedWordArray 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.! Item was removed: - ----- Method: IntegerArray>>asIntegerArray (in category 'converting') ----- - asIntegerArray - ^self! Item was removed: - SequenceableCollection subclass: #Interval - instanceVariableNames: 'start stop step' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !Interval commentStamp: '<historical>' prior: 0! - I represent a finite arithmetic progression.! Item was removed: - ----- 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." - - ^((startInteger hasLimitedPrecision or: [stopInteger hasLimitedPrecision]) - ifTrue: [self limitedPrecisionSpecies] - ifFalse: [self]) basicNew - setFrom: startInteger - to: stopInteger - by: 1! Item was removed: - ----- 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." - - ^((startInteger hasLimitedPrecision or: [stopInteger hasLimitedPrecision or: [stepInteger hasLimitedPrecision]]) - ifTrue: [self limitedPrecisionSpecies] - ifFalse: [self]) basicNew - setFrom: startInteger - to: stopInteger - by: stepInteger! Item was removed: - ----- Method: Interval class>>initializedInstance (in category 'instance creation') ----- - initializedInstance - ^self newFrom: #()! Item was removed: - ----- Method: Interval class>>limitedPrecisionSpecies (in category 'instance creation') ----- - limitedPrecisionSpecies - "Answer a class able to handle limited precision bounds or step" - - ^LimitedPrecisionInterval! Item was removed: - ----- 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 anyOne to: aCollection anyOne]. - newInterval := self - from: aCollection first - to: aCollection last - by: (aCollection last - aCollection first) / (n - 1). - (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. - "! Item was removed: - ----- Method: Interval>>+ (in category 'arithmetic') ----- - + number - - ^ start + number to: stop + number by: step! Item was removed: - ----- Method: Interval>>, (in category 'adding') ----- - , otherCollection - "Override to answer an Interval if otherCollection is an adjacent and congruent interval." - ^(otherCollection isInterval - and: [otherCollection increment = step - and: [otherCollection first = (self last + step)]]) - ifTrue: [self class from: start to: otherCollection last by: step] - ifFalse: [super, otherCollection]! Item was removed: - ----- Method: Interval>>- (in category 'arithmetic') ----- - - number - - ^ start - number to: stop - number by: step! Item was removed: - ----- Method: Interval>>= (in category 'comparing') ----- - = anObject - ^ self == anObject - or: [anObject isInterval - ifFalse: [super = anObject] - ifTrue: - [start = anObject first - and: [step = anObject increment - and: [self last = anObject last]]]]! Item was removed: - ----- Method: Interval>>add: (in category 'adding') ----- - add: newObject - "Adding to an Interval is not allowed." - - self shouldNotImplement! Item was removed: - ----- Method: Interval>>addAllFirstTo: (in category 'adding') ----- - addAllFirstTo: anOrderedCollection - "Add all of my elements to the beginning of anOrderedCollection" - - self reverseDo: [ :each | anOrderedCollection addFirst: each ]! Item was removed: - ----- Method: Interval>>anyOne (in category 'accessing') ----- - anyOne - "This message will fail for an empty Interval, super would not." - ^self at: 1! Item was removed: - ----- 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]! Item was removed: - ----- 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'! Item was removed: - ----- 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! Item was removed: - ----- Method: Interval>>copyFrom:to: (in category 'copying') ----- - copyFrom: startIndex to: stopIndex - (startIndex = 1 and: [stopIndex = self size]) ifTrue: [^self]. - stopIndex < startIndex ifTrue: [^self copyEmpty]. - ^(self at: startIndex) to: (self at: stopIndex) by: step! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Interval>>extent (in category 'accessing') ----- - extent - "Answer the max - min of the receiver interval." - "(10 to: 50) extent" - - ^stop - start! Item was removed: - ----- Method: Interval>>first (in category 'accessing') ----- - first - "Refer to the comment in SequenceableCollection|first." - - ^start! Item was removed: - ----- Method: Interval>>hash (in category 'comparing') ----- - hash - "Hash is reimplemented because = is implemented." - ^((start hash hashMultiply bitXor: self last hash) hashMultiply - bitXor: self size)! Item was removed: - ----- Method: Interval>>increment (in category 'accessing') ----- - increment - "Answer the receiver's interval increment." - - ^step! Item was removed: - ----- Method: Interval>>indexOf:startingAt: (in category 'accessing') ----- - indexOf: anElement startingAt: startIndex - "startIndex is an positive integer, the collection index where the search is started." - - | index | - index := (anElement - start / step) rounded + 1. - (index between: startIndex and: self size) ifFalse: [ ^0 ]. - (self at: index) = anElement ifFalse: [ ^0 ]. - ^index! Item was removed: - ----- Method: Interval>>isEmpty (in category 'testing') ----- - isEmpty - ^self size = 0! Item was removed: - ----- Method: Interval>>isInterval (in category 'testing') ----- - isInterval - - ^ true! Item was removed: - ----- Method: Interval>>last (in category 'accessing') ----- - last - "Refer to the comment in SequenceableCollection|last." - - ^stop - (stop - start \\ step)! Item was removed: - ----- 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 - ! Item was removed: - ----- 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: $)! Item was removed: - ----- 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] - ! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Interval>>reversed (in category 'converting') ----- - reversed - self isEmpty ifTrue: [^stop to: start by: step negated]. - ^self last to: start by: step negated! Item was removed: - ----- Method: Interval>>setFrom:to:by: (in category 'private') ----- - setFrom: startInteger to: stopInteger by: stepInteger - - start := startInteger. - stop := stopInteger. - step := stepInteger! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Interval>>sorted (in category 'sorting') ----- - sorted - "an Interval is already sorted" - step < 0 ifTrue: [^self reversed]. - ^self! Item was removed: - ----- Method: Interval>>species (in category 'private') ----- - species - - ^Array! Item was removed: - ----- Method: Interval>>start (in category 'accessing') ----- - start - ^ start! Item was removed: - ----- Method: Interval>>stop (in category 'accessing') ----- - stop - ^ stop! Item was removed: - ----- 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: $)! Item was removed: - ----- Method: Interval>>sum (in category 'accessing') ----- - sum - "Optimized version. Use the sum(n * i - k, i=a..b) = -1/2 * (a - b - 1) * (n * (a + b) - 2 * k) equation with a = 1, n = step, b = self size and k = step - start." - - | b | - b := self size. - ^b * ((b - 1) * step + (start * 2)) / 2! Item was removed: - Error subclass: #KeyNotFound - instanceVariableNames: 'key' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Exceptions'! Item was removed: - ----- Method: KeyNotFound class>>key: (in category 'instance creation') ----- - key: anObject - ^self new key: anObject! Item was removed: - ----- Method: KeyNotFound>>description (in category 'accessing') ----- - description - "Return a textual description of the exception." - ^self messageText! Item was removed: - ----- Method: KeyNotFound>>key (in category 'accessing') ----- - key - "The key which wasn't found" - ^key! Item was removed: - ----- Method: KeyNotFound>>key: (in category 'accessing') ----- - key: anObject - "The key which wasn't found" - key := anObject! Item was removed: - ----- Method: KeyNotFound>>messageText (in category 'accessing') ----- - messageText - - ^ messageText ifNil: ['Key not found: {1}' translated format: {self key}]! Item was removed: - KeyedSet subclass: #KeyedIdentitySet - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Unordered'! - - !KeyedIdentitySet commentStamp: 'nice 8/26/2010 22:01' prior: 0! - A KeyedIdentitySet is like a Bag, except that items are compared with #== instead of #= . - - See the comment of IdentitySet for more information.! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ (keyBlock value: element enclosedSetElement) == anObject ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - 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.! Item was removed: - ----- 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! Item was removed: - ----- 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 | - index := self scanFor: (keyBlock value: newObject). - (array at: index) ifNil: [self atNewIndex: index put: newObject asSetElement]. - ^ newObject! Item was removed: - ----- 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! Item was removed: - ----- Method: KeyedSet>>at: (in category 'accessing') ----- - at: key - "Answer the value associated with the key." - - ^ self at: key ifAbsent: [self errorKeyNotFound: key]! Item was removed: - ----- 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." - - ^(array at: (self scanFor: key)) ifNil: [ aBlock value ] ifNotNil:[:obj| obj enclosedSetElement]! Item was removed: - ----- 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]! Item was removed: - ----- 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." - - ^(array at: (self scanFor: key)) ifNotNil: [:obj| aBlock value: obj enclosedSetElement]! Item was removed: - ----- Method: KeyedSet>>at:ifPresent:ifAbsent: (in category 'accessing') ----- - at: key ifPresent: oneArgBlock ifAbsent: absentBlock - "Lookup the given key in the receiver. If it is present, answer the - value of evaluating the oneArgBlock with the value associated - with the key, otherwise answer the value of absentBlock." - - ^(array at: (self scanFor: key)) - ifNil: [ absentBlock value ] - ifNotNil: [ :value | oneArgBlock value: value enclosedSetElement ]! Item was removed: - ----- Method: KeyedSet>>copyEmpty (in category 'copying') ----- - copyEmpty - - ^super copyEmpty - keyBlock: keyBlock; - yourself! Item was removed: - ----- Method: KeyedSet>>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 := array at: (index := index \\ array size + 1)) == nil ] whileFalse: [ - | newIndex | - (newIndex := self scanFor: (keyBlock value: element enclosedSetElement)) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: nil ] ]! Item was removed: - ----- Method: KeyedSet>>includes: (in category 'testing') ----- - includes: anObject - - (array at: (self scanFor: (keyBlock value: anObject))) ifNil: [ ^false ] ifNotNil: [ ^true ]! Item was removed: - ----- Method: KeyedSet>>includesKey: (in category 'testing') ----- - includesKey: key - - (array at: (self scanFor: key)) ifNil: [ ^false ] ifNotNil: [ ^true ]! Item was removed: - ----- Method: KeyedSet>>initialize: (in category 'private') ----- - initialize: n - - super initialize: n. - keyBlock := #key - ! Item was removed: - ----- 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! Item was removed: - ----- Method: KeyedSet>>keys (in category 'accessing') ----- - keys - "Answer an Array containing the receiver's keys." - - ^Array new: self size streamContents: [:s| self keysDo: [:key| s nextPut: key]]! Item was removed: - ----- Method: KeyedSet>>keysDo: (in category 'accessing') ----- - keysDo: block - - self do: [:item | block value: (keyBlock value: item)]! Item was removed: - ----- Method: KeyedSet>>keysSorted (in category 'accessing') ----- - keysSorted - - ^self keys sort! Item was removed: - ----- Method: KeyedSet>>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: (keyBlock value: anObject))) - ifNotNil: [ :element | element enclosedSetElement]! Item was removed: - ----- Method: KeyedSet>>like:ifAbsent: (in category 'accessing') ----- - like: anObject ifAbsent: aBlock - "Answer an object in the receiver that is equal to anObject, - or evaluate the block if not found. Relies heavily on hash properties" - - ^(array at: (self scanFor: (keyBlock value: anObject))) - ifNil: [ aBlock value ] - ifNotNil: [ :element | element enclosedSetElement ]! Item was removed: - ----- Method: KeyedSet>>member: (in category 'adding') ----- - member: newObject - "Include newObject as one of the receiver's elements, if already exists just return it" - - | index | - index := self scanFor: (keyBlock value: newObject). - (array at: index) ifNotNil: [ :element | ^element enclosedSetElement]. - self atNewIndex: index put: newObject asSetElement. - ^ newObject! Item was removed: - ----- 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 | - (anArray at: index) ifNotNil: [ :object | - array - at: (self scanForEmptySlotFor: (keyBlock value: object enclosedSetElement)) - put: object ] ]! Item was removed: - ----- Method: KeyedSet>>put: (in category 'accessing') ----- - put: newObject - "Include newObject as one of the receiver's elements even if there is already an element with the same key. Answer the replaced SetElement object or nil if no element existed with newObject's key. This method's behavior is similar to Dictionary >> #at:put:'s, hence the name." - - | index | - index := self scanFor: (keyBlock value: newObject). - (array at: index) - ifNil: [ - self atNewIndex: index put: newObject asSetElement. - ^nil ] - ifNotNil: [ :oldObject | - array at: index put: newObject asSetElement. - ^oldObject ]! Item was removed: - ----- Method: KeyedSet>>remove:ifAbsent: (in category 'removing') ----- - remove: oldObject ifAbsent: aBlock - - | index | - index := self scanFor: (keyBlock value: oldObject). - (array at: index) ifNil: [ ^ aBlock value ]. - tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: nil. - self fixCollisionsFrom: index. - ^ oldObject! Item was removed: - ----- Method: KeyedSet>>removeAll (in category 'removing') ----- - removeAll - "See super." - - | tmp | - tmp := keyBlock. - super removeAll. - keyBlock := tmp! Item was removed: - ----- Method: KeyedSet>>removeKey: (in category 'removing') ----- - removeKey: key - - ^ self removeKey: key ifAbsent: [self errorKeyNotFound: key]! Item was removed: - ----- Method: KeyedSet>>removeKey:ifAbsent: (in category 'removing') ----- - removeKey: key ifAbsent: aBlock - - | index obj | - index := self scanFor: key. - obj := (array at: index) ifNil: [ ^ aBlock value ]. - tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: nil. - self fixCollisionsFrom: index. - ^ obj enclosedSetElement! Item was removed: - ----- 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 size | - index := start := anObject hash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ (keyBlock value: element enclosedSetElement) = anObject ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - Object subclass: #LRUCache - instanceVariableNames: 'map head calls hits size factory' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Cache'! - - !LRUCache commentStamp: 'ul 4/12/2015 02:55' prior: 0! - I'm a cache of values, given a key I return a Value from the cache or from the factory. - - I use a Dictionary to find the corresponding value for the given key. I also store the key-value pairs in a circular doubly-linked list with a head element. The list is implemented by an LRUCacheHeadNode - stored in the head instance variable - and an LRUCacheNode for each key-value pair. The nodes in the list are ordered by access time. The first node (next of head) is the most recently accessed, the last one (previous of head) is the least recently accessed. - If the number of stored key-value pairs is equal to size, and a new pair needs to be stored, then I remove the least recently used pair before adding the new pair.! Item was removed: - ----- Method: LRUCache class>>size:factory: (in category 'instance creation') ----- - size: aNumber factory: aBlock - "answer an instance of the receiver" - ^ self new initializeSize: aNumber factory: aBlock! Item was removed: - ----- Method: LRUCache class>>test (in category 'testing') ----- - test - " - LRUCache test - " - | c | - c := LRUCache - size: 5 - factory: [:key | key * 2]. - c at: 1. - c at: 2. - c at: 3. - c at: 4. - c at: 1. - c at: 5. - c at: 6. - c at: 7. - c at: 8. - c at: 1. - ^ c! Item was removed: - ----- Method: LRUCache class>>test2 (in category 'testing') ----- - test2 - " - LRUCache test2. - Time millisecondsToRun:[LRUCache test2]. - MessageTally spyOn:[LRUCache test2]. - " - | c | - c := LRUCache - size: 600 - factory: [:key | key * 2]. - 1 - to: 6000 - do: [:each | c at: each]. - ^ c! Item was removed: - ----- Method: LRUCache>>at: (in category 'accessing') ----- - at: aKey - "answer the object for aKey, if not present in the cache creates it" - - calls := calls + 1. - ^map - at: aKey - ifPresent: [ :node | - hits := hits + 1. - head next == node ifFalse: [ - node - unlink; - linkAfter: head ]. - node value ] - ifAbsent: [ - | node | - map size = size - ifTrue: [ - node := head previous. - node unlink. - map removeKey: node key. ] - ifFalse: [ node := LRUCacheNode new ]. - node linkAfter: head. - map at: aKey put: node. - node - key: aKey; - value: (factory value: aKey); - value ]! Item was removed: - ----- Method: LRUCache>>initializeSize:factory: (in category 'initialization') ----- - initializeSize: anInteger factory: aBlock - "initialize the receiver's size and factory" - - anInteger strictlyPositive ifFalse: [ self error: 'Size must be at least 1' ]. - size := anInteger. - head := LRUCacheHeadNode new. - map := PluggableDictionary integerDictionary. - factory := aBlock. - calls := 0. - hits := 0! Item was removed: - ----- Method: LRUCache>>printOn: (in category 'printing') ----- - printOn: aStream - "Append to the argument, aStream, a sequence of characters - that identifies the receiver." - aStream nextPutAll: self class name; - nextPutAll: ' size:'; - nextPutAll: size asString; - nextPutAll: ', calls:'; - nextPutAll: calls asString; - nextPutAll: ', hits:'; - nextPutAll: hits asString; - nextPutAll: ', ratio:'; - nextPutAll: ((hits isNumber and: [calls isNumber and: [calls ~= 0]]) - ifTrue: [hits / calls] - ifFalse: [0]) asFloat asString! Item was removed: - ----- Method: LRUCache>>reset (in category 'initialization') ----- - reset - - self initializeSize: size factory: factory! Item was removed: - Object subclass: #LRUCacheHeadNode - instanceVariableNames: 'next previous' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Cache'! Item was removed: - ----- Method: LRUCacheHeadNode>>initialize (in category 'initialize-release') ----- - initialize - - previous := next := self! Item was removed: - ----- Method: LRUCacheHeadNode>>next (in category 'accessing') ----- - next - - ^next! Item was removed: - ----- Method: LRUCacheHeadNode>>next: (in category 'accessing') ----- - next: anObject - - next := anObject! Item was removed: - ----- Method: LRUCacheHeadNode>>previous (in category 'accessing') ----- - previous - - ^previous! Item was removed: - ----- Method: LRUCacheHeadNode>>previous: (in category 'accessing') ----- - previous: anObject - - previous := anObject! Item was removed: - LRUCacheHeadNode subclass: #LRUCacheNode - instanceVariableNames: 'key value' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Cache'! Item was removed: - ----- Method: LRUCacheNode>>key (in category 'accessing') ----- - key - - ^key! Item was removed: - ----- Method: LRUCacheNode>>key: (in category 'accessing') ----- - key: anObject - - key := anObject! Item was removed: - ----- Method: LRUCacheNode>>linkAfter: (in category 'list operations') ----- - linkAfter: anLRUCacheHeadNode - - next := anLRUCacheHeadNode next. - previous := anLRUCacheHeadNode. - next previous: self. - previous next: self! Item was removed: - ----- Method: LRUCacheNode>>printOn: (in category 'accessing') ----- - printOn: stream - - super printOn: stream. - stream - nextPut: $(; - print: key; - nextPutAll: ', '; - print: value; - nextPut: $)! Item was removed: - ----- Method: LRUCacheNode>>unlink (in category 'list operations') ----- - unlink - - next previous: previous. - previous next: next. - next := previous := nil! Item was removed: - ----- Method: LRUCacheNode>>value (in category 'accessing') ----- - value - - ^value! Item was removed: - ----- Method: LRUCacheNode>>value: (in category 'accessing') ----- - value: anObject - - value := anObject! Item was removed: - CharacterSet subclass: #LazyCharacterSet - instanceVariableNames: 'block' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! - - !LazyCharacterSet commentStamp: 'nice 2/12/2019 22:36' prior: 0! - A LazyCharacterSet is a kind of CharacterSet which does not know in advance which Character it contains or not. - If will lazily evaluate a block on demand if ever one ask whether it includes: a character. - It is not feasible to enumerate a LazyCharacterSet, because there are way too many characters. - - Instance Variables - block: <BlockContext | Symbol> - byteArrayMapCache: <ByteArray | nil> - - block - - a valuable, answering either true or false when sent the message value: - true means that this set includes the character passed as value: argument. - - byteArrayMapCache - - a cache holding 0 or 1 for the first 256 character codes - 0 meaning not included, 1 included. This is used in some primitives - ! Item was removed: - ----- Method: LazyCharacterSet class>>including: (in category 'instance creation') ----- - including: aBlock - "Create the set of Character for which aBlock evaluates to true" - ^self new block: aBlock! Item was removed: - ----- Method: LazyCharacterSet>>add: (in category 'adding') ----- - add: aCharacter - | oldBlock | - oldBlock := block. - block := [:c | c = aCharacter or: [oldBlock value: c]]. - ^aCharacter! Item was removed: - ----- Method: LazyCharacterSet>>addAll: (in category 'adding') ----- - addAll: aCollection - | oldBlock | - oldBlock := block. - block := [:c | (aCollection includes: c) or: [oldBlock value: c]]. - ^aCollection! Item was removed: - ----- Method: LazyCharacterSet>>block (in category 'accessing') ----- - block - ^block! Item was removed: - ----- Method: LazyCharacterSet>>block: (in category 'accessing') ----- - block: aValuable - "Set the block used to determine if I include a Character or not. - aValuable is an object that shoud answer true or false when sent value:" - - byteArrayMap := nil. - block := aValuable! Item was removed: - ----- Method: LazyCharacterSet>>canBeEnumerated (in category 'testing') ----- - canBeEnumerated - ^false! Item was removed: - ----- Method: LazyCharacterSet>>do: (in category 'enumerating') ----- - do: aBlock - "evaluate aBlock with each character in the set. - don't do it, there are too many loop..." - - self shouldNotImplement! Item was removed: - ----- Method: LazyCharacterSet>>enumerationCost (in category 'private') ----- - enumerationCost - "The maximum cost. I can't even do: loops, it's too expensive." - - ^100! Item was removed: - ----- Method: LazyCharacterSet>>includes: (in category 'testing') ----- - includes: aCharacter - ^block value: aCharacter! Item was removed: - ----- Method: LazyCharacterSet>>includesCode: (in category 'testing') ----- - includesCode: anInteger - ^block value: (Character value: anInteger)! Item was removed: - ----- Method: LazyCharacterSet>>intersection: (in category 'enumerating') ----- - intersection: aCollection - ^((self isCharacters: aCollection) - ifTrue: [aCollection select: block] - ifFalse: - ["protect feeding block with non character" - aCollection select: [:e |e isCharacter and: [block value: e]]]) as: CharacterSet - ! Item was removed: - ----- Method: LazyCharacterSet>>printElementsOn: (in category 'printing') ----- - printElementsOn: aString - "Do nothing,elements cannot be directly enumerated"! Item was removed: - ----- Method: LazyCharacterSet>>reject: (in category 'enumerating') ----- - reject: aBlock - ^self class including: [:char | (aBlock value: char) not and: [block value: char]]! Item was removed: - ----- Method: LazyCharacterSet>>remove: (in category 'removing') ----- - remove: aCharacter - | oldBlock | - oldBlock := block. - block := [:c | (c = aCharacter) not and: [oldBlock value: c]]. - ^aCharacter! Item was removed: - ----- Method: LazyCharacterSet>>remove:ifAbsent: (in category 'removing') ----- - remove: aCharacter ifAbsent: aBlock - (self includes: aCharacter) ifFalse: [^aBlock value]. - ^self remove: aCharacter! Item was removed: - ----- Method: LazyCharacterSet>>removeAll: (in category 'removing') ----- - removeAll: aCollection - | oldBlock | - oldBlock := block. - block := [:c | (aCollection includes: c) not and: [oldBlock value: c]]. - ^aCollection! Item was removed: - ----- Method: LazyCharacterSet>>select: (in category 'enumerating') ----- - select: aBlock - ^self class including: [:char | (block value: char) and: [aBlock value: char]]! Item was removed: - ----- Method: LazyCharacterSet>>union: (in category 'enumerating') ----- - union: aCollection - (self isCharacters: aCollection) ifFalse: [^super union: aCollection]. - ^self class including: [:c | (aCollection includes: c) or: [block value: c]]! Item was removed: - Interval subclass: #LimitedPrecisionInterval - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !LimitedPrecisionInterval commentStamp: 'nice 3/3/2021 01:47' prior: 0! - A LimitedPrecisionInterval is an Interval whose bounds or step haveLimitedPrecision. - Due to inexact arithmetic, special precautions must be taken in the implementation, - in order to avoid unconsistent and surprising behavior as much as possible. - - Despite those efforts, LimitedPrecisionInterval is full of pitfalls. - It is recommended to avoid using LimitedPrecisionInterval unless understanding those pitfalls. - For example, (0.2 to: 0.6 by: 0.1) last = 0.5. - This interval does not includes 0.6 because (0.1*4+0.2) is slightly greater than 0.6. - Another example is that (0.2 to: 0.6 by: 0.1) does not include 0.3 but a Float slightly greater. - - A usual workaround is to use an Integer interval, and reconstruct the Float inside the loop. - For example: - (0 to: 4) collect: [:i | 0.1*i+0.2]. - or better if we want to have 0.3 and 0.6: - (2 to: 6) collect: [:i | i / 10.0]. - Another workaround is to not use limited precision at all, but Fraction or ScaledDecimal when possible: - (1/10 to: 7/10 by: 1/10). - (0.1s to: 0.7s by: 0.1s). - - Yet another pitfall is that optimized to:by:do: might differ from (to:by:) do: - In the former case, repeated addition of increment is used, in the later, a multiplication is used. - Observe the differences: - Array streamContents: [:str | 0 to: 3 by: 0.3 do: [:e | str nextPut: e]]. - Array streamContents: [:str | (0 to: 3 by: 0.3) do: [:e | str nextPut: e]]. - - There are many more discrepancies, so use carefully, or not use it at all.! Item was removed: - ----- Method: LimitedPrecisionInterval>>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. - Implementation notes: see do: for an explanation on loop detail" - | result | - result := self species new: self size. - 1 to: result size do: - [:i | - "(self at: i) is inlined here to avoid repeated bound checking" - result at: i put: (aBlock value: i - 1 * step + start)]. - ^ result! Item was removed: - ----- Method: LimitedPrecisionInterval>>copyFrom:to: (in category 'copying') ----- - copyFrom: startIndex to: stopIndex - startIndex = 1 ifTrue: [^super copyFrom: startIndex to: stopIndex]. - stopIndex < startIndex ifTrue: [^self copyEmpty]. - ^Array new: stopIndex - startIndex + 1 streamContents: [:stream | - startIndex to: stopIndex do: [:i | stream nextPut: (self at: i)]]! Item was removed: - ----- Method: LimitedPrecisionInterval>>do: (in category 'enumerating') ----- - do: aBlock - "Evaluate aBlock for each value of the interval. - Implementation note: instead of repeatedly incrementing the value - aValue := aValue + step. - until stop is reached, - We prefer to recompute value from start - aValue := start + (index * step). - This is better for floating points accuracy, while not degrading Integer and Fraction speed too much. - Moreover, this is consistent with methods #at: and #size" - - | aValue index size | - index := 0. - size := self size. - [index < size] - whileTrue: [aValue := start + (index * step). - index := index + 1. - aBlock value: aValue]! Item was removed: - ----- Method: LimitedPrecisionInterval>>last (in category 'accessing') ----- - last - "Refer to the comment in SequenceableCollection|last." - - ^start + (step * (self size - 1))! Item was removed: - ----- Method: LimitedPrecisionInterval>>reverseDo: (in category 'enumerating') ----- - reverseDo: aBlock - "Evaluate aBlock for each element of my interval, in reverse order. - Implementation notes: see do: for an explanation on loop detail" - - | aValue index | - index := self size. - [index > 0] - whileTrue: [ - index := index - 1. - aValue := start + (index * step). - aBlock value: aValue]! Item was removed: - ----- Method: LimitedPrecisionInterval>>reversed (in category 'converting') ----- - reversed - "There is no guaranty that super reversed would contain same elements. - Answer an Array instead" - - ^Array new: self size streamContents: [:stream | self reverseDo: [:each | stream nextPut: each]]! Item was removed: - ----- Method: LimitedPrecisionInterval>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - | candidateSize | - candidateSize := (stop - start / step max: 0) rounded. - step > 0 - ifTrue: [candidateSize * step + start <= stop ifTrue: [^candidateSize + 1]] - ifFalse: [candidateSize * step + start >= stop ifTrue: [^candidateSize + 1]]. - ^candidateSize! Item was removed: - 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. ! Item was removed: - ----- Method: LimitedWriteStream>>next:putAll:startingAt: (in category 'writing') ----- - next: anInteger putAll: aCollection startingAt: startIndex - "Store the next anInteger elements from the given collection." - - | newEnd | - anInteger > 0 ifFalse: [ ^aCollection ]. - - newEnd := position + anInteger. - newEnd > limit ifTrue: [ - super next: (limit - position max: 0) putAll: aCollection startingAt: startIndex. - limitBlock value. - ^ aCollection]. - - ^ super next: anInteger putAll: aCollection startingAt: startIndex! Item was removed: - ----- Method: LimitedWriteStream>>nextPut: (in category 'accessing') ----- - nextPut: anObject - "Ensure that the limit is not exceeded" - - position >= limit - ifTrue: - [ limitBlock value. - ^anObject ]. - ^super nextPut: anObject - ! Item was removed: - ----- Method: LimitedWriteStream>>nextPutAll: (in category 'writing') ----- - 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. - ^aCollection - ]. - newEnd > writeLimit ifTrue: [ - self growTo: newEnd - ]. - - collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. - position := newEnd. - ^aCollection! Item was removed: - ----- Method: LimitedWriteStream>>pastEndPut: (in category 'private') ----- - pastEndPut: anObject - collection size >= limit ifTrue: [limitBlock value]. "Exceptional return" - ^ super pastEndPut: anObject! Item was removed: - ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'initialize-release') ----- - 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! Item was removed: - 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! Item was removed: - ----- 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 - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: LimitingLineStreamWrapper class>>exampleStream (in category 'examples') ----- - exampleStream - ^ReadStream on: - 'From me at somewhere - From: me - To: you - Subject: Test - - Test - - From you at elsewhere - From: you - To: me - Subject: Re: test - - okay - '! Item was removed: - ----- Method: LimitingLineStreamWrapper class>>on:delimiter: (in category 'instance creation') ----- - on: aStream delimiter: aString - - ^self new setStream: aStream delimiter: aString - ! Item was removed: - ----- Method: LimitingLineStreamWrapper>>atEnd (in category 'testing') ----- - atEnd - - ^line isNil or: [limitingBlock value: line]! Item was removed: - ----- Method: LimitingLineStreamWrapper>>close (in category 'stream protocol') ----- - close - ^stream close! Item was removed: - ----- 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]]) - ! Item was removed: - ----- Method: LimitingLineStreamWrapper>>lastLineRead (in category 'accessing') ----- - lastLineRead - "Return line last read. At stream end, this is the boundary line or nil" - - ^ line! Item was removed: - ----- 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. - self updatePosition! Item was removed: - ----- Method: LimitingLineStreamWrapper>>linesUpToEnd (in category 'accessing') ----- - linesUpToEnd - - | elements ln | - elements := OrderedCollection new. - [(ln := self nextLine) isNil] whileFalse: [ - elements add: ln]. - ^elements! Item was removed: - ----- Method: LimitingLineStreamWrapper>>next (in category 'accessing') ----- - next - "Provide character-based access" - - position ifNil: [ ^nil ]. - position < line size ifTrue: [^line at: (position := position + 1)]. - line := stream nextLine. - self updatePosition. - ^ Character cr! Item was removed: - ----- Method: LimitingLineStreamWrapper>>nextLine (in category 'accessing') ----- - nextLine - - | thisLine | - self atEnd ifTrue: [^nil]. - thisLine := line. - line := stream nextLine. - ^thisLine - ! Item was removed: - ----- Method: LimitingLineStreamWrapper>>peekLine (in category 'accessing') ----- - peekLine - - self atEnd ifTrue: [^nil]. - ^ line! Item was removed: - ----- Method: LimitingLineStreamWrapper>>printOn: (in category 'printing') ----- - printOn: aStream - - super printOn: aStream. - aStream nextPutAll: ' on '. - stream printOn: aStream! Item was removed: - ----- Method: LimitingLineStreamWrapper>>setStream:delimiter: (in category 'private') ----- - setStream: aStream delimiter: aString - - stream := aStream. - line := stream nextLine. - self delimiter: aString. "sets position" - ! Item was removed: - ----- Method: LimitingLineStreamWrapper>>skipThisLine (in category 'accessing') ----- - skipThisLine - - line := stream nextLine. - self updatePosition. - ! Item was removed: - ----- Method: LimitingLineStreamWrapper>>upToEnd (in category 'accessing') ----- - upToEnd - ^String streamContents: [:strm | - | ln | - [(ln := self nextLine) isNil] whileFalse: [ - strm nextPutAll: ln; cr]]! Item was removed: - ----- Method: LimitingLineStreamWrapper>>updatePosition (in category 'accessing') ----- - updatePosition - "Call this before doing character-based access" - - position := self atEnd ifFalse: [0]! Item was removed: - 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.! Item was removed: - ----- 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! Item was removed: - ----- Method: Link>>asLink (in category 'converting') ----- - asLink - - ^ self! Item was removed: - ----- Method: Link>>nextLink (in category 'accessing') ----- - nextLink - - ^ nextLink! Item was removed: - ----- Method: Link>>nextLink: (in category 'accessing') ----- - nextLink: aLink - "Store the argument, aLink, as the link to which the receiver refers. - Answer aLink." - - ^ nextLink := aLink! Item was removed: - SequenceableCollection subclass: #LinkedList - instanceVariableNames: 'firstLink lastLink' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !LinkedList commentStamp: 'topa 12/6/2016 14:17' 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. - - If you attempt to add any object into a LinkedList that is not a Link, it will automatically be wrapped by a ValueLink. A LinkedList therefore behaves very much like any collection, except that certain calls such as atIndex: are linear rather than constant time.! Item was removed: - ----- Method: LinkedList class>>new: (in category 'instance creation') ----- - new: anInt - "LinkedList don't need capacity" - ^self new! Item was removed: - ----- Method: LinkedList class>>new:streamContents: (in category 'stream creation') ----- - new: size streamContents: aBlock - ^ self withAll: (super new: size streamContents: aBlock)! Item was removed: - ----- Method: LinkedList class>>newFrom: (in category 'instance creation') ----- - newFrom: aCollection - "Answer an instance with same elements as aCollection." - ^self new - addAll: aCollection; - yourself! Item was removed: - ----- Method: LinkedList>>add: (in category 'adding') ----- - add: aLinkOrObject - "Add aLink to the end of the receiver's list. Answer aLink." - - ^self addLast: aLinkOrObject! Item was removed: - ----- Method: LinkedList>>add:after: (in category 'adding') ----- - add: link after: otherLinkOrObject - "Add otherLink after link in the list. Answer aLink." - - | otherLink | - otherLink := self linkAt: (self indexOf: otherLinkOrObject). - ^ self add: link afterLink: otherLink! Item was removed: - ----- Method: LinkedList>>add:afterLink: (in category 'adding') ----- - add: aLinkOrObject afterLink: otherLink - - "Add otherLink after link in the list. Answer aLink." - - | savedLink aLink | - lastLink == otherLink ifTrue: [^ self addLast: aLinkOrObject]. - savedLink := otherLink nextLink. - aLink := aLinkOrObject asLink. - otherLink nextLink: aLink. - aLink nextLink: savedLink. - ^aLink.! Item was removed: - ----- Method: LinkedList>>add:before: (in category 'adding') ----- - add: link before: otherLinkOrObject - "Add otherLink after link in the list. Answer aLink." - - | otherLink | - otherLink := self linkAt: (self indexOf: otherLinkOrObject). - ^ self add: link beforeLink: otherLink! Item was removed: - ----- Method: LinkedList>>add:beforeLink: (in category 'adding') ----- - add: aLinkOrObject beforeLink: otherLink - - | currentLink| - - firstLink == otherLink ifTrue: [^ self addFirst: aLinkOrObject]. - - currentLink := firstLink. - [currentLink == nil] whileFalse: [ - currentLink nextLink == otherLink ifTrue: [ - | aLink | - aLink := aLinkOrObject asLink. - aLink nextLink: currentLink nextLink. - currentLink nextLink: aLink. - ^ aLink - ]. - currentLink := currentLink nextLink. - ]. - ^ self errorNotFound: otherLink! Item was removed: - ----- Method: LinkedList>>addFirst: (in category 'adding') ----- - addFirst: aLinkOrObject - "Add aLink to the beginning of the receiver's list. Answer aLink." - |aLink| - aLink := aLinkOrObject asLink. - self isEmpty ifTrue: [lastLink := aLink]. - aLink nextLink: firstLink. - firstLink := aLink. - ^aLink! Item was removed: - ----- Method: LinkedList>>addLast: (in category 'adding') ----- - addLast: aLinkOrObject - "Add aLink to the end of the receiver's list. Answer aLink." - |aLink| - aLink := aLinkOrObject asLink. - self isEmpty - ifTrue: [firstLink := aLink] - ifFalse: [lastLink nextLink: aLink]. - lastLink := aLink. - ^aLink! Item was removed: - ----- Method: LinkedList>>at: (in category 'accessing') ----- - at: index - - ^(self linkAt: index) value! Item was removed: - ----- Method: LinkedList>>at:ifAbsent: (in category 'accessing') ----- - at: index ifAbsent: exceptionBlock - "Optimized to scan the list once, super would twice." - | i | - index < 1 ifTrue: [^exceptionBlock value]. - i := 0. - self do: [:link | - (i := i + 1) = index ifTrue: [^ link]]. - ^exceptionBlock value! Item was removed: - ----- Method: LinkedList>>at:put: (in category 'accessing') ----- - at: index put: anObject - - ^self at: index putLink: (self linkOf: anObject ifAbsent: [anObject asLink])! Item was removed: - ----- Method: LinkedList>>at:putLink: (in category 'accessing') ----- - at: index putLink: aLink - | previousLink nextLink | - "Please don't put a link which is already in the list, or you will create an infinite loop" - (self validIndex: index) ifFalse: [^ self errorOutOfBounds]. - - index = 1 ifTrue: [ - aLink nextLink: self firstLink nextLink. - firstLink := aLink. - aLink nextLink ifNil: [lastLink := aLink]. - ^ aLink]. - - previousLink := self linkAt: index - 1. - nextLink := previousLink nextLink nextLink. - - nextLink - ifNil: [aLink nextLink: self lastLink] - ifNotNil: [:link |aLink nextLink: link]. - - previousLink nextLink: aLink. - - nextLink ifNil: [ - lastLink := aLink. - aLink nextLink: nil]. - - ^ aLink! Item was removed: - ----- Method: LinkedList>>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." - - | aLink newCollection | - newCollection := self class new. - aLink := firstLink. - [aLink == nil] whileFalse: - [newCollection add: (aBlock value: aLink value). - aLink := aLink nextLink]. - ^ newCollection! Item was removed: - ----- Method: LinkedList>>collect:thenSelect: (in category 'enumerating') ----- - collect: collectBlock thenSelect: selectBlock - "Optimized version of SequenceableCollection>>#collect:#thenSelect:" - - | newCollection newElement | - newCollection := self class new. - self - do: [ :each | - newElement := collectBlock value: each. - (selectBlock value: newElement) - ifTrue: [ newCollection add: newElement ] ]. - ^ newCollection! Item was removed: - ----- Method: LinkedList>>copyWith: (in category 'copying') ----- - copyWith: newElement - ^self copy add: newElement; yourself! Item was removed: - ----- Method: LinkedList>>copyWithout: (in category 'copying') ----- - copyWithout: oldElement - |newInst| - newInst := self class new. - self do: [:each | each = oldElement ifFalse: [newInst add: each]]. - ^newInst! Item was removed: - ----- Method: LinkedList>>do: (in category 'enumerating') ----- - do: aBlock - - | aLink | - aLink := firstLink. - [aLink == nil] whileFalse: - [aBlock value: aLink value. - aLink := aLink nextLink]! Item was removed: - ----- Method: LinkedList>>first (in category 'accessing') ----- - first - "Answer the first link. Create an error notification if the receiver is - empty." - - ^ self firstLink value! Item was removed: - ----- Method: LinkedList>>firstLink (in category 'accessing') ----- - firstLink - "Answer the first link. Create an error notification if the receiver is - empty." - - self emptyCheck. - ^firstLink! Item was removed: - ----- Method: LinkedList>>indexOf:startingAt: (in category 'private') ----- - indexOf: anElement startingAt: start - "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." - - |currentLink index| - currentLink := self linkAt: start ifAbsent: [nil]. - index := start. - [ currentLink == nil ] - whileFalse: [currentLink value = anElement value ifTrue: [^index]. - currentLink := currentLink nextLink. - index := index +1]. - ^0! Item was removed: - ----- Method: LinkedList>>isEmpty (in category 'testing') ----- - isEmpty - - ^ firstLink isNil! Item was removed: - ----- Method: LinkedList>>last (in category 'accessing') ----- - last - "Answer the last link. Create an error notification if the receiver is - empty." - - - ^self lastLink value! Item was removed: - ----- Method: LinkedList>>lastLink (in category 'accessing') ----- - lastLink - "Answer the last link. Create an error notification if the receiver is - empty." - - self emptyCheck. - ^lastLink! Item was removed: - ----- Method: LinkedList>>linkAt: (in category 'private') ----- - linkAt: index - - ^self linkAt: index ifAbsent: [ self errorSubscriptBounds: index]! Item was removed: - ----- Method: LinkedList>>linkAt:ifAbsent: (in category 'private') ----- - linkAt: index ifAbsent: errorBlock - - | i | - i := 0. - self linksDo: [:link | (i := i + 1) = index ifTrue: [^ link]]. - ^ errorBlock value! Item was removed: - ----- Method: LinkedList>>linkOf: (in category 'private') ----- - linkOf: anObject - - ^ self - linkOf: anObject - ifAbsent: [self error: 'No such element']! Item was removed: - ----- Method: LinkedList>>linkOf:ifAbsent: (in category 'private') ----- - linkOf: anObject ifAbsent: errorBlock - - self linksDo: [:link | link value = anObject value ifTrue: [^ link]]. - ^ errorBlock value! Item was removed: - ----- Method: LinkedList>>linksDo: (in category 'enumerating') ----- - linksDo: aBlock - - | aLink | - aLink := firstLink. - [aLink == nil] whileFalse: - [aBlock value: aLink. - aLink := aLink nextLink]! Item was removed: - ----- Method: LinkedList>>postCopy (in category 'copying') ----- - postCopy - | aLink | - super postCopy. - firstLink ifNotNil: [ - aLink := firstLink := firstLink copy. - [aLink nextLink isNil] whileFalse: [aLink nextLink: (aLink := aLink nextLink copy)]. - lastLink := aLink].! Item was removed: - ----- Method: LinkedList>>remove:ifAbsent: (in category 'removing') ----- - remove: aLinkOrObject ifAbsent: aBlock - "Remove aLink from the receiver. If it is not there, answer the result of evaluating aBlock." - - | link | - link := self linkOf: aLinkOrObject ifAbsent: [^aBlock value]. - self removeLink: link ifAbsent: [^aBlock value]. - ^aLinkOrObject! Item was removed: - ----- Method: LinkedList>>removeAll (in category 'removing') ----- - removeAll - "Implementation note: this has to be fast" - - firstLink := lastLink := nil! Item was removed: - ----- Method: LinkedList>>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. For LinkedLists, it's safe to use do:." - - self do: [:each | (aBlock value: each) ifTrue: [self remove: each]]! Item was removed: - ----- 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 value! Item was removed: - ----- 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 value! Item was removed: - ----- Method: LinkedList>>removeLink: (in category 'removing') ----- - removeLink: aLink - ^self removeLink: aLink ifAbsent: [self error: 'no such method!!']! Item was removed: - ----- Method: LinkedList>>removeLink:ifAbsent: (in category 'removing') ----- - removeLink: 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 ifNil: [ ^ aBlock value ]. - tempLink nextLink == aLink] - whileFalse: [tempLink := tempLink nextLink]. - tempLink nextLink: aLink nextLink. - aLink == lastLink - ifTrue: [lastLink := tempLink]]. - "Not nilling the link enables us to delete while iterating" - "aLink nextLink: nil." - ^aLink! Item was removed: - ----- Method: LinkedList>>select: (in category 'enumerating') ----- - select: aBlock - "Reimplemennt #select: for speedup on linked lists. - The super implemention accesses the linkes by index, thus causing an O(n^2)" - - | newCollection | - newCollection := self class new. - self do: [:each | (aBlock value: each) ifTrue: [newCollection add: each]]. - ^newCollection! Item was removed: - ----- Method: LinkedList>>select:thenCollect: (in category 'enumerating') ----- - select: selectBlock thenCollect: collectBlock - "Optimized version of SequenceableCollection>>#select:thenCollect:" - - | newCollection | - newCollection := self class new. - self do: [ :each | (selectBlock value: each) ifTrue: [newCollection add: (collectBlock value: each)]]. - ^ newCollection! Item was removed: - ----- Method: LinkedList>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - | tally | - tally := 0. - self do: [:each | tally := tally + 1]. - ^ tally! Item was removed: - ----- Method: LinkedList>>species (in category 'enumerating') ----- - species - - ^ Array! Item was removed: - ----- Method: LinkedList>>swap:with: (in category 'accessing') ----- - swap: ix1 with: ix2 - "Reimplemented, super would create an infinite loop" - | minIx maxIx link1Prev link2Prev link1 link2 link1Next link2Next newLink2Next | - ((self validIndex: ix1) and: [self validIndex: ix2]) ifFalse: [^ self errorOutOfBounds]. - - "Get edge case out of the way" - ix1 = ix2 ifTrue: [^ self ]. - - "Sort indexes to make boundary-checks easier" - minIx := ix1 min: ix2. - maxIx := ix2 max: ix1. - - link1Prev := (minIx = 1) ifFalse: [self linkAt: minIx -1]. - link1 := link1Prev ifNotNil: [ link1Prev nextLink] - ifNil: [self linkAt: minIx]. - link1Next := link1 nextLink. - link2Prev := self linkAt: maxIx -1. - link2 := link2Prev nextLink. - link2Next := link2 nextLink. - - "Link at start being swapped" - link1 = firstLink ifTrue: [firstLink := link2.] ifFalse: [link1Prev nextLink: link2]. - "Link at end being swapped" - link2 = lastLink ifTrue: [lastLink := link1] ifFalse: []. - "Links being swapped adjacent" - newLink2Next := (link1 nextLink = link2) ifTrue: [link1] ifFalse: [link2Prev nextLink: link1. - link1Next]. - link1 nextLink: link2Next. - link2 nextLink: newLink2Next. - ! Item was removed: - ----- Method: LinkedList>>validIndex: (in category 'private') ----- - validIndex: index - - ^ index > 0 and: [index <= self size]! Item was removed: - 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.! Item was removed: - ----- 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! Item was removed: - ----- Method: LookupKey>>< (in category 'comparing') ----- - < aLookupKey - "Refer to the comment in Magnitude|<." - - ^key < aLookupKey key! Item was removed: - ----- Method: LookupKey>>= (in category 'comparing') ----- - = aLookupKey - - self species = aLookupKey species - ifTrue: [^key = aLookupKey key] - ifFalse: [^false]! Item was removed: - ----- Method: LookupKey>>allLiteralsDo: (in category 'literals') ----- - allLiteralsDo: aBlock - "Treat myself or my key as literal. Do not treat any value (i.e., in Association or Binding) as literal to avoid decending too thoroughly. As a consequence, for example, classes have to be resolved to their class bindings or class names before using them as input in this interface." - - aBlock value: self. - self key allLiteralsDo: aBlock.! Item was removed: - ----- Method: LookupKey>>beBindingOfType:announcing: (in category 'bindings') ----- - beBindingOfType: aClass announcing: aBool - "Make the receiver a global binding of the given type" - - self class == aClass ifTrue:[^self]. - self becomeForward: (aClass key: self key value: self value). - "NOTE: Now self == read-only (e.g., the new binding)" - ^self recompileBindingsAnnouncing: aBool! Item was removed: - ----- Method: LookupKey>>beReadOnlyBinding (in category 'bindings') ----- - beReadOnlyBinding - "Make the receiver (a global read-write binding) be a read-only binding" - ^self beReadOnlyBindingAnnouncing: true! Item was removed: - ----- 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! Item was removed: - ----- Method: LookupKey>>beReadWriteBinding (in category 'bindings') ----- - beReadWriteBinding - "Make the receiver (a global read-only binding) be a read-write binding" - ^self beReadWriteBindingAnnouncing: true! Item was removed: - ----- 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! Item was removed: - ----- Method: LookupKey>>canAssign (in category 'accessing') ----- - canAssign - - ^ true! Item was removed: - ----- Method: LookupKey>>hash (in category 'comparing') ----- - hash - "Hash is reimplemented because = is implemented." - - ^key hash! Item was removed: - ----- 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! Item was removed: - ----- Method: LookupKey>>isVariableBinding (in category 'testing') ----- - isVariableBinding - "Return true if I represent a literal variable binding" - ^true! Item was removed: - ----- Method: LookupKey>>key (in category 'accessing') ----- - key - "Answer the lookup key of the receiver." - - ^key! Item was removed: - ----- Method: LookupKey>>key: (in category 'accessing') ----- - key: anObject - "Store the argument, anObject, as the lookup key of the receiver." - - key := anObject! Item was removed: - ----- Method: LookupKey>>literalEqual: (in category 'literals') ----- - literalEqual: otherLiteral - "Answer true if the receiver and otherLiteral represent the same literal. - - By default, all lookup keys (such as variable bindings) are literally equal only if identical. This is how variable sharing works, by preserving identity and changing only the value. - - Override if you want to be more flexible such as in class bindings." - - ^ self == otherLiteral! Item was removed: - ----- Method: LookupKey>>name (in category 'accessing') ----- - name - - ^ self key isString - ifTrue: [self key] - ifFalse: [self key printString]! Item was removed: - ----- Method: LookupKey>>printOn: (in category 'printing') ----- - printOn: aStream - - key printOn: aStream! Item was removed: - ----- Method: LookupKey>>recompileBindingsAnnouncing: (in category 'bindings') ----- - recompileBindingsAnnouncing: aBool - "Recompile all references to the receiver. If the argument is true then put up a progress bar while doing so." - - aBool - ifTrue: - [Project uiManager informUserDuring: - [:bar | - (self systemNavigation allCallsOn: self) do: - [:mref | - bar value: ('Recompiling {1}' translated format: {mref asStringOrText}). - mref actualClass recompile: mref methodSymbol]]] - ifFalse: - [(self systemNavigation allCallsOn: self) do: - [:mref | mref actualClass recompile: mref methodSymbol]]! Item was removed: - ----- Method: LookupKey>>writeOnFilterStream: (in category 'filter streaming') ----- - writeOnFilterStream: aStream - - aStream write:key.! Item was removed: - 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. - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix class>>new (in category 'instance creation') ----- - new - ^self rows: 0 columns: 0! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix class>>ones: (in category 'instance creation') ----- - ones: n - ^self new: n element: 1 - ! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix class>>rows:columns: (in category 'instance creation') ----- - rows: rows columns: columns - ^self rows: rows columns: columns contents: (Array new: rows*columns)! Item was removed: - ----- Method: Matrix class>>rows:columns:contents: (in category 'private') ----- - rows: rows columns: columns contents: contents - ^super new rows: rows columns: columns contents: contents! Item was removed: - ----- 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)! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: Matrix class>>zeros: (in category 'instance creation') ----- - zeros: n - ^self new: n element: 0! Item was removed: - ----- 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 - ! Item was removed: - ----- 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 - - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: Matrix>>= (in category 'comparing') ----- - = aMatrix - ^aMatrix class == self class and: [ - aMatrix rowCount = nrows and: [ - aMatrix columnCount = ncols and: [ - aMatrix privateContents = contents]]]! Item was removed: - ----- Method: Matrix>>add: (in category 'adding') ----- - add: newObject - self shouldNotImplement! Item was removed: - ----- Method: Matrix>>anyOne (in category 'accessing') ----- - anyOne - ^contents anyOne! Item was removed: - ----- Method: Matrix>>asArray (in category 'converting') ----- - asArray - ^contents shallowCopy! Item was removed: - ----- Method: Matrix>>asBag (in category 'converting') ----- - asBag - ^contents asBag! Item was removed: - ----- Method: Matrix>>asByteArray (in category 'converting') ----- - asByteArray - ^contents asByteArray! Item was removed: - ----- Method: Matrix>>asCharacterSet (in category 'converting') ----- - asCharacterSet - ^contents asCharacterSet! Item was removed: - ----- Method: Matrix>>asFloat32Array (in category 'converting') ----- - asFloat32Array - ^contents asFloat32Array! Item was removed: - ----- Method: Matrix>>asFloat64Array (in category 'converting') ----- - asFloat64Array - ^contents asFloat64Array! Item was removed: - ----- Method: Matrix>>asIdentitySet (in category 'converting') ----- - asIdentitySet - ^contents asIdentitySet! Item was removed: - ----- Method: Matrix>>asIntegerArray (in category 'converting') ----- - asIntegerArray - ^contents asIntegerArray! Item was removed: - ----- Method: Matrix>>asOrderedCollection (in category 'converting') ----- - asOrderedCollection - ^contents asOrderedCollection! Item was removed: - ----- Method: Matrix>>asSet (in category 'converting') ----- - asSet - ^contents asSet! Item was removed: - ----- Method: Matrix>>asSortedArray (in category 'converting') ----- - asSortedArray - ^contents asSortedArray! Item was removed: - ----- Method: Matrix>>asSortedCollection (in category 'converting') ----- - asSortedCollection - ^contents asSortedCollection! Item was removed: - ----- Method: Matrix>>asSortedCollection: (in category 'converting') ----- - asSortedCollection: aBlock - ^contents asSortedCollection: aBlock! Item was removed: - ----- Method: Matrix>>asWordArray (in category 'converting') ----- - asWordArray - ^contents asWordArray! Item was removed: - ----- Method: Matrix>>at:at: (in category 'accessing') ----- - at: row at: column - ^contents at: (self indexForRow: row andColumn: column)! Item was removed: - ----- 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 - ! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>at:at:put: (in category 'accessing') ----- - at: row at: column put: value - ^contents at: (self indexForRow: row andColumn: column) put: value! Item was removed: - ----- Method: Matrix>>atAllPut: (in category 'accessing') ----- - atAllPut: value - contents atAllPut: value! Item was removed: - ----- Method: Matrix>>atColumn: (in category 'accessing rows/columns') ----- - atColumn: column - |p| - nrows = 0 ifTrue: [ - (column between: 1 and: ncols) - ifFalse: [self error: '2nd subscript out of range']. - ^ #()]. - p := (self indexForRow: 1 andColumn: column)-ncols. - ^(1 to: nrows) collect: [:row | contents at: (p := p+ncols)] - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: Matrix>>atRandom (in category 'accessing') ----- - atRandom - ^contents atRandom - ! Item was removed: - ----- Method: Matrix>>atRandom: (in category 'accessing') ----- - atRandom: aGenerator - ^contents atRandom: aGenerator! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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)]! Item was removed: - ----- 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] - ! Item was removed: - ----- 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] - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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)! Item was removed: - ----- Method: Matrix>>columnCount (in category 'accessing') ----- - columnCount - ^ncols! Item was removed: - ----- 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)]! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>do: (in category 'enumerating') ----- - do: aBlock - "Pass elements to aBlock one at a time in row-major order." - contents do: aBlock! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>identityIncludes: (in category 'testing') ----- - identityIncludes: anObject - ^contents identityIncludes: anObject! Item was removed: - ----- Method: Matrix>>identityIndexOf: (in category 'accessing') ----- - identityIndexOf: anElement - ^self identityIndexOf: anElement ifAbsent: [0 at 0] - ! Item was removed: - ----- Method: Matrix>>identityIndexOf:ifAbsent: (in category 'accessing') ----- - identityIndexOf: anElement ifAbsent: anExceptionBlock - ^self rowAndColumnForIndex: - (contents identityIndexOf: anElement ifAbsent: [^anExceptionBlock value]) - ! Item was removed: - ----- Method: Matrix>>includes: (in category 'testing') ----- - includes: anObject - ^contents includes: anObject! Item was removed: - ----- Method: Matrix>>includesAllOf: (in category 'testing') ----- - includesAllOf: aCollection - ^contents includesAllOf: aCollection! Item was removed: - ----- Method: Matrix>>includesAnyOf: (in category 'testing') ----- - includesAnyOf: aCollection - ^contents includesAnyOf: aCollection! Item was removed: - ----- 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! Item was removed: - ----- 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 at c, otherwise answer 0 at 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 at 0] - ! Item was removed: - ----- 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 at c, otherwise answer the result of anExceptionBlock." - - ^self rowAndColumnForIndex: - (contents indexOf: anElement ifAbsent: [^anExceptionBlock value]) - ! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>indicesDo: (in category 'enumerating') ----- - indicesDo: aBlock - 1 to: nrows do: [:row | - 1 to: ncols do: [:column | - aBlock value: row value: column]].! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - ^contents occurrencesOf: anObject! Item was removed: - ----- Method: Matrix>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - contents := contents copy! Item was removed: - ----- 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)] - ! Item was removed: - ----- Method: Matrix>>preMultiplyByMatrix: (in category 'arithmetic') ----- - preMultiplyByMatrix: m - "Answer m +* self where m is a Matrix." - - - nrows = m columnCount ifFalse: [self error: 'dimensions do not conform']. - ^Matrix rows: m rowCount columns: ncols tabulate: [:row :col | | s | - s := 0. - 1 to: nrows do: [:k | s := (m at: row at: k) * (self at: k at: col) + s]. - s]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>reject: (in category 'enumerating') ----- - reject: aBlock - self shouldNotImplement! Item was removed: - ----- Method: Matrix>>remove:ifAbsent: (in category 'removing') ----- - remove: anObject ifAbsent: anExceptionBlock - self shouldNotImplement! Item was removed: - ----- Method: Matrix>>removeAll (in category 'removing') ----- - removeAll - - self shouldNotImplement! Item was removed: - ----- Method: Matrix>>replaceAll:with: (in category 'accessing') ----- - replaceAll: oldObject with: newObject - contents replaceAll: oldObject with: newObject! Item was removed: - ----- Method: Matrix>>rowAndColumnForIndex: (in category 'private') ----- - rowAndColumnForIndex: index - |t| - - t := index - 1. - ^(t // ncols + 1)@(t \\ ncols + 1)! Item was removed: - ----- Method: Matrix>>rowCount (in category 'accessing') ----- - rowCount - ^nrows! Item was removed: - ----- 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! Item was removed: - ----- Method: Matrix>>select: (in category 'enumerating') ----- - select: aBlock - self shouldNotImplement! Item was removed: - ----- Method: Matrix>>shuffled (in category 'copying') ----- - shuffled - ^self class rows: nrows columns: ncols contents: (contents shuffled)! Item was removed: - ----- Method: Matrix>>shuffledBy: (in category 'copying') ----- - shuffledBy: aRandom - ^self class rows: nrows columns: ncols contents: (contents shuffledBy: aRandom)! Item was removed: - ----- Method: Matrix>>size (in category 'accessing') ----- - size - ^contents size! Item was removed: - ----- 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: $)! Item was removed: - ----- Method: Matrix>>stringForReadout (in category 'printing') ----- - stringForReadout - "Answer a String whose characters are a description of the receiver layed out in rows and columns" - - ^ String streamContents: [:aStream | - 1 - to: self rowCount - do: [:iRow | - 1 - to: self columnCount - do: [:iCols | - aStream - print: (self at: iRow at: iCols). - aStream tab: 2]. - aStream cr]]! Item was removed: - ----- 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)! Item was removed: - ----- 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]. - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- Method: Matrix>>transposed (in category 'accessing rows/columns') ----- - transposed - ^ self species rows: ncols columns: nrows tabulate: [:i :j | self at: j at: i]! Item was removed: - ----- 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)] - ! Item was removed: - ----- 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)]. - ! Item was removed: - ----- 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)]! Item was removed: - ----- 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 - ! Item was removed: - ----- 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]]. - ! Item was removed: - ----- 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! Item was removed: - Object subclass: #MimeConverter - instanceVariableNames: 'dataStream mimeStream' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! Item was removed: - ----- Method: MimeConverter class>>forEncoding: (in category 'convenience') ----- - forEncoding: encodingString - "Answer a converter class for the given encoding" - encodingString ifNil: [^ NullMimeConverter]. - ^ encodingString asLowercase caseOf: - { ['base64'] -> [Base64MimeConverter]. - ['quoted-printable'] -> [QuotedPrintableMimeConverter]. - ['7bit'] -> [Bit7MimeConverter]. - ['8bit'] -> [NullMimeConverter]. - ['binary'] -> [NullMimeConverter] } - otherwise: [NullMimeConverter]. - ! Item was removed: - ----- Method: MimeConverter class>>mimeDecode:as: (in category 'convenience') ----- - mimeDecode: aStringOrStream as: contentsClass - ^ contentsClass streamContents: [:out | - self mimeDecode: aStringOrStream to: out]! Item was removed: - ----- 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! Item was removed: - ----- Method: MimeConverter class>>mimeEncode: (in category 'convenience') ----- - mimeEncode: aCollectionOrStream - ^ String streamContents: [:out | - self mimeEncode: aCollectionOrStream to: out]! Item was removed: - ----- 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! Item was removed: - ----- Method: MimeConverter>>dataStream (in category 'accessing') ----- - dataStream - ^dataStream! Item was removed: - ----- Method: MimeConverter>>dataStream: (in category 'accessing') ----- - dataStream: anObject - dataStream := anObject! Item was removed: - ----- Method: MimeConverter>>mimeDecode (in category 'conversion') ----- - mimeDecode - "Do conversion reading from mimeStream writing to dataStream" - - self subclassResponsibility! Item was removed: - ----- Method: MimeConverter>>mimeEncode (in category 'conversion') ----- - mimeEncode - "Do conversion reading from dataStream writing to mimeStream" - - self subclassResponsibility! Item was removed: - ----- Method: MimeConverter>>mimeStream (in category 'accessing') ----- - mimeStream - ^mimeStream! Item was removed: - ----- Method: MimeConverter>>mimeStream: (in category 'accessing') ----- - mimeStream: anObject - mimeStream := anObject! Item was removed: - OrderedCollection subclass: #NonPointersOrderedCollection - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !NonPointersOrderedCollection commentStamp: 'ul 3/26/2017 21:38' prior: 0! - I am an OrderedCollection with an internal array holding non-pointers objects. This has the advantage that the array is never subject of garbage collection. But I can only hold objects of a given type defined by my class-side #arrayType method, which is the only method they have to implement.! Item was removed: - ----- Method: NonPointersOrderedCollection class>>isAbstract (in category 'testing') ----- - isAbstract - ^self = NonPointersOrderedCollection! Item was removed: - ----- Method: NonPointersOrderedCollection>>arrayType (in category 'private') ----- - arrayType - "This method must return a non-pointers array class." - - self subclassResponsibility! Item was removed: - ----- Method: NonPointersOrderedCollection>>makeRoomAtFirst (in category 'private') ----- - makeRoomAtFirst - "Same as super without trying to store nil in the emptied slots of array." - - | tally newFirstIndex newLastIndex capacity | - tally := self size. - capacity := array size. - tally * 2 >= capacity ifTrue: [ ^self growAtFirst ]. - tally = 0 ifTrue: [ ^self resetTo: capacity + 1 ]. - newFirstIndex := capacity // 2 + 1. - newLastIndex := newFirstIndex - firstIndex + lastIndex. - 0 to: tally - 1 do: [ :offset | - array at: newLastIndex - offset put: (array at: lastIndex - offset) ]. - firstIndex := newFirstIndex. - lastIndex := newLastIndex! Item was removed: - ----- Method: NonPointersOrderedCollection>>makeRoomAtLast (in category 'private') ----- - makeRoomAtLast - "Same as super without trying to store nil in the emptied slots of array." - - | tally newFirstIndex newLastIndex | - tally := self size. - tally * 2 >= lastIndex ifTrue: [ ^self growAtLast ]. - tally = 0 ifTrue: [ ^self resetTo: 1 ]. - newLastIndex := lastIndex // 2. - newFirstIndex := newLastIndex - lastIndex + firstIndex. - array - replaceFrom: newFirstIndex - to: newLastIndex - with: array - startingAt: firstIndex. - firstIndex := newFirstIndex. - lastIndex := newLastIndex! Item was removed: - ----- Method: NonPointersOrderedCollection>>removeAllSuchThat: (in category 'removing') ----- - removeAllSuchThat: aBlock - "Same as super without trying to store nil in the emptied slots of array." - - | n | - n := firstIndex. - firstIndex to: lastIndex do: [ :index | - | element | - (aBlock value: (element := array at: index)) ifFalse: [ - array at: n put: element. - n := n + 1 ] ]. - lastIndex := n - 1! Item was removed: - ----- Method: NonPointersOrderedCollection>>removeFirst (in category 'removing') ----- - removeFirst - "Same as super without trying to store nil in the emptied slot of array." - - | firstObject | - firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. - firstObject := array at: firstIndex. - firstIndex := firstIndex + 1. - ^firstObject! Item was removed: - ----- Method: NonPointersOrderedCollection>>removeFirst: (in category 'removing') ----- - removeFirst: n - "Same as super without trying to store nil in the emptied slots of array." - - | lastIndexToRemove result | - n < 1 ifTrue: [ self errorNoSuchElement ]. - lastIndex < (lastIndexToRemove := firstIndex + n - 1) ifTrue: [ self errorNotEnoughElements ]. - result := array copyFrom: firstIndex to: lastIndexToRemove. - firstIndex := lastIndexToRemove + 1. - ^result! Item was removed: - ----- Method: NonPointersOrderedCollection>>removeIndex: (in category 'private') ----- - removeIndex: removedIndex - "Same as super without trying to store nil in the emptied slot of array." - - array - replaceFrom: removedIndex - to: lastIndex - 1 - with: array - startingAt: removedIndex + 1. - lastIndex := lastIndex - 1.! Item was removed: - ----- Method: NonPointersOrderedCollection>>removeLast (in category 'removing') ----- - removeLast - "Same as super without trying to store nil in the emptied slot of array." - - | lastObject | - firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. - lastObject := array at: lastIndex. - lastIndex := lastIndex - 1. - ^ lastObject! Item was removed: - ----- Method: NonPointersOrderedCollection>>removeLast: (in category 'removing') ----- - removeLast: n - "Same as super without trying to store nil in the emptied slots of array." - - | firstIndexToRemove result | - n < 1 ifTrue: [ self errorNoSuchElement ]. - (firstIndexToRemove := lastIndex - n + 1) < firstIndex ifTrue: [ self errorNotEnoughElements ]. - result := array copyFrom: firstIndexToRemove to: lastIndex. - lastIndex := firstIndexToRemove - 1. - ^result! Item was removed: - Error subclass: #NotFound - instanceVariableNames: 'object' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Exceptions'! Item was removed: - ----- Method: NotFound class>>object: (in category 'instance creation') ----- - object: anObject - ^self new object: anObject! Item was removed: - ----- Method: NotFound>>messageText (in category 'accessing') ----- - messageText - - ^ messageText ifNil: ['Object is not in the collection.' translated]! Item was removed: - ----- Method: NotFound>>object (in category 'accessing') ----- - object - ^object! Item was removed: - ----- Method: NotFound>>object: (in category 'accessing') ----- - object: anObject - object := anObject! Item was removed: - MimeConverter subclass: #NullMimeConverter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! Item was removed: - ----- Method: NullMimeConverter>>mimeDecode (in category 'conversion') ----- - mimeDecode - - dataStream nextPutAll: mimeStream upToEnd. - ^ dataStream! Item was removed: - ----- Method: NullMimeConverter>>mimeEncode (in category 'conversion') ----- - mimeEncode - - mimeStream nextPutAll: dataStream upToEnd. - ^ mimeStream - ! Item was removed: - Stream subclass: #NullStream - instanceVariableNames: 'binary position' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! - - !NullStream commentStamp: 'ar 2/25/2010 14:49' prior: 0! - NullStream is a stream generating and consuming an infinite number of elements. It can be used as an equivalent of /dev/null or for performance benchmarks.! Item was removed: - ----- Method: NullStream class>>new (in category 'instance creation') ----- - new - "Creates a new instance" - - ^self basicNew initialize! Item was removed: - ----- Method: NullStream>>ascii (in category 'accessing') ----- - ascii - "Switches the stream to ascii mode" - - binary := false.! Item was removed: - ----- Method: NullStream>>atEnd (in category 'testing') ----- - atEnd - "Answer whether the receiver can access any more objects." - - ^false! Item was removed: - ----- Method: NullStream>>binary (in category 'accessing') ----- - binary - "Switches the stream to binary mode" - - binary := true! Item was removed: - ----- Method: NullStream>>collectionSpecies (in category 'accessing') ----- - collectionSpecies - "The type of collection returned by the stream" - - ^binary ifTrue:[ByteArray] ifFalse:[ByteString]! Item was removed: - ----- Method: NullStream>>contents (in category 'accessing') ----- - contents - "Answer all of the contents of the receiver." - - self shouldNotImplement! Item was removed: - ----- Method: NullStream>>cr (in category 'writing') ----- - cr! Item was removed: - ----- Method: NullStream>>crtab: (in category 'writing') ----- - crtab: n! Item was removed: - ----- Method: NullStream>>element (in category 'accessing') ----- - element - "The element returned by the stream" - - ^binary ifTrue:[0] ifFalse:[Character null]! Item was removed: - ----- Method: NullStream>>ensureCr (in category 'writing') ----- - ensureCr! Item was removed: - ----- Method: NullStream>>initialize (in category 'initialize') ----- - initialize - "Initialize the receiver" - - binary := false. - position := 0.! Item was removed: - ----- Method: NullStream>>isBinary (in category 'testing') ----- - isBinary - "Return true if the receiver is a binary byte stream" - - ^binary! Item was removed: - ----- Method: NullStream>>isEmpty (in category 'testing') ----- - isEmpty - "Answer whether the receiver's contents has no elements." - - ^false - ! Item was removed: - ----- Method: NullStream>>next (in category 'reading') ----- - next - "Answer the next object accessible by the receiver." - - position := position +1. - ^self element! Item was removed: - ----- Method: NullStream>>next: (in category 'reading') ----- - next: anInteger - "Answer the next anInteger elements of my collection. Must override - because default uses self contents species, which might involve a large - collection." - - position := position +anInteger. - ^self collectionSpecies new: anInteger! Item was removed: - ----- Method: NullStream>>next:into:startingAt: (in category 'reading') ----- - 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." - - position := position +n. - ^aCollection! Item was removed: - ----- Method: NullStream>>next:putAll: (in category 'writing') ----- - next: anInteger putAll: aCollection - "Store the next anInteger elements from the given collection." - - ^self next: anInteger putAll: aCollection startingAt: 1! Item was removed: - ----- Method: NullStream>>next:putAll:startingAt: (in category 'writing') ----- - next: anInteger putAll: aCollection startingAt: startIndex - "Store the next anInteger elements from the given collection." - - anInteger > 0 ifFalse: [ ^aCollection ]. - position := position + anInteger. - ^aCollection! Item was removed: - ----- Method: NullStream>>nextInto: (in category 'reading') ----- - 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.! Item was removed: - ----- Method: NullStream>>nextPut: (in category 'writing') ----- - nextPut: anObject - "Insert the argument, anObject, as the next object accessible by the - receiver. Answer anObject." - - position := position +1. - ^anObject! Item was removed: - ----- Method: NullStream>>nextPutAll: (in category 'writing') ----- - nextPutAll: aCollection - "Append the elements of aCollection to the sequence of objects accessible - by the receiver. Answer aCollection." - - position := position + aCollection size. - ^aCollection! Item was removed: - ----- Method: NullStream>>nl (in category 'writing') ----- - nl! Item was removed: - ----- Method: NullStream>>peek (in category 'writing') ----- - peek - "Answer what would be returned if the message next were sent to the - receiver. If the receiver is at the end, answer nil." - - ^self element! Item was removed: - ----- Method: NullStream>>position (in category 'positioning') ----- - position - "Answer the current position of accessing the sequence of objects." - - ^position! Item was removed: - ----- Method: NullStream>>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) - ifTrue: [position := anInteger] - ifFalse: [self positionError]! Item was removed: - ----- Method: NullStream>>readInto:startingAt:count: (in category 'reading') ----- - readInto: aCollection startingAt: startIndex count: n - "Read n objects into the given collection. - Return number of elements that have been read." - - position := position + n. - ^n! Item was removed: - ----- Method: NullStream>>reset (in category 'positioning') ----- - reset - "Set the receiver's position to the beginning of the sequence of objects." - - position := 0! Item was removed: - ----- Method: NullStream>>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! Item was removed: - ----- Method: NullStream>>space (in category 'writing') ----- - space! Item was removed: - ----- Method: NullStream>>tab (in category 'writing') ----- - tab! Item was removed: - ----- Method: NullStream>>tab: (in category 'writing') ----- - tab: n! Item was removed: - ----- Method: Number>>compareSafely: (in category '*collections') ----- - compareSafely: aNumber - ^ aNumber isNumber - ifTrue: [ self < aNumber ] - ifFalse: [ super compareSafely: aNumber ]! Item was removed: - ----- Method: Object>>asLink (in category '*collections') ----- - asLink - - ^ ValueLink value: self! Item was removed: - ----- Method: Object>>compareSafely: (in category '*collections') ----- - compareSafely: anObject - ^ self class = anObject class - ifTrue: [ self printString < anObject printString ] - ifFalse: [ self class name < anObject class name ]! Item was removed: - 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.! Item was removed: - ----- Method: OrderedCollection class>>new (in category 'instance creation') ----- - new - ^ self new: 10! Item was removed: - ----- Method: OrderedCollection class>>new: (in category 'instance creation') ----- - new: anInteger - | instance | - ^(instance := self basicNew) setCollection: (instance arrayType new: anInteger)! Item was removed: - ----- Method: OrderedCollection class>>new:withAll: (in category 'instance creation') ----- - new: anInteger withAll: anObject - | instance | - ^(instance := self basicNew) setContents: (instance arrayType new: anInteger withAll: anObject)! Item was removed: - ----- 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) - addAll: aCollection; - yourself - - " OrderedCollection newFrom: {1. 2. 3} - {1. 2. 3} as: OrderedCollection - {4. 2. 7} as: SortedCollection - "! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: OrderedCollection>>add: (in category 'adding') ----- - add: newObject - - ^self addLast: newObject! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: OrderedCollection>>addAll: (in category 'adding') ----- - addAll: aCollection - "Add each element of aCollection at my end. Answer aCollection." - - ^ self addAllLast: aCollection! Item was removed: - ----- Method: OrderedCollection>>addAllFirst: (in category 'adding') ----- - addAllFirst: aCollection - "Add all elements of aCollection to the beginning of the me. Answer aCollection. Use double dispatch to add elements in reverse order if aCollection implements #reverseDo:." - - ^aCollection addAllFirstTo: self! Item was removed: - ----- 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! Item was removed: - ----- Method: OrderedCollection>>addAllLast: (in category 'adding') ----- - addAllLast: aCollection - "Add each element of aCollection at the end of me. Answer aCollection." - - ^aCollection do: [ :each | self addLast: each ]! Item was removed: - ----- Method: OrderedCollection>>addFirst: (in category 'adding') ----- - addFirst: newObject - "Add newObject to the beginning of the receiver. Answer newObject." - - firstIndex = 1 ifTrue: [ self makeRoomAtFirst ]. - ^array at: (firstIndex := firstIndex - 1) put: newObject! Item was removed: - ----- Method: OrderedCollection>>addLast: (in category 'adding') ----- - addLast: newObject - "Add newObject to the end of the receiver. Answer newObject." - - array size = lastIndex ifTrue: [ self makeRoomAtLast ]. - ^array at: (lastIndex := lastIndex + 1) put: newObject! Item was removed: - ----- Method: OrderedCollection>>allButFirstDo: (in category 'enumerating') ----- - allButFirstDo: aBlock - "Override the superclass for performance reasons." - - firstIndex + 1 to: lastIndex do: [ :index | - aBlock value: (array at: index) ]! Item was removed: - ----- Method: OrderedCollection>>allButLastDo: (in category 'enumerating') ----- - allButLastDo: aBlock - "Override the superclass for performance reasons." - - firstIndex to: lastIndex - 1 do: [ :index | - aBlock value: (array at: index) ]! Item was removed: - ----- Method: OrderedCollection>>arrayType (in category 'private') ----- - arrayType - ^ Array! Item was removed: - ----- Method: OrderedCollection>>asArray (in category 'converting') ----- - asArray - "Overriden for speed" - - | result size | - result := Array new: (size := self size). - result - replaceFrom: 1 - to: size - with: array - startingAt: firstIndex. - ^result! Item was removed: - ----- 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" - - | index | - 1 <= anInteger ifFalse: [ self errorNoSuchElement ]. - (index := anInteger + firstIndex - 1) <= lastIndex ifFalse: [ self errorNoSuchElement ]. - ^array at: index! Item was removed: - ----- Method: OrderedCollection>>at:ifAbsentPut: (in category 'accessing') ----- - 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)" - - [ index <= self size ] whileFalse: [ self add: nil ]. - ^(self at: index) ifNil: [ self at: index put: block value ]! Item was removed: - ----- 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 | - 1 <= anInteger ifFalse: [ self errorNoSuchElement ]. - (index := anInteger + firstIndex - 1) <= lastIndex ifFalse: [ self errorNoSuchElement ]. - ^array at: index put: anObject! Item was removed: - ----- Method: OrderedCollection>>capacity (in category 'accessing') ----- - capacity - "Answer the current capacity of the receiver." - - ^ array size! Item was removed: - ----- Method: OrderedCollection>>collect: (in category 'enumerating') ----- - collect: aBlock - "Evaluate aBlock with each of my elements as the argument. - Collect the resulting values into an OrderedCollection." - - | newCollection | - newCollection := OrderedCollection new: self size. - firstIndex to: lastIndex do: - [:index | - newCollection addLast: (aBlock value: (array at: index))]. - ^ newCollection! Item was removed: - ----- Method: OrderedCollection>>collect:from:to: (in category 'enumerating') ----- - collect: aBlock from: fromIndex to: toIndex - "Evaluate aBlock with each of my elements as the argument between fromIndex and toIndex. - Collect the resulting values into an OrderedCollection." - - | result offset | - offset := firstIndex - 1. - (fromIndex < 1 or:[toIndex + offset > lastIndex]) - ifTrue: [^self errorNoSuchElement]. - result := OrderedCollection new: toIndex - fromIndex + 1. - fromIndex + offset to: toIndex + offset do: - [:index | result addLast: (aBlock value: (array at: index))]. - ^ result - ! Item was removed: - ----- Method: OrderedCollection>>collector (in category 'private') ----- - collector "Private" - ^ array! Item was removed: - ----- Method: OrderedCollection>>copyEmpty (in category 'copying') ----- - copyEmpty - "Answer a copy of the receiver that contains no elements." - - ^self species new! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: OrderedCollection>>do: (in category 'enumerating') ----- - do: aBlock - "Override the superclass for performance reasons." - - firstIndex to: lastIndex do: [ :index | - aBlock value: (array at: index) ]! Item was removed: - ----- Method: OrderedCollection>>errorNoSuchElement (in category 'private') ----- - errorNoSuchElement - - ^ self error: ('Attempt to index a non-existent element in {1}' translated format: {self name})! Item was removed: - ----- Method: OrderedCollection>>errorNotEnoughElements (in category 'private') ----- - errorNotEnoughElements - - ^ self error: ('Attempt to remove more elements than possible from {1}' translated format: {self name})! Item was removed: - ----- 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: " - - firstIndex to: lastIndex do: [ :index | - (array at: index) = oldObject ifTrue: [ ^index ] ]. - self errorNotFound: oldObject! Item was removed: - ----- Method: OrderedCollection>>first (in category 'accessing') ----- - first - - firstIndex > lastIndex ifTrue: [ self errorNoSuchElement ]. - ^array at: firstIndex! Item was removed: - ----- Method: OrderedCollection>>growAtFirst (in category 'private') ----- - growAtFirst - "Add new empty slots to the front of array, while keeping the empty slots at the end." - - | newArray newFirstIndex newLastIndex | - newArray := self arrayType new: (array size * 2 max: 1). - newFirstIndex := newArray size - array size + firstIndex. - newLastIndex := newFirstIndex + lastIndex - firstIndex. - newArray - replaceFrom: newFirstIndex - to: newLastIndex - with: array - startingAt: firstIndex. - array := newArray. - firstIndex := newFirstIndex. - lastIndex := newLastIndex! Item was removed: - ----- Method: OrderedCollection>>growAtLast (in category 'private') ----- - growAtLast - "Add new empty slots to the end of array, while keeping the empty slots at the front." - - | newArray | - newArray := self arrayType new: (array size * 2 max: 1). - newArray - replaceFrom: firstIndex - to: lastIndex - with: array - startingAt: firstIndex. - array := newArray! Item was removed: - ----- Method: OrderedCollection>>indexOf:startingAt: (in category 'accessing') ----- - indexOf: anElement startingAt: start - "Optimized version." - - firstIndex + start - 1 to: lastIndex do: [ :index | - (array at: index) = anElement ifTrue: [ ^index - firstIndex + 1 ] ]. - ^0! Item was removed: - ----- 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! Item was removed: - ----- Method: OrderedCollection>>isEmpty (in category 'testing') ----- - isEmpty - ^firstIndex > lastIndex! Item was removed: - ----- Method: OrderedCollection>>isSorted (in category 'sorting') ----- - isSorted - "Return true if the receiver is sorted by #<=." - - ^array - isSortedBetween: firstIndex - and: lastIndex! Item was removed: - ----- Method: OrderedCollection>>isSortedBetween:and: (in category 'sorting') ----- - isSortedBetween: startIndex and: endIndex - "Return true if the receiver is sorted by #<= between startIndex and endIndex." - - ^array isSortedBetween: startIndex + firstIndex - 1 and: endIndex + firstIndex - 1! Item was removed: - ----- Method: OrderedCollection>>isSortedBy: (in category 'sorting') ----- - isSortedBy: aSortBlockOrNil - "Return true if the receiver is sorted by aSortBlockOrNil. Use #<= for comparison if aSortBlockOrNil is nil." - - ^array - isSortedBy: aSortBlockOrNil - between: firstIndex - and: lastIndex! Item was removed: - ----- Method: OrderedCollection>>isSortedBy:between:and: (in category 'sorting') ----- - isSortedBy: aSortBlockOrNil between: startIndex and: endIndex - "Return true if the receiver is sorted by aSortBlockOrNil between startIndex and endIndex. Use #<= for comparison if aSortBlockOrNil is nil." - - ^array - isSortedBy: aSortBlockOrNil - between: startIndex + firstIndex - 1 - and: endIndex + firstIndex - 1! Item was removed: - ----- Method: OrderedCollection>>last (in category 'accessing') ----- - last - - firstIndex > lastIndex ifTrue: [ self errorNoSuchElement ]. - ^array at: lastIndex! Item was removed: - ----- Method: OrderedCollection>>makeRoomAtFirst (in category 'private') ----- - makeRoomAtFirst - "Make some empty slots at the front of the array. If we have more than 50% free space, then just move the elements, so that the first 50% of the slots are free, otherwise add new free slots to the front by growing. Precondition: firstIndex = 1" - - | tally newFirstIndex newLastIndex capacity | - tally := self size. - capacity := array size. - tally * 2 >= capacity ifTrue: [ ^self growAtFirst ]. - tally = 0 ifTrue: [ ^self resetTo: capacity + 1 ]. - newFirstIndex := capacity // 2 + 1. - newLastIndex := newFirstIndex - firstIndex + lastIndex. - 0 to: tally - 1 do: [ :offset | - array at: newLastIndex - offset put: (array at: lastIndex - offset) ]. - array from: firstIndex to: newFirstIndex - 1 put: nil. - firstIndex := newFirstIndex. - lastIndex := newLastIndex! Item was removed: - ----- Method: OrderedCollection>>makeRoomAtLast (in category 'private') ----- - makeRoomAtLast - "Make some empty slots at the end of the array. If we have more than 50% free space, then just move the elements, so that the last 50% of the slots are free, otherwise add new free slots to the end by growing. Precondition: lastIndex = array size" - - | tally newFirstIndex newLastIndex | - tally := self size. - tally * 2 >= lastIndex ifTrue: [ ^self growAtLast ]. - tally = 0 ifTrue: [ ^self resetTo: 1 ]. - newLastIndex := lastIndex // 2. - newFirstIndex := newLastIndex - lastIndex + firstIndex. - array - replaceFrom: newFirstIndex - to: newLastIndex - with: array - startingAt: firstIndex. - array from: newLastIndex + 1 to: lastIndex put: nil. - firstIndex := newFirstIndex. - lastIndex := newLastIndex! Item was removed: - ----- Method: OrderedCollection>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - | tally | - tally := 0. - firstIndex to: lastIndex do: [ :index | - (array at: index) = anObject ifTrue: [ tally := tally + 1 ] ]. - ^tally! Item was removed: - ----- Method: OrderedCollection>>postCopy (in category 'copying') ----- - postCopy - array := array copy! Item was removed: - ----- 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! Item was removed: - ----- Method: OrderedCollection>>remove:ifAbsent: (in category 'removing') ----- - remove: oldObject ifAbsent: absentBlock - - firstIndex to: lastIndex do: [ :index | - (array at: index) = oldObject ifTrue: [ - self removeIndex: index. - ^oldObject ] ]. - ^absentBlock value! Item was removed: - ----- Method: OrderedCollection>>removeAll (in category 'removing') ----- - removeAll - "remove all the elements from this collection. - Keep same amount of storage" - - self setCollection: (self arrayType new: array size)! Item was removed: - ----- 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 | - | element | - (aBlock value: (element := array at: index)) ifFalse: [ - array at: n put: element. - n := n + 1 ] ]. - array from: n to: lastIndex put: nil. - lastIndex := n - 1! Item was removed: - ----- Method: OrderedCollection>>removeAt: (in category 'removing') ----- - removeAt: index - | removed | - removed := self at: index. - self removeIndex: index + firstIndex - 1. - ^removed! Item was 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 | - firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. - firstObject := array at: firstIndex. - array at: firstIndex put: nil. - firstIndex := firstIndex + 1. - ^firstObject! Item was removed: - ----- Method: OrderedCollection>>removeFirst: (in category 'removing') ----- - removeFirst: n - "Remove the first n objects into an array." - - | lastIndexToRemove result | - n < 0 ifTrue: [ self errorNoSuchElement ]. - lastIndex < (lastIndexToRemove := firstIndex + n - 1) ifTrue: [ self errorNotEnoughElements ]. - result := array copyFrom: firstIndex to: lastIndexToRemove. - array from: firstIndex to: lastIndexToRemove put: nil. - firstIndex := lastIndexToRemove + 1. - ^result! Item was removed: - ----- 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.! Item was removed: - ----- 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 | - firstIndex > lastIndex ifTrue: [ self errorEmptyCollection ]. - lastObject := array at: lastIndex. - array at: lastIndex put: nil. - lastIndex := lastIndex - 1. - ^ lastObject! Item was removed: - ----- Method: OrderedCollection>>removeLast: (in category 'removing') ----- - removeLast: n - "Remove the last n objects into an array with last in last position." - - | firstIndexToRemove result | - n < 0 ifTrue: [ self errorNoSuchElement ]. - (firstIndexToRemove := lastIndex - n + 1) < firstIndex ifTrue: [ self errorNotEnoughElements ]. - result := array copyFrom: firstIndexToRemove to: lastIndex. - array from: firstIndexToRemove to: lastIndex put: nil. - lastIndex := firstIndexToRemove - 1. - ^result! Item was removed: - ----- Method: OrderedCollection>>replace: (in category 'enumerating') ----- - replace: aBlock - "Evaluate aBlock with each of my elements as the argument. Collect the resulting values into myself. - Override superclass in order to work on the internal array directly." - - firstIndex to: lastIndex do: [ :index | - array at: index put: (aBlock value: (array at: index)) ]! Item was removed: - ----- Method: OrderedCollection>>reset (in category 'removing') ----- - reset - "Quickly remove all elements. The objects will be still referenced, but will not be accessible." - - self resetTo: 1! Item was removed: - ----- Method: OrderedCollection>>resetTo: (in category 'removing') ----- - resetTo: index - "Quickly remove all elements. The objects will be still referenced, but will not be accessible. Also make sure that the first object will be inserted at index. Choosing the right value has had great impact on performance, but it's neglible with the current implementation, so it's better to use #reset instead in most cases." - - firstIndex := index. - lastIndex := firstIndex - 1! Item was removed: - ----- Method: OrderedCollection>>reverseDo: (in category 'enumerating') ----- - reverseDo: aBlock - "Override the superclass for performance reasons." - - lastIndex to: firstIndex by: -1 do: [ :index | - aBlock value: (array at: index) ]! Item was removed: - ----- 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! Item was removed: - ----- Method: OrderedCollection>>setCollection: (in category 'private') ----- - setCollection: anArray - array := anArray. - self reset! Item was removed: - ----- Method: OrderedCollection>>setContents: (in category 'private') ----- - setContents: anArray - array := anArray. - firstIndex := 1. - lastIndex := array size.! Item was removed: - ----- Method: OrderedCollection>>size (in category 'accessing') ----- - size - "Answer how many elements the receiver contains." - - ^ lastIndex - firstIndex + 1! Item was removed: - ----- Method: OrderedCollection>>sort (in category 'sorting') ----- - sort - "Sort this array into ascending order using the '<=' operator." - - self sort: nil! Item was removed: - ----- Method: OrderedCollection>>sort: (in category 'sorting') ----- - sort: aSortBlock - "Sort this collection using aSortBlock. The block should take two arguments and return true if the first element should preceed the second one. If aSortBlock is nil then <= is used for comparison." - - self size <= 1 ifTrue: [ ^self ]. - array - mergeSortFrom: firstIndex - to: lastIndex - by: aSortBlock! Item was removed: - ----- Method: OrderedCollection>>sorted: (in category 'sorting') ----- - sorted: aSortBlockOrNil - "Return a new sequenceable collection which contains the same elements as self but its elements are sorted by aSortBlockOrNil. The block should take two arguments and return true if the first element should preceed the second one. If aSortBlock is nil then <= is used for comparison." - - ^self copy sort: aSortBlockOrNil! Item was removed: - ----- 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 offset size | - (size := self size) = otherCollection size ifFalse: [ self error: 'otherCollection must be the same size' ]. - result := OrderedCollection new: size. - offset := 1 - firstIndex. - firstIndex to: lastIndex do: [ :index | - result addLast: ( - twoArgBlock - value: (array at: index) - value: (otherCollection at: index + offset)) ]. - ^result! Item was removed: - ----- 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 offset | - newCollection := OrderedCollection new: self size. - offset := 1 - firstIndex. - firstIndex to: lastIndex do: - [:index | - newCollection addLast: (elementAndIndexBlock - value: (array at: index) - value: index + offset) ]. - ^ newCollection! Item was removed: - PluggableDictionary subclass: #OrderedDictionary - instanceVariableNames: 'order' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !OrderedDictionary commentStamp: 'mt 1/16/2015 10:42' prior: 0! - I am an ordered dictionary. I have an additional index (called 'order') to keep track of the insertion order of my associations. - - The read access is not affected by the additional index. - - The index is updated in O(1) [time] when inserting new keys. For present keys, that insertion involves actions in O(n) to move the respective element to the end of the order. - - The growth operation compacts the index and takes O(n) additional time. - - NOTE: This is still no instance of SequenceableCollection. Having this, some protocols are missing and may require working on #associations, which is an Array and thus sequenceable.! Item was removed: - ----- Method: OrderedDictionary>>associationsDo: (in category 'enumerating') ----- - associationsDo: aBlock - "Iterate over the order instead of the internal array." - - order from: 1 to: tally do: aBlock! Item was removed: - ----- Method: OrderedDictionary>>atIndex: (in category 'accessing') ----- - atIndex: integer - - integer > tally ifTrue: [ self error: 'indices are out of bounds' ]. - ^order at: integer! Item was removed: - ----- Method: OrderedDictionary>>atIndex:ifAbsent: (in category 'accessing') ----- - atIndex: integer ifAbsent: exceptionBlock - "As we are sequenceable, provide index-based access." - - integer > tally ifTrue: [ ^exceptionBlock value ]. - ^order at: integer ifAbsent: exceptionBlock! Item was removed: - ----- Method: OrderedDictionary>>atNewIndex:put: (in category 'private') ----- - atNewIndex: index put: anObject - - super atNewIndex: index put: anObject. - order at: tally put: anObject - ! Item was removed: - ----- Method: OrderedDictionary>>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! Item was removed: - ----- Method: OrderedDictionary>>eighth (in category 'accessing') ----- - eighth - "Answer the eighth element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 8! Item was removed: - ----- Method: OrderedDictionary>>fifth (in category 'accessing') ----- - fifth - "Answer the fifth element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 5! Item was removed: - ----- Method: OrderedDictionary>>first (in category 'accessing') ----- - first - "Answer the first element of the receiver" - - ^ self atIndex: 1! Item was removed: - ----- Method: OrderedDictionary>>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! Item was removed: - ----- Method: OrderedDictionary>>fourth (in category 'accessing') ----- - fourth - "Answer the fourth element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 4! Item was removed: - ----- Method: OrderedDictionary>>growTo: (in category 'private') ----- - growTo: anInteger - - | newCapacity capacityDifference | - super growTo: anInteger. - newCapacity := self capacity. - capacityDifference := newCapacity - order size. - capacityDifference = 0 ifTrue: [ ^self ]. - order := capacityDifference > 0 - ifTrue: [ order grownBy: capacityDifference ] - ifFalse: [ order first: newCapacity ]! Item was removed: - ----- Method: OrderedDictionary>>hasEqualElements: (in category 'comparing') ----- - hasEqualElements: anOrderedDictionary - "Answer whether my elements are the same as anOrderedDictionary, and in the same order." - | index | - self size = anOrderedDictionary size ifFalse: [ ^ false ]. - index := 0. - self associationsDo: - [ : eachMyAssociation | - (anOrderedDictionary - atIndex: (index:=index+1) - ifAbsent: [ ^ false ]) = eachMyAssociation ifFalse: [ ^ false ] ]. - ^ true! Item was removed: - ----- Method: OrderedDictionary>>initialize: (in category 'private') ----- - initialize: n - - super initialize: n. - order := self arrayType new: self capacity! Item was removed: - ----- Method: OrderedDictionary>>isSorted (in category 'sorting') ----- - isSorted - "Return true if the receiver is sorted by #<=." - - ^ order - isSortedBetween: 1 - and: tally! Item was removed: - ----- Method: OrderedDictionary>>keysInOrder (in category 'accessing') ----- - keysInOrder - "Overridden. Preserve the order of the receiver." - ^ self keys! Item was removed: - ----- Method: OrderedDictionary>>last (in category 'accessing') ----- - last - "Answer the last element of the receiver" - - ^ self atIndex: self size! Item was removed: - ----- Method: OrderedDictionary>>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! Item was removed: - ----- Method: OrderedDictionary>>middle (in category 'accessing') ----- - middle - "Answer the middle element of the receiver." - - ^ self atIndex: self size // 2 + 1! Item was removed: - ----- Method: OrderedDictionary>>ninth (in category 'accessing') ----- - ninth - "Answer the ninth element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 9! Item was removed: - ----- Method: OrderedDictionary>>postCopy (in category 'copying') ----- - postCopy - "We must not copy associations again but retrieve them from the array, which is already a copy. See super." - - super postCopy. - order := order copy. - 1 to: tally do: [ :index | - order at: index put: (array at: (self scanFor: (order at: index) key)) ]! Item was removed: - ----- Method: OrderedDictionary>>postCopyFrom:to: (in category 'copying') ----- - postCopyFrom: startIndex to: endIndex - "Adapted from SequenceableCollection and OrderedCollection." - - | oldOrder | - oldOrder := order. - array := self arrayType - new: (self class goodPrimeAtLeast: endIndex - startIndex + 1 * 4 // 3). "fill 75% to 100%" - order := self arrayType - new: array size + 1 * 3 // 4. "remove 25%" - - startIndex to: endIndex do: [:index | | element | - element := (oldOrder at: index) copy. - order at: index - startIndex + 1 put: element. - array at: (self scanFor: element key) put: element]. - - tally := endIndex - startIndex + 1! Item was removed: - ----- Method: OrderedDictionary>>removeKey:ifAbsent: (in category 'removing') ----- - removeKey: key ifAbsent: aBlock - - | result | - result := super removeKey: key ifAbsent: [ ^aBlock value ]. - (self scanOrderFor: key) ifNotNil: [ :index | - order - replaceFrom: index - to: tally - with: order - startingAt: index + 1 ]. - . order at: tally + 1 put: nil. - ^result! Item was removed: - ----- Method: OrderedDictionary>>replace: (in category 'enumerating') ----- - replace: aBlock - "Like super, but iterate in order." - - order from: 1 to: tally do: [:each | each value: (aBlock value: each value)]! Item was removed: - ----- Method: OrderedDictionary>>scanOrderFor: (in category 'private') ----- - scanOrderFor: anObject - - 1 to: tally do: [ :index | - (order at: index) key = anObject ifTrue: [ ^index ] ]. - ^nil! Item was removed: - ----- Method: OrderedDictionary>>second (in category 'accessing') ----- - second - "Answer the second element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 2! Item was removed: - ----- Method: OrderedDictionary>>seventh (in category 'accessing') ----- - seventh - "Answer the seventh element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 7! Item was removed: - ----- Method: OrderedDictionary>>sixth (in category 'accessing') ----- - sixth - "Answer the sixth element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 6! Item was removed: - ----- Method: OrderedDictionary>>sort (in category 'sorting') ----- - sort - - self sort: nil! Item was removed: - ----- Method: OrderedDictionary>>sort: (in category 'sorting') ----- - sort: aSortBlock - "Like in OrderedCollection, sort the associations according to the sort block." - - tally <= 1 ifTrue: [ ^self ]. - order - mergeSortFrom: 1 - to: tally - by: aSortBlock! Item was removed: - ----- Method: OrderedDictionary>>sorted: (in category 'sorting') ----- - sorted: aSortBlockOrNil - - ^ self copy sort: aSortBlockOrNil! Item was removed: - ----- Method: OrderedDictionary>>third (in category 'accessing') ----- - third - "Answer the third element of the receiver. - Raise an error if there are not enough elements." - - ^ self atIndex: 3! Item was removed: - Dictionary subclass: #PluggableDictionary - instanceVariableNames: 'hashBlock equalBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Unordered'! - - !PluggableDictionary commentStamp: 'eem 3/30/2017 17:44' 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 <BlockClosure> A one argument block used for hashing the elements. - equalBlock <BlockClosure> A two argument block used for comparing the elements. - ! Item was removed: - ----- Method: PluggableDictionary class>>hashBlock: (in category 'instance creation') ----- - hashBlock: aHashBlock - - ^ self new - hashBlock: aHashBlock; - yourself! Item was removed: - ----- Method: PluggableDictionary class>>hashBlock:equalBlock: (in category 'instance creation') ----- - hashBlock: aHashBlock equalBlock: anEqualBlock - - ^ self new - hashBlock: aHashBlock; - equalBlock: anEqualBlock; - yourself! Item was removed: - ----- Method: PluggableDictionary class>>integerDictionary (in category 'instance creation') ----- - integerDictionary - ^ self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]! Item was removed: - ----- Method: PluggableDictionary>>= (in category 'comparing') ----- - = anObject - "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 == anObject ifTrue: [ ^true ]. - self species = anObject species ifFalse: [ ^false ]. - hashBlock = anObject hashBlock ifFalse: [ ^false ]. - equalBlock = anObject equalBlock ifFalse: [ ^false ]. - ^ self hasEqualElements: anObject! Item was removed: - ----- Method: PluggableDictionary>>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) - hashBlock: hashBlock; - equalBlock: equalBlock; - yourself. - self associationsDo: [ :each | - newCollection at: each key put: (aBlock value: each value) ]. - ^newCollection - - ! Item was removed: - ----- Method: PluggableDictionary>>copyEmpty (in category 'copying') ----- - copyEmpty - - ^super copyEmpty - hashBlock: hashBlock; - equalBlock: equalBlock; - yourself! Item was removed: - ----- Method: PluggableDictionary>>equalBlock (in category 'accessing') ----- - equalBlock - "Return the block used for comparing the elements in the receiver." - ^equalBlock! Item was removed: - ----- 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.! Item was removed: - ----- Method: PluggableDictionary>>hasEqualElements: (in category 'comparing') ----- - hasEqualElements: aDictionary - "Answer whether my elements are the same as those of aDictionary." - self size = aDictionary size ifFalse: [ ^ false ]. - self associationsDo: - [ : association | - (aDictionary - at: association key - ifAbsent: [ ^ false ]) = association value ifFalse: [ ^ false ] ]. - ^ true! Item was removed: - ----- Method: PluggableDictionary>>hashBlock (in category 'accessing') ----- - hashBlock - "Return the block used for hashing the elements in the receiver." - ^hashBlock! Item was removed: - ----- 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.! Item was removed: - ----- 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 size | - index := start := (hashBlock - ifNil: [ anObject hash ] - ifNotNil: [ hashBlock value: anObject ]) \\ (size := 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 \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := (hashBlock - ifNil: [ anObject hash ] - ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - Set subclass: #PluggableSet - instanceVariableNames: 'hashBlock equalBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Unordered'! - - !PluggableSet commentStamp: 'eem 3/30/2017 17:59' 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 <BlockClosure> A one argument block used for hashing the elements. - equalBlock <BlockClosure> A two argument block used for comparing the elements. - - Example: Adding 1000000 integer points in the range (0 at 0) to: (100 at 100) to a set. - - ( | n rnd set max points | - set := Set new: (n := 1000000). - rnd := Random new. - max := 100. - points := (1 to: n) collect: [:ign| (rnd next @ rnd next * max) truncated]. - Smalltalk garbageCollectMost. "to reduce variability in the run-to-run times" - [1 to: 1000000 do: [:i| set add: (points at: i)]] - timeToRun - ) - - 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: - - ( | n rnd set max points | - set := PluggableSet new: (n := 1000000). - set hashBlock: [:item| (item x bitShift: 10) + item y]. - rnd := Random new. - max := 100. - points := (1 to: n) collect: [:ign| (rnd next @ rnd next * max) truncated]. - Smalltalk garbageCollectMost. "to reduce variability in the run-to-run times" - [1 to: 1000000 do: [:i| set add: (points at: i)]] - timeToRun - )! Item was removed: - ----- Method: PluggableSet class>>hashBlock: (in category 'instance creation') ----- - hashBlock: aHashBlock - - ^ self new - hashBlock: aHashBlock; - yourself! Item was removed: - ----- Method: PluggableSet class>>hashBlock:equalBlock: (in category 'instance creation') ----- - hashBlock: aHashBlock equalBlock: anEqualBlock - - ^ self new - hashBlock: aHashBlock; - equalBlock: anEqualBlock; - yourself! Item was removed: - ----- Method: PluggableSet class>>integerSet (in category 'instance creation') ----- - integerSet - ^self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]! Item was removed: - ----- Method: PluggableSet>>= (in category 'comparing') ----- - = anObject - "Two sets 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 == anObject ifTrue: [ ^true ]. - self species == anObject species ifFalse: [ ^false ]. - hashBlock = anObject hashBlock ifFalse: [ ^false ]. - equalBlock = anObject equalBlock ifFalse: [ ^false ]. - self size = anObject size ifFalse: [ ^false ]. - ^self allSatisfy: [ :each | anObject includes: each ]! Item was removed: - ----- Method: PluggableSet>>copyEmpty (in category 'copying') ----- - copyEmpty - - ^super copyEmpty - hashBlock: hashBlock; - equalBlock: equalBlock; - yourself! Item was removed: - ----- Method: PluggableSet>>equalBlock (in category 'accessing') ----- - equalBlock - "Return the block used for comparing the elements in the receiver." - ^equalBlock! Item was removed: - ----- 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.! Item was removed: - ----- Method: PluggableSet>>hashBlock (in category 'accessing') ----- - hashBlock - "Return the block used for hashing the elements in the receiver." - ^hashBlock! Item was removed: - ----- 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.! Item was removed: - ----- 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 size | - index := start := (hashBlock - ifNil: [ anObject hash ] - ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ - equalBlock - ifNil: [ element enclosedSetElement = anObject ] - ifNotNil: [ equalBlock value: element enclosedSetElement value: anObject ] ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := (hashBlock - ifNil: [ anObject hash ] - ifNotNil: [ hashBlock value: anObject ]) \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - 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.! Item was removed: - ----- Method: PluggableTextAttribute class>>evalBlock: (in category 'instance creation') ----- - evalBlock: aBlock - ^super new evalBlock: aBlock! Item was removed: - ----- Method: PluggableTextAttribute>>actOnClickFor: (in category 'event handling') ----- - 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'! Item was removed: - ----- Method: PluggableTextAttribute>>evalBlock: (in category 'initialization') ----- - evalBlock: aBlock - evalBlock := aBlock! Item was removed: - ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: aStream - "Impossible for this kind of attribute" - ^ self shouldNotImplement - ! Item was removed: - 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.! Item was removed: - ----- 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! Item was removed: - ----- 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)! Item was removed: - ----- Method: PositionableStream>>asBinaryOrTextStream (in category 'converting') ----- - asBinaryOrTextStream - "Convert to a stream that can switch between bytes and characters" - - ^ (RWBinaryOrTextStream with: self contentsOfEntireFile) reset! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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 - - ! Item was removed: - ----- Method: PositionableStream>>basicBack (in category 'accessing - multibyte support') ----- - basicBack - - ^self back! Item was removed: - ----- Method: PositionableStream>>basicSkipTo: (in category 'accessing - multibyte support') ----- - basicSkipTo: anObject - - ^self skipTo: anObject! Item was removed: - ----- Method: PositionableStream>>basicUpTo: (in category 'accessing - multibyte support') ----- - basicUpTo: anObject - - ^self upTo: anObject! Item was removed: - ----- Method: PositionableStream>>boolean (in category 'data get/put') ----- - boolean - "Answer the next boolean value from this (binary) stream." - - ^ self next ~= 0 - ! Item was removed: - ----- 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]). - ! Item was removed: - ----- Method: PositionableStream>>collectionSpecies (in category 'private') ----- - collectionSpecies - "Answer the species of collection into which the receiver can stream" - - ^collection species! Item was removed: - ----- Method: PositionableStream>>contents (in category 'accessing') ----- - contents - "Answer with a copy of my collection from 1 to readLimit." - - ^collection copyFrom: 1 to: readLimit! Item was removed: - ----- Method: PositionableStream>>contentsOfEntireFile (in category 'accessing') ----- - contentsOfEntireFile - "For non-file streams" - ^ self contents! Item was removed: - ----- Method: PositionableStream>>errorCantGoBack (in category 'accessing') ----- - errorCantGoBack - self error: ' CantGoBack '! Item was removed: - ----- 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 - ! Item was removed: - ----- 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). - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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). - ! Item was removed: - ----- Method: PositionableStream>>isBinary (in category 'testing') ----- - isBinary - "Return true if the receiver is a binary byte stream" - ^collection class == ByteArray! Item was removed: - ----- 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]! Item was removed: - ----- Method: PositionableStream>>last (in category 'accessing') ----- - last - "Return the element that was read last" - - ^ collection at: position! Item was removed: - ----- 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 - - ! Item was removed: - ----- 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 := self collectionSpecies new: anInteger. - 1 to: anInteger do: [:index | newArray at: index put: self next]. - ^newArray! Item was removed: - ----- 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! Item was removed: - ----- Method: PositionableStream>>next:putAll:startingAt: (in category 'accessing') ----- - next: anInteger putAll: aCollection startingAt: startIndex - "Store the next anInteger elements from the given collection." - - startIndex to: startIndex + anInteger - 1 do: [ :index | - self nextPut: (aCollection at: index) ]. - ^aCollection! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- Method: PositionableStream>>nextLine (in category 'accessing') ----- - nextLine - "Answer next line (may be empty) without line end delimiters, or nil if at end. - Let the stream positioned after the line delimiter(s). - Handle a zoo of line delimiters CR, LF, or CR-LF pair" - - self atEnd ifTrue: [^nil]. - ^self upToAnyOf: CharacterSet crlf do: [:char | char = Character cr ifTrue: [self peekFor: Character lf]]! Item was removed: - ----- 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 - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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 - ! Item was removed: - ----- 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. This is restricted to Latin1 encoded String." - - | length aByteArray | - 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. - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: PositionableStream>>nextWord (in category 'nonhomogeneous accessing') ----- - nextWord - "Answer the next two bytes from the receiver as an Integer." - - | high low | - high := self next ifNil: [ ^false ]. - low := self next ifNil: [ ^false ]. - ^(high asInteger bitShift: 8) + low asInteger! Item was removed: - ----- 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! Item was removed: - ----- 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 - 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" - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: PositionableStream>>oldPeekBack (in category 'accessing') ----- - oldPeekBack - "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! Item was removed: - ----- Method: PositionableStream>>on: (in category 'private') ----- - on: aCollection - - collection := aCollection. - readLimit := aCollection size. - position := 0. - self reset! Item was removed: - ----- Method: PositionableStream>>originalContents (in category 'accessing') ----- - originalContents - "Answer the receiver's actual contents collection, NOT a copy. 1/29/96 sw" - - ^ collection! Item was removed: - ----- 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.! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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 | - self position = 0 ifTrue: [self errorCantGoBack]. - element := self back. - self skip: 1. - ^ element! Item was removed: - ----- 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." - - self atEnd ifTrue: [^false]. - "gobble it if found" - self next = anObject ifTrue: [ ^true ]. - position := position - 1. - ^false! Item was removed: - ----- Method: PositionableStream>>position (in category 'positioning') ----- - position - "Answer the current position of accessing the sequence of objects." - - ^position! Item was removed: - ----- 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]! Item was removed: - ----- 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'! Item was removed: - ----- 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]! Item was removed: - ----- 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 := subCollection readStream. - startPosition := self position. - [ pattern atEnd or: [ self atEnd ] ] whileFalse: [ - 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 ]. - ^exceptionBlock value! Item was removed: - ----- Method: PositionableStream>>pushBack: (in category 'positioning') ----- - pushBack: aString - "Compatibility with SocketStreams" - self skip: aString size negated! Item was removed: - ----- Method: PositionableStream>>reset (in category 'positioning') ----- - reset - "Set the receiver's position to the beginning of the sequence of objects." - - position := 0! Item was removed: - ----- Method: PositionableStream>>resetContents (in category 'positioning') ----- - resetContents - "Set the position and limits to 0." - - position := 0. - readLimit := 0! Item was removed: - ----- Method: PositionableStream>>setFrom:to: (in category 'private') ----- - setFrom: newStart to: newStop - - position := newStart - 1. - readLimit := newStop! Item was removed: - ----- Method: PositionableStream>>setToEnd (in category 'positioning') ----- - setToEnd - "Set the position of the receiver to the end of the sequence of objects." - - position := readLimit! Item was removed: - ----- 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! Item was removed: - ----- Method: PositionableStream>>skipSeparators (in category 'positioning') ----- - skipSeparators - [self atEnd] - whileFalse: - [self next isSeparator ifFalse: [^ self position: self position-1]]! Item was removed: - ----- 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! Item was removed: - ----- 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 - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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). - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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). - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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). - ! Item was removed: - ----- 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! Item was removed: - ----- 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." - - ^self collectionSpecies streamContents: [ :stream | - | element | - [self atEnd or: [(element := self next) = anObject]] - whileFalse: [stream nextPut: element]]! Item was removed: - ----- 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 upToPosition: endMatch - aCollection size. - self position: endMatch. - ^ result] - ifFalse: [self position: startPos. - ^ self upToEnd]! Item was removed: - ----- 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." - ^self upToAnyOf: aCollection do: [:matchingObject | ]! Item was removed: - ----- Method: PositionableStream>>upToAnyOf:do: (in category 'accessing') ----- - upToAnyOf: subcollection do: aBlock - "Answer a subcollection from the current access position to the occurrence (if any, but not inclusive) of any object in the collection. - Evaluate aBlock with this occurence as argument. - If no matching object is found, don't evaluate aBlock and answer the entire rest of the receiver." - - ^self collectionSpecies new: 1000 streamContents: [ :stream | - | ch | - [ self atEnd or: [ (subcollection includes: (ch := self next)) and: [aBlock value: ch. true] ] ] - whileFalse: [ stream nextPut: ch ] ]! Item was removed: - ----- 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: (self collectionSpecies new: 100). - [self atEnd] whileFalse: [ newStream nextPut: self next ]. - ^ newStream contents! Item was removed: - ----- Method: PositionableStream>>upToPosition: (in category 'accessing') ----- - upToPosition: anInteger - "Answer a subcollection containing items starting from the current position and ending including the given position. Usefully different to #next: in that in the case of MultiByteFileStream, and perhaps others, positions measure in terms of encoded items, while #next: convention is to name a number of items, independent of their encoding in the underlying buffer." - ^ self next: anInteger - position - ! Item was removed: - Notification subclass: #ProgressNotification - instanceVariableNames: 'amount done extra' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Exceptions'! - - !ProgressNotification commentStamp: '<historical>' prior: 0! - Used to signal progress without requiring a specific receiver to notify. Caller/callee convention could be to simply count the number of signals caught or to pass more substantive information with #signal:.! Item was removed: - ----- Method: ProgressNotification class>>signal:extra: (in category 'exceptionInstantiator') ----- - signal: signalerText extra: extraParam - "TFEI - Signal the occurrence of an exceptional condition with a specified textual description." - - | ex | - ex := self new. - ex extraParam: extraParam. - ^ex signal: signalerText! Item was removed: - ----- Method: ProgressNotification>>amount (in category 'accessing') ----- - amount - ^amount! Item was removed: - ----- Method: ProgressNotification>>amount: (in category 'accessing') ----- - amount: aNumber - amount := aNumber! Item was removed: - ----- Method: ProgressNotification>>done (in category 'accessing') ----- - done - ^done! Item was removed: - ----- Method: ProgressNotification>>done: (in category 'accessing') ----- - done: aNumber - done := aNumber! Item was removed: - ----- Method: ProgressNotification>>extraParam (in category 'accessing') ----- - extraParam - ^extra! Item was removed: - ----- Method: ProgressNotification>>extraParam: (in category 'accessing') ----- - extraParam: anObject - extra := anObject! Item was removed: - ComposedSortFunction subclass: #PropertySortFunction - instanceVariableNames: 'property' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !PropertySortFunction commentStamp: 'nice 11/5/2017 22:36' prior: 0! - A PropertySortFunction is a SortFunction for sorting by a specific property. - - Instance Variables - collator <SortFunction> the SortFunction to be used for sorting the properties - property <Symbol | Block> a valuable returning the value of property for objects to be sorted! Item was removed: - ----- Method: PropertySortFunction class>>property: (in category 'instance creation') ----- - property: selectorOrOneArgBlock - ^self new - property: selectorOrOneArgBlock! Item was removed: - ----- Method: PropertySortFunction class>>property:collatedWith: (in category 'instance creation') ----- - property: selectorOrOneArgBlock collatedWith: aSortFunction - ^self new - property: selectorOrOneArgBlock; - baseSortFunction: aSortFunction! Item was removed: - ----- Method: PropertySortFunction>>= (in category 'comparing') ----- - = anObject - "Answer whether the receiver and anObject represent the same object." - - self == anObject - ifTrue: [ ^ true ]. - self class = anObject class - ifFalse: [ ^ false ]. - ^ baseSortFunction = anObject baseSortFunction - and: [ property = anObject property ]! Item was removed: - ----- Method: PropertySortFunction>>collate:with: (in category 'evaluating') ----- - collate: anObject with: another - "Answer the collation order of anObject and another based on the property." - ^ baseSortFunction collate: (property value: anObject) with: (property value: another)! Item was removed: - ----- Method: PropertySortFunction>>hash (in category 'comparing') ----- - hash - "Answer an integer value that is related to the identity of the receiver." - - ^ super hash bitXor: property hash! Item was removed: - ----- Method: PropertySortFunction>>property (in category 'accessing') ----- - property - ^ property! Item was removed: - ----- Method: PropertySortFunction>>property: (in category 'accessing') ----- - property: aValuable - property := aValuable! Item was removed: - ----- Method: PropertySortFunction>>undefinedFirst (in category 'converting') ----- - undefinedFirst - "apply on the property" - ^self class - property: property - collatedWith: baseSortFunction undefinedFirst! Item was removed: - ----- Method: PropertySortFunction>>undefinedLast (in category 'converting') ----- - undefinedLast - "apply on the property" - ^self class - property: property - collatedWith: baseSortFunction undefinedLast! Item was removed: - QuotedPrintableMimeConverter subclass: #QEncodingMimeConverter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! - - !QEncodingMimeConverter commentStamp: 'pre 4/30/2018 12:13' prior: 0! - I do q format MIME decoding as specified in RFC 2047 ""MIME Part Three: Message Header Extensions for Non-ASCII Text". See String>>decodeMimeHeader! Item was removed: - ----- Method: QEncodingMimeConverter>>encodeChar:to: (in category 'private-encoding') ----- - encodeChar: aChar to: aStream - - aChar = Character space - ifTrue: [^ aStream nextPut: $_]. - ^ super encodeChar: aChar to: aStream! Item was removed: - ----- Method: QEncodingMimeConverter>>encodeWord: (in category 'private-encoding') ----- - encodeWord: aString - - | characterEncodedString | - (aString noneSatisfy: [:c | self conversionNeededFor: c]) - ifTrue: [^ aString]. - - characterEncodedString := aString squeakToUtf8. - - ^ String streamContents: [:stream | - stream nextPutAll: '=?UTF-8?Q?'. - characterEncodedString do: [:c | self encodeChar: c to: stream]. - stream nextPutAll: '?=']! Item was removed: - ----- Method: QEncodingMimeConverter>>mimeDecode (in category 'conversion') ----- - mimeDecode - "Do conversion reading from mimeStream writing to dataStream. See String>>decodeMimeHeader for the character set handling." - - | 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! Item was removed: - ----- Method: QEncodingMimeConverter>>mimeEncode (in category 'conversion') ----- - mimeEncode - "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars." - - | currentWord encodedWord | - - [dataStream atEnd] whileFalse: [ - self readUpToWordInto: mimeStream. - currentWord := self readWord. - encodedWord := self encodeWord: currentWord. - mimeStream nextPutAll: encodedWord]. - - ^ mimeStream! Item was removed: - ----- Method: QEncodingMimeConverter>>readUpToWordInto: (in category 'private-encoding') ----- - readUpToWordInto: aStream - - | currentCharacter | - [dataStream atEnd] whileFalse: - [currentCharacter := dataStream peek. - currentCharacter isSeparator - ifTrue: [aStream nextPut: currentCharacter. - dataStream next] - ifFalse: [^ true]]! Item was removed: - ----- Method: QEncodingMimeConverter>>readWord (in category 'private-encoding') ----- - readWord - - | strm | - strm := WriteStream on: (String new: 20). - [dataStream atEnd] whileFalse: [ - dataStream peek isSeparator - ifTrue: [^ strm contents] - ifFalse: [strm nextPut: dataStream next]]. - ^ strm contents! Item was removed: - ----- Method: QEncodingMimeConverter>>reservedCharacters (in category 'private-encoding') ----- - reservedCharacters - - ^ '?=_ ' ! Item was removed: - MimeConverter subclass: #QuotedPrintableMimeConverter - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! - - !QuotedPrintableMimeConverter commentStamp: 'pre 4/30/2018 12:13' 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 - - (2) simply states that 33 to 126 can be represented by US-ASCII except of the equal-sign itself - - --pre! Item was removed: - ----- Method: QuotedPrintableMimeConverter>>conversionNeededFor: (in category 'conversion') ----- - conversionNeededFor: aCharacter - - ^ ((aCharacter asciiValue between: 32 and: 127) not and: [aCharacter asciiValue ~= 9]) - or: [self reservedCharacters includes: aCharacter]! Item was removed: - ----- Method: QuotedPrintableMimeConverter>>encodeChar:to: (in category 'private - encoding') ----- - encodeChar: aChar to: aStream - - (self conversionNeededFor: aChar) - ifFalse: [aStream nextPut: aChar] - ifTrue: [aStream nextPut: $=; - nextPut: (Character digitValue: aChar asciiValue // 16); - nextPut: (Character digitValue: aChar asciiValue \\ 16)]. - - - ! Item was removed: - ----- Method: QuotedPrintableMimeConverter>>mimeDecode (in category 'conversion') ----- - mimeDecode - "Do conversion reading from mimeStream writing to dataStream" - - | line lineStream c1 v1 c2 v2 | - [(line := mimeStream nextLine) isNil] whileFalse: [ - line := line withoutTrailingBlanks. - line - ifEmpty: [dataStream cr] - ifNotEmpty: [ - lineStream := ReadStream on: line. - [dataStream nextPutAll: (lineStream upTo: $=). - lineStream atEnd] whileFalse: [ - c1 := lineStream next. v1 := c1 digitValue. - ((v1 between: 0 and: 15) and: [lineStream atEnd not]) - ifFalse: [dataStream nextPut: $=; nextPut: c1] - ifTrue: [c2 := lineStream 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 ~= $= and: [mimeStream atEnd not]) ifTrue: [dataStream cr]]]. - ^ dataStream! Item was removed: - ----- Method: QuotedPrintableMimeConverter>>mimeEncode (in category 'conversion') ----- - mimeEncode - "Do conversion reading from dataStream writing to mimeStream. Break long lines and escape non-7bit chars." - - | currentCharacter line lineStream linePosition | - currentCharacter := nil. - [(line := dataStream nextLine) isNil] whileFalse: [ - lineStream := ReadStream on: line. - linePosition := 0. - - [lineStream atEnd] whileFalse: [ - currentCharacter := lineStream next. - self encodeChar: currentCharacter to: mimeStream. - linePosition := linePosition + 1. - linePosition = 73 ifTrue: [mimeStream nextPut: $=; crlf. linePosition := 0]]. - dataStream atEnd ifFalse: [mimeStream crlf]]. - ^ mimeStream! Item was removed: - ----- Method: QuotedPrintableMimeConverter>>reservedCharacters (in category 'private - encoding') ----- - reservedCharacters - - ^ '=' ! Item was removed: - 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.! Item was removed: - ----- Method: RWBinaryOrTextStream>>asBinaryOrTextStream (in category 'converting') ----- - asBinaryOrTextStream - - ^ self! Item was removed: - ----- Method: RWBinaryOrTextStream>>ascii (in category 'accessing') ----- - ascii - isBinary := false! Item was removed: - ----- Method: RWBinaryOrTextStream>>binary (in category 'accessing') ----- - binary - isBinary := true! Item was removed: - ----- Method: RWBinaryOrTextStream>>contents (in category 'accessing') ----- - 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.! Item was removed: - ----- Method: RWBinaryOrTextStream>>contentsOfEntireFile (in category 'accessing') ----- - contentsOfEntireFile - "For compatibility with file streams." - - ^ self contents! Item was removed: - ----- Method: RWBinaryOrTextStream>>isBinary (in category 'testing') ----- - isBinary - ^ isBinary! Item was removed: - ----- Method: RWBinaryOrTextStream>>next (in category 'accessing') ----- - next - - isBinary ifFalse: [ ^super next ]. - ^super next ifNotNil: [ :character | character asInteger ]! Item was removed: - ----- Method: RWBinaryOrTextStream>>next: (in category 'accessing') ----- - 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! Item was removed: - ----- Method: RWBinaryOrTextStream>>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." - "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]! Item was removed: - ----- 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! Item was removed: - ----- Method: RWBinaryOrTextStream>>nextPut: (in category 'accessing') ----- - nextPut: charOrByte - - ^super nextPut: charOrByte asCharacter! Item was removed: - ----- Method: RWBinaryOrTextStream>>nextPutAll: (in category 'writing') ----- - nextPutAll: aCollection - "Optimized for ByteArrays" - aCollection class == ByteArray - ifTrue:[^super nextPutAll: aCollection asString]. - ^super nextPutAll: aCollection! Item was removed: - ----- Method: RWBinaryOrTextStream>>peekLast (in category 'accessing') ----- - peekLast - "Return that item just put at the end of the stream" - - ^ position > 0 - ifTrue: [self isBinary - ifTrue: [(collection at: position) asInteger] - ifFalse: [(collection at: position) asCharacter]] - ifFalse: [nil]! Item was removed: - ----- Method: RWBinaryOrTextStream>>readInto:startingAt:count: (in category 'accessing') ----- - readInto: aCollection startingAt: startIndex count: n - "Read n objects into the given collection. - Return number of elements that 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! Item was removed: - ----- Method: RWBinaryOrTextStream>>reset (in category 'positioning') ----- - 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]. - ! Item was removed: - ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'properties-setting') ----- - setFileTypeToObject - "do nothing. We don't have a file type"! Item was removed: - ----- Method: RWBinaryOrTextStream>>text (in category 'accessing') ----- - text - isBinary := false! Item was removed: - ----- Method: RWBinaryOrTextStream>>upTo: (in category 'accessing') ----- - upTo: anObject - "fast version using indexOf:" - - | start end | - isBinary - ifTrue: [ anObject isInteger ifFalse: [ ^self upToEnd ] ] - ifFalse: [ anObject isCharacter ifFalse: [ ^self upToEnd ] ]. - start := position + 1. - end := collection indexOf: anObject asCharacter startingAt: start. - "not present--return rest of the collection" - (end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ]. - "skip to the end and return the data passed over" - position := end. - ^((isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: end - start) - replaceFrom: 1 - to: end - start - with: collection - startingAt: start! Item was removed: - ----- Method: RWBinaryOrTextStream>>upToEnd (in category 'accessing') ----- - upToEnd - "Must override to get class right." - | newArray | - newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position. - ^ self nextInto: newArray! Item was removed: - ArrayedCollection subclass: #RawBitsArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !RawBitsArray commentStamp: 'nice 5/10/2020 16:48' prior: 0! - RawBitsArray is an abstract superclass for all arrays whose elements are not stored as pointer but as raw bits of fixed-width. - See Behavior>>#isBits. - Currently, SpurVM supports arrays of elements with a bit-width of 8, 16, 32, or 64 bits. - When accessing a specific element with #basicAt: or #basicAt:put:, the bits are exchanged under the form of an unsigned Integer. - The range of such integer must be between 0 and 2**bitWidth-1. - - The subclasses are free to re-interpret those bits as more specialized Objects. - Unless they represent unisgned Integers, they shall define at least two methods: - - #at:put: should take an object as argument and encode it into raw bits (an unsigned Integer no longer than expected bit-width) - - #at: should convert the raw bits into an Object - Note that SpurVM supports conversion to/from signed integer via primitives 165 and 166. - - The name of subclasses is historical and constrained by backward compatibility.! Item was removed: - ----- Method: RawBitsArray class>>isAbstract (in category 'testing') ----- - isAbstract - "RawBitsArray and abstract subclasses such as SignedIntegerArray and UnsignedIntegerArray - are not bits classes. So use isBits to distinguish between concrete subclasses that are bits." - ^self isBits not! Item was removed: - ----- Method: RawBitsArray>>atAllPut: (in category 'accessing') ----- - atAllPut: anObject - self isEmpty ifTrue: [^self]. - "Note: #primFill: (primitiveConstantFill) does only handle unsigned integer. - Let at:put: take care of properly encoding anObject as bits" - self at: 1 put: anObject. - self primFill: (self basicAt: 1)! Item was removed: - ----- Method: RawBitsArray>>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; - - [0..65535] for double byte arrays; - - [0..(2^32 - 1)] for word arrays; - - [0..(2^64 - 1)] for double word arrays." - - <primitive: 145> - self errorImproperStore.! Item was removed: - LookupKey subclass: #ReadOnlyVariableBinding - instanceVariableNames: 'value' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! Item was removed: - ----- Method: ReadOnlyVariableBinding class>>key:value: (in category 'instance creation') ----- - key: key value: aValue - ^self new privateSetKey: key value: aValue! Item was removed: - ----- Method: ReadOnlyVariableBinding>>canAssign (in category 'accessing') ----- - canAssign - - ^ false! Item was removed: - ----- 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! Item was removed: - ----- Method: ReadOnlyVariableBinding>>privateSetKey:value: (in category 'private') ----- - privateSetKey: aKey value: aValue - key := aKey. - value := aValue! Item was removed: - ----- Method: ReadOnlyVariableBinding>>value (in category 'accessing') ----- - value - ^value! Item was removed: - ----- Method: ReadOnlyVariableBinding>>value: (in category 'accessing') ----- - value: aValue - (AttemptToWriteReadOnlyGlobal signal: 'Cannot store into read-only bindings') == true ifTrue:[ - value := aValue. - ].! Item was removed: - PositionableStream subclass: #ReadStream - instanceVariableNames: 'initialPositionOrNil' - 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.! Item was removed: - ----- 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! Item was removed: - ----- Method: ReadStream>>ascii (in category 'accessing') ----- - ascii! Item was removed: - ----- Method: ReadStream>>binary (in category 'accessing') ----- - binary! Item was removed: - ----- Method: ReadStream>>contents (in category 'accessing') ----- - contents - "Answer with a copy of my collection from the start to readLimit." - - ^collection copyFrom: (initialPositionOrNil ifNil: [1]) to: readLimit! Item was removed: - ----- Method: ReadStream>>contentsFrom:to: (in category 'accessing') ----- - contentsFrom: startIndex to: stopIndex - "Answer with a copy of my collection from startIndex to stopIndex." - - ^collection copyFrom: (initialPositionOrNil ifNil: [1]) + startIndex - 1 to: ((initialPositionOrNil ifNil: [1]) + stopIndex - 1 min: readLimit)! Item was removed: - ----- Method: ReadStream>>localName (in category 'file stream compatibility') ----- - localName - ^'ReadStream'! Item was removed: - ----- Method: ReadStream>>match: (in category 'positioning') ----- - match: subCollection - "Faster version than the one implemented by super, but due to my subclasses breaking various invariants true for actual ReadStreams, only use it when the receiver's class is ReadStream." - - | matchPosition | - self class == ReadStream ifFalse: [ ^super match: subCollection ]. - subCollection isEmpty ifTrue: [ ^true ]. - matchPosition := collection indexOfSubCollection: subCollection startingAt: position + 1. - matchPosition = 0 ifTrue: [ - position := readLimit. - ^false ]. - matchPosition <= readLimit ifFalse: [ ^false ]. - position := matchPosition + subCollection size - 1. - ^true! Item was removed: - ----- 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)]! Item was removed: - ----- 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 - ! Item was removed: - ----- 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]! Item was removed: - ----- 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: CharacterSet nonSeparators byteArrayMap 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! Item was removed: - ----- Method: ReadStream>>nextPut: (in category 'accessing') ----- - nextPut: anObject - - self shouldNotImplement! Item was removed: - ----- 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]. - initialPositionOrNil := position + 1! Item was removed: - ----- Method: ReadStream>>openReadOnly (in category 'file stream compatibility') ----- - openReadOnly! Item was removed: - ----- Method: ReadStream>>readInto:startingAt:count: (in category 'accessing') ----- - readInto: aCollection startingAt: startIndex count: n - "Read n objects into the given collection. - Return number of elements that 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! Item was removed: - ----- Method: ReadStream>>readOnly (in category 'file stream compatibility') ----- - readOnly! Item was removed: - ----- Method: ReadStream>>readStream (in category 'accessing') ----- - readStream - "polymorphic with SequenceableCollection. Return self" - - ^ self! Item was removed: - ----- Method: ReadStream>>size (in category 'accessing') ----- - size - "Compatibility with other streams (e.g., FileStream)" - ^readLimit! Item was removed: - ----- Method: ReadStream>>skipTo: (in category 'accessing') ----- - skipTo: anObject - "fast version using indexOf:" - - (position := collection indexOf: anObject startingAt: position + 1) = 0 ifTrue: [ - "not present. consume all characters" - position := readLimit. - ^false ]. - ^true! Item was removed: - ----- Method: ReadStream>>take: (in category 'collections - accessing') ----- - take: maxNumberOfElements - "Overridden for efficiency." - - ^ self next: maxNumberOfElements! Item was removed: - ----- Method: ReadStream>>upTo: (in category 'accessing') ----- - upTo: anObject - "fast version using indexOf:" - | start end | - - start := position+1. - end := collection indexOf: anObject startingAt: start. - - "not present--return rest of the collection" - (end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ]. - - "skip to the end and return the data passed over" - position := end. - ^collection copyFrom: start to: (end-1)! Item was removed: - ----- Method: ReadStream>>upToAnyOf:do: (in category 'accessing') ----- - upToAnyOf: aCollection do: aBlock - "Overriden for speed" - | end result | - end := collection indexOfAnyOf: aCollection startingAt: 1 + position. - (end = 0 or: [end > readLimit]) ifTrue: [^self upToEnd]. - result := collection copyFrom: 1 + position to: -1 + end. - position := end. - aBlock value: (collection at: end). - ^result! Item was removed: - ----- Method: ReadStream>>upToEnd (in category 'accessing') ----- - upToEnd - | start | - start := 1 + position. - position := readLimit. - ^collection copyFrom: start to: position! Item was removed: - 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.! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: ReadWriteStream>>contents (in category 'accessing') ----- - contents - "Answer with a copy of my collection from the start to readLimit." - - readLimit := readLimit max: position. - ^collection copyFrom: (initialPositionOrNil ifNil: [1]) to: readLimit! Item was removed: - ----- Method: ReadWriteStream>>hash (in category 'testing') ----- - hash - - self class == ReadWriteStream ifFalse: [^ super hash]. - ^ (self position + readLimit + 53) hash! Item was removed: - ----- Method: ReadWriteStream>>name (in category 'accessing') ----- - name - ^ 'a stream' "for fileIn compatibility"! Item was removed: - ----- 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)]! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: ReadWriteStream>>readStream (in category 'converting') ----- - readStream - "polymorphic with SequenceableCollection. Return self" - - ^ self! Item was removed: - ----- Method: ReadWriteStream>>take: (in category 'collections - accessing') ----- - take: maxNumberOfElements - "Overridden for efficiency." - - ^ self next: maxNumberOfElements! Item was removed: - ComposedSortFunction subclass: #ReverseSortFunction - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !ReverseSortFunction commentStamp: 'nice 11/6/2017 21:54' prior: 0! - A ReverseSortFunction wraps over another SortFunction so as to sort in reverse order.! Item was removed: - ----- Method: ReverseSortFunction>>collate:with: (in category 'evaluating') ----- - collate: anObject with: another - ^(baseSortFunction collate: anObject with: another) negated! Item was removed: - ----- Method: ReverseSortFunction>>reversed (in category 'converting') ----- - reversed - ^baseSortFunction! Item was removed: - ----- Method: ReverseSortFunction>>undefinedFirst (in category 'converting') ----- - undefinedFirst - "apply on the original" - ^baseSortFunction undefinedLast reversed! Item was removed: - ----- Method: ReverseSortFunction>>undefinedLast (in category 'converting') ----- - undefinedLast - "apply on the original" - ^baseSortFunction undefinedFirst reversed! Item was removed: - SequenceableCollection subclass: #RunArray - instanceVariableNames: 'runs values lastIndex lastRun lastOffset' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !RunArray commentStamp: 'nice 12/30/2019 00:57' 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. - Beware: methods modifying the RunArray contents should reset the lastIndex cache to nil. - - Many complexities of access can be bypassed by using the method - RunArray withStartStopAndValueDo:! Item was removed: - ----- Method: RunArray class>>new (in category 'instance creation') ----- - new - - ^self runs: Array new values: Array new! Item was removed: - ----- Method: RunArray class>>new: (in category 'instance creation') ----- - new: aSize - ^ self new: aSize withAll: nil! Item was removed: - ----- 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)! Item was removed: - ----- 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. - newCollection fillFrom: aCollection with: [:each | each]. - ^newCollection - - " RunArray newFrom: {1. 2. 2. 3} - {1. $a. $a. 3} as: RunArray - ({1. $a. $a. 3} as: RunArray) values - "! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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:" - | runs values attrList char | - (strm peekFor: $( ) ifFalse: [^ nil]. - runs := OrderedCollection new. - [strm skipSeparators. - strm peekFor: $)] whileFalse: - [runs add: (Number readFrom: strm)]. - values := OrderedCollection new. "Value array" - attrList := OrderedCollection new. "Attributes list" - [(char := strm peek) == nil] whileFalse: [ - (char isSeparator or: [ char = $!! ]) - ifTrue: [ "n.b. Skip $!! to meet expectations of RunArrayTest>>testScanFromTrailer. - The example string used in that test does not seem to match the implemention - of the fileOut serialization, but the test may be right and the implementation - wrong. In any case, relax the parsing here to meet the test expectations, and to - be more consistent with the original version of this method that assumed any - unexpected charater to be a separator. -dtl Jan 2014" - strm next "space, cr do nothing"] - ifFalse: [char == $, - ifTrue: [strm next. - values add: attrList asArray. - attrList reset ] - ifFalse: [attrList add: (TextAttribute newFrom: strm)] - ] - ]. - values add: attrList asArray. - ^ self runs: runs asArray values: (values copyFrom: 1 to: runs size) asArray - " - RunArray scanFrom: (ReadStream on: '(14 50 312)f1,f1b,f1LInteger +;i') - "! Item was removed: - ----- 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)! Item was removed: - ----- Method: RunArray>>= (in category 'comparing') ----- - = anObject - self == anObject ifTrue: [^ true]. - ^anObject class == self class - and: - [(runs hasEqualElements: anObject runs) - and: [values hasEqualElements: anObject values]]! Item was removed: - ----- Method: RunArray>>add:withOccurrences: (in category 'adding') ----- - add: value withOccurrences: 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]! Item was removed: - ----- 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]! Item was removed: - ----- 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]. - ^value! Item was removed: - ----- Method: RunArray>>asBag (in category 'converting') ----- - asBag - | aBag | - aBag := Bag new: values size. - self runsAndValuesDo: [:run :value | - aBag add: value withOccurrences: run]. - ^aBag! Item was removed: - ----- Method: RunArray>>asSet (in category 'converting') ----- - asSet - ^values asSet! Item was removed: - ----- Method: RunArray>>at: (in category 'accessing') ----- - at: index - - self at: index setRunOffsetAndValue: [:run :offset :value | - offset < 0 ifTrue: [ self errorSubscriptBounds: index ]. - offset >= (runs at: run) ifTrue: [ self errorSubscriptBounds: index ]. - ^value]! Item was removed: - ----- 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! Item was removed: - ----- 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"! Item was removed: - ----- Method: RunArray>>atPin: (in category 'accessing') ----- - atPin: index - - self at: index setRunOffsetAndValue: [:run :offset :value | ^value]! Item was removed: - ----- Method: RunArray>>coalesce (in category 'private') ----- - coalesce - "Coalesce theRuns and theValues if ever the values have adjacent equal objects" - - | lastLength lastValue mustCoalesce coalescedRuns coalescedValued runIndex | - mustCoalesce := false. - runIndex := 0. - lastLength := 0. - lastValue := Object new. - runs with: values do: [:run :value | - (lastValue = value or: [run = 0]) - ifTrue: - [mustCoalesce - ifFalse: - [coalescedRuns := (Array new: runs size) writeStream. - coalescedValued := (Array new: values size) writeStream. - coalescedRuns next: runIndex putAll: runs startingAt: 1. - coalescedValued next: runIndex putAll: values startingAt: 1. - mustCoalesce := true]. - lastLength := lastLength + run] - ifFalse: - [lastLength > 0 - ifTrue: - [mustCoalesce - ifTrue: - [coalescedRuns nextPut: lastLength. - coalescedValued nextPut: lastValue]. - runIndex := runIndex + 1]. - lastLength := run. - lastValue := value]]. - mustCoalesce - ifTrue: - [lastLength > 0 - ifTrue: - [coalescedRuns nextPut: lastLength. - coalescedValued nextPut: lastValue]. - self setRuns: coalescedRuns contents setValues: coalescedValued contents]! Item was removed: - ----- 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)! Item was removed: - ----- 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)! Item was removed: - ----- Method: RunArray>>copyUpThrough: (in category 'copying') ----- - copyUpThrough: value - "Optimized" - - | newSize newValues newRuns | - newSize := values indexOf: value startingAt: 1. - newSize = 0 ifTrue: [^self copy]. - newRuns := runs copyFrom: 1 to: newSize. - newRuns at: newSize put: 1. - newValues := values copyFrom: 1 to: newSize. - ^ self class - runs: newRuns - values: newValues! Item was removed: - ----- Method: RunArray>>copyUpTo: (in category 'copying') ----- - copyUpTo: anElement - "Optimized" - - | newValues | - newValues := values copyUpTo: anElement. - ^ self class - runs: (runs copyFrom: 1 to: newValues size) - values: newValues! Item was removed: - ----- Method: RunArray>>copyUpToLast: (in category 'copying') ----- - copyUpToLast: value - "Optimized" - - | newSize run newRuns newValues | - newSize := values lastIndexOf: value startingAt: values size. - newSize = 0 ifTrue: [^self copy]. - run := runs at: newSize. - run > 1 - ifTrue: - [newRuns := runs copyFrom: 1 to: newSize. - newRuns at: newSize put: run - 1] - ifFalse: - [newSize := newSize - 1. - newRuns := runs copyFrom: 1 to: newSize]. - newValues := values copyFrom: 1 to: newSize. - ^ self class - runs: newRuns - values: newValues! Item was removed: - ----- Method: RunArray>>do: (in category 'enumerating') ----- - do: aBlock - "This is refined for speed" - - 1 to: runs size do: [:i | - | r v | - v := values at: i. - r := runs at: i. - [( r := r - 1) >= 0] - whileTrue: [aBlock value: v]].! Item was removed: - ----- Method: RunArray>>fillFrom:with: (in category 'private') ----- - fillFrom: aCollection with: aBlock - "Evaluate aBlock with each of aCollections's elements as the argument. - Collect the resulting values into self. Answer self." - - | newRuns newValues lastLength lastValue | - newRuns := (Array new: aCollection size) writeStream. - newValues := (Array new: aCollection size) writeStream. - lastLength := 0. - lastValue := Object new. - lastIndex := nil. "flush access cache" - aCollection do: [:each | - | value | - value := aBlock value: each. - lastValue = value - ifTrue: [lastLength := lastLength + 1] - ifFalse: - [lastLength > 0 - ifTrue: - [newRuns nextPut: lastLength. - newValues nextPut: lastValue]. - lastLength := 1. - lastValue := value]]. - lastLength > 0 - ifTrue: - [newRuns nextPut: lastLength. - newValues nextPut: lastValue]. - self setRuns: newRuns contents setValues: newValues contents! Item was removed: - ----- Method: RunArray>>findFirst: (in category 'enumerating') ----- - findFirst: aBlock - | index | - index := 1. - self runsAndValuesDo: [ :run :value | - (aBlock value: value) ifTrue: [^index]. - index := index + run]. - ^0! Item was removed: - ----- Method: RunArray>>findLast: (in category 'enumerating') ----- - findLast: aBlock - | index | - index := values size + 1. - [(index := index - 1) >= 1] whileTrue: - [(aBlock value: (values at: index)) ifTrue: [^(1 to: index) detectSum: [:i | runs at: i]]]. - ^0! Item was removed: - ----- Method: RunArray>>first (in category 'accessing') ----- - first - ^values at: 1! Item was removed: - ----- Method: RunArray>>includes: (in category 'testing') ----- - includes: anObject - "Answer whether anObject is one of the receiver's elements." - - ^values includes: anObject! Item was removed: - ----- Method: RunArray>>indexOf:startingAt: (in category 'accessing') ----- - indexOf: anElement startingAt: start - "Answer the index of the first occurence of anElement after start - within the receiver. If the receiver does not contain anElement, - answer 0." - - | index | - index := 1. - self runsAndValuesDo: [ :run :value | - (index >= start and: [value = anElement]) ifTrue: [^index]. - index := index + run]. - ^0! Item was removed: - ----- Method: RunArray>>indexOfAnyOf:startingAt: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start - "Answer the index of the first occurence of any element included in aCollection after start within the receiver. - If the receiver does not contain anElement, answer zero, which is an invalid index." - - | index | - index := 1. - self runsAndValuesDo: [ :run :value | - (index >= start and: [aCollection includes: value]) ifTrue: [^index]. - index := index + run]. - ^0! Item was removed: - ----- Method: RunArray>>isSorted (in category 'testing') ----- - isSorted - ^values isSorted! Item was removed: - ----- Method: RunArray>>isSortedBy: (in category 'testing') ----- - isSortedBy: aBlock - ^values isSortedBy: aBlock! Item was removed: - ----- Method: RunArray>>keysAndValuesDo: (in category 'enumerating') ----- - keysAndValuesDo: aBlock - "This is refined for speed" - - | index | - index := 0. - 1 to: runs size do: [:i | - | r v | - v := values at: i. - r := runs at: i. - [( r := r - 1) >= 0] - whileTrue: [aBlock value: (index := index + 1) value: v]].! Item was removed: - ----- Method: RunArray>>last (in category 'accessing') ----- - last - ^values at: values size! Item was removed: - ----- Method: RunArray>>lastIndexOf:startingAt: (in category 'accessing') ----- - lastIndexOf: anElement startingAt: lastIndex - "Answer the index of the last occurence of anElement within the - receiver. If the receiver does not contain anElement, answer 0." - - | lastValueIndex | - lastValueIndex := values lastIndexOf: anElement startingAt: values size. - [lastValueIndex > 0] whileTrue: - [| i index | - i := index := 0. - [index <= lastIndex and: [(i := i + 1) <= lastValueIndex]] - whileTrue: [index := index + (runs at: i)]. - index <= lastIndex ifTrue: [^index]. - index - (runs at: lastValueIndex) < lastIndex ifTrue: [^lastIndex]. - lastValueIndex := values lastIndexOf: anElement startingAt: lastValueIndex - 1]. - ^0! Item was removed: - ----- Method: RunArray>>lastIndexOfAnyOf:startingAt: (in category 'accessing') ----- - lastIndexOfAnyOf: aCollection startingAt: lastIndex - "Answer the index of the last occurence of any element of aCollection - within the receiver. If the receiver does not contain any of those - elements, answer 0" - - | lastValueIndex | - lastValueIndex := values lastIndexOfAnyOf: aCollection startingAt: values size. - [lastValueIndex > 0] whileTrue: - [| i index | - i := index := 0. - [index <= lastIndex and: [(i := i + 1) <= lastValueIndex]] - whileTrue: [index := index + (runs at: i)]. - index <= lastIndex ifTrue: [^index]. - index - (runs at: lastValueIndex) < lastIndex ifTrue: [^lastIndex]. - lastValueIndex := values lastIndexOfAnyOf: aCollection startingAt: lastValueIndex - 1]. - ^0! Item was removed: - ----- Method: RunArray>>mapValues: (in category 'private') ----- - mapValues: mapBlock - "NOTE: only meaningful to an entire set of runs" - - values := values collect: mapBlock! Item was removed: - ----- Method: RunArray>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - runs := runs copy. - values := values copy! Item was removed: - ----- Method: RunArray>>printOn: (in category 'printing') ----- - printOn: aStream - self printNameOn: aStream. - aStream - nextPutAll: ' runs: '; - print: runs; - nextPutAll: ' values: '; - print: values! Item was removed: - ----- Method: RunArray>>rangeOf:startingAt: (in category 'accessing') ----- - 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] - ]! Item was removed: - ----- Method: RunArray>>remove:ifAbsent: (in category 'removing') ----- - remove: anObject ifAbsent: exceptionBlock - | index mustCoalesce run | - lastIndex := nil. "flush access cache" - index := values indexOf: anObject ifAbsent: [^exceptionBlock value]. - (run := runs at: index) > 1 - ifTrue: [runs at: index put: run - 1] - ifFalse: - [mustCoalesce := index > 1 and: [index < values size and: [(values at: index - 1) = (values at: index + 1)]]. - runs := runs copyWithoutIndex: index. - values := values copyWithoutIndex: index. - mustCoalesce - ifTrue: - [runs at: index - 1 put: (runs at: index - 1) + (runs at: index). - runs := runs copyWithoutIndex: index. - values := values copyWithoutIndex: index]]. - ^anObject! Item was removed: - ----- Method: RunArray>>removeAll (in category 'removing') ----- - removeAll - lastIndex := nil. "flush access cache" - runs := runs copyEmpty. - values := values copyEmpty! Item was removed: - ----- 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] ! Item was removed: - ----- 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]! Item was removed: - ----- Method: RunArray>>replace: (in category 'enumerating') ----- - replace: aBlock - "destructively replace the values in this RunArray with the ones transformed by aBlock." - lastIndex := nil. "flush access cache" - values := values replace: aBlock. - self coalesce! Item was removed: - ----- Method: RunArray>>reverseDo: (in category 'enumerating') ----- - reverseDo: aBlock - "This is refined for speed" - - | i | - i := runs size. - [i > 0] - whileTrue: - [ | r v | - v := values at: i. - r := runs at: i. - i := i - 1. - [( r := r - 1) >= 0] - whileTrue: [aBlock value: v]].! Item was removed: - ----- Method: RunArray>>reversed (in category 'converting') ----- - reversed - - ^self class runs: runs reversed values: values reversed! Item was removed: - ----- 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]! Item was removed: - ----- Method: RunArray>>runs (in category 'private') ----- - runs - - ^runs! Item was removed: - ----- Method: RunArray>>runsAndValuesDo: (in category 'enumerating') ----- - runsAndValuesDo: aBlock - "Evaluate aBlock with run lengths and values from the receiver" - ^runs with: values do: aBlock.! Item was removed: - ----- 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" - start > stop ifTrue:[^self]. - self at: start setRunOffsetAndValue:[:firstRun :offset :firstValue| - | run value index | - 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)]]. - ! Item was removed: - ----- Method: RunArray>>setRuns:setValues: (in category 'private') ----- - setRuns: newRuns setValues: newValues - lastIndex := nil. "flush access cache" - runs := newRuns asArray. - values := newValues asArray.! Item was removed: - ----- Method: RunArray>>size (in category 'accessing') ----- - size - | size | - size := 0. - 1 to: runs size do: [:i | size := size + (runs at: i)]. - ^size! Item was removed: - ----- 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: $)! Item was removed: - ----- Method: RunArray>>values (in category 'private') ----- - values - "Answer the values in the receiver." - - ^values! Item was removed: - ----- Method: RunArray>>withIndexDo: (in category 'enumerating') ----- - withIndexDo: aBlock - "This is refined for speed" - - | index | - index := 0. - 1 to: runs size do: [:i | - | r v | - v := values at: i. - r := runs at: i. - [( r := r - 1) >= 0] - whileTrue: [aBlock value: v value: (index := index + 1)]].! Item was removed: - ----- Method: RunArray>>withStartStopAndValueDo: (in category 'accessing') ----- - withStartStopAndValueDo: aBlock - | start | - start := 1. - runs with: values do: - [:len : val | | stop | - stop := start + len - 1. - aBlock value: start value: stop value: val. - start := stop + 1] - ! Item was removed: - ----- 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)]! Item was removed: - ----- 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"! Item was removed: - 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.! Item was removed: - ----- Method: SequenceableCollection class>>isAbstract (in category 'testing') ----- - isAbstract - ^self = SequenceableCollection! Item was removed: - ----- Method: SequenceableCollection class>>new:streamContents: (in category 'stream creation') ----- - new: newSize streamContents: blockWithArg - - | stream originalContents | - stream := WriteStream on: (self new: newSize). - blockWithArg value: stream. - originalContents := stream originalContents. - originalContents size = stream position - ifTrue: [ ^originalContents ] - ifFalse: [ ^stream contents ]! Item was removed: - ----- Method: SequenceableCollection class>>streamContents: (in category 'stream creation') ----- - streamContents: blockWithArg - - ^self new: 100 streamContents: blockWithArg! Item was removed: - ----- 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' - "! Item was removed: - ----- Method: SequenceableCollection>>, (in category 'copying') ----- - , otherCollection - "Concatenate two Strings or Collections." - ^ self copyReplaceFrom: self size + 1 - to: self size - with: otherCollection asCollection - " - #(2 4 6 8) , #(who do we appreciate) - ((2989 storeStringBase: 16) copyFrom: 4 to: 6) , ' boy!!' - "! Item was removed: - ----- Method: SequenceableCollection>>= (in category 'comparing') ----- - = otherCollection - "Answer true if the receiver is equivalent to the otherCollection. - First test for identity, then rule out different class and sizes of - collections. As a last resort, examine each element of the receiver - and the otherCollection." - - self == otherCollection ifTrue: [^ true]. - self class = otherCollection class ifFalse: [^ false]. - ^ self hasEqualElements: otherCollection! Item was removed: - ----- Method: SequenceableCollection>>@ (in category 'converting') ----- - @ aCollection - ^ self with: aCollection collect: [:a :b | a @ b]! Item was removed: - ----- Method: SequenceableCollection>>addAllFirstTo: (in category 'adding') ----- - addAllFirstTo: anOrderedCollection - "Add all of my elements to the beginning of anOrderedCollection" - - self reverseDo: [ :each | anOrderedCollection addFirst: each ]! Item was removed: - ----- 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]! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>allButFirstDo: (in category 'enumerating') ----- - allButFirstDo: block - - 2 to: self size do: - [:index | block value: (self at: index)]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>allButLastDo: (in category 'enumerating') ----- - allButLastDo: block - - 1 to: self size - 1 do: - [:index | block value: (self at: index)]! Item was removed: - ----- Method: SequenceableCollection>>any: (in category 'accessing') ----- - any: numberOfElements - - ^ self first: numberOfElements! Item was removed: - ----- Method: SequenceableCollection>>anyOne (in category 'accessing') ----- - anyOne - ^ self first! Item was removed: - ----- Method: SequenceableCollection>>asArray (in category 'converting') ----- - asArray - "Answer an Array whose elements are the elements of the receiver." - - ^ Array withAll: self! Item was removed: - ----- Method: SequenceableCollection>>asByteArray (in category 'converting') ----- - asByteArray - "Answer a ByteArray whose elements are the elements of the receiver." - - ^ ByteArray withAll: self! Item was removed: - ----- Method: SequenceableCollection>>asColorArray (in category 'converting') ----- - asColorArray - ^ColorArray withAll: self! Item was removed: - ----- 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]].! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>asFloat32Array (in category 'converting') ----- - asFloat32Array - "Answer a Float32Array whose elements are the elements of the receiver, in - the same order." - - | floatArray | - floatArray := Float32Array new: self size. - 1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ]. - ^floatArray! Item was removed: - ----- Method: SequenceableCollection>>asFloat64Array (in category 'converting') ----- - asFloat64Array - "Answer a Float64Array whose elements are the elements of the receiver, in - the same order." - - | floatArray | - floatArray := Float64Array new: self size. - 1 to: self size do:[:i| floatArray at: i put: (self at: i) asFloat ]. - ^floatArray! Item was removed: - ----- Method: SequenceableCollection>>asFloatArray (in category 'converting') ----- - asFloatArray - "For backward compatibility, answer a 32 bits FloatArray" - - ^self asFloat32Array! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>at:ifPresent: (in category 'accessing') ----- - at: index ifPresent: aBlock - - ^ self at: index ifPresent: aBlock ifAbsent: []! Item was removed: - ----- Method: SequenceableCollection>>at:ifPresent:ifAbsent: (in category 'accessing') ----- - at: index ifPresent: elementBlock ifAbsent: exceptionBlock - "Answer the value of elementBlock on the element at position index. If I do not contain an element at index, answer the result of evaluating exceptionBlock." - ^ elementBlock value: - (self - at: index - ifAbsent: [ ^ exceptionBlock value ])! Item was removed: - ----- Method: SequenceableCollection>>at:incrementBy: (in category 'accessing') ----- - at: index incrementBy: value - ^self at: index put: (self at: index) + value! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>atAllPut: (in category 'accessing') ----- - atAllPut: anObject - "Put anObject at every one of the receiver's indices." - - | size | - (size := self size) > 50 "first method faster for larger sizes; see below" - ifTrue: [self from: 1 to: size put: anObject] - ifFalse: [1 to: size do: [:index | self at: index put: anObject]] - - "Here's code to test what's a good cross over." - "(1 to: 3) collect: - [:j| - { Array. ByteArray. FloatArray. WordArray } collect: - [:class| | a e | - a := class new: 250. - e := a at: 1. - (1 to: a size) detect: - [:n| | t1 t2 | - t1 := [1 to: 1000 do: [:i| a from: 1 to: n put: e]] timeToRun. - t2 := [1 to: 1000 do: [:i| 1 to: n do: [:index | a at: index put: e]]] timeToRun. - t1 < t2]]]" - "32-bit Spur x86 #(#(69 54 9 63) #(64 52 10 55) #(63 53 9 61))" - "64-bit Spur x86-64 #(#(63 50 10 55) #(60 48 10 54) #(63 44 9 50))"! Item was removed: - ----- 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']! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>atLast:ifPresent: (in category 'accessing') ----- - atLast: indexFromEnd ifPresent: elementBlock - - ^ self - at: self size + 1 - indexFromEnd - ifPresent: elementBlock - ifAbsent: []! Item was removed: - ----- Method: SequenceableCollection>>atLast:ifPresent:ifAbsent: (in category 'accessing') ----- - atLast: indexFromEnd ifPresent: elementBlock ifAbsent: exceptionBlock - "Answer the value of elementBlock on the element at indexFromEnd from the last position. If the receiver does not contain an element at this position, answer the result of evaluating exceptionBlock." - - ^ self - at: self size + 1 - indexFromEnd - ifPresent: elementBlock - ifAbsent: exceptionBlock! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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)! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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]! Item was removed: - ----- Method: SequenceableCollection>>beginsWith: (in category 'testing') ----- - beginsWith: sequence - "Answer if the receiver starts with the argument collection." - - | sequenceSize | - sequenceSize := sequence size. - self size < sequenceSize ifTrue: [ ^false ]. - 1 to: sequenceSize do: [ :index | - (sequence at: index) = (self at: index) ifFalse: [ ^false ] ]. - ^true! Item was removed: - ----- Method: SequenceableCollection>>beginsWithAnyOf: (in category 'testing') ----- - beginsWithAnyOf: aCollection - "Return true if the receiver starts with any of the elements in aCollection." - ^aCollection anySatisfy:[:prefix| self beginsWith: prefix].! Item was removed: - ----- Method: SequenceableCollection>>checkedAt: (in category 'private') ----- - checkedAt: index - index > self size ifTrue: [self error: 'not enough elements']. - ^ self at: index! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>collect:from:to: (in category 'enumerating') ----- - collect: aBlock from: firstIndex to: lastIndex - "Refer to the comment in Collection|collect:." - - | size result | - size := lastIndex - firstIndex + 1. - result := self species new: size. - 1 to: size do: [ :index | - result at: index put: (aBlock value: (self at: index + firstIndex - 1)) ]. - ^result! Item was removed: - ----- 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." - " (1 to: 5) combinations: 3 atATimeDo: [:each | Transcript cr; show: each printString]" - - | aCollection | - aCollection := Array new: kk. - self combinationsAt: 1 in: aCollection after: 0 do: aBlock! Item was removed: - ----- 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) combinations: 3 atATimeDo: [: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]].! Item was removed: - ----- Method: SequenceableCollection>>concatenation (in category 'converting') ----- - concatenation - "Flattens the collection by one level into an Array. Avoids using #gather: and #streamContents: for performance reasons." - - | 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! Item was removed: - ----- 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])! Item was removed: - ----- 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])! Item was removed: - ----- Method: SequenceableCollection>>copyEmpty (in category 'copying') ----- - copyEmpty - ^ self species new: 0! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>copyLast: (in category 'copying') ----- - copyLast: num - "Deprecated. Use #last:" - - ^ self last: num! Item was removed: - ----- 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'"! Item was removed: - ----- 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. " - - | currentIndex | - (ifTokens and: [ self isString not and: [ self isText not ] ]) ifTrue: [ - self error: 'Token replacement only valid for Strings' ]. - (currentIndex := self indexOfSubCollection: oldSubstring startingAt: 1) = 0 ifTrue: [ ^self copy ]. - oldSubstring size = newSubstring size ifTrue: [ "Special case" - | string startSearch endIndex | - string := self species withAll: self. - startSearch := 1. - [ - endIndex := currentIndex + oldSubstring size - 1. - (ifTokens and: [ - (currentIndex > 1 and: [ (self at: currentIndex - 1) isAlphaNumeric ]) - or: [ endIndex < self size and: [ (self at: endIndex + 1) isAlphaNumeric ] ] ]) - ifFalse: [ "match" - string - replaceFrom: currentIndex - to: endIndex - with: newSubstring - startingAt: 1 ]. - startSearch := endIndex + 1. - (currentIndex := self indexOfSubCollection: oldSubstring startingAt: startSearch) = 0 ] whileFalse. - ^string ]. - ^self species new: self size streamContents: [ :stream | - | startSearch endIndex | - startSearch := 1. - [ - endIndex := currentIndex + oldSubstring size - 1. - (ifTokens and: [ - (currentIndex > 1 and: [ (self at: currentIndex - 1) isAlphaNumeric ]) - or: [ endIndex < self size and: [ (self at: endIndex + 1) isAlphaNumeric ] ] ]) - ifFalse: [ "match" - stream - next: currentIndex - startSearch - putAll: self - startingAt: startSearch; - nextPutAll: newSubstring ] - ifTrue: [ - stream - next: currentIndex - startSearch + oldSubstring size - putAll: self - startingAt: startSearch ]. - startSearch := endIndex + 1. - (currentIndex := self indexOfSubCollection: oldSubstring startingAt: startSearch) = 0 ] whileFalse. - stream - next: self size - startSearch + 1 - putAll: self - startingAt: startSearch ] - - "Test case: - 'test te string' copyReplaceAll: 'te' with: 'longone' asTokens: true "! Item was removed: - ----- 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 | - endReplacement := start - 1 + replacementCollection size. - newSize := self size + endReplacement - stop. - 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! Item was removed: - ----- Method: SequenceableCollection>>copyUpThrough: (in category 'copying') ----- - copyUpThrough: anElement - "Answer all elements up to and including anObject. If there - is no such object, answer a copy of the receiver." - - | index | - index := self indexOf: anElement. - index = 0 ifTrue: [ ^self copy ]. - ^self first: index! Item was removed: - ----- 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." - - | index | - index := self indexOf: anElement. - index = 0 ifTrue: [ ^self copy ]. - ^self first: index - 1! Item was removed: - ----- 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." - - | index | - index := self lastIndexOf: anElement. - index = 0 ifTrue: [ ^self copy ]. - ^self first: index - 1! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>copyWithoutFirst (in category 'copying') ----- - copyWithoutFirst - "Deprecatd. Return a copy of the receiver which doesn't include - the first element." - - ^ self allButFirst! Item was removed: - ----- 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! Item was removed: - ----- 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)]! Item was removed: - ----- 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)]! Item was removed: - ----- 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)]]! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>endsWith: (in category 'testing') ----- - endsWith: sequence - "Answer if the receiver ends with the argument collection." - - | sequenceSize offset | - sequenceSize := sequence size. - (offset := self size - sequenceSize) < 0 ifTrue: [ ^false ]. - 1 to: sequenceSize do: [ :index | - (sequence at: index) = (self at: index + offset) ifFalse: [ ^false ] ]. - ^true! Item was removed: - ----- Method: SequenceableCollection>>endsWithAnyOf: (in category 'testing') ----- - endsWithAnyOf: aCollection - "Return true if the receiver ends with any of the elements in aCollection." - ^aCollection anySatisfy:[:suffix| self endsWith: suffix].! Item was removed: - ----- Method: SequenceableCollection>>errorFirstObject: (in category 'private') ----- - errorFirstObject: anObject - - ^ self error: 'Specified object is first object' translated! Item was removed: - ----- Method: SequenceableCollection>>errorLastObject: (in category 'private') ----- - errorLastObject: anObject - - ^ self error: 'Specified object is last object' translated! Item was removed: - ----- Method: SequenceableCollection>>errorOutOfBounds (in category 'private') ----- - errorOutOfBounds - - ^ self error: 'Indices are out of bounds' translated! Item was removed: - ----- 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! Item was removed: - ----- 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 do: [ :found | found ] ifNone: [ self errorNotFound: aBlock ]! Item was removed: - ----- Method: SequenceableCollection>>findBinary:do:ifNone: (in category 'enumerating') ----- - findBinary: aBlock do: actionBlock 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 found, evaluate actionBlock with the found element as argument - If no matching element is found, evaluate exceptionBlock, - with the 'bounding' elements (or nil) as optional arguments. - Examples: - #(1 3 5 7 11 15 23) - findBinary: [ :arg | 11 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ', {a. b} printString) ] - #(1 3 5 7 11 15 23) - findBinary: [ :arg | 12 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ', {a. b} printString) ] - #(1 3 5 7 11 15 23) - findBinary: [ :arg | 0.5 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ', {a. b} printString) ] - #(1 3 5 7 11 15 23) - findBinary: [ :arg | 25 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ',{a. b} printString) ] - " - ^self - findBinaryIndex: aBlock - do: [ :foundIndex | actionBlock value: (self at: foundIndex) ] - ifNone: [ :prevIndex :nextIndex | - exceptionBlock - cull: (prevIndex > 0 ifTrue: [ self at: prevIndex ]) - cull: (nextIndex <= self size ifTrue: [ self at: nextIndex ]) ]! Item was removed: - ----- 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, - with the 'bounding' elements (or nil) as optional arguments." - - ^self findBinary: aBlock do: [ :found | found ] ifNone: exceptionBlock! Item was removed: - ----- 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 do: [ :found | found ] ifNone: [ self errorNotFound: aBlock]! Item was removed: - ----- Method: SequenceableCollection>>findBinaryIndex:do:ifNone: (in category 'enumerating') ----- - findBinaryIndex: aBlock do: actionBlock 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 found, evaluate actionBlock with the index as argument - If no matching element is found, evaluate exceptionBlock, - with the indexes of the 'bounding' elements as optional - arguments. Warning: Might give invalid indexes, see - examples below. - Examples: - #(1 3 5 7 11 15 23) - findBinaryIndex: [ :arg | 11 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ', {a. b} printString)] - #(1 3 5 7 11 15 23) - findBinaryIndex: [ :arg | 12 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ', {a. b} printString) ] - #(1 3 5 7 11 15 23) d - findBinaryIndex: [ :arg | 0.5 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ', {a. b} printString) ] - #(1 3 5 7 11 15 23) - findBinaryIndex: [ :arg | 25 - arg ] - do: [ :found | found ] - ifNone: [ :a :b | ('between: ',{a. b} printString) ] - " - | index low high test | - low := 1. - high := self size. - [ high < low ] whileFalse: [ - index := high + low // 2. - (test := aBlock value: (self at: index)) < 0 - ifTrue: [ high := index - 1 ] - ifFalse: [ - 0 < test - ifTrue: [ low := index + 1 ] - ifFalse: [ "test = 0" - ^actionBlock value: index ] ] ]. - ^exceptionBlock cull: high cull: low! Item was removed: - ----- 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, - with the indexes of the 'bounding' elements as optional - arguments. Warning: Might give invalid indexes." - - ^self findBinaryIndex: aBlock do: [ :found | found ] ifNone: exceptionBlock! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>findLast:startingAt: (in category 'enumerating') ----- - findLast: aBlock startingAt: i - "Return the index of my last element with index >= i for which aBlock evaluates as true." - - | index | - index := self size + 1. - [(index := index - 1) >= i] whileTrue: - [(aBlock value: (self at: index)) ifTrue: [^index]]. - ^ 0! Item was removed: - ----- Method: SequenceableCollection>>findNearbyBinaryIndex: (in category 'enumerating') ----- - findNearbyBinaryIndex: 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, answer the closest index we could find, - answering 0 if the element should preceed all items in the collection, - and size + 1 if the element should follow all items in the collection." - - ^self - findBinaryIndex: aBlock - ifNone: [ :lower :upper | - lower = self size - ifTrue: [ upper ] - ifFalse: [ lower ] ]! Item was removed: - ----- Method: SequenceableCollection>>first (in category 'accessing') ----- - first - "Answer the first element of the receiver" - - ^ self at: 1! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>flatten (in category 'converting') ----- - flatten - "Similar to #concatenation but removes all nesting except for strings. - Example: {3 .4 .{2 .4 .{'hi'} .'ho'}} flatten = {3 .4 .2 .4 .'hi' .'ho'}" - - ^ Array streamContents: [:stream | - self do: [:each | - ((each isCollection and: [each isString not]) or: [each isStream]) - ifFalse: [stream nextPut: each] - ifTrue: [stream nextPutAll: each flatten]]]! Item was removed: - ----- Method: SequenceableCollection>>flattened (in category 'converting') ----- - flattened - "An alias for #flatten - This message's name is in line with messages like #sorted or #reversed - while #flatten's is in line with #reverse (as per ANSI, see comment there)" - - ^ self flatten! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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)]! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>groupsDo: (in category 'enumerating') ----- - groupsDo: aBlock - "Evaluate aBlock with my elements taken n at a time, where n is the number of arguments of aBlock. Ignore any leftovers at the end." - - | index argumentArray numArgs endIndex | - numArgs := aBlock numArgs. - numArgs - caseOf: { - [ 0 ] -> [ ^self error: 'At least one block argument expected.' ]. - [ 1 ] -> [ ^self do: aBlock ]. - [ 2 ] -> [ ^self pairsDo: aBlock ] } - otherwise: []. - argumentArray := Array new: numArgs. - index := 1. - endIndex := self size - numArgs + 1. - [ index <= endIndex ] whileTrue: [ - argumentArray - replaceFrom: 1 - to: numArgs - with: self - startingAt: index. - aBlock valueWithArguments: argumentArray. - index := index + numArgs ].! Item was removed: - ----- 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 | - passArray := aBlock numArgs = 1. - ^(n - to: self size - by: n) - collect: [:index | - | args | - args := (self copyFrom: index - n + 1 to: index) asArray. - passArray - ifTrue: [aBlock value: args] - ifFalse: [aBlock valueWithArguments: args]]! Item was removed: - ----- 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 | - passArray := (aBlock numArgs = 1). - n - to: self size - by: n - do: [:index | - | args | - args := (self copyFrom: index - n + 1 to: index) asArray. - passArray ifTrue: [ aBlock value: args ] - ifFalse: [ aBlock valueWithArguments: args ]].! Item was removed: - ----- Method: SequenceableCollection>>grownBy: (in category 'copying') ----- - grownBy: length - "Answer a copy of receiver collection with size grown by length" - ^ (self class ofSize: self size + length) - replaceFrom: 1 to: self size with: self startingAt: 1 ; - yourself! Item was removed: - ----- 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 isSequenceable ifFalse: [^ false]. - (size := self size) = otherCollection size ifFalse: [^ false]. - 1 to: size do: - [:index | - (self at: index) = (otherCollection at: index) ifFalse: [^ false]]. - ^ true! Item was removed: - ----- 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! Item was removed: - ----- 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 startingAt: 1! Item was removed: - ----- 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." - - | index | - (index := self identityIndexOf: anElement startingAt: 1) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>identityIndexOf:startingAt: (in category 'accessing') ----- - identityIndexOf: anElement startingAt: startIndex - "Answer the index of anElement within the receiver starting at startIndex. - If the receiver does not contain anElement, answer 0." - - startIndex to: self size do: [ :index | - (self at: index) == anElement ifTrue: [ ^index ] ]. - ^0! Item was removed: - ----- Method: SequenceableCollection>>identityIndexOf:startingAt:ifAbsent: (in category 'accessing') ----- - identityIndexOf: anElement startingAt: startIndex ifAbsent: exceptionBlock - "Answer the index of anElement within the receiver starting at startIndex. - If the receiver does not contain anElement, answer the result of evaluating - the argument, exceptionBlock." - - | index | - (index := self identityIndexOf: anElement startingAt: startIndex) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>includes: (in category 'testing') ----- - includes: anObject - "Answer whether anObject is one of the receiver's elements." - - ^ (self indexOf: anObject) ~= 0! Item was removed: - ----- 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 startingAt: 1! Item was removed: - ----- 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." - - | index | - (index := self indexOf: anElement startingAt: 1) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>indexOf:startingAt: (in category 'accessing') ----- - indexOf: anElement startingAt: start - "Answer the index of the first occurence of anElement after start - within the receiver. If the receiver does not contain anElement, - answer 0." - - start to: self size do: [ :index | - (self at: index) = anElement ifTrue: [ ^index ] ]. - ^0! Item was removed: - ----- 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." - - | index | - (index := self indexOf: anElement startingAt: start) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>indexOfAnyOf: (in category 'accessing') ----- - indexOfAnyOf: aCollection - "Answer the index of the first occurence of any element included in aCollection within the receiver. - If the receiver does not contain anElement, answer zero, which is an invalid index." - - ^self indexOfAnyOf: aCollection startingAt: 1! Item was removed: - ----- Method: SequenceableCollection>>indexOfAnyOf:ifAbsent: (in category 'accessing') ----- - indexOfAnyOf: aCollection ifAbsent: exceptionBlock - "Answer the index of the first occurence of any element included in aCollection within the receiver. - If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock." - - ^self indexOfAnyOf: aCollection startingAt: 1 ifAbsent: exceptionBlock! Item was removed: - ----- Method: SequenceableCollection>>indexOfAnyOf:startingAt: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start - "Answer the index of the first occurence of any element included in aCollection after start within the receiver. - If the receiver does not contain anElement, answer zero, which is an invalid index." - - start to: self size do: [ :index | - (aCollection includes: (self at: index)) ifTrue: [ ^index ] ]. - ^0! Item was removed: - ----- Method: SequenceableCollection>>indexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') ----- - indexOfAnyOf: aCollection startingAt: start ifAbsent: exceptionBlock - "Answer the index of the first occurence of any element included in aCollection after start within the receiver. - If the receiver does not contain anElement, answer the result of evaluating the argument, exceptionBlock. - Note: it is user responsibility to provide aCollection that behaves relatevily fast when asked for includes: (like a Set)" - - | index | - (index := self indexOfAnyOf: aCollection startingAt: start) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>indexOfSubCollection: (in category 'accessing') ----- - indexOfSubCollection: aSubCollection - "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 the first - element of the receiver. If no such match is found, answer 0." - - ^self - indexOfSubCollection: aSubCollection - startingAt: 1! Item was removed: - ----- Method: SequenceableCollection>>indexOfSubCollection:startingAt: (in category 'accessing') ----- - indexOfSubCollection: subCollection startingAt: start - "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 0." - - | first index subCollectionSize | - (subCollectionSize := subCollection size) = 0 ifTrue: [ ^0 ]. - first := subCollection at: 1. - (start max: 1) to: self size - subCollectionSize + 1 do: [ :startIndex | - (self at: startIndex) = first ifTrue: [ - index := 2. - [ index <= subCollectionSize - and: [ (self at: startIndex + index - 1) = (subCollection at: index) ] ] - whileTrue: [ index := index + 1 ]. - index <= subCollectionSize ifFalse: [ ^startIndex ] ] ]. - ^0! Item was removed: - ----- 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." - - | index | - (index := self indexOfSubCollection: sub startingAt: start) = 0 ifFalse: [ ^index ]. - ^ exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>indicesOfSubCollection: (in category 'accessing') ----- - indicesOfSubCollection: subCollection - "Answer an Array (possibly empty) of all the indices of subCollection in the receiver." - - ^self indicesOfSubCollection: subCollection startingAt: 1! Item was removed: - ----- Method: SequenceableCollection>>indicesOfSubCollection:startingAt: (in category 'accessing') ----- - indicesOfSubCollection: subCollection startingAt: initialIndex - "Answer an Array (possibly empty) of all the indices of subCollection in the receiver starting at - initialIndex. N.B. This does not (yet) use Boyer-Moore to skip over unnecessary alignments." - - ^Array streamContents: - [:s| | index | - index := initialIndex - 1. - [(index := self indexOfSubCollection: subCollection startingAt: index + 1) = 0] whileFalse: - [s nextPut: index]]! Item was removed: - ----- Method: SequenceableCollection>>integerAt: (in category 'accessing') ----- - integerAt: index - "Return the integer at the given index" - ^self at: index! Item was removed: - ----- Method: SequenceableCollection>>integerAt:put: (in category 'accessing') ----- - integerAt: index put: value - "Return the integer at the given index" - ^self at: index put: value! Item was removed: - ----- Method: SequenceableCollection>>isSequenceable (in category 'testing') ----- - isSequenceable - ^ true! Item was removed: - ----- Method: SequenceableCollection>>join (in category 'converting') ----- - join - "Example: #(H e l l o W o r l d) join = 'HelloWorld'. " - - ^ self joinSeparatedBy: ''! Item was removed: - ----- Method: SequenceableCollection>>joinOn: (in category 'printing') ----- - joinOn: stream - - ^ self joinOn: stream separatedBy: ''! Item was removed: - ----- Method: SequenceableCollection>>joinOn:separatedBy: (in category 'printing') ----- - joinOn: stream separatedBy: aSeparator - - self - do: [:ea | stream nextPutAll: ea asString] - separatedBy: [stream nextPutAll: aSeparator asString].! Item was removed: - ----- Method: SequenceableCollection>>joinSeparatedBy: (in category 'converting') ----- - joinSeparatedBy: aSeparator - "Returns a string, which is a concatenation of each element's string representation separated by another string. - - August 2019 -- http://forum.world.st/The-Inbox-Collections-ct-827-mcz-td5099876.html - There was a discussion about whether to move this method up to Collection. We identified a trade-off between (iinterface) convenience and (result) predictability. In Collection, this method would be available for Set, too. However, random result order makes such a feature questionable. What would be the result of #(1 2 3) asSet joinSeparatedBy: '-'? For such scenarios, some people argued, it would be better to explicitely call #asArray and maybe explain why a non-sequenceable collection was used in the first place." - - ^ String streamContents: [:stream | - self joinOn: stream separatedBy: aSeparator]! Item was removed: - ----- 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)]! Item was removed: - ----- Method: SequenceableCollection>>last (in category 'accessing') ----- - last - "Answer the last element of the receiver" - - ^ self at: self size! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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." - - | index | - (index := self lastIndexOf: anElement startingAt: self size) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>lastIndexOf:startingAt: (in category 'accessing') ----- - lastIndexOf: anElement startingAt: lastIndex - "Answer the index of the last occurence of anElement within the - receiver. If the receiver does not contain anElement, answer 0." - - lastIndex to: 1 by: -1 do: [ :index | - (self at: index) = anElement ifTrue: [ ^index ] ]. - ^0! Item was removed: - ----- 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." - - | index | - (index := self lastIndexOf: anElement startingAt: lastIndex) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>lastIndexOfAnyOf: (in category 'accessing') ----- - lastIndexOfAnyOf: aCollection - "Answer the index of the last occurence of any element of aCollection - within the receiver. If the receiver does not contain any of those - elements, answer 0" - - ^self lastIndexOfAnyOf: aCollection startingAt: self size! Item was removed: - ----- Method: SequenceableCollection>>lastIndexOfAnyOf:ifAbsent: (in category 'accessing') ----- - lastIndexOfAnyOf: aCollection ifAbsent: exceptionBlock - "Answer the index of the last occurence of any element of aCollection - within the receiver. If the receiver does not contain any of those - elements, answer the result of evaluating the argument, exceptionBlock." - - | index | - (index := self lastIndexOfAnyOf: aCollection startingAt: self size) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>lastIndexOfAnyOf:startingAt: (in category 'accessing') ----- - lastIndexOfAnyOf: aCollection startingAt: lastIndex - "Answer the index of the last occurence of any element of aCollection - within the receiver. If the receiver does not contain any of those - elements, answer 0" - - lastIndex to: 1 by: -1 do: [ :index | - (aCollection includes: (self at: index)) ifTrue: [ ^index ] ]. - ^0! Item was removed: - ----- Method: SequenceableCollection>>lastIndexOfAnyOf:startingAt:ifAbsent: (in category 'accessing') ----- - lastIndexOfAnyOf: aCollection startingAt: lastIndex ifAbsent: exceptionBlock - "Answer the index of the last occurence of any element of aCollection - within the receiver. If the receiver does not contain any of those - elements, answer the result of evaluating the argument, exceptionBlock." - - | index | - (index := self lastIndexOfAnyOf: aCollection startingAt: lastIndex) = 0 ifFalse: [ ^index ]. - ^exceptionBlock value! Item was removed: - ----- Method: SequenceableCollection>>middle (in category 'accessing') ----- - middle - "Answer the middle element of the receiver." - ^ self at: self size // 2 + 1! Item was removed: - ----- Method: SequenceableCollection>>nextToLast (in category 'enumerating') ----- - nextToLast - ^self at: self size - 1! Item was removed: - ----- 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! Item was removed: - ----- 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 ofSize: 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! Item was removed: - ----- 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)]! Item was removed: - ----- 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 ]! Item was removed: - ----- 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: [])]! Item was removed: - ----- 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] - "! Item was removed: - ----- 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] - "! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: SequenceableCollection>>piecesCutWhere: (in category 'enumerating') ----- - piecesCutWhere: binaryBlock - "Answer substrings of the receiver derived from cutting the receiver - at points where binaryBlock answers true for adjacent elements." - - | pieces | - pieces := OrderedCollection new. - self piecesCutWhere: binaryBlock - do: [:piece| - pieces add: piece]. - ^pieces - - "'Now is the time for all good people to come to the aid of the cause of world peace. It is just fine, even desirable, to love your country, if that means wanting it to play a beneficial role in the course of world events and be the best possible example of a good society. But if it means wanting dominion over the rest of the world, it is not love but defensiveness or self-glorification, and will lead only to oblivion.' - piecesCutWhere: [:a :b| a = $. and: [b isSeparator]]"! Item was removed: - ----- Method: SequenceableCollection>>piecesCutWhere:do: (in category 'enumerating') ----- - piecesCutWhere: binaryBlock do: pieceBlock - "Evaluate pieceBlock with substrings of the receiver derived from cutting the - receiver at points where binaryBlock answers true for adjacent elements." - - | size lastCut this next | - (size := self size) <= 1 ifTrue: - [size = 1 ifTrue: - [pieceBlock value: self]. - ^self]. - lastCut := 1. - this := self at: 1. - 2 to: size do: - [:i| - next := self at: i. - (binaryBlock value: this value: next) ifTrue: - [pieceBlock value: (self copyFrom: lastCut to: i - 1). - lastCut := i]. - this := next]. - pieceBlock value: (self copyFrom: lastCut to: size)! Item was removed: - ----- Method: SequenceableCollection>>polynomialEval: (in category 'enumerating') ----- - polynomialEval: thisX - "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" - - | index sum | - sum := self at: (index := self size). - [ (index := index - 1) >= 1 ] whileTrue: [ - sum := sum * thisX + (self at: index) ]. - ^sum! Item was removed: - ----- Method: SequenceableCollection>>putOn: (in category 'filter streaming') ----- - putOn: aStream - - self do: [ :each | each putOn: aStream ]! Item was removed: - ----- Method: SequenceableCollection>>readStream (in category 'converting') ----- - readStream - ^ ReadStream on: self! Item was removed: - ----- Method: SequenceableCollection>>remove:ifAbsent: (in category 'removing') ----- - remove: oldObject ifAbsent: anExceptionBlock - "SequencableCollections cannot implement removing." - - self shouldNotImplement! Item was removed: - ----- Method: SequenceableCollection>>replace: (in category 'enumerating') ----- - replace: aBlock - "Evaluate aBlock with each of the receiver's elements as the argument. - Collect the resulting values into self." - - 1 to: self size do: [ :index | - self at: index put: (aBlock value: (self at: index)) ]! Item was removed: - ----- Method: SequenceableCollection>>replaceAll:with: (in category 'accessing') ----- - replaceAll: oldObject with: newObject - "Replace all occurences of oldObject with newObject" - - | index | - index := 0. - [ (index := self indexOf: oldObject startingAt: index + 1) = 0 ] - whileFalse: [ self at: index put: newObject ]! Item was removed: - ----- 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! Item was removed: - ----- 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)]! Item was removed: - ----- Method: SequenceableCollection>>reverse (in category 'converting') ----- - reverse - "The ANSI standard (5.7.8.26) requires this method to return a copy of the receiver. If you want to reverse the collection in place, then use #reverseInPlace." - - ^self reversed! Item was removed: - ----- 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)]! Item was removed: - ----- Method: SequenceableCollection>>reverseInPlace (in category 'converting') ----- - reverseInPlace - "Reverse this collection in place." - - | start end | - start := 1. - end := self size. - [ start < end ] whileTrue: [ - | temp | - temp := self at: start. - self - at: start put: (self at: end); - at: end put: temp. - start := start + 1. - end := end - 1 ] - ! Item was removed: - ----- 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)]! Item was removed: - ----- 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 ofSize: n. - src := n + 1. - 1 to: n do: [:i | result at: i put: (self at: (src := src - 1))]. - ^ result - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>shuffle (in category 'shuffling') ----- - shuffle - - ^self shuffleBy: ThreadSafeRandom value! Item was removed: - ----- Method: SequenceableCollection>>shuffleBy: (in category 'shuffling') ----- - shuffleBy: aRandom - "Durstenfeld's version of the Fisher-Yates shuffle" - - self size to: 2 by: -1 do: [ :i | - self swap: i with: (aRandom nextInt: i) ]! Item was removed: - ----- Method: SequenceableCollection>>shuffled (in category 'shuffling') ----- - shuffled - - ^self shuffledBy: ThreadSafeRandom value - - "Examples: - ($A to: $Z) shuffled - "! Item was removed: - ----- Method: SequenceableCollection>>shuffledBy: (in category 'shuffling') ----- - shuffledBy: aRandom - "Durstenfeld's version of the Fisher-Yates shuffle" - - ^self copy shuffleBy: aRandom! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>size (in category 'accessing') ----- - size - ^self subclassResponsibility! Item was removed: - ----- Method: SequenceableCollection>>splitBy: (in category 'enumerating') ----- - splitBy: aCollection - "Answer the receiver, split by aCollection. - - This method works similarly to findTokens: but - a) takes a collection argument (i.e., 'hello<p>world<p>' splitBy: '<p>') - b) is 'strict' in its splitting, for example: - 'a///b' findTokens: '/' ==> #('a' 'b') - 'a///b' splitBy: '/' ==> #('a' '' '' 'b') - " - - ^Array streamContents:[:stream| - self splitBy: aCollection do:[:each| stream nextPut: each]. - ]. - ! Item was removed: - ----- Method: SequenceableCollection>>splitBy:do: (in category 'enumerating') ----- - splitBy: aCollection do: aBlock - "Split the receiver by aCollection. Evaluate aBlock with the parts. - - This method works similarly to findTokens: but - a) takes a collection argument (i.e., 'hello<p>world<p>' splitBy: '<p>') - b) is 'strict' in its splitting, for example: - 'a///b' findTokens: '/' ==> #('a' 'b') - 'a///b' splitBy: '/' ==> #('a' '' '' 'b') - " - - | lastIndex nextIndex | - lastIndex := 1. - [nextIndex := self indexOfSubCollection: aCollection startingAt: lastIndex. - nextIndex = 0] whileFalse:[ - aBlock value: (self copyFrom: lastIndex to: nextIndex-1). - lastIndex := nextIndex+ aCollection size. - ]. - aBlock value: (self copyFrom: lastIndex to: self size). - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: SequenceableCollection>>upTo: (in category 'enumerating') ----- - upTo: anObject - "Deprecated. Use copyUpTo:" - self deprecated: 'Use #copyUpTo:'. - ^ self copyUpTo: anObject! Item was removed: - ----- 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 | - self isOfSameSizeCheck: otherCollection. - 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! Item was removed: - ----- Method: SequenceableCollection>>with:do: (in category 'enumerating') ----- - with: otherCollection do: twoArgBlock - "Evaluate twoArgBlock with corresponding elements from this collection and otherCollection." - self isOfSameSizeCheck: otherCollection. - 1 to: self size do: - [:index | - twoArgBlock value: (self at: index) - value: (otherCollection at: index)]! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: SequenceableCollection>>withoutDuplicates (in category 'copying') ----- - withoutDuplicates - "Answer a copy of the receiver that preserves order but eliminates any duplicates." - | seen | - seen := Set new: self size. - ^self select: [:each| seen ifAbsentAdd: each]! Item was removed: - ----- Method: SequenceableCollection>>writeStream (in category 'converting') ----- - writeStream - ^ WriteStream on: self! Item was removed: - HashedCollection subclass: #Set - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Unordered'! - - !Set commentStamp: 'nice 8/26/2010 22:14' 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 #scanFor:, 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. - - I can include an UndefinedObject (nil) thanks to a special implementation using a wrapper (see message #asSetElement and class SetElement). - Indeed, a nil entry in the storage array means vacuity, it cannot mean I contain nil.! Item was removed: - ----- 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 - "! Item was removed: - ----- Method: Set class>>quickRehashAllSets (in category 'initialization') ----- - quickRehashAllSets - - self deprecated: 'Use HashedCollection >> #rehashAll'. - HashedCollection rehashAll! Item was removed: - ----- Method: Set class>>rehashAllSets (in category 'initialization') ----- - rehashAllSets - - self deprecated: 'Use HashedCollection >> #rehashAll'. - HashedCollection rehashAll! Item was removed: - ----- Method: Set>>= (in category 'comparing') ----- - = anObject - "Two sets 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 == anObject ifTrue: [ ^true ]. - self species == anObject species ifFalse: [ ^false ]. - self size = anObject size ifFalse: [ ^false ]. - ^self allSatisfy: [ :each | anObject includes: each ]! Item was removed: - ----- 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 | - index := self scanFor: newObject. - (array at: index) ifNil: [self atNewIndex: index put: newObject asSetElement]. - ^ newObject! Item was removed: - ----- Method: Set>>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 add: anObject! Item was removed: - ----- Method: Set>>asSet (in category 'converting') ----- - asSet - ^self! Item was removed: - ----- 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. - self do: [ :each | newSet add: (aBlock value: each) ]. - ^newSet! Item was removed: - ----- Method: Set>>copyWithout: (in category 'copying') ----- - copyWithout: oldElement - "Answer a copy of the receiver that does not contain any - elements equal to oldElement." - - ^ self copy - remove: oldElement ifAbsent: []; - yourself! Item was removed: - ----- Method: Set>>do: (in category 'enumerating') ----- - do: aBlock - - tally = 0 ifTrue: [ ^self ]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :element | - aBlock value: element enclosedSetElement] ]! Item was removed: - ----- 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 := array at: (index := index \\ array size + 1)) == nil ] whileFalse: [ - | newIndex | - (newIndex := self scanFor: element enclosedSetElement) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: nil ] ]! Item was removed: - ----- Method: Set>>ifAbsentAdd: (in category 'adding') ----- - ifAbsentAdd: anObject - "Ensure anObject is part of the receiver. Answer whether its membership was newly acquired." - | index | - index := self scanFor: anObject. - (array at: index) ifNil: - [self - atNewIndex: index - put: anObject asSetElement. - ^true]. - ^false! Item was removed: - ----- Method: Set>>includes: (in category 'testing') ----- - includes: anObject - - (array at: (self scanFor: anObject)) ifNil: [ ^false ] ifNotNil: [ ^true ]! Item was removed: - ----- 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)) ifNotNil:[:obj| obj enclosedSetElement]! Item was removed: - ----- Method: Set>>like:ifAbsent: (in category 'accessing') ----- - like: anObject ifAbsent: aBlock - "Answer an object in the receiver that is equal to anObject, - or evaluate the block if not found. Relies heavily on hash properties" - - ^(array at: (self scanFor: anObject)) - ifNil: [ aBlock value ] - ifNotNil: [ :element | element enclosedSetElement ]! Item was removed: - ----- 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 | - (anArray at: index) ifNotNil: [ :object | - array - at: (self scanForEmptySlotFor: object enclosedSetElement) - put: object ] ]! Item was removed: - ----- Method: Set>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - (self includes: anObject) ifTrue: [ ^1 ]. - ^0! Item was removed: - ----- Method: Set>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - array := array copy! Item was removed: - ----- Method: Set>>remove:ifAbsent: (in category 'removing') ----- - remove: oldObject ifAbsent: aBlock - - | index | - index := self scanFor: oldObject. - (array at: index) ifNil: [ ^ aBlock value ]. - tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: nil. - self fixCollisionsFrom: index. - ^ oldObject! Item was removed: - ----- 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 size | - index := start := anObject hash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ anObject = element enclosedSetElement ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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! Item was removed: - Object subclass: #SetElement - instanceVariableNames: 'enclosedElement' - classVariableNames: 'NilElement' - poolDictionaries: '' - category: 'Collections-Support'! - - !SetElement commentStamp: 'nice 8/26/2010 22:21' prior: 0! - A SetElement is a special wrapper used to handle addition of some special elements into Set. - This is necessary mainly for storing an UndefinedObject in a Set, since nil is used in Set algorithm to designate free slots in internal storage. - - Instance Variables - enclosedElement: <Object> - - enclosedElement - - the real element we wish to put into the set - ! Item was removed: - ----- Method: SetElement class>>initialize (in category 'class initialization') ----- - initialize - NilElement := self with: nil. - ! Item was removed: - ----- Method: SetElement class>>with: (in category 'instance creation') ----- - with: anObject - ^ self new enclosedSetElement: anObject! Item was removed: - ----- Method: SetElement class>>withNil (in category 'accessing') ----- - withNil - ^ NilElement - ! Item was removed: - ----- Method: SetElement>>= (in category 'comparing') ----- - = anObject - ^ anObject class = self class and: [ enclosedElement = anObject enclosedSetElement ] - ! Item was removed: - ----- Method: SetElement>>asSetElement (in category 'converting') ----- - asSetElement - "A receiver has to be included into a set, as a distinct object. - We need to wrap receiver in own turn, otherwise #enclosedSetElement will return wrong object for that set" - ^ SetElement with: self! Item was removed: - ----- Method: SetElement>>enclosedSetElement (in category 'accessing') ----- - enclosedSetElement - ^ enclosedElement! Item was removed: - ----- Method: SetElement>>enclosedSetElement: (in category 'accessing') ----- - enclosedSetElement: anObject - enclosedElement := anObject! Item was removed: - ----- Method: SetElement>>hash (in category 'comparing') ----- - hash - ^ enclosedElement hash - ! Item was removed: - 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.! Item was removed: - ----- Method: SharedQueue class>>new (in category 'instance creation') ----- - new - "Answer a new instance of SharedQueue that has 10 elements." - - ^self new: 10! Item was removed: - ----- Method: SharedQueue class>>new: (in category 'instance creation') ----- - new: anInteger - ^super new initialize: anInteger! Item was removed: - ----- 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].! Item was removed: - ----- Method: SharedQueue>>flushAllSuchThat: (in category 'accessing') ----- - flushAllSuchThat: aBlock - "Remove from the queue all objects that satisfy aBlock." - - accessProtect critical: [ - | newReadPos | - newReadPos := writePosition. - writePosition - 1 to: readPosition by: -1 do: [ :i | - | value | - value := contentsArray at: i. - contentsArray at: i put: nil. - ((aBlock value: value) and: [ (readSynch waitIfLocked: [ nil ]) notNil ]) ifFalse: [ - newReadPos := newReadPos - 1. - contentsArray at: newReadPos put: value ] ]. - readPosition := newReadPos ]! Item was removed: - ----- Method: SharedQueue>>initialize: (in category 'private') ----- - initialize: size - - contentsArray := Array new: size. - readPosition := 1. - writePosition := 1. - accessProtect := Semaphore forMutualExclusion. - readSynch := Semaphore new! Item was removed: - ----- 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! Item was removed: - ----- Method: SharedQueue>>makeRoomAtEnd (in category 'private') ----- - makeRoomAtEnd - - | contentsSize newContentsArray | - contentsSize := writePosition - readPosition. - newContentsArray := contentsSize * 2 > contentsArray size - ifTrue: [ contentsArray class new: contentsArray size * 2 ] - ifFalse: [ - (contentsArray size > 10 and: [ contentsSize * 4 <= contentsArray size ]) - ifTrue: [ contentsArray class new: (contentsSize * 2 max: 10) ] - ifFalse: [ contentsArray ] ]. - newContentsArray - replaceFrom: 1 - to: contentsSize - with: contentsArray - startingAt: readPosition. - contentsArray == newContentsArray - ifFalse: [ contentsArray := newContentsArray ] - ifTrue: [ contentsArray from: contentsSize + 1 to: contentsArray size put: nil ]. - readPosition := 1. - writePosition := contentsSize + 1! Item was removed: - ----- 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." - - readSynch wait. - ^accessProtect - critical: [ - | value | - 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].! Item was removed: - ----- 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>." - - readSynch waitIfLocked: [ ^nil ]. - ^accessProtect - critical: [ - | value | - 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 ]! Item was removed: - ----- 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 (^)." - - ^accessProtect critical: [ - | value readPos | - value := nil. - readPos := readPosition. - [ readPos < writePosition and: [ value isNil ] ] whileTrue: [ - value := contentsArray at: readPos. - readPos := readPos + 1. - (aBlock value: value) - ifFalse: [ value := nil ] - ifTrue: [ - readSynch waitIfLocked: [ ^nil ]. "We found the value, but someone else booked it." - readPos-1 to: readPosition+1 by: -1 do: [ :j | contentsArray at: j put: (contentsArray at: j-1) ]. - contentsArray at: readPosition put: nil. - readPosition := readPosition+1 ] ]. - 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 - ==="! Item was removed: - ----- 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! Item was removed: - ----- 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" - - ^readSynch - critical: [ - accessProtect critical: [ - readPosition >= writePosition ifFalse: [ - contentsArray at: readPosition ] ] ] - ifLocked: [ nil ]! Item was removed: - ----- Method: SharedQueue>>peekLast (in category 'accessing') ----- - peekLast - "Answer the object that was sent through the receiver last and has not - yet been received by anyone. If no object has been sent, answer nil" - - "SharedQueue new nextPut: 1; nextPut: 2; peekLast" - - ^readSynch - critical: - [accessProtect critical: - [writePosition > 1 ifTrue: - [contentsArray at: writePosition - 1]]] - ifLocked: [nil]! Item was removed: - ----- Method: SharedQueue>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - contentsArray := contentsArray copy. - accessProtect := Semaphore forMutualExclusion. - readSynch := Semaphore new! Item was removed: - ----- Method: SharedQueue>>printOn: (in category 'private') ----- - printOn: aStream - super printOn: aStream. - "Print a guesstimate of the size of the queue without aquiring the lock properly" - aStream nextPut: $(. - aStream print: writePosition - readPosition. - aStream nextPut: $).! Item was removed: - ----- 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! Item was removed: - 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. - ! Item was removed: - ----- Method: SharedQueue2 class>>new (in category 'instance creation') ----- - new - ^self basicNew initialize! Item was removed: - ----- Method: SharedQueue2>>flush (in category 'accessing') ----- - flush - self deprecated: 'use removeAll'. - ^self removeAll! Item was removed: - ----- Method: SharedQueue2>>flushAllSuchThat: (in category 'accessing') ----- - flushAllSuchThat: aBlock - self deprecated: 'use removeAllSuchThat:'. - - ^self removeAllSuchThat: aBlock! Item was removed: - ----- Method: SharedQueue2>>initialize (in category 'initializing') ----- - initialize - monitor := Monitor new. - items := OrderedCollection new. - ! Item was removed: - ----- Method: SharedQueue2>>isEmpty (in category 'size') ----- - isEmpty - ^monitor critical: [ items isEmpty ]! Item was removed: - ----- Method: SharedQueue2>>next (in category 'accessing') ----- - next - - ^monitor critical: [ - monitor waitWhile: [ items isEmpty ]. - items removeFirst ] - ! Item was removed: - ----- Method: SharedQueue2>>nextOrNil (in category 'accessing') ----- - nextOrNil - ^monitor critical: [ - items isEmpty ifTrue: [ nil ] ifFalse: [ items removeFirst ] ]! Item was removed: - ----- 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." - - ^monitor critical: [ - | index | - index := items findFirst: aBlock. - index = 0 ifTrue: [ - nil ] - ifFalse: [ - items removeAt: index ] ]. - ! Item was removed: - ----- Method: SharedQueue2>>nextPut: (in category 'accessing') ----- - nextPut: item - - monitor critical: [ - items addLast: item. - monitor signal. ]. - ^item! Item was removed: - ----- 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 ] ] - ! Item was removed: - ----- Method: SharedQueue2>>peekLast (in category 'accessing') ----- - peekLast - "Answer the object that was sent through the receiver last and has not - yet been received by anyone. If no object has been sent, answer nil" - - "SharedQueue2 new nextPut: 1; nextPut: 2; peekLast" - ^monitor critical: - [items isEmpty ifFalse: - [items last]]! Item was removed: - ----- Method: SharedQueue2>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - monitor critical: - [items := items copy. - monitor := Monitor new]! Item was removed: - ----- Method: SharedQueue2>>printOn: (in category 'printing') ----- - printOn: aStream - monitor critical: [ - aStream - nextPutAll: self class name; - nextPutAll: ' with '; - print: items size; - nextPutAll: ' items' ].! Item was removed: - ----- Method: SharedQueue2>>removeAll (in category 'accessing') ----- - removeAll - monitor critical: [ - items removeAll ].! Item was removed: - ----- Method: SharedQueue2>>removeAllSuchThat: (in category 'accessing') ----- - removeAllSuchThat: aBlock - "Remove from the queue all objects that satisfy aBlock." - monitor critical: [ - items removeAllSuchThat: aBlock ]! Item was removed: - ----- Method: SharedQueue2>>size (in category 'size') ----- - size - ^monitor critical: [ items size ]! Item was removed: - SignedIntegerArray variableByteSubclass: #SignedByteArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !SignedByteArray commentStamp: 'nice 5/10/2020 17:21' prior: 0! - A SignedByteArray store 8bit signed Integer values in the range -128 to 127. - Negative values are stored as 2's complement.! Item was removed: - ----- Method: SignedByteArray>>at: (in category 'accessing') ----- - at: index - | word | - <primitive: 165> - word := self basicAt: index. - ^word >= 16r80 "Negative?!!" - ifTrue:[16r100 - word] - ifFalse:[word]! Item was removed: - ----- Method: SignedByteArray>>at:put: (in category 'accessing') ----- - at: index put: anInteger - | byte | - <primitive: 166> - anInteger < 0 - ifTrue: - [anInteger < -16r80 ifTrue: [self error: anInteger asString , ' out of range']. - byte := 16r100 + anInteger] - ifFalse: - [anInteger > 16r7F ifTrue: [self error: anInteger asString , ' out of range']. - byte := anInteger]. - self basicAt: index put: byte. - ^anInteger! Item was removed: - ----- Method: SignedByteArray>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 1! Item was removed: - SignedIntegerArray variableDoubleByteSubclass: #SignedDoubleByteArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !SignedDoubleByteArray commentStamp: 'nice 5/10/2020 17:21' prior: 0! - A SignedDoubleByteArray store 16bit signed Integer values in the range -32766 to 32765. - Negative values are stored as 2's complement.! Item was removed: - ----- Method: SignedDoubleByteArray>>at: (in category 'accessing') ----- - at: index - | word | - <primitive: 165> - word := self basicAt: index. - ^word >= 16r8000 "Negative?!!" - ifTrue:[16r10000 - word] - ifFalse:[word]! Item was removed: - ----- Method: SignedDoubleByteArray>>at:put: (in category 'accessing') ----- - at: index put: anInteger - | byte | - <primitive: 166> - anInteger < 0 - ifTrue: - [anInteger < -16r8000 ifTrue: [self error: anInteger asString , ' out of range']. - byte := 16r10000 + anInteger] - ifFalse: - [anInteger > 16r7FFF ifTrue: [self error: anInteger asString , ' out of range']. - byte := anInteger]. - self basicAt: index put: byte. - ^anInteger! Item was removed: - ----- Method: SignedDoubleByteArray>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 2! Item was removed: - SignedIntegerArray variableDoubleWordSubclass: #SignedDoubleWordArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !SignedDoubleWordArray commentStamp: 'nice 5/10/2020 17:30' prior: 0! - A SignedDoubleWordArray store 64bit signed Integer values in the range (1<<63)negated (-9,223,372,036,854,775,808) to (1<<63-1) (9,223,372,036,854,775,807) - that is about 9 US-quintillon (10**3**(5+1)*9), or 9 british-trillion (10**6**3*9). - Negative values are stored as 2's complement.! Item was removed: - ----- Method: SignedDoubleWordArray>>at: (in category 'accessing') ----- - at: index - | word64 | - <primitive: 165> - word64 := self basicAt: index. - word64 < SmallInteger maxVal ifTrue:[^word64]. "Avoid LargeInteger computations" - ^word64 >= 16r8000000000000000 "Negative?!!" - ifTrue: ["word64 - 16r10000000000000000" - (word64 bitInvert64 + 1) negated] - ifFalse: [word64]! Item was removed: - ----- Method: SignedDoubleWordArray>>at:put: (in category 'accessing') ----- - at: index put: anInteger - | word64 | - <primitive: 166> - anInteger < 0 - ifTrue: - [anInteger < -16r8000000000000000 ifTrue: [self error: anInteger asString , ' out of range']. - "word64 := 16r10000000000000000 + anInteger" - word64 := (anInteger + 1) negated bitInvert64] - ifFalse: - [anInteger > 16r7FFFFFFFFFFFFFFF ifTrue: [self error: anInteger asString , ' out of range']. - word64 := anInteger]. - self basicAt: index put: word64. - ^anInteger! Item was removed: - ----- Method: SignedDoubleWordArray>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 8! Item was removed: - RawBitsArray subclass: #SignedIntegerArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !SignedIntegerArray commentStamp: 'nice 5/10/2020 16:00' prior: 0! - SignedIntegerArray is an abstract class for all arrays of signed integer of fixed bit-width.! Item was removed: - ----- Method: SignedIntegerArray>>defaultElement (in category 'accessing') ----- - defaultElement - "Return the default element of the receiver" - ^0! Item was removed: - SignedIntegerArray variableWordSubclass: #SignedWordArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !SignedWordArray commentStamp: 'nice 5/10/2020 17:22' prior: 0! - A SignedWordArray store 64bit signed Integer values in the range -16r80000000 (-2,147,483,648) to 16r7FFFFFFF (2,147,483,647) - Negative values are stored as 2's complement.! Item was removed: - ----- Method: SignedWordArray>>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]! Item was removed: - ----- Method: SignedWordArray>>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! Item was removed: - ----- Method: SignedWordArray>>bytesPerElement (in category 'accessing') ----- - bytesPerElement - "Number of bytes in each item. This multiplied by (self size)*8 gives the number of bits stored." - ^ 4! Item was removed: - Object subclass: #SortFunction - instanceVariableNames: '' - classVariableNames: 'Default' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !SortFunction commentStamp: 'nice 11/5/2017 22:52' prior: 0! - I am intended to be used in place of two arg sort blocks. - - Usage - - In the following example, an ascending SortFunction is created based on the result of the #first message send to each object. - #(#(1 2) #(2 3) #(0 0)) sorted: #first ascending. - - To sort by the #last element, but descending, the following would be used: - #(#(1 2) #(2 3) #(0 0)) sorted: #last descending. - - One can use blocks as well. The following sorts in descending order, the sub elements based on the sum of their values. - | sumBlock | - sumBlock := [:sequence | sequence inject: 0 into: [:sum :each | sum + each]]. - #(#(1 2) #(2 3) #(0 0)) sorted: sumBlock descending. - - One can even use 2 arg blocks, for those cases where the function isn't expressible with objects that respond to < and =. The only catch, is that such a function has to return not true and false, but instead a collation order, values of -1 (for before), 0 (the same) or 1 (to follow). For example: - - | oddBlock | - oddBlock := - [:a :b | - a odd = b odd ifTrue: [0] ifFalse: [a odd ifTrue: [-1] ifFalse: [1]]]. - #(1 5 1 3 2 7 9 4 6) asSortedCollection: oddBlock descending - - Instance Variables - collator <SortFunction> This is the object responsible for collating objetcs, generally a SortFunction. - - ! Item was removed: - ----- Method: SortFunction class>>default (in category 'accessing') ----- - default - ^Default! Item was removed: - ----- Method: SortFunction>>, (in category 'converting') ----- - , aSortFunction - "Return a new SortFunction which is the concatenation of aSortFunction to me, I will be the primary sort, but if I compare equal, I will defer to the argument." - - ^ChainedSortFunction startWith: self then: aSortFunction asSortFunction! Item was removed: - ----- Method: SortFunction>>asSortFunction (in category 'converting') ----- - asSortFunction - - ^self! Item was removed: - ----- Method: SortFunction>>collate:with: (in category 'evaluating') ----- - collate: value1 with: value2 - "answer the collation order for the two values -1,0 or 1" - - ^self subclassResponsibility! Item was removed: - ----- Method: SortFunction>>reversed (in category 'converting') ----- - reversed - "Return new sort function with reverse sort order." - - ^ReverseSortFunction on: self! Item was removed: - ----- Method: SortFunction>>undefinedFirst (in category 'converting') ----- - undefinedFirst - "Return a new SortFunction that sort all the nil first, an non nil with myself." - ^(UndefinedSortFunction on: self) undefinedFirst! Item was removed: - ----- Method: SortFunction>>undefinedLast (in category 'converting') ----- - undefinedLast - "Return a new SortFunction that sort all the nil last, an non nil with myself." - ^(UndefinedSortFunction on: self) undefinedLast! Item was removed: - ----- Method: SortFunction>>value:value: (in category 'evaluating') ----- - value: anObject value: bObject - "Masquerade as a two argument block, used by many of the sorting APIs, by returning whether anObject should be placed before bObject or not." - - | result | - result := (self collate: anObject with: bObject). - ^result <= 0! Item was removed: - OrderedCollection subclass: #SortedCollection - instanceVariableNames: 'sortBlock' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Sequenceable'! - - !SortedCollection commentStamp: 'eem 3/30/2017 17:33' prior: 0! - I represent a collection of objects ordered by some property of the objects themselves. The ordering is specified in a two argument BlockClosure. The default sorting function is a <= comparison on elements.! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: SortedCollection>>add: (in category 'adding') ----- - add: newObject - ^ super insert: newObject before: (self indexForInserting: newObject)! Item was removed: - ----- 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! Item was removed: - ----- Method: SortedCollection>>addFirst: (in category 'adding') ----- - addFirst: newObject - self shouldNotImplement! Item was removed: - ----- Method: SortedCollection>>at:put: (in category 'accessing') ----- - at: anInteger put: anObject - self shouldNotImplement! Item was removed: - ----- Method: SortedCollection>>copyEmpty (in category 'adding') ----- - copyEmpty - "Answer a copy of the receiver without any of the receiver's elements." - - ^self species sortBlock: sortBlock! Item was removed: - ----- Method: SortedCollection>>indexForInserting: (in category 'private') ----- - indexForInserting: newObject - - | index low high | - low := firstIndex. - high := lastIndex. - sortBlock - ifNil: [ - [ low > high ] whileFalse: [ - index := (high + low) // 2. - (array at: index) <= newObject - ifTrue: [ low := index + 1 ] - ifFalse: [ high := index - 1 ] ] ] - ifNotNil: [ - [ low > high ] whileFalse: [ - index := (high + low) // 2. - (sortBlock value: (array at: index) value: newObject) - ifTrue: [ low := index + 1 ] - ifFalse: [ high := index - 1 ] ] ]. - ^low! Item was removed: - ----- Method: SortedCollection>>insert:before: (in category 'private') ----- - insert: anObject before: spot - self shouldNotImplement! Item was removed: - ----- Method: SortedCollection>>median (in category 'accessing') ----- - median - "Return the middle element, or as close as we can get." - - ^ self at: self size + 1 // 2! Item was removed: - ----- Method: SortedCollection>>reSort (in category 'private') ----- - reSort - - firstIndex < lastIndex ifTrue: [ - array quickSortFrom: firstIndex to: lastIndex by: sortBlock ]! Item was removed: - ----- 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 | - newFirstIndex := 1 + array size - lastIndex. - lastIndex := 1 + array size - firstIndex. - firstIndex := newFirstIndex. - array := array reversed. - sortBlock := sortBlock - ifNil: [ [ :a :b | b <= a ] ] - ifNotNil: [ [ :a :b | sortBlock value: b value: a ] ]! Item was removed: - ----- Method: SortedCollection>>reversed (in category 'converting') ----- - reversed - "Answer a collection that Sort elements in reverse order" - - ^self shallowCopy reverseInPlace! Item was removed: - ----- Method: SortedCollection>>should:precede: (in category 'private') ----- - should: a precede: b - - ^sortBlock ifNil: [a <= b] ifNotNil: [sortBlock value: a value: b] - ! Item was removed: - ----- Method: SortedCollection>>sort: (in category 'sorting') ----- - sort: aSortBlock - "Sort this collection using aSortBlock. The block should take two arguments - and return true if the first element should preceed the second one. - If aSortBlock is nil then <= is used for comparison." - - super sort: aSortBlock. - sortBlock := aSortBlock! Item was removed: - ----- Method: SortedCollection>>sortBlock (in category 'accessing') ----- - sortBlock - "Answer the blockContext which is the criterion for sorting elements of - the receiver." - - ^sortBlock! Item was removed: - ----- Method: SortedCollection>>sortBlock: (in category 'accessing') ----- - sortBlock: aBlock - "Make the argument, aBlock, be the criterion for ordering elements of the - receiver." - - sortBlock := aBlock. - "sortBlocks with side effects may not work right" - self size > 1 ifTrue: [self reSort]! Item was removed: - ----- 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! Item was removed: - SparseLargeTable variableSubclass: #SparseLargeArray - instanceVariableNames: 'arrayClass' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !SparseLargeArray commentStamp: '<historical>' prior: 0! - A version of SparseLargeTable that does not populate its bins until a value other than the default is stored.! Item was removed: - ----- Method: SparseLargeArray>>analyzeSpaceSaving (in category 'private') ----- - analyzeSpaceSaving - - | elems tablesTotal nonNilTables lastPage lastChunkSize | - elems := 0. - tablesTotal := self basicSize. - nonNilTables := 0. - lastPage := self basicAt: self basicSize. - (lastChunkSize := size \\ chunkSize) = 0 ifTrue: - [lastChunkSize := chunkSize]. - 1 to: self basicSize do: - [:i | | page | - (page := self basicAt: i) ifNotNil: - [nonNilTables := nonNilTables + 1. - 1 to: (page == lastPage ifTrue: [lastChunkSize] ifFalse: [chunkSize]) do: - [:j| - (page at: j) ~= defaultValue ifTrue: - [elems := elems + 1]]]]. - - ^String streamContents: - [:strm | - strm nextPutAll: 'total: '; print: size. - strm nextPutAll: ' elements: '; print: elems. - strm nextPutAll: ' tables: '; print: tablesTotal. - strm nextPutAll: ' non-nil: '; print: nonNilTables]! Item was removed: - ----- Method: SparseLargeArray>>atAllPut: (in category 'accessing') ----- - atAllPut: anObject - "Put anObject at every one of the receiver's indices." - - 1 to: self basicSize do: - [:i| - self basicAt: i put: nil]. - defaultValue := anObject! Item was removed: - ----- Method: SparseLargeArray>>initChunkSize:size:arrayClass:base:defaultValue: (in category 'initialization') ----- - initChunkSize: aChunkSize size: aSize arrayClass: aClass base: b defaultValue: d - chunkSize := aChunkSize. - size := aSize. - base := b. - defaultValue := d. - arrayClass := aClass - ! Item was removed: - ----- Method: SparseLargeArray>>noCheckAt: (in category 'accessing') ----- - noCheckAt: index - ^(self basicAt: index - base // chunkSize + 1) - ifNil: [defaultValue] - ifNotNil: [:chunk| chunk at: index - base \\ chunkSize + 1] - ! Item was removed: - ----- Method: SparseLargeArray>>noCheckAt:put: (in category 'accessing') ----- - noCheckAt: index put: value - | chunkIndex chunk lastChunkSize | - chunkIndex := index - base // chunkSize + 1. - (chunk := self basicAt: chunkIndex) ifNil: - [value = defaultValue ifTrue: - [^value]. - chunk := arrayClass - new: ((chunkIndex == self basicSize - and: [(lastChunkSize := size \\ chunkSize) > 0]) - ifTrue: [lastChunkSize] - ifFalse: [chunkSize]) - withAll: defaultValue. - self basicAt: chunkIndex put: chunk]. - ^chunk at: index - base \\ chunkSize + 1 put: value! Item was removed: - 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.! Item was removed: - ----- Method: SparseLargeTable class>>defaultChunkSize (in category 'accessing') ----- - defaultChunkSize - - ^100! Item was removed: - ----- Method: SparseLargeTable class>>defaultChunkSizeForFiles (in category 'accessing') ----- - defaultChunkSizeForFiles - - ^8000! Item was removed: - ----- Method: SparseLargeTable class>>new: (in category 'instance creation') ----- - new: size - - ^self new: size chunkSize: self defaultChunkSize - ! Item was removed: - ----- Method: SparseLargeTable class>>new:chunkSize: (in category 'instance creation') ----- - new: size chunkSize: chunkSize - - ^self new: size chunkSize: chunkSize arrayClass: Array - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: SparseLargeTable>>allDefaultValueSubtableAt: (in category 'private') ----- - allDefaultValueSubtableAt: index - - | t | - t := self basicAt: index. - t ifNil: [^ true]. - t do: [:e | - e ~= defaultValue ifTrue: [^ false]. - ]. - ^ true. - ! Item was removed: - ----- 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. - ]. - - ! Item was removed: - ----- Method: SparseLargeTable>>arrayClass (in category 'accessing') ----- - arrayClass - - ^(self basicAt: 1) class - ! Item was removed: - ----- Method: SparseLargeTable>>at: (in category 'accessing') ----- - at: index - - self pvtCheckIndex: index. - ^self noCheckAt: index. - ! Item was removed: - ----- Method: SparseLargeTable>>at:put: (in category 'accessing') ----- - at: index put: value - - self pvtCheckIndex: index. - ^self noCheckAt: index put: value - ! Item was removed: - ----- Method: SparseLargeTable>>base (in category 'accessing') ----- - base - - ^ base. - ! Item was removed: - ----- Method: SparseLargeTable>>chunkSize (in category 'accessing') ----- - chunkSize - - ^chunkSize - ! Item was removed: - ----- Method: SparseLargeTable>>copyEmpty (in category 'private') ----- - copyEmpty - "Answer a copy of the receiver that contains no elements." - ^self speciesNew: 0 - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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)]. - ! Item was removed: - ----- 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)) - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: SparseLargeTable>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - 1 to: self basicSize do: [:i | self basicAt: i put: (self basicAt: i) copy]! Item was removed: - ----- 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: $) - ! Item was removed: - ----- Method: SparseLargeTable>>printOn: (in category 'printing') ----- - printOn: aStream - - (#(String) includes: self arrayClass name) - ifTrue: [^self storeOn: aStream]. - ^super printOn: aStream - ! Item was removed: - ----- Method: SparseLargeTable>>privateSize: (in category 'private') ----- - privateSize: s - - size := s. - ! Item was removed: - ----- 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]. - ! Item was removed: - ----- Method: SparseLargeTable>>similarInstance (in category 'private') ----- - similarInstance - - ^self class - new: self size - chunkSize: self chunkSize - arrayClass: self arrayClass - ! Item was removed: - ----- Method: SparseLargeTable>>similarInstance: (in category 'private') ----- - similarInstance: newSize - - ^self class - new: newSize - chunkSize: self chunkSize - arrayClass: self arrayClass - ! Item was removed: - ----- Method: SparseLargeTable>>similarSpeciesInstance (in category 'private') ----- - similarSpeciesInstance - - ^self similarInstance - ! Item was removed: - ----- Method: SparseLargeTable>>similarSpeciesInstance: (in category 'private') ----- - similarSpeciesInstance: newSize - - ^self similarInstance: newSize - ! Item was removed: - ----- Method: SparseLargeTable>>size (in category 'accessing') ----- - size - - ^size - ! Item was removed: - ----- Method: SparseLargeTable>>sparseElementsAndIndicesDo: (in category 'enumerating') ----- - sparseElementsAndIndicesDo: binaryBlock - "Evaluate binaryBlock for each element and index in the receiver that has a non-default value." - - 1 to: self basicSize do: [:chunkIndex | - (self basicAt: chunkIndex) ifNotNil: [:chunk | - chunk withIndexDo: [:element :innerIndex | - element ~= defaultValue ifTrue: [ - binaryBlock value: element value: innerIndex + base - 1 + (chunkIndex - 1 * chunkSize)]]]].! Item was removed: - ----- Method: SparseLargeTable>>speciesNew (in category 'private') ----- - speciesNew - - ^self species - new: self size - chunkSize: self chunkSize - arrayClass: self arrayClass - ! Item was removed: - ----- Method: SparseLargeTable>>speciesNew: (in category 'private') ----- - speciesNew: newSize - - ^self species - new: newSize - chunkSize: self chunkSize - arrayClass: self arrayClass - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: SparseLargeTable>>withIndexDo: (in category 'enumerating') ----- - withIndexDo: binaryBlock - - self base to: self size do: [:index | - binaryBlock - value: (self at: index) - value: index].! Item was removed: - ----- 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. - ! Item was removed: - 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.! Item was removed: - ----- Method: Stack>>errorEmptyStack (in category 'private') ----- - errorEmptyStack - self error: 'this stack is empty'! Item was removed: - ----- Method: Stack>>initialize (in category 'initialize-release') ----- - initialize - super initialize. - linkedList := LinkedList new! Item was removed: - ----- Method: Stack>>isEmpty (in category 'testing') ----- - isEmpty - ^ self linkedList isEmpty! Item was removed: - ----- 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! Item was removed: - ----- Method: Stack>>notEmptyCheck (in category 'private') ----- - notEmptyCheck - "Ensure the stack is not empty." - self isEmpty - ifTrue: [self errorEmptyStack]! Item was removed: - ----- Method: Stack>>pop (in category 'removing') ----- - pop - "Returns the first element and remove it from the stack." - - self notEmptyCheck. - ^self linkedList removeFirst element! Item was removed: - ----- Method: Stack>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - linkedList := linkedList copy! Item was removed: - ----- 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.! Item was removed: - ----- Method: Stack>>size (in category 'accessing') ----- - size - "How many objects in me ?" - ^ self linkedList size! Item was removed: - ----- Method: Stack>>top (in category 'accessing') ----- - top - "Answer the first element of the stack without removing it." - self notEmptyCheck. - ^ self linkedList first element! Item was removed: - 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.! Item was removed: - ----- Method: StackLink class>>with: (in category 'instance creation') ----- - with: anObject - ^ self new element: anObject! Item was removed: - ----- Method: StackLink>>element (in category 'accessing') ----- - element - ^element! Item was removed: - ----- Method: StackLink>>element: (in category 'accessing') ----- - element: anObject - "Any kind of Object." - element := anObject! Item was removed: - ----- Method: StackLink>>printOn: (in category 'printing') ----- - printOn: aStream - aStream nextPutAll: self class printString; - nextPutAll: ' with: '; - nextPutAll: self element printString! Item was removed: - 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".! Item was removed: - ----- Method: Stream class>>new (in category 'instance creation') ----- - new - - self error: 'Streams are created with on: and with:'! Item was removed: - ----- Method: Stream>><< (in category 'readability') ----- - << items - - items putOn: self. - - ^ self! Item was removed: - ----- Method: Stream>>any: (in category 'collections - accessing') ----- - any: numberOfElements - "See Collection protocol." - - ^ self next: numberOfElements! Item was removed: - ----- Method: Stream>>atEnd (in category 'testing') ----- - atEnd - "Answer whether the receiver can access any more objects." - - self subclassResponsibility! Item was removed: - ----- Method: Stream>>basicNext (in category 'accessing - multibyte support') ----- - basicNext - - ^ self next. - ! Item was removed: - ----- Method: Stream>>basicNext: (in category 'accessing - multibyte support') ----- - basicNext: anInteger - - ^self next: anInteger - ! Item was removed: - ----- Method: Stream>>basicNext:putAll:startingAt: (in category 'accessing - multibyte support') ----- - basicNext: anInteger putAll: aCollection startingAt: startIndex - - ^self next: anInteger putAll: aCollection startingAt: startIndex - ! Item was removed: - ----- Method: Stream>>basicNextPut: (in category 'accessing - multibyte support') ----- - basicNextPut: anObject - - ^ self nextPut: anObject! Item was removed: - ----- Method: Stream>>basicNextPutAll: (in category 'accessing - multibyte support') ----- - basicNextPutAll: aCollection - - ^ self nextPutAll: aCollection. - ! Item was removed: - ----- Method: Stream>>binary (in category 'accessing') ----- - binary! Item was removed: - ----- Method: Stream>>close (in category 'file open/close') ----- - close! Item was removed: - ----- Method: Stream>>closed (in category 'testing') ----- - closed - ^ false! Item was removed: - ----- Method: Stream>>collect: (in category 'collections - enumerating') ----- - collect: block - - ^ Generator on: [:g | - [self atEnd] whileFalse: [ - g yield: (self next ifNotNil: [:object | block value: object])]]! Item was removed: - ----- Method: Stream>>contents (in category 'accessing') ----- - contents - "Answer all of the contents of the receiver." - - self subclassResponsibility! Item was removed: - ----- Method: Stream>>do: (in category 'collections - enumerating') ----- - do: aBlock - "Evaluate aBlock for each of the objects accessible by receiver." - - [self atEnd] - whileFalse: [aBlock value: self next]! Item was removed: - ----- Method: Stream>>ensureOpen (in category 'file open/close') ----- - ensureOpen - "API compatibility with FileBased streams."! Item was removed: - ----- Method: Stream>>flatten (in category 'converting') ----- - flatten - - ^ Generator on: [:g | - [self atEnd] whileFalse: [ - self next in: [:object | - ((object isCollection and: [object isString not]) or: [object isStream]) - ifFalse: [g yield: object] - ifTrue: [object flatten do: [:each | g yield: each]]]]]! Item was removed: - ----- Method: Stream>>flattened (in category 'converting') ----- - flattened - "An alias for #flatten - This message's name is in line with messages like #sorted or #reversed - while #flatten's is in line with #reverse (as per ANSI, see comment there)" - - ^ self flatten! Item was removed: - ----- Method: Stream>>flush (in category 'accessing') ----- - flush - "Do nothing by default"! Item was removed: - ----- Method: Stream>>gather: (in category 'collections - enumerating') ----- - gather: block - - ^ Generator on: [:g | - [self atEnd] whileFalse: [ - self next - ifNil: [g yield: nil] - ifNotNil: [:object | - (block value: object) do: [:ea | - g yield: ea]]]]! Item was removed: - ----- Method: Stream>>isStream (in category 'testing') ----- - isStream - "Return true if the receiver responds to the stream protocol" - ^true! Item was removed: - ----- Method: Stream>>isTypeHTTP (in category 'testing') ----- - isTypeHTTP - ^false! Item was removed: - ----- Method: Stream>>localName (in category 'accessing') ----- - localName - ^'a stream'! Item was removed: - ----- Method: Stream>>next (in category 'accessing') ----- - next - "Answer the next object accessible by the receiver." - - self subclassResponsibility! Item was removed: - ----- 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! Item was removed: - ----- Method: Stream>>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! Item was removed: - ----- Method: Stream>>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." - - | count | - count := self readInto: aCollection startingAt: startIndex count: n. - count = n - ifTrue:[ ^aCollection ] - ifFalse:[ ^aCollection copyFrom: 1 to: startIndex + count - 1 ]! Item was removed: - ----- 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! Item was removed: - ----- Method: Stream>>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.! Item was removed: - ----- Method: Stream>>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.! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Stream>>nextPut: (in category 'accessing') ----- - nextPut: anObject - "Insert the argument, anObject, as the next object accessible by the - receiver. Answer anObject." - - self subclassResponsibility! Item was removed: - ----- 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! Item was removed: - ----- Method: Stream>>nextSatisfy: (in category 'accessing') ----- - nextSatisfy: aBlock - - self do: [:each | (aBlock value: each) ifTrue: [^ each]]. - Error signal: 'No object could satisfy the block'.! Item was removed: - ----- 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! Item was removed: - ----- Method: Stream>>open (in category 'file open/close') ----- - open - "API compatibility with FileBased streaams." - ^ self! Item was removed: - ----- Method: Stream>>openReadOnly (in category 'file open/close') ----- - openReadOnly - ^self! Item was removed: - ----- Method: Stream>>print: (in category 'printing') ----- - print: anObject - "Have anObject print itself on the receiver." - - anObject printOn: self! Item was removed: - ----- Method: Stream>>print:maxDecimalPlaces: (in category 'printing') ----- - print: anObject maxDecimalPlaces: placesDesired - "Have anObject print itself on the receiver, with at most the given number of decimal places desired." - - anObject printOn: self maxDecimalPlaces: placesDesired! Item was removed: - ----- Method: Stream>>printHtml: (in category 'printing') ----- - printHtml: anObject - anObject printHtmlOn: self! Item was removed: - ----- Method: Stream>>printOn: (in category 'printing') ----- - printOn: stream - - super printOn: stream. - " - stream space. - self contents printOn: stream. - - NOTE: some subclasses actually read from the stream to return its contents. - To not modify the state we must *not* send contents here. - "! Item was removed: - ----- Method: Stream>>readInto:startingAt:count: (in category 'accessing') ----- - readInto: aCollection startingAt: startIndex count: n - "Read n objects into the given collection. - Return number of elements that have been read." - | obj | - 0 to: n - 1 do: [:i | - obj := self next ifNil: [ ^i ]. - aCollection at: startIndex + i put: obj]. - ^n! Item was removed: - ----- Method: Stream>>readOnly (in category 'accessing') ----- - readOnly - ^self! Item was removed: - ----- Method: Stream>>reject: (in category 'collections - enumerating') ----- - reject: aBlock - - ^ self select: [:element | (aBlock value: element) == false]! Item was removed: - ----- Method: Stream>>select: (in category 'collections - enumerating') ----- - select: block - - ^ Generator on: [:g | - [self atEnd] whileFalse: [ - self next - ifNil: [g yield: nil] - ifNotNil: [:object | - (block value: object) - ifTrue: [g yield: object]]]]! Item was removed: - ----- Method: Stream>>select:thenCollect: (in category 'collections - enumerating') ----- - select: block thenCollect: anotherBlock - - ^ (self select: block) collect: anotherBlock! Item was removed: - ----- Method: Stream>>sleep (in category 'file directory') ----- - sleep - - "an FTP-based stream might close the connection here"! Item was removed: - ----- Method: Stream>>take: (in category 'collections - accessing') ----- - take: maxNumberOfElements - "See Collection protocol." - - | aCollection | - aCollection := OrderedCollection new. - maxNumberOfElements timesRepeat: [ - self atEnd ifTrue: [^ aCollection]. - aCollection addLast: self next]. - ^ aCollection! Item was removed: - ----- Method: Stream>>upToEnd (in category 'accessing') ----- - upToEnd - "Answer the remaining elements in the stream." - - | elements | - elements := OrderedCollection new. - [self atEnd] whileFalse: [ - elements add: self next]. - ^ elements! Item was removed: - ----- Method: Stream>>write: (in category 'filter streaming') ----- - write:encodedObject - ^encodedObject putOn:self. - ! Item was removed: - ArrayedCollection subclass: #String - instanceVariableNames: '' - classVariableNames: 'AsciiOrder CSMacroCharacters CaseInsensitiveOrder CaseSensitiveOrder CrLfExchangeTable FormatCharacterSet 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: - ! Item was removed: - ----- 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." - - | c1 c2 length1 length2 | - length1 := string1 size. - length2 := string2 size. - (order == nil or: [ order == AsciiOrder ]) ifTrue: [ "AsciiOrder is the identity function" - 1 to: (length1 min: length2) do: [ :i | - (c1 := string1 basicAt: i) = (c2 := string2 basicAt: i) ifFalse: [ - c1 < c2 - ifTrue: [ ^1 ] - ifFalse: [ ^3 ] ] ]. - length1 = length2 ifTrue: [ ^2 ]. - length1 < length2 - ifTrue: [ ^1 ] - ifFalse: [ ^3 ] ]. - 1 to: (length1 min: length2) do: [ :i | - (c1 := string1 basicAt: i) < 256 ifTrue: [ c1 := order at: c1 + 1 ]. - (c2 := string2 basicAt: i) < 256 ifTrue: [ c2 := order at: c2 + 1 ]. - c1 = c2 ifFalse:[ - c1 < c2 - ifTrue: [ ^1 ] - ifFalse: [ ^3 ] ] ]. - length1 = length2 ifTrue: [ ^2 ]. - length1 < length2 - ifTrue: [ ^1 ] - ifFalse: [ ^3 ].! Item was removed: - ----- Method: String class>>cr (in category 'instance creation') ----- - cr - "Answer a string containing a single carriage return character." - - ^ self with: Character cr - ! Item was removed: - ----- Method: String class>>crLfExchangeTable (in category 'accessing') ----- - crLfExchangeTable - - ^CrLfExchangeTable! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: String class>>crlfcrlf (in category 'instance creation') ----- - crlfcrlf - ^self crlf , self crlf. - ! Item was removed: - ----- Method: String class>>empty (in category 'instance creation') ----- - empty - "A canonicalized empty String instance." - ^ ''! Item was removed: - ----- 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! Item was removed: - ----- 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'! Item was removed: - ----- Method: String class>>findFirstInString:inSet:startingAt: (in category 'primitives') ----- - findFirstInString: aString inSet: inclusionMap startingAt: start - "Trivial, non-primitive version" - - | i stringSize ascii | - inclusionMap size ~= 256 ifTrue: [ ^0 ]. - stringSize := aString size. - i := start - 1. - [ (i := i + 1) <= stringSize ] whileTrue: [ - (ascii := aString basicAt: i) < 256 ifTrue: [ - (inclusionMap at: ascii + 1) = 0 ifFalse: [ ^i ] ] ]. - ^0! Item was removed: - ----- Method: String class>>fromByteArray: (in category 'instance creation') ----- - fromByteArray: aByteArray - - ^ aByteArray asString - ! Item was removed: - ----- 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" - ! Item was removed: - ----- 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! Item was removed: - ----- Method: String class>>htmlEntities (in category 'accessing') ----- - htmlEntities - - ^ HtmlEntities! Item was removed: - ----- Method: String class>>indexOfAscii:inString:startingAt: (in category 'primitives') ----- - indexOfAscii: anInteger inString: aString startingAt: start - "Trivial, non-primitive version" - - start to: aString size do: [ :index | - (aString basicAt: index) = anInteger ifTrue: [ ^index ] ]. - ^0 - ! Item was removed: - ----- 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: [$~]]). - - "% and < for #expandMacros*" - CSMacroCharacters := CharacterSet newFrom: '%<'. - - "{\ used by #format:" - FormatCharacterSet := CharacterSet newFrom: '{\'. - - "a table for exchanging cr with lf and vica versa" - CrLfExchangeTable := Character allByteCharacters collect: [ :each | - each - caseOf: { - [ Character cr ] -> [ Character lf ]. - [ Character lf ] -> [ Character cr ] } - otherwise: [ each ] ]! Item was removed: - ----- 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]! Item was removed: - ----- Method: String class>>lf (in category 'instance creation') ----- - lf - "Answer a string containing a single carriage return character." - - ^ self with: Character lf! Item was removed: - ----- 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].! Item was removed: - ----- 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! Item was removed: - ----- Method: String class>>space (in category 'instance creation') ----- - space - "Answer a string containing a single space character." - - ^ self with: Character space - ! Item was removed: - ----- Method: String class>>stringHash:initialHash: (in category 'primitives') ----- - stringHash: aString initialHash: speciesHash - "Answer the hash of a byte-indexed string, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - | hash | - hash := speciesHash bitAnd: 16r0FFFFFFF. - 1 to: aString size do: - [:pos | - hash := (hash + (aString basicAt: pos)) hashMultiply]. - ^hash! Item was removed: - ----- Method: String class>>tab (in category 'instance creation') ----- - tab - "Answer a string containing a single tab character." - - ^ self with: Character tab - ! Item was removed: - ----- Method: String class>>translate:from:to:table: (in category 'primitives') ----- - translate: aString from: start to: stop table: table - "Trivial, non-primitive version" - - start to: stop do: [ :i | - | char | - (char := aString basicAt: i) < 256 ifTrue: [ - aString at: i put: (table at: char+1) ] ]. - ! Item was removed: - ----- Method: String class>>value: (in category 'instance creation') ----- - value: anInteger - - ^ self with: (Character value: anInteger). - ! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>* (in category 'arithmetic') ----- - * arg - - ^ arg adaptToString: self andSend: #*! Item was removed: - ----- Method: String>>+ (in category 'arithmetic') ----- - + arg - - ^ arg adaptToString: self andSend: #+! Item was removed: - ----- Method: String>>, (in category 'converting') ----- - , anObject - "Concatenate the argument to the receiver. - Transcript cr; show: 'The value is: ', 3. - " - ^ self copyReplaceFrom: self size + 1 - to: self size - with: anObject asString! Item was removed: - ----- Method: String>>- (in category 'arithmetic') ----- - - arg - - ^ arg adaptToString: self andSend: #-! Item was removed: - ----- Method: String>>/ (in category 'arithmetic') ----- - / arg - - ^ arg adaptToString: self andSend: #/! Item was removed: - ----- Method: String>>// (in category 'arithmetic') ----- - // arg - - ^ arg adaptToString: self andSend: #//! Item was removed: - ----- Method: String>>< (in category 'comparing') ----- - < aString - "Answer whether the receiver sorts before aString. - The collation order is simple ascii (with case differences)." - - ^(self compareWith: aString) < 0! Item was removed: - ----- 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 compareWith: aString) <= 0! Item was removed: - ----- Method: String>><=> (in category 'sorting') ----- - <=> aCharacterArray - "Return a collation order of -1, 0, or 1, indicating whether I should be collated before the receiver, am equal, or after. - See also: http://en.wikipedia.org/wiki/Spaceship_operator" - - aCharacterArray isString ifTrue: [ ^(self compare: aCharacterArray) - 2 ]. - self = aCharacterArray ifTrue: [ ^0 ]. - self < aCharacterArray ifTrue: [ ^-1 ]. - ^1! Item was removed: - ----- Method: String>>= (in category 'comparing') ----- - = aString - "Answer whether the receiver sorts equally as aString. - The collation order is simple ascii (with case differences)." - - self == aString ifTrue: [ ^true ]. - aString isString ifFalse: [ ^false ]. - self size = aString size ifFalse: [ ^false ]. - ^ (self compareWith: aString) = 0! Item was removed: - ----- Method: String>>> (in category 'comparing') ----- - > aString - "Answer whether the receiver sorts after aString. - The collation order is simple ascii (with case differences)." - - ^(self compareWith: aString) > 0! Item was removed: - ----- 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 compareWith: aString) >= 0! Item was removed: - ----- Method: String>>\\ (in category 'arithmetic') ----- - \\ arg - - ^ arg adaptToString: self andSend: #\\! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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: [((self basicAt: i) bitAnd: 16rDF) = ((aString basicAt: i) bitAnd: 16rDF)]] - whileTrue: [ i := i + 1 ]. - [(j > 0) and: [(k > 0) and: - [((self basicAt: j) bitAnd: 16rDF) = ((aString basicAt: k) bitAnd: 16rDF)]]] - whileTrue: [ j := j - 1. k := k - 1. ]. - ^ i - 1 + self size - j + bonus. ! Item was removed: - ----- Method: String>>applyLanguageInformation: (in category 'accessing') ----- - applyLanguageInformation: aLanguage - "Apply language-specific information to the receiver. Note that aLanguage can be anything that answers #leadingChar at the moment, which includes instances of Locale, LanguageEnvironment, and (prototypical) Character. Also note that we even have to apply a leading char 0 to replace any prior language information." - - | leadingChar | - leadingChar := aLanguage leadingChar. - self withIndexDo: [:each :idx | each asInteger > 16rFF "ascii or latin-1" - ifTrue: [self at: idx put: (Character leadingChar: leadingChar code: each charCode)]].! Item was removed: - ----- Method: String>>asAscii (in category 'converting') ----- - asAscii - ^ self select: [ : each | each isAscii ]! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: String>>asByteString (in category 'converting') ----- - asByteString - "Convert the receiver into a ByteString" - ^self asOctetString! Item was removed: - ----- Method: String>>asCamelCase (in category 'converting') ----- - asCamelCase - "Convert to CamelCase. Can be convenient - in conjunction with #asLegalSelector - 'A man, a plan, a canal, panama' asCamelCase. - 'A man, a plan, a canal, panama' asCamelCase asLegalSelector. - 'Here 123should % be 6 the name6 of the method' asCamelCase. - 'Here 123should % be 6 the name6 of the method' asCamelCase asLegalSelector." - - ^ self class streamContents: [:stream | - self substrings do: [:sub | - stream nextPutAll: sub capitalized]]! Item was removed: - ----- 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:[$·]! Item was removed: - ----- 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]! Item was removed: - ----- Method: String>>asDisplayText (in category 'converting') ----- - asDisplayText - "Answer a DisplayText whose text string is the receiver." - - ^DisplayText text: self asText! Item was removed: - ----- Method: String>>asFileName (in category 'converting') ----- - asFileName - "Answer a String made up from the receiver that is an acceptable file base - name. Does not produce corrected fulll paths if the directory separator etc are included" - - | string checkedString | - string := FileDirectory checkName: self fixErrors: true. - checkedString := (FilePath pathName: string) asVmPathName. - ^ (FilePath pathName: checkedString isEncoded: true) asSqueakPathName. - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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! Item was removed: - ----- 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: '&'. - 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 - "! Item was removed: - ----- 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 - - "! Item was removed: - ----- Method: String>>asInteger (in category 'converting') ----- - asInteger - - ^self asIntegerSigned: true - ! Item was removed: - ----- Method: String>>asIntegerSigned: (in category 'converting') ----- - asIntegerSigned: signed - "Return the first decimal integer I can find or nil." - - | index character size result negative | - index := 0. - size := self size. - "Find the first character between $0 and $9." - [ (index := index + 1) > size or: [ (self at: index) isDigit ] ] whileFalse. - index > size ifTrue: [ ^nil ]. - negative := signed and: [ index > 1 and: [ (self at: index - 1) == $- ] ]. - "Parse the number." - size - index > 15 ifTrue: [ - negative ifTrue: [ index := index - 1 ]. - ^Integer readFrom: ( - ReadStream - on: self - from: index - to: size) ]. - result := (self at: index) digitValue. - [ (index := index + 1) <= size - and: [ (character := self at: index) isDigit ] ] whileTrue: [ - result := result * 10 + character digitValue ]. - negative ifTrue: [ ^result negated ]. - ^result! Item was removed: - ----- Method: String>>asLegalSelector (in category 'converting') ----- - asLegalSelector - | toUse | - toUse := self select: [:char | char isAlphaNumeric]. - (toUse size = 0 or: [toUse first isLetter not]) - ifTrue: [toUse := 'v', toUse]. - ^ toUse withFirstCharacterDownshifted! Item was removed: - ----- Method: String>>asLowercase (in category 'converting') ----- - asLowercase - "Answer a String made up from the receiver whose characters are all - lowercase." - - ^ self copy asString translateToLowercase! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>asOctetString (in category 'converting') ----- - asOctetString - "Convert the receiver into an octet string if possible. The resulting string will contain - only bytes if all characters fit into bytes. If there is any character > 255 the resulting - string will be a WideString instead." - | string | - string := String new: self size. - 1 to: self size do: [:i | string at: i put: (self at: i)]. - ^string! Item was removed: - ----- Method: String>>asPacked (in category 'converting') ----- - asPacked - "Convert to a longinteger that describes the string" - - ^ self inject: 0 into: [ :pack :next | pack * 256 + next asInteger ].! Item was removed: - ----- 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 - ifTrue: [^ self]. - (aNumberOrCollection isCollection and: [aNumberOrCollection size = 1]) - ifTrue: [^ self]. - - ^ (self endsWith: 's') - ifTrue: [self , 'es'] - ifFalse: [self , 's'] - ! Item was removed: - ----- 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]! Item was removed: - ----- Method: String>>asSignedInteger (in category 'converting') ----- - asSignedInteger - "Return the first signed integer I can find or nil." - - ^self asIntegerSigned: true! Item was removed: - ----- 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: $". - ]. - ! Item was removed: - ----- Method: String>>asSqueakPathName (in category 'converting') ----- - asSqueakPathName - - ^ self. - ! Item was removed: - ----- Method: String>>asString (in category 'converting') ----- - asString - "Answer this string." - - ^ self - ! Item was removed: - ----- Method: String>>asStringOrText (in category 'converting') ----- - asStringOrText - "Answer this string." - - ^ self - ! Item was removed: - ----- Method: String>>asSymbol (in category 'converting') ----- - asSymbol - "Answer the unique Symbol whose characters are the characters of the - string." - ^Symbol intern: self! Item was removed: - ----- Method: String>>asText (in category 'converting') ----- - asText - "Answer a Text whose string is the receiver." - - ^Text fromString: self! Item was removed: - ----- Method: String>>asTextFromHtml (in category 'converting') ----- - asTextFromHtml - "Answer a Text by interpreting the receiver as HTML." - - ^ (HtmlReadWriter on: self readStream) nextText! Item was removed: - ----- 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: [ - (rest beginsWith: '#') - ifTrue: [Character value: rest allButFirst asInteger] - ifFalse: [Character space]])] - ifFalse: [out nextPut: char]]. - ]. - ^ out contents! Item was removed: - ----- Method: String>>asUnsignedInteger (in category 'converting') ----- - asUnsignedInteger - "Returns the first unsigned integer I can find or nil." - - ^self asIntegerSigned: false! Item was removed: - ----- Method: String>>asUppercase (in category 'converting') ----- - asUppercase - "Answer a String made up from the receiver whose characters are all - uppercase." - - ^self copy asString translateToUppercase! Item was removed: - ----- Method: String>>asVmPathName (in category 'converting') ----- - asVmPathName - - ^ (FilePath pathName: self) asVmPathName. - ! Item was removed: - ----- Method: String>>asWideString (in category 'converting') ----- - asWideString - self isWideString - ifTrue:[^self] - ifFalse:[^WideString from: self]! Item was removed: - ----- Method: String>>ascii85Decoded (in category 'converting') ----- - ascii85Decoded - "Decode the receiver from Ascii85" - "'<~87cURD]i,""Ebo7~>' ascii85Decoded" - - ^ self ascii85DecodedAs: self class - ! Item was removed: - ----- Method: String>>ascii85DecodedAs: (in category 'converting') ----- - ascii85DecodedAs: aClass - "Decode the receiver from Ascii85" - "'<~87cURD]i,""Ebo7~>' ascii85DecodedAs: String" - - ^ Ascii85Converter decode: self as: aClass! Item was removed: - ----- Method: String>>ascii85Encoded (in category 'converting') ----- - ascii85Encoded - "Encode the receiver as Ascii85" - "'Hello World' ascii85Encoded" - - ^ (Ascii85Converter encode: self readStream) contents - ! Item was removed: - ----- Method: String>>askIfAddStyle:req: (in category 'converting') ----- - askIfAddStyle: priorMethod req: requestor - ^ self "we are a string with no text style"! Item was removed: - ----- Method: String>>base64Decoded (in category 'converting') ----- - base64Decoded - "Decode the receiver from base 64" - "'SGVsbG8gV29ybGQ=' base64Decoded" - ^(Base64MimeConverter mimeDecode: self as: self class)! Item was removed: - ----- Method: String>>base64Encoded (in category 'converting') ----- - base64Encoded - "Encode the receiver as base64" - "'Hello World' base64Encoded" - - ^(Base64MimeConverter - mimeEncode: (ReadStream on: self) - multiLine: false) contents! Item was removed: - ----- Method: String>>beginsWith: (in category 'testing') ----- - beginsWith: sequence - "Answer if the receiver starts with the argument collection. The comparison is case-sensitive. Overridden for better performance." - - | index sequenceSize | - sequence isString ifFalse: [ ^super beginsWith: sequence ]. - sequenceSize := sequence size. - self size < sequenceSize ifTrue: [ ^false ]. - index := 0. - [ (index := index + 1) <= sequenceSize ] whileTrue: [ - (sequence at: index) == (self at: index) ifFalse: [ ^false ] ]. - ^true! Item was removed: - ----- Method: String>>byteAt: (in category 'accessing') ----- - byteAt: index - ^self subclassResponsibility! Item was removed: - ----- Method: String>>byteAt:put: (in category 'accessing') ----- - byteAt: index put: value - ^self subclassResponsibility! Item was removed: - ----- Method: String>>byteEncode: (in category 'filter streaming') ----- - byteEncode:aStream - - ^aStream writeString: self. - ! Item was removed: - ----- Method: String>>byteSize (in category 'accessing') ----- - byteSize - ^self subclassResponsibility! Item was removed: - ----- Method: String>>canBeToken (in category 'testing') ----- - canBeToken - "Extracted from #numArgs to allow specialization by subclasses" - - ^ self allSatisfy: [:c | c tokenish]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>combinations:atATimeDo: (in category 'enumerating') ----- - combinations: kk atATimeDo: aBlock - "Gather the combinations into a String rather than an Array" - - " 'abcde' combinations: 3 atATimeDo: [:each | Transcript cr; show: each printString]" - - | aCollection | - aCollection := String new: kk. - self combinationsAt: 1 in: aCollection after: 0 do: aBlock! Item was removed: - ----- 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! Item was removed: - ----- 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 result | - map := aBool ifTrue:[CaseSensitiveOrder] ifFalse:[CaseInsensitiveOrder]. - result := self compareWith: aString collated: map. - result = 0 ifTrue: [ ^2 ]. - ^result > 0 - ifTrue: [ 3 ] - ifFalse: [ 1 ]! Item was removed: - ----- 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. - - "! Item was removed: - ----- Method: String>>compareSafely: (in category '*collections') ----- - compareSafely: aString - ^ aString isString - ifTrue: [ self < aString ] - ifFalse: [ super compareSafely: aString ]! Item was removed: - ----- Method: String>>compareWith: (in category 'comparing') ----- - compareWith: aString - - "<primitive: 158>" - ^self compareWith: aString collated: AsciiOrder! Item was removed: - ----- Method: String>>compareWith:collated: (in category 'comparing') ----- - compareWith: aString collated: collation - - <primitive: 158> - ^(self compare: self with: aString collated: collation) - 2! Item was removed: - ----- 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 result ri c | - null := Character null. - str := self copyFrom: 1 to: self size. "Working string will get altered" - finalSize := str size. - tokens withIndexDo: - [:token :tIndex | - | start ts | - 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! Item was removed: - ----- Method: String>>condensedIntoOneLine (in category 'converting') ----- - condensedIntoOneLine - "Return a copy of the receiver with all separators converted to spaces, and with no consecutive spaces. A formatting tool." - ^ String streamContents: - [ : stream | | prior | - prior := $X. "some non-separator" - self do: - [ : char | char isSeparator ifTrue: [ prior isSeparator ifFalse: [stream space]] ifFalse: [ stream nextPut: char ]. - prior := char ] ]! Item was removed: - ----- 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 - "! Item was removed: - ----- Method: String>>convertFromEncoding: (in category 'converting') ----- - convertFromEncoding: encodingName - ^self convertFromWithConverter: (TextConverter newForEncoding: encodingName)! Item was removed: - ----- Method: String>>convertFromSuperSwikiServerString (in category 'converting') ----- - convertFromSuperSwikiServerString - ^self convertFromEncoding: 'shift_jis'! Item was removed: - ----- Method: String>>convertFromWithConverter: (in category 'converting') ----- - convertFromWithConverter: converter - - ^(converter ifNil: [ ^self]) decodeString: self! Item was removed: - ----- Method: String>>convertToEncoding: (in category 'converting') ----- - convertToEncoding: encodingName - ^self convertToWithConverter: (TextConverter newForEncoding: encodingName).! Item was removed: - ----- Method: String>>convertToSuperSwikiServerString (in category 'converting') ----- - convertToSuperSwikiServerString - ^self convertToEncoding: 'shift_jis'! Item was removed: - ----- Method: String>>convertToSystemString (in category 'converting') ----- - convertToSystemString - ^self convertToWithConverter: Locale currentPlatform systemConverter! Item was removed: - ----- Method: String>>convertToWithConverter: (in category 'converting') ----- - convertToWithConverter: converter - - ^(converter ifNil: [ ^self]) encodeString: self! Item was removed: - ----- 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'"! Item was removed: - ----- 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! Item was removed: - ----- 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." - - ^self - correctAgainstEnumerator: ( - wordList ifNotNil: [ - [ :action | wordList do: action without: nil ] ]) - continuedFrom: oldCollection! Item was removed: - ----- Method: String>>correctAgainstDictionary:continuedFrom: (in category 'converting') ----- - correctAgainstDictionary: wordDict continuedFrom: oldCollection - "Like correctAgainst:continuedFrom:. Use when you want to correct against a dictionary." - - ^self - correctAgainstEnumerator: ( - wordDict ifNotNil: [ - [ :action | wordDict keysDo: action ] ]) - continuedFrom: oldCollection! Item was removed: - ----- 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 results maxChoices scoreMin | - scoreMin := self size // 2 min: 3. - maxChoices := 10. - choices := oldCollection ifNil: [ - SortedCollection sortBlock: [ :x :y | x value > y value ] ]. - wordBlock - ifNil: [ - results := OrderedCollection new. - 1 to: (maxChoices min: choices size) do: [ :i | results add: (choices at: i) key ] ] - ifNotNil: [ - wordBlock - value: [ :word | - | score | - (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! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>decodeMimeHeader (in category 'internet') ----- - decodeMimeHeader - "See RFC 2047, MIME Part Three: Message Header Extension for Non-ASCII - Text and RFC 1342. 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 / QEncodingMimeConverter. - - 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 := WriteStream on: String new. - decoder := encoding = 'B' - ifTrue: [Base64MimeConverter new] - ifFalse: [QEncodingMimeConverter new]. - decoder - mimeStream: (ReadStream on: temp); - dataStream: encodedStream; - mimeDecode. - - output nextPutAll: (MultiByteBinaryOrTextStream with: encodedStream contents encoding: charset) contents. - pos := input position. - input skipSeparators. - "Delete spaces if followed by =" - input peek = $= - ifFalse: [input position: pos]] - ifFalse: [output nextPut: $=; - nextPut: temp]]. - ^ output contents! Item was removed: - ----- Method: String>>decodeQuotedPrintable (in category 'internet') ----- - decodeQuotedPrintable - "Assume receiver is in MIME 'quoted-printable' encoding, and decode it." - - ^QuotedPrintableMimeConverter mimeDecode: self as: self class! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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] - "! Item was removed: - ----- 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: $'! Item was removed: - ----- 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]. - ! Item was removed: - ----- Method: String>>encodeForHTTPWithTextEncoding: (in category 'converting') ----- - encodeForHTTPWithTextEncoding: encodingName - - ^ self encodeForHTTPWithTextEncoding: encodingName conditionBlock: [:c | c isSafeForHTTP]. - ! Item was removed: - ----- 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 | - httpSafeStream := WriteStream on: (String new). - encodedStream := MultiByteBinaryOrTextStream on: (String new: 6). - encodedStream converter: (TextConverter newForEncoding: encodingName). - self do: [:c | | cont | - (conditionBlock value: c) - ifTrue: [httpSafeStream nextPut: (Character value: c charCode)] - ifFalse: [ - encodedStream text; resetToStart. - 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. - ! Item was removed: - ----- Method: String>>endsWith: (in category 'testing') ----- - endsWith: sequence - "Answer if the receiver ends with the argument collection. The comparison is case-sensitive." - - | index sequenceSize offset | - sequence isString ifFalse: [ ^super endsWith: sequence ]. - sequenceSize := sequence size. - (offset := self size - sequenceSize) < 0 ifTrue: [ ^false ]. - index := 0. - [ (index := index + 1) <= sequenceSize ] whileTrue: [ - (sequence at: index) == (self at: index + offset) ifFalse: [ ^false ] ]. - ^true! Item was removed: - ----- Method: String>>endsWithAColon (in category 'testing') ----- - endsWithAColon - "Answer whether the final character of the receiver is a colon" - - ^ self size > 0 and: [self last == $:] - - " - #fred: endsWithAColon - 'fred' endsWithAColon - "! Item was removed: - ----- Method: String>>endsWithAnyOf: (in category 'testing') ----- - endsWithAnyOf: aCollection - aCollection do:[:suffix| - (self endsWith: suffix) ifTrue:[^true]. - ]. - ^false! Item was removed: - ----- Method: String>>endsWithDigit (in category 'testing') ----- - endsWithDigit - "Answer whether the receiver's final character represents a digit. 3/11/96 sw" - - ^ self size > 0 and: [self last isDigit]! Item was removed: - ----- Method: String>>expandMacros (in category 'formatting') ----- - expandMacros - ^self expandMacrosWithArguments: #()! Item was removed: - ----- Method: String>>expandMacrosWith: (in category 'formatting') ----- - expandMacrosWith: anObject - ^self expandMacrosWithArguments: (Array with: anObject)! Item was removed: - ----- Method: String>>expandMacrosWith:with: (in category 'formatting') ----- - expandMacrosWith: anObject with: anotherObject - ^self - expandMacrosWithArguments: (Array with: anObject with: anotherObject)! Item was removed: - ----- Method: String>>expandMacrosWith:with:with: (in category 'formatting') ----- - expandMacrosWith: anObject with: anotherObject with: thirdObject - ^self expandMacrosWithArguments: (Array - with: anObject - with: anotherObject - with: thirdObject)! Item was removed: - ----- 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)! Item was removed: - ----- Method: String>>expandMacrosWithArguments: (in category 'formatting') ----- - expandMacrosWithArguments: anArray - - ^self class new: self size streamContents: [ :output | - | lastIndex nextIndex | - lastIndex := 1. - [ (nextIndex := self indexOfAnyOf: CSMacroCharacters startingAt: lastIndex) = 0 ] whileFalse: [ - nextIndex = lastIndex ifFalse: [ - output next: nextIndex - lastIndex putAll: self startingAt: lastIndex ]. - (self at: nextIndex) == $% - ifTrue: [ output nextPut: (self at: (nextIndex := nextIndex + 1)) ] - ifFalse: [ - | nextCharacter argumentIndex | - nextCharacter := (self at: (nextIndex := nextIndex + 1)) asUppercase. - nextCharacter == $N ifTrue: [ output cr ]. - nextCharacter == $T ifTrue: [ output tab ]. - (nextCharacter between: $0 and: $9) ifTrue: [ - argumentIndex := nextCharacter digitValue. - [ (nextIndex := nextIndex + 1) <= self size and: [ - (nextCharacter := self at: nextIndex) between: $0 and: $9 ] ] whileTrue: [ - argumentIndex := argumentIndex * 10 + nextCharacter digitValue ]. - nextCharacter := nextCharacter asUppercase ]. - nextCharacter == $P ifTrue: [ output print: (anArray at: argumentIndex) ]. - nextCharacter == $S ifTrue: [ output nextPutAll: (anArray at: argumentIndex) ]. - nextCharacter == $? ifTrue: [ - | trueEnd falseEnd | - trueEnd := self indexOf: $: startingAt: nextIndex + 1. - falseEnd := self indexOf: $> startingAt: trueEnd + 1. - (anArray at: argumentIndex) - ifTrue: [ output next: trueEnd - nextIndex - 1 putAll: self startingAt: nextIndex + 1 ] - ifFalse: [ output next: falseEnd - trueEnd - 1 putAll: self startingAt: trueEnd + 1 ]. - nextIndex := falseEnd - 1 ]. - (self at: (nextIndex := nextIndex + 1)) == $> ifFalse: [ - self error: '> expected' ] ]. - lastIndex := nextIndex + 1 ]. - lastIndex <= self size ifTrue: [ - output next: self size - lastIndex + 1 putAll: self startingAt: lastIndex ] ]! Item was removed: - ----- 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." - - ^delimiters inject: 1 + self size into: [:min :delim | - "delim may be a char, a string of length 1, or a substring" - | ind | - ind := delim isCharacter - ifTrue: [self indexOf: delim - startingAt: start ifAbsent: [min]] - ifFalse: [self indexOfSubCollection: delim - startingAt: start ifAbsent: [min]]. - min min: ind]! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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." - - delimiters size = 1 ifTrue: [ ^self indexOf: delimiters anyOne startingAt: start ifAbsent: self size + 1 ]. - ^self indexOfAnyOf: delimiters startingAt: start ifAbsent: self size + 1! Item was removed: - ----- Method: String>>findFeatureIndicesDo: (in category 'accessing - features') ----- - findFeatureIndicesDo: aBlock - "Support for simple analysis of natural language in source code. - - In addition to whitespace separation like #findTokens:, also separate features using higher-level rules: - (1) 'camelCase' -> #('camel' 'Case'), - (2) 'UPPERCase' -> #('UPPER' 'Case'), - (3) integer numbers such as 'MyModel55' -> #('My' 'Model' '55'), and - (4) operators such as '5 <= 4' -> #('5' '<=' '4'). - Other kinds of characters are tokenized as operators: '[state := 2]' -> #('[' 'state' ':=' '2' ']'). - - This method works like #lineIndicesDo: and provides start/stop indices of tokens to the given aBlock to, for example, extract and normalize features (or tokens)." - - | last state char | - state := 0. "0 = start, 1 = a, 2 = A, 3 = AA, 4 = num, 5 = op" - last := 1. "last character index" - - 1 to: self size do: [ :index | - char := self at: index. - - char isLowercase - ifTrue: [ "a" - state < 3 ifTrue: [state := 1]. "*a -> a" - state = 3 ifTrue: [ - "AAa -> A + Aa (camel case follows uppercase)" - aBlock value: last value: index - 2. - last := index - 1. - state := 2]. - state > 3 ifTrue: [ - "+a -> + | a (letter follows non-letter)" - aBlock value: last value: index - 1. - last := index. - state := 1]] - ifFalse: [ - char isUppercase - ifTrue: [ "A" - state = 0 - ifTrue: [state := 2] "start -> A" - ifFalse: [ - (state < 2) | (state > 3) ifTrue: [ - "*A -> * | A (uppercase begins, flush before)" - aBlock value: last value: index - 1. - last := index. - state := 2] ifFalse: [ - "AA -> AA (uppercase continues)" - state := 3]]] - ifFalse: [ - char isSeparator - ifTrue: [ " " - "skip whitespace" - state > 0 ifTrue: [ - aBlock value: last value: index - 1. - state := 0]. - last := index + 1] - ifFalse: [ - - char isDigit - ifTrue: [ "num" - state = 0 - ifTrue: [state := 4] - ifFalse: [ - state ~= 4 ifTrue: [ - aBlock value: last value: index - 1. - last := index. - state := 4]]] - ifFalse: [ "op" - state = 0 - ifTrue: [state := 5] - ifFalse: [ - state < 5 ifTrue: [ - aBlock value: last value: index - 1. - last := index. - state := 5]] ] ] ] ] ]. - last <= self size ifTrue: [ - aBlock value: last value: self size]! Item was removed: - ----- Method: String>>findFeatures (in category 'accessing - features') ----- - findFeatures - - ^ Array streamContents: [:features | - self findFeaturesDo: [:feature | features nextPut: feature]]! Item was removed: - ----- Method: String>>findFeaturesDo: (in category 'accessing - features') ----- - findFeaturesDo: aBlock - "Simple analysis of natural language in source code. Select all features that are letters only, normalize them as lowercase. No support for word stemming. - - Example: - 'Transcript show: 123 asString; cr; show: #HelloWorld.' - -> #('transcript' 'show' 'as' 'string' 'cr' 'show' 'hello' 'world') - " - - self findFeatureIndicesDo: [:start :end | - (self at: start) isLetter ifTrue: [ - aBlock value: (self copyFrom: start to: end) asLowercase]].! Item was removed: - ----- Method: String>>findLastOccurrenceOfString:startingAt: (in category 'accessing') ----- - findLastOccurrenceOfString: subString startingAt: start - "Answer the index of the last occurrence of subString within the receiver, starting at start. If - the receiver does not contain subString, answer 0. Case-sensitive match used." - - | 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 - ! Item was removed: - ----- Method: String>>findLiteral (in category 'converting') ----- - findLiteral - "Scan the receiver for tokens that represent Smalltalk code literals. Return the first token or nil if non were found." - - | tokens | - tokens := Scanner new typedScanTokens: self. - ^tokens isEmpty ifFalse: [tokens first]! Item was removed: - ----- 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 | - sel := self withBlanksTrimmed. - (sel includes: $:) - ifTrue: - [sel := sel copyWithRegex: '''[^'']*''' matchesReplacedWith: '''a string'''. - sel := sel copyWithRegex: '#[^\[\(\s\.$]*' matchesReplacedWith: '#aSymbol'. - sel := sel copyWithRegex: '\$.' matchesReplacedWith: '$x'. "handle $( $[ and $:" - sel := sel copyWithRegex: '\:(?!!=)' matchesReplacedWith: ': '. "for the style (aa max:bb) with no space" - sel := sel copyReplaceAll: '[:' with: '[ :'. "for the style ([:a) with no space" - possibleParens := sel substrings. - sel := self class streamContents: - [:s | | level | - level := 0. - possibleParens do: - [:token | - (level = 0 and: [token endsWith: ':']) - ifTrue: [s nextPutAll: token] - ifFalse: [level := level - + (token occurrencesOf: $() - (token occurrencesOf: $)) - + (token occurrencesOf: $[) - (token occurrencesOf: $]) - + (token occurrencesOf: ${) - (token occurrencesOf: $})]]]] - ifFalse: - [sel := self substrings ifNotEmpty: [:tokens | tokens last]]. - sel ifEmpty: [^ nil]. - sel first = $# ifTrue: - [sel := sel allButFirst. - sel ifEmpty: [^ nil]]. - sel isOctetString ifTrue: [sel := sel asOctetString]. - ^ Symbol lookup: sel! Item was removed: - ----- 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.! Item was removed: - ----- 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! Item was removed: - ----- 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]]! Item was removed: - ----- Method: String>>findSubstring:in:startingAt:matchTable: (in category 'accessing') ----- - 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 keySize matchTableSize | - (keySize := key size) = 0 ifTrue: [ ^0 ]. - matchTable ifNil: [ - start to: body size - keySize + 1 do: [ :startIndex | - index := 0. - [ (body at: startIndex + index) == (key at: (index := index + 1)) ] whileTrue: [ - index = keySize ifTrue: [ ^startIndex ] ] ]. - ^0 ]. - matchTableSize := matchTable size. - start to: body size - keySize + 1 do: [ :startIndex | - index := 0. - [ - (c1 := (body basicAt: startIndex + index) + 1) <= matchTableSize ifTrue: [ - c1 := matchTable at: c1 ]. - (c2 := (key basicAt: (index := index + 1)) + 1) <= matchTableSize ifTrue: [ - c2 := matchTable at: c2 ]. - c1 = c2 ] - whileTrue: [ - index = keySize ifTrue: [ ^startIndex ] ] ]. - ^0! Item was removed: - ----- Method: String>>findSymbol (in category 'converting') ----- - findSymbol - "Return the currently selected symbol, or nil if none. Spaces, tabs and returns are ignored. Note that we do never return the empty symbol." - - | aString | - aString := self copyWithoutAll: CharacterSet separators. - aString size = 0 ifTrue: [^ nil]. - ^ Symbol lookup: aString! Item was removed: - ----- Method: String>>findTokens (in category 'accessing - tokens') ----- - findTokens - - ^ self findTokens: Character separators! Item was removed: - ----- Method: String>>findTokens: (in category 'accessing') ----- - findTokens: delimiters - "Answer the collection of tokens between delimiters, which results from parsing self." - - | tokens | - tokens := OrderedCollection new. - self - findTokens: delimiters - do: [:token | tokens addLast: token]. - ^ tokens! Item was removed: - ----- Method: String>>findTokens:do: (in category 'accessing - tokens') ----- - findTokens: delimiters do: aBlock - - self - findTokens: delimiters - indicesDo: [:start :end | aBlock value: (self copyFrom: start to: end)].! Item was removed: - ----- 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 ifNil: [ '' ]) asString. - quoteChars := (quoteDelimiters ifNil: [ '' ]) asString. - tokens := OrderedCollection new. - rs := ReadStream on: self. - activeEscapeCharacter := nil. - ts := WriteStream on: ''. - [ rs atEnd ] - whileFalse: [ - char := rs next. - activeEscapeCharacter - ifNil: [ - (quoteChars includes: char) - ifTrue: [ activeEscapeCharacter := char ] - ifFalse: [ - (delimiterChars includes: char) - ifTrue: [ - token := ts contents. - tokens add: token. - ts := WriteStream on: '' ] - ifFalse: [ ts nextPut: char ] ] ] - ifNotNil: [ - 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: String>>findTokens:indicesDo: (in category 'accessing - tokens') ----- - findTokens: oneOrMoreCharacters indicesDo: aBlock - "Parse self to find tokens between delimiters. Any character in the Collection delimiters marks a border. Several delimiters in a row are considered as just one separation. The interface is similar to #lineIndicesDo:." - - | keyStart keyStop separators size | - size := self size. - separators := oneOrMoreCharacters isCharacter - ifTrue: [{oneOrMoreCharacters}] - ifFalse: [oneOrMoreCharacters]. - keyStop := 1. - [keyStop <= size] whileTrue: [ - keyStart := self skipDelimiters: separators startingAt: keyStop. - keyStop := self findDelimiters: separators startingAt: keyStart. - keyStart < keyStop - ifTrue: [aBlock value: keyStart value: keyStop - 1]].! Item was removed: - ----- 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! Item was removed: - ----- 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"! Item was removed: - ----- Method: String>>format: (in category 'formatting') ----- - format: aCollection - "Substitute tokens in the receiver with element values of aCollection. The tokens are indicated in curly-braces and may be either numeric, e.g., {1}, {2}, etc. and map to a SequenceableCollection, OR, alphanumeric, e.g., {name}, {date}, etc., in which case aCollection should be a Dictionary. - The values can be static or, with the specification of a Block element, dynamic. - - Simplest examples: - 'foo {date} bar' format: ({'date'->Date today} as: Dictionary). - - Dynamic calculation is allowed via Blocks. - 'foo {NOW} bar' format: ({'NOW'-> [DateAndTime now]} as: Dictionary). - - Backward-compatible with numeric-only #format: - 'foo {1} bar' format: {Date today}. - - Now with block support: - 'foo {1} bar' format: {[Date today]}. - - Complete example with escaped characters: - '\{ \} \\ foo {1} bar {2}' format: {12. 'string'}. - '\{ \} \\ foo {FOO} bar {BAR}' format: ({'FOO'->12. 'BAR'->'string'} as: Dictionary)." - ^ self class - new: self size * 11 // 10 "ready for +10% growth" - streamContents: - [ : output | | lastIndex nextIndex key | - lastIndex := 1. - key := 0. - [ "stream to output until first { or \" - (nextIndex := self indexOfAnyOf: FormatCharacterSet startingAt: lastIndex) = 0 ] whileFalse: - [ nextIndex = lastIndex ifFalse: - [ output next: nextIndex - lastIndex putAll: self startingAt: lastIndex ]. - "special char hit, escape char?" - (self at: nextIndex) == $\ - ifTrue: - [ "transfer the escaped character. " - output nextPut: (self at: (nextIndex := nextIndex + 1)) ] - ifFalse: - [ | nextKeyChar | - "${ char, parse the key" - [ nextKeyChar := self at: (nextIndex := nextIndex + 1). - nextKeyChar isAscii and: [ nextKeyChar isAlphaNumeric ] ] whileTrue: - [ (key isInteger and: [ nextKeyChar between: $0 and: $9 ]) - ifTrue: [ key := key * 10 + nextKeyChar digitValue ] - ifFalse: - [ key isInteger ifTrue: - [ key := WriteStream with: - (key isZero - ifTrue: [ String empty ] - ifFalse: [ key asString ]) ]. - key nextPut: nextKeyChar ] ]. - nextKeyChar == $} ifFalse: [ self error: '$} expected' translated ]. - key isInteger - ifTrue: - [ output nextPutAll: (aCollection at: key) value asString. - key := 0 ] - ifFalse: - [ output nextPutAll: (aCollection at: key contents) value asString. - key reset ] ]. - lastIndex := nextIndex + 1 ]. - lastIndex <= self size ifTrue: - [ output next: self size - lastIndex + 1 putAll: self startingAt: lastIndex ] ]! Item was removed: - ----- 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. - eem 4/17/2017 it's not possible to use String hash (name) for the - initial hash because that would be recursive." - ^self hashWithInitialHash: ByteString identityHash! Item was removed: - ----- Method: String>>hashWithInitialHash: (in category 'private') ----- - hashWithInitialHash: speciesHash - "Answer the hash of a byte-indexed string, using speciesHash as the initial value. - See SmallInteger>>hashMultiply." - | hash | - hash := speciesHash bitAnd: 16r0FFFFFFF. - 1 to: self size do: - [:pos | - hash := (hash + (self basicAt: pos)) hashMultiply]. - ^hash! Item was removed: - ----- 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 - - ! Item was removed: - ----- Method: String>>includesSubstring: (in category 'testing') ----- - includesSubstring: aString - - ^(self findString: aString startingAt: 1) > 0! Item was removed: - ----- Method: String>>includesSubstring:caseSensitive: (in category 'testing') ----- - includesSubstring: aString caseSensitive: caseSensitive - - ^ (self findString: aString startingAt: 1 caseSensitive: caseSensitive) > 0! Item was removed: - ----- Method: String>>includesUnifiedCharacter (in category 'testing') ----- - includesUnifiedCharacter - ^false! Item was removed: - ----- 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." - - | leadingTabs nonTab nonTabIndex nonSepIndex lineEndIndex | - nonTab := (CharacterSet with: Character tab) complement. - nonTabIndex := self indexOfAnyOf: nonTab startingAt: 1. - nonTabIndex = 0 ifTrue: [ - "Only made of tabs or empty" - ^aBlock value: self size]. - leadingTabs := nonTabIndex - 1. - nonSepIndex := self indexOfAnyOf: CharacterSet nonSeparators startingAt: 1. - nonSepIndex = 0 ifTrue: [ - "Only made of separators" - ^aBlock value: leadingTabs]. - lineEndIndex := self indexOfAnyOf: CharacterSet crlf startingAt: 1. - (lineEndIndex between: 1 and: nonSepIndex) ifTrue: [ - "Only made of separators up to a line end" - ^aBlock value: leadingTabs]. - ^leadingTabs! Item was removed: - ----- Method: String>>indexOf:startingAt: (in category 'accessing') ----- - indexOf: aCharacter startingAt: start - - (aCharacter isCharacter) ifFalse: [^ 0]. - ^ self class indexOfAscii: aCharacter asciiValue inString: self startingAt: start! Item was removed: - ----- Method: String>>indexOfSubCollection:startingAt: (in category 'accessing') ----- - indexOfSubCollection: subCollection startingAt: start - - subCollection isString ifFalse: [ ^super indexOfSubCollection: subCollection startingAt: start ]. - ^self findString: subCollection startingAt: start caseSensitive: true! Item was removed: - ----- 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 - " - ! Item was removed: - ----- Method: String>>isAllDigits (in category 'testing') ----- - isAllDigits - "whether the receiver is composed entirely of digits" - - ^self allSatisfy: [ :character | character isDigit ]! Item was removed: - ----- Method: String>>isAllSeparators (in category 'testing') ----- - isAllSeparators - "whether the receiver is composed entirely of separators" - self do: [ :c | c isSeparator ifFalse: [ ^false ] ]. - ^true! Item was removed: - ----- Method: String>>isAsciiString (in category 'testing') ----- - isAsciiString - - ^self allSatisfy: [ :each | each asciiValue <= 127 ]! Item was removed: - ----- Method: String>>isByteString (in category 'testing') ----- - isByteString - "Answer whether the receiver is a ByteString" - ^false! Item was removed: - ----- Method: String>>isLiteral (in category 'testing') ----- - isLiteral - "Answer whether the receiver is a valid Smalltalk literal." - - ^ true! Item was removed: - ----- 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 basicAt: pos) >= 256 ifTrue: [^ false]. - ]. - ^ true. - ! Item was removed: - ----- Method: String>>isString (in category 'testing') ----- - isString - ^ true! Item was removed: - ----- Method: String>>isWideString (in category 'testing') ----- - isWideString - "Answer whether the receiver is a WideString" - ^false! Item was removed: - ----- Method: String>>isoToSqueak (in category 'internet') ----- - isoToSqueak - ^self "no longer needed"! Item was removed: - ----- Method: String>>isoToUtf8 (in category 'internet') ----- - isoToUtf8 - "Convert ISO 8559-1 to UTF-8" - | s | - s := WriteStream on: (String new: self size). - self do: [:c | - | v | - 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. - ! Item was removed: - ----- Method: String>>keywords (in category 'converting') ----- - keywords - "Answer an array of the keywords that compose the receiver." - | keywords | - keywords := Array streamContents: - [:kwds | - | kwd | - kwd := WriteStream on: (String new: 16). - 1 to: self size do: - [:i | - | char | - 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! Item was removed: - ----- Method: String>>lastSpacePosition (in category 'accessing') ----- - 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 - "! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: String>>lineCorrespondingToIndex: (in category 'accessing') ----- - lineCorrespondingToIndex: anIndex - "Answer a string containing the line at the given character position." - - self lineIndicesDo: [:start :endWithoutDelimiters :end | - anIndex <= end ifTrue: [^self copyFrom: start to: endWithoutDelimiters]]. - ^''! Item was removed: - ----- Method: String>>lineCount (in category 'accessing') ----- - lineCount - "Answer the number of lines represented by the receiver, where every line delimiter CR, LF or CRLF pair adds one line." - - | lineCount | - lineCount := 0. - self lineIndicesDo: [:start :endWithoutDelimiters :end | - lineCount := lineCount + 1]. - ^lineCount! Item was removed: - ----- Method: String>>lineIndicesDo: (in category 'accessing') ----- - lineIndicesDo: aBlock - "execute aBlock with 3 arguments for each line: - - start index of line - - end index of line without line delimiter - - end index of line including line delimiter(s) CR, LF or CRLF" - - | cr lf start sz nextLF nextCR | - start := 1. - sz := self size. - cr := Character cr. - nextCR := self indexOf: cr startingAt: 1. - lf := Character lf. - nextLF := self indexOf: lf startingAt: 1. - [ start <= sz ] whileTrue: [ - (nextLF = 0 and: [ nextCR = 0 ]) - ifTrue: [ "No more CR, nor LF, the string is over" - aBlock value: start value: sz value: sz. - ^self ]. - (nextCR = 0 or: [ 0 < nextLF and: [ nextLF < nextCR ] ]) - ifTrue: [ "Found a LF" - aBlock value: start value: nextLF - 1 value: nextLF. - start := 1 + nextLF. - nextLF := self indexOf: lf startingAt: start ] - ifFalse: [ 1 + nextCR = nextLF - ifTrue: [ "Found a CR-LF pair" - aBlock value: start value: nextCR - 1 value: nextLF. - start := 1 + nextLF. - nextCR := self indexOf: cr startingAt: start. - nextLF := self indexOf: lf startingAt: start ] - ifFalse: [ "Found a CR" - aBlock value: start value: nextCR - 1 value: nextCR. - start := 1 + nextCR. - nextCR := self indexOf: cr startingAt: start ]]]! Item was removed: - ----- Method: String>>lineNumber: (in category 'accessing') ----- - lineNumber: anIndex - "Answer a string containing the characters in the given line number." - - | lineCount | - lineCount := 0. - self lineIndicesDo: [:start :endWithoutDelimiters :end | - (lineCount := lineCount + 1) = anIndex ifTrue: [^self copyFrom: start to: endWithoutDelimiters]]. - ^nil! Item was removed: - ----- Method: String>>lines (in category 'accessing') ----- - lines - "Answer an array of lines composing this receiver without the line ending delimiters." - - ^Array new: (self size // 60 max: 16) streamContents: [:lines | - self linesDo: [:aLine | lines nextPut: aLine]]! Item was removed: - ----- Method: String>>linesDo: (in category 'accessing') ----- - linesDo: aBlock - "Execute aBlock with each line in this string. The terminating line delimiters CR, LF or CRLF pairs are not included in what is passed to aBlock" - - self lineIndicesDo: [:start :endWithoutDelimiters :end | - aBlock value: (self copyFrom: start to: endWithoutDelimiters)]! Item was removed: - ----- Method: String>>macToSqueak (in category 'internet') ----- - macToSqueak - "Convert the receiver from MacRoman to Squeak encoding" - ^ self collect: [:each | each macToSqueak]! Item was removed: - ----- 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' true - '*foo#zort' match: 'afoo3zortthenfoo3zort' true - '*foo*zort' match: 'afoodezortorfoo3zort' true - "! Item was removed: - ----- Method: String>>numArgs (in category 'accessing') ----- - 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. It is intended mostly for the assistance of spelling correction." - - | numColons index size c | - (size := self size) = 0 ifTrue: [ ^-1 ]. - index := 1. - (self at: index) isSpecial ifTrue: [ - 2 to: size do: [ :i | (self at: i) isSpecial ifFalse: [ ^-1 ] ]. - ^1 ]. - self canBeToken ifFalse: [ ^-1 ]. - "Fast colon count" - numColons := 0. - [ - ((c := self at: index) isLetter - or: [ c = $_ and: [ Scanner prefAllowUnderscoreSelectors ] ]) ifFalse: - [ ^-1 ]. - (index := (self indexOf: $: startingAt: index) + 1) > 1 ifFalse: - [ numColons = 0 ifTrue: [ ^0 ]. - ^-1 ]. - numColons := numColons + 1. - index <= size ] whileTrue. - ^numColons! Item was removed: - ----- Method: String>>numericSuffix (in category 'converting') ----- - numericSuffix - ^ self stemAndNumericSuffix last - - " - 'abc98' numericSuffix - '98abc' numericSuffix - "! Item was removed: - ----- Method: String>>occurrencesOf: (in category 'enumerating') ----- - occurrencesOf: anObject - "Answer how many of the receiver's elements are equal to anObject. Optimized version." - - | tally | - anObject isCharacter ifFalse: [ ^0 ]. - tally := 0. - 1 to: self size do: [ :index | - (self at: index) == anObject ifTrue: [ tally := tally + 1 ] ]. - ^tally! Item was removed: - ----- Method: String>>onlyLetters (in category 'converting') ----- - onlyLetters - "answer the receiver with only letters" - ^ self select:[:each | each isLetter]! Item was removed: - ----- Method: String>>padded:to:with: (in category 'copying') ----- - padded: leftOrRight to: length with: aCharacter - - | result paddingLength | - (paddingLength := length - self size) <= 0 ifTrue: [ ^self ]. - result := self species new: length. - leftOrRight = #left ifTrue: [ - ^result - from: 1 - to: paddingLength - put: aCharacter; - replaceFrom: paddingLength + 1 - to: length - with: self - startingAt: 1; - yourself ]. - leftOrRight = #right ifTrue: [ - ^result - replaceFrom: 1 - to: self size - with: self - startingAt: 1; - from: self size + 1 - to: length - put: aCharacter; - yourself ]! Item was removed: - ----- Method: String>>printAsLiteralOn: (in category 'printing') ----- - printAsLiteralOn: aStream - "Print inside string quotes, doubling embedded quotes." - self storeOn: aStream! Item was removed: - ----- Method: String>>printOn: (in category 'printing') ----- - printOn: aStream - "Print inside string quotes, doubling embedded quotes." - - self storeOn: aStream! Item was removed: - ----- Method: String>>putOn: (in category 'filter streaming') ----- - putOn:aStream - - ^aStream nextPutAll: self. - ! Item was removed: - ----- 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> - | index repOff | - repOff := repStart - start. - index := start - 1. - [(index := index + 1) <= stop] - whileTrue: [self at: index put: (replacement at: repOff + index) asCharacter].! Item was removed: - ----- 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! Item was removed: - ----- 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 == aString ifTrue: [ ^true ]. - ^(self compare: aString caseSensitive: false) = 2! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- 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 includes: (self at: i)) ifFalse: [ ^i ] ]. - ^self size + 1! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>squeakToIso (in category 'internet') ----- - squeakToIso - ^self "no longer needed"! Item was removed: - ----- Method: String>>squeakToMac (in category 'internet') ----- - squeakToMac - "Convert the receiver from Squeak to MacRoman encoding" - ^ self collect: [:each | each squeakToMac]! Item was removed: - ----- Method: String>>squeakToUtf8 (in category 'converting') ----- - squeakToUtf8 - "Convert the receiver into a UTF8-encoded string" - - ^self convertToWithConverter: UTF8TextConverter new.! Item was removed: - ----- 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. - - "Process consecutive *s and #s at the beginning." - anyMatch := false. - [ i <= self size and: [ - (self at: i) - caseOf: { - [ $* ] -> [ - anyMatch := true. - i := i + 1. - true ]. - [ $# ] -> [ - i := i + 1. - j := j + 1. - true ] } - otherwise: [ false ] ] ] whileTrue. - i > self size ifTrue: [ - ^j - 1 = text size or: [ "We reached the end by matching the character with a #." - anyMatch and: [ j <= text size ] "Or there was a * before the end." ] ]. - matchStart := i. - - "Now determine the match string" - matchEnd := self size. - (ii := self indexOf: $* startingAt: matchStart) > 0 ifTrue: [ matchEnd := ii-1 ]. - (ii := self indexOf: $# startingAt: matchStart) > 0 ifTrue: [ 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"! Item was removed: - ----- Method: String>>startsWithDigit (in category 'testing') ----- - startsWithDigit - "Answer whether the receiver's first character represents a digit" - - ^ self size > 0 and: [self first isDigit]! Item was removed: - ----- 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"! Item was removed: - ----- Method: String>>storeOn: (in category 'printing') ----- - storeOn: aStream - "Print inside string quotes, doubling embedded quotes." - - | start matchIndex | - aStream nextPut: $'. - start := 1. - [ (matchIndex := self indexOf: $' startingAt: start) = 0 ] whileFalse: [ - aStream - next: matchIndex - start + 1 putAll: self startingAt: start; - nextPut: $'. - start := matchIndex + 1 ]. - aStream - next: self size - start + 1 putAll: self startingAt: start; - nextPut: $'! Item was removed: - ----- Method: String>>string (in category 'converting') ----- - string - ^self! Item was removed: - ----- 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 ! Item was removed: - ----- Method: String>>stringhash (in category 'private') ----- - stringhash - - ^ self hash. - ! Item was removed: - ----- 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! Item was removed: - ----- 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 isCharacter]]) 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! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>surroundedBySingleQuotes (in category 'converting') ----- - surroundedBySingleQuotes - "Answer the receiver with leading and trailing quotes. " - - ^ $' asString, self, $' asString! Item was removed: - ----- 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] - "! Item was removed: - ----- 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! Item was removed: - ----- Method: String>>translateToLowercase (in category 'converting') ----- - translateToLowercase - "Translate all characters to lowercase, in place" - - self translateWith: LowercasingTable! Item was removed: - ----- Method: String>>translateToUppercase (in category 'converting') ----- - translateToUppercase - "Translate all characters to uppercase, in place" - - self translateWith: UppercasingTable! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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"! Item was removed: - ----- Method: String>>unescapePercents (in category 'converting') ----- - unescapePercents - "decode %xx form. This is the opposite of #encodeForHTTP. Assume UTF-8 encoding by default." - - | unescaped | - unescaped := self unescapePercentsRaw. - ^[ unescaped utf8ToSqueak ] - on: Error - do: [ unescaped ]! Item was removed: - ----- Method: String>>unescapePercentsRaw (in category 'converting') ----- - unescapePercentsRaw - "Decode myself if I'm percent-encoded, also replace + with space. Return self if the encoding is not valid." - - ^String new: self size streamContents: [ :stream | - | value1 value2 specialChars startIndex endIndex | - specialChars := '+%' asCharacterSet. - startIndex := 1. - [ (endIndex := self indexOfAnyOf: specialChars startingAt: startIndex) > 0 ] whileTrue: [ - stream next: endIndex - startIndex putAll: self startingAt: startIndex. - (self at: endIndex) == $% - ifTrue: [ - endIndex + 2 <= self size ifFalse: [ ^self ]. - value1 := (self at: endIndex + 1) asUppercase digitValue. - (value1 < 0 or: [ value1 > 15 ]) ifTrue: [ ^self ]. - value2 := (self at: endIndex + 2) asUppercase digitValue. - (value2 < 0 or: [ value2 > 15 ]) ifTrue: [ ^self ]. - stream nextPut: (Character value: value1 * 16 + value2). - startIndex := endIndex + 3 ] - ifFalse: [ "$+" - stream nextPut: Character space. - startIndex := endIndex + 1 ] ]. - startIndex <= self size ifTrue: [ - stream next: self size + 1 - startIndex putAll: self startingAt: startIndex ] ]! Item was removed: - ----- Method: String>>unescapePercentsWithTextConverter: (in category 'converting') ----- - unescapePercentsWithTextConverter: aTextConverter - "decode string including %XX form" - - | unescaped | - unescaped := self unescapePercentsRaw. - ^[ unescaped convertFromWithConverter: aTextConverter ] - on: Error - do: ["the contents may be squeak-encoded" - unescaped ]! Item was removed: - ----- Method: String>>unescapePercentsWithTextEncoding: (in category 'converting') ----- - unescapePercentsWithTextEncoding: encodingName - "decode string including %XX form" - - | converter | - converter := (TextConverter newForEncoding: encodingName) - ifNil: [ TextConverter newForEncoding: nil ]. - ^self unescapePercentsWithTextConverter: converter! Item was removed: - ----- 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 - - " - ! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: String>>utf8ToSqueak (in category 'converting') ----- - utf8ToSqueak - "Convert the receiver from a UTF8-encoded string" - - ^self convertFromWithConverter: UTF8TextConverter new.! Item was removed: - ----- Method: String>>vmPathToSqueakPath (in category 'converting') ----- - vmPathToSqueakPath - "convert a file path string received from the vm to a Squeak String" - - ^ (FilePath pathName: self isEncoded: true) asSqueakPathName! Item was removed: - ----- Method: String>>withBlanksCondensed (in category 'converting') ----- - withBlanksCondensed - "Return a copy of the receiver with leading/trailing blanks removed - and consecutive white spaces condensed." - - ^String streamContents: [:stream | - | trimmed lastBlank | - trimmed := self withBlanksTrimmed. - lastBlank := false. - trimmed do: [:c | (c isSeparator and: [lastBlank]) ifFalse: [stream nextPut: c]. - lastBlank := c isSeparator]]. - - " ' abc d ' withBlanksCondensed" - ! Item was removed: - ----- Method: String>>withBlanksTrimmed (in category 'converting') ----- - withBlanksTrimmed - "Return a copy of the receiver from which leading and trailing blanks have been trimmed." - - | first last | - first := self indexOfAnyOf: CharacterSet nonSeparators startingAt: 1. - first = 0 ifTrue: [ ^'' ]. "no non-separator character" - last := self lastIndexOfAnyOf: CharacterSet nonSeparators startingAt: self size ifAbsent: [self size]. - (first = 1 and: [ last = self size ]) ifTrue: [ ^self copy ]. - ^self - copyFrom: first - to: last - ! Item was removed: - ----- 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 ]].! Item was removed: - ----- 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. ! Item was removed: - ----- Method: String>>withInternetLineEndings (in category 'internet') ----- - withInternetLineEndings - "change line endings from CR's and LF's to CRLF's. This is probably in prepration for sending a string over the Internet" - - ^self withLineEndings: String crlf! Item was removed: - ----- Method: String>>withLineEndings: (in category 'internet') ----- - withLineEndings: lineEndingString - - | stream | - stream := nil. - self lineIndicesDo: [ :start :endWithoutDelimiters :end | - (stream isNil and: [ endWithoutDelimiters ~= end ]) ifTrue: [ - (self copyFrom: endWithoutDelimiters + 1 to: end) = lineEndingString ifFalse: [ - stream := WriteStream with: self copy. - stream position: start - 1 ] ]. - stream ifNotNil: [ - stream next: endWithoutDelimiters - start + 1 putAll: self startingAt: start. - endWithoutDelimiters = end ifFalse: [ - stream nextPutAll: lineEndingString ] ] ]. - ^stream - ifNil: [ self ] - ifNotNil: [ - stream position = self size - ifTrue: [ stream originalContents ] - ifFalse: [ stream contents ] ]! Item was removed: - ----- 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" - aNumber isNumber not | (aNumber < 1) ifTrue: [self error: 'too narrow']. - ^self class - new: self size * (aNumber + 1) // aNumber "provision for supplementary line breaks" - streamContents: [ :stream | - self lineIndicesDo: [ :start :endWithoutDelimiters :end | - | pastEnd lineStart | - pastEnd := endWithoutDelimiters + 1. - "eliminate spaces at beginning of line" - lineStart := (self indexOfAnyOf: CharacterSet nonSeparators startingAt: start ifAbsent: [pastEnd]) min: pastEnd. - [| lineStop lineEnd spacePosition | - lineEnd := lineStop := lineStart + aNumber min: pastEnd.. - spacePosition := lineStart. - [spacePosition < lineStop] whileTrue: [ - spacePosition := self indexOfAnyOf: CharacterSet separators startingAt: spacePosition + 1 ifAbsent: [pastEnd]. - spacePosition <= lineStop ifTrue: [lineEnd := spacePosition]. - ]. - "split before space or before lineStop if no space" - stream nextPutAll: (self copyFrom: lineStart to: lineEnd - 1). - "eliminate spaces at beginning of next line" - lineStart := self indexOfAnyOf: CharacterSet nonSeparators startingAt: lineEnd ifAbsent: [pastEnd]. - lineStart <= endWithoutDelimiters ] - whileTrue: [stream cr]. - stream nextPutAll: (self copyFrom: pastEnd to: end) ] ]! Item was removed: - ----- 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: [CharacterSet separators 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! Item was removed: - ----- 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." - - (self includes: Character lf) ifFalse: [ ^self ]. - (self includes: Character cr) ifFalse: [ - ^self copy translateWith: String crLfExchangeTable ]. - ^self withLineEndings: String cr! Item was removed: - ----- Method: String>>withUnixLineEndings (in category 'internet') ----- - withUnixLineEndings - "Assume the string is textual, and that CR, LF, and CRLF are all valid line endings. - Replace each occurence with a single LF." - - (self includes: Character cr) ifFalse: [ ^self ]. - (self includes: Character lf) ifFalse: [ - ^self copy translateWith: String crLfExchangeTable ]. - ^self withLineEndings: String lf! Item was removed: - ----- 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 - " - ! Item was removed: - ----- 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" - ! Item was removed: - ----- 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 - " - ! Item was removed: - ----- Method: String>>withoutLineEndings (in category 'converting') ----- - withoutLineEndings - - ^self withLineEndings: ' '! Item was removed: - ----- 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 = self last and: [ quote = $' or: [ quote = $" ] ]) - ifTrue: [ ^self copyFrom: 2 to: self size - 1 ] - ifFalse: [ ^self ].! Item was removed: - ----- 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" - ! Item was removed: - ----- 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" - | i | - i := self size. - [i > 0] whileTrue: [ - ((self at: i) isDigit or: [ (self at: i) = $ ]) ifFalse: [ - ^ self copyFrom: 1 to: i - ]. - i := i - 1. - ]. - ^ '' - - - " - 'Whoopie234' withoutTrailingDigits - 'Lucida Grande 15' withoutTrailingDigits - ' 4321 BlastOff!!' withoutLeadingDigits - 'wimpy' withoutLeadingDigits - ' 89Ten ' withoutLeadingDigits - '78 92' withoutLeadingDigits - " - ! Item was removed: - ----- 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. - ! Item was removed: - String subclass: #Symbol - instanceVariableNames: '' - classVariableNames: 'NewSymbols SymbolTable' - poolDictionaries: '' - category: 'Collections-Strings'! - - !Symbol commentStamp: 'ul 3/28/2022 19:53' prior: 0! - I represent Strings that are created uniquely. Thus, someString asSymbol == someString asSymbol. - - On my class-side, there is an implementation of a symbol table which provides concurrent access (both read and write) without using locks (Semaphore, Mutex, Monitor). - The state of the symbol table is stored in two immutable (see #beReadOnlyObject) WeakSets stored by the class variables SymbolTable and NewSymbols. - SymbolTable holds most of the interned symbols, while new symbols are always added to NewSymbols. - Once the size of NewSymbols exceeds a limit (1000 currently, see #intern:), its content is merged into SymbolTable (see #condenseNewSymbols). - - To ensure a consistent view of the symbol table, all methods accessing it start with atomically creating a "snapshot" of the state, the two variables, by assigning them to two temporaries. Except for #intern:, which only accesses NewSymbols, hence it only creates a snapshot of that. - If the symbol table changes, NewSymbols will always be a different object, so it is enough to check whether NewSymbols is the same as before the operation to verify that the symbol table has not been modified. - - There are three methods that can update the symbol table: #condenseNewSymbols, #rehash and #intern:. They create a snapshot first as described above, then create copies of the updated parts, and finally check whether NewSymbols is the same as before, and if it is, they apply their changes. That all happens atomically because #==, #ifTrue: and assignments are executed by the VM without suspension points, hence atomically. If NewSymbols is different, the methods are repeated until they succeed. - ! Item was removed: - ----- Method: Symbol class>>allSymbolTablesDo: (in category 'class initialization') ----- - allSymbolTablesDo: aBlock - "See the class comment for details about the usage of the class variables before changing this method" - - | originalNewSymbols originalSymbolTable | - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - originalNewSymbols do: aBlock. - originalSymbolTable do: aBlock.! Item was removed: - ----- Method: Symbol class>>allSymbolTablesDo:after: (in category 'class initialization') ----- - allSymbolTablesDo: aBlock after: aSymbol - "See the class comment for details about the usage of the class variables before changing this method" - - | originalNewSymbols originalSymbolTable | - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - (originalNewSymbols includes: aSymbol) - ifTrue: [ - originalNewSymbols do: aBlock after: aSymbol. - originalSymbolTable do: aBlock after: aSymbol ] - ifFalse: [ - originalSymbolTable do: aBlock after: aSymbol. - originalNewSymbols do: aBlock after: aSymbol ] - ! Item was removed: - ----- Method: Symbol class>>allSymbols (in category 'accessing') ----- - allSymbols - "Answer all interned symbols" - "See the class comment for details about the usage of the class variables before changing this method" - - | originalNewSymbols originalSymbolTable | - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - ^Array - new: originalNewSymbols slowSize + originalSymbolTable slowSize - streamContents: [ :stream | - stream - nextPutAll: originalNewSymbols; - nextPutAll: originalSymbolTable ] - ! Item was removed: - ----- Method: Symbol class>>cleanUp (in category 'class initialization') ----- - cleanUp - "Flush caches" - - self condenseNewSymbols! Item was removed: - ----- Method: Symbol class>>compactSymbolTable (in category 'class initialization') ----- - compactSymbolTable - "Reduce the size of the symbol table so that it holds all existing symbols with 25% free space." - - self deprecated: 'Use #condenseNewSymbols instead'. - self condenseNewSymbols! Item was removed: - ----- Method: Symbol class>>condenseNewSymbols (in category 'private') ----- - condenseNewSymbols - "Move all symbols from NewSymbols to SymbolTable, and compact SymbolTable if needed." - "See the class comment for details about the usage of the class variables before changing this method." - - | originalNewSymbols originalSymbolTable newNewSymbols newSymbolTable | - [ - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - (originalNewSymbols isEmpty and: [ originalSymbolTable isCompact ]) ifTrue: [ - "Only recreate the sets if necessary" - ^self ]. - (newNewSymbols := WeakSet new) - beReadOnlyObject. - (newSymbolTable := WeakSet new: originalNewSymbols slowSize + originalSymbolTable slowSize) - addAll: originalSymbolTable; - addAll: originalNewSymbols; - beReadOnlyObject. - originalNewSymbols == NewSymbols ifTrue: [ - NewSymbols := newNewSymbols. - SymbolTable := newSymbolTable. - ^self ]. - "Some other process has modified the symbol table. Try again." ] repeat! Item was removed: - ----- Method: Symbol class>>empty (in category 'instance creation') ----- - empty - "A canonicalized empty symbol." - ^ #''! Item was removed: - ----- 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." - - (self lookup: aString) - ifNil: [ ^false ] - ifNotNil: [ :symbol | - symBlock value: symbol. - ^true ]! Item was removed: - ----- Method: Symbol class>>initialize (in category 'class initialization') ----- - initialize - - "Symbol initialize" - - Symbol rehash. - Smalltalk addToShutDownList: self. - ! Item was removed: - ----- Method: Symbol class>>intern: (in category 'instance creation') ----- - intern: aStringOrSymbol - "Answer the unique Symbol formed with given String. - If it does not exist yet, create it and intern it in the NewSymbols. - Interning a Symbol should return the Symbol itself, no Symbol should be duplicated" - "See the class comment for details about the usage of the class variables before changing this method" - - | originalNewSymbols | - originalNewSymbols := NewSymbols. - ^(self lookup: aStringOrSymbol) ifNil:[ - | aSymbol newNewSymbols | - aStringOrSymbol isSymbol ifTrue:[ - aSymbol := aStringOrSymbol. - ] ifFalse:[ - aSymbol := (aStringOrSymbol isOctetString ifTrue:[ByteSymbol] ifFalse:[WideSymbol]) - new: aStringOrSymbol size. - aSymbol - copyFrom: aStringOrSymbol; - beReadOnlyObject. - ]. - newNewSymbols := originalNewSymbols copyWith: aSymbol. - newNewSymbols beReadOnlyObject. - originalNewSymbols == NewSymbols - ifTrue: [ - NewSymbols := newNewSymbols. - newNewSymbols size > 1000 ifTrue: [ self condenseNewSymbols ]. - aSymbol ] - ifFalse: [ - "Some other process has modified the symbols. Try again." - self intern: aStringOrSymbol ] ]! Item was removed: - ----- Method: Symbol class>>lookup: (in category 'instance creation') ----- - lookup: aStringOrSymbol - "Answer the unique Symbol formed with given String, if it exists. - Answer nil if no such Symbol does exist yet. - Looking up a Symbol should return the Symbol itself - - no Symbol should be duplicated - - every Symbol should be registered in one of the two Symbol tables" - "See the class comment for details about the usage of the class variables before changing this method" - - | originalNewSymbols originalSymbolTable | - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - ^(originalSymbolTable like: aStringOrSymbol) ifNil: [ "Most symbols are in originalSymbolTable, so look for existing symbols in there first" - originalNewSymbols like: aStringOrSymbol ]! Item was removed: - ----- 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 - "! Item was removed: - ----- 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 | - 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 | - (((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" - (self lookup: binary) ifNotNil: [:him | best addFirst: him]]. - ^ best! Item was removed: - ----- 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"! Item was removed: - ----- Method: Symbol class>>rehash (in category 'private') ----- - rehash - "Rebuild the hash table, reclaiming unreferenced Symbols. This method will intern all symbols. You're probably looking for #condenseNewSymbols instead." - "See the class comment for details about the usage of the class variables before changing this method" - - | originalNewSymbols originalSymbolTable newNewSymbols newSymbolTable | - [ - originalNewSymbols := NewSymbols. - originalSymbolTable := SymbolTable. - newNewSymbols := WeakSet new. - newSymbolTable := WeakSet withAll: self allSubInstances. - newNewSymbols beReadOnlyObject. - newSymbolTable beReadOnlyObject. - originalNewSymbols == NewSymbols ifTrue: [ - NewSymbols := newNewSymbols. - SymbolTable := newSymbolTable. - ^self ]. - "Some other process has modified the symbol table. Try again." ] repeat - ! Item was removed: - ----- Method: Symbol class>>selectorsContaining: (in category 'accessing') ----- - 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 | - selectorList := OrderedCollection new. - (size := aString size) = 0 ifTrue: [ ^selectorList ]. - self allSymbolTablesDo: [ :each | - (each size >= size - and: [ (each includesSubstring: aString caseSensitive: false) - and: [ each numArgs ~= -1 ] ]) - ifTrue: [ selectorList add: each ] ]. - ^selectorList - - "Symbol selectorsContaining: 'scon'"! Item was removed: - ----- Method: Symbol class>>selectorsMatching: (in category 'accessing') ----- - selectorsMatching: aStringPattern - "Answer a list of selectors that match aStringPattern within them. Case-insensitive. Does return symbols that begin with a capital letter." - - | selectorList | - selectorList := OrderedCollection new. - aStringPattern isEmpty ifTrue: [ ^selectorList ]. - self allSymbolTablesDo: [ :each | - ((aStringPattern match: each) and: [ each numArgs ~= -1 ]) - ifTrue: [selectorList add: each ] ]. - ^selectorList - - "Symbol selectorsMatching: 'parse:*'"! Item was removed: - ----- Method: Symbol class>>shutDown: (in category 'private') ----- - shutDown: aboutToQuit - - self condenseNewSymbols! Item was removed: - ----- Method: Symbol class>>thatStarts:skipping: (in category 'accessing') ----- - 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" - ! Item was removed: - ----- Method: Symbol class>>thatStartsCaseSensitive:skipping: (in category 'accessing') ----- - 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 - ! Item was removed: - ----- Method: Symbol>>= (in category 'comparing') ----- - = aSymbol - "Compare the receiver and aSymbol." - self == aSymbol ifTrue: [^ true]. - aSymbol isSymbol ifTrue: [^ false]. - "Use String comparison otherwise" - ^ super = aSymbol! Item was removed: - ----- Method: Symbol>>asSortFunction (in category '*Collections-SortFunctions-converting') ----- - asSortFunction - "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." - "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')" - - ^PropertySortFunction property: self! Item was removed: - ----- 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! Item was removed: - ----- Method: Symbol>>asSymbol (in category 'converting') ----- - asSymbol - "Refer to the comment in String|asSymbol."! Item was removed: - ----- Method: Symbol>>ascending (in category '*Collections-SortFunctions-converting') ----- - ascending - "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in ascending order using the <=> method." - "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('de' 'abc' 'fghi')" - - ^self asSortFunction ! Item was removed: - ----- Method: Symbol>>at:put: (in category 'accessing') ----- - at: anInteger put: anObject - "You cannot modify the receiver." - - self errorNoModification! Item was removed: - ----- Method: Symbol>>byteEncode: (in category 'filter streaming') ----- - byteEncode:aStream - ^aStream writeSymbol:self. - ! Item was removed: - ----- Method: Symbol>>canBeToken (in category 'testing') ----- - canBeToken - "Since definition of #tokenish depends on a preference, we want to make sure - that underscores are always considered tokenish. This is so that selectors created - when the preference was turned on don't suddenly become invalid when the - preference is turned off." - - ^ self allSatisfy: [:c | c = $_ or: [c tokenish]]! Item was removed: - ----- Method: Symbol>>capitalized (in category 'converting') ----- - capitalized - ^ self asString capitalized asSymbol! Item was removed: - ----- Method: Symbol>>collatedBy: (in category '*Collections-SortFunctions-converting') ----- - collatedBy: aSortFunction - "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated iusing aSortFunction." - "#('abc' 'de' 'fghi') sorted: (#size collatedWith: [:e|e bitAnd: 1]) , #size >>> #( 'de' 'fghi' 'abc')" - - ^PropertySortFunction property: self collatedWith: aSortFunction asSortFunction! Item was removed: - ----- Method: Symbol>>copy (in category 'copying') ----- - copy - "Answer with the receiver, because Symbols are unique."! Item was removed: - ----- Method: Symbol>>cull: (in category 'evaluating') ----- - cull: anObject - - ^anObject perform: self! Item was removed: - ----- Method: Symbol>>descending (in category '*Collections-SortFunctions-converting') ----- - descending - "Return a SortFunction around the receiver, where the receiver will be used as a unary message to send to both a and b during sorting, and then the result of said send will be collated in descending order using the <=> method." - "#('abc' 'de' 'fghi') sorted: #size ascending >>> #('fghi' 'abc' 'de')" - - ^self asSortFunction reversed! Item was removed: - ----- Method: Symbol>>errorNoModification (in category 'private') ----- - errorNoModification - - self error: 'symbols can not be modified.'! Item was removed: - ----- 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> - ! Item was removed: - ----- Method: Symbol>>includesKey: (in category 'testing') ----- - includesKey: sym - ^self == sym.! Item was removed: - ----- Method: Symbol>>isBinary (in category 'testing') ----- - isBinary - ^ self isInfix.! Item was removed: - ----- Method: Symbol>>isDoIt (in category 'testing') ----- - isDoIt - - ^ (self == #DoIt) or: [self == #DoItIn:].! Item was removed: - ----- Method: Symbol>>isInfix (in category 'testing') ----- - isInfix - "Answer whether the receiver is an infix message selector." - - ^ self precedence = 2! Item was removed: - ----- Method: Symbol>>isKeyword (in category 'testing') ----- - isKeyword - "Answer whether the receiver is a message keyword." - - ^ self precedence = 3! Item was removed: - ----- Method: Symbol>>isMessageSelector (in category 'testing') ----- - isMessageSelector - "Answer if the receiver is a valid message selector. This method is not perfect. - The compiler does allow all caps to be selectors but these are not included. - If AllowUnderscoreSelectors is true then _ is a valid selector but this will be excluded - also. But it is IMO more useful to exclude class names and hence exclude some rarely - used selectors than to erroneously identify class names as message selectors." - - ^Scanner isMessageSelector: self! Item was removed: - ----- Method: Symbol>>isOrientedFill (in category 'printing') ----- - isOrientedFill - "Needs to be implemented here because symbols can occupy 'color' slots of morphs." - - ^ false! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Symbol>>isSymbol (in category 'testing') ----- - isSymbol - ^ true ! Item was removed: - ----- Method: Symbol>>isUnary (in category 'testing') ----- - isUnary - "Answer whether the receiver is an unary message selector." - - ^ self precedence = 1! Item was removed: - ----- 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 #+ " - - | numArgs offset |. - (numArgs := self numArgs) >= n ifTrue: [ ^self ]. - numArgs = 0 - ifTrue: [ offset := 1 ] - ifFalse: [ offset := 0 ]. - ^(String new: n - numArgs + offset * 5 + offset + self size streamContents: [ :stream | - stream nextPutAll: self. - numArgs = 0 ifTrue: [ stream nextPut: $:. ]. - numArgs + offset + 1 to: n do: [ :i | stream nextPutAll: 'with:' ] ]) asSymbol! Item was removed: - ----- 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 canBeIdentifierInitial ifFalse: [ ^ 2 ]. - self last = $: ifTrue: [ ^ 3 ]. - ^ 1! Item was removed: - ----- Method: Symbol>>replaceFrom:to:with:startingAt: (in category 'accessing') ----- - replaceFrom: start to: stop with: replacement startingAt: repStart - - self errorNoModification! Item was removed: - ----- Method: Symbol>>selector (in category 'accessing') ----- - selector - ^ self! Item was removed: - ----- Method: Symbol>>shallowCopy (in category 'copying') ----- - shallowCopy - "Answer with the receiver, because Symbols are unique."! Item was removed: - ----- Method: Symbol>>storeOn: (in category 'printing') ----- - storeOn: aStream - - aStream nextPut: $#. - (Scanner isLiteralSymbol: self) - ifTrue: [aStream nextPutAll: self] - ifFalse: [super storeOn: aStream]! Item was removed: - ----- Method: Symbol>>value: (in category 'evaluating') ----- - value: anObject - ^anObject perform: self.! Item was removed: - ----- Method: Symbol>>value:value: (in category 'evaluating') ----- - value: anObject value: anotherObject - - ^anObject perform: self with: anotherObject! Item was removed: - ----- Method: Symbol>>veryDeepCopy (in category 'copying') ----- - veryDeepCopy - "Overridden for performance." - ^ self! Item was removed: - ----- Method: Symbol>>veryDeepCopyWith: (in category 'copying') ----- - veryDeepCopyWith: deepCopier - "Return self. I am immutable in the Morphic world. Do not record me."! Item was removed: - ----- Method: Symbol>>withFirstCharacterDownshifted (in category 'converting') ----- - withFirstCharacterDownshifted - "Answer an object like the receiver but with first character downshifted if necessary" - - ^self asString withFirstCharacterDownshifted asSymbol! Item was removed: - ArrayedCollection subclass: #Text - instanceVariableNames: 'string runs' - classVariableNames: 'IgnoreStyleIfOnlyBold' - 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! Item was removed: - ----- Method: Text class>>THEQUICKBROWNFOX (in category 'filler text') ----- - THEQUICKBROWNFOX - - ^ self fromString: 'THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG.'! Item was removed: - ----- 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]]! Item was removed: - ----- Method: Text class>>allDigits (in category 'filler text') ----- - allDigits - - ^ self fromString: '0123456789'! Item was removed: - ----- Method: Text class>>codeSample (in category 'filler text') ----- - codeSample - - self flag: #linebreaks. "Samples are used in FontImporterTool and must contain manual linebreaks (visually stable example texts per line)." - ^ 'exampleWithNumber: x - "A method that illustrates every part of Smalltalk method syntax - including primitives. It has unary, binary, and keyboard messages; - declares arguments and temporaries; accesses a global variable - (but not an instance variable); uses literals (array, nested array, - character, symbol, string, integer, float, scaled decimal, and byte - array); uses the pseudo variables nil, true, false, self, super, and - thisContext; shows that within a literal array nil, true, and false are - still pseudo variables; and has sequence, assignment, return, - cascade, and tuple (array) creation. It has both zero argument - and one argument blocks, and has a block temporary." - <primitive: ''primitiveCopyBits'' module: #BitBltPlugin error: ec> - | y | - true & false not & (nil isNil) ifFalse: [self halt]. - y := self size + super size. - #($a #a ''a'' "a" (1 1.0 1.0s2) nil true false), { #[65]. thisContext. nil. true. false } - do: [ :each | | class | - class := each class. - Transcript - show: (class name); - show: '' '']. - ^ x < y'! Item was removed: - ----- Method: Text class>>forssmanSample (in category 'filler text') ----- - forssmanSample - "Detailtypografie. Friedrich Forssmann, Ralf de Jong. Verlag Hermann Schmidt. 2004. ISBN 978-3874395687. http://www.detailtypografie.de/" - - ^ self fromString: 'Wien, Venedig, Ravenna? Also gut: Ravenna. Gleichmäßiger - Regen hüllt den Abend ein. Die Fassaden der Häuser haben ihr - Antlitz verloren. Ein korpulenter Polizist humpelt auf - Krücken zum Strand. Vergeblich halten wir Ausschau, - melancholisch spielt Frau Löwe mit ihrem Zirkel. Wir öffnen - die Tür. Wir sehen nichts. In der Ferne ein Gewitter. Früher - wägte man den Sinn und den Unsinn und entschied sich für den - Unsinn. Das war eine Geschmackssache. Wir liegen in Fesseln, - ach und in Feuchte. Frau Löwe malt ein vergangenes Bild der - Wissenschaft auf die bröcklige Leinwand der Herzen. Sie - verneigt sich und küßt uns die Augen. Wir finden keine Luft - mehr, wir halten uns nur noch auf dem laufenden. Gott im - Himmel, laß es ein Ende haben!! Gott im Himmel, erweiche dein - Herz!! Gott im Himmel schenk uns dein Fleisch!! Wir finden ... - Luft ... Das Leselicht erlischt. »Blind ist der Blinde nur - hinter der Binde.« Schiller & Goethe reichen sich die Hände. - »Na denn? Na denn!!«'! Item was removed: - ----- 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: #()! Item was removed: - ----- Method: Text class>>hamburgefonstiv (in category 'filler text') ----- - hamburgefonstiv - - ^ self fromString: 'Hamburgefonstiv'! Item was removed: - ----- Method: Text class>>ignoreStyleIfOnlyBold (in category 'preferences') ----- - ignoreStyleIfOnlyBold - <preference: 'Ignore style if only bold' category: 'browsing' description: 'If true, then any method submission in which the only style change is for bolding will be treated as a method with no style specifications.' type: #Boolean> - ^ IgnoreStyleIfOnlyBold ifNil: [true].! Item was removed: - ----- Method: Text class>>ignoreStyleIfOnlyBold: (in category 'preferences') ----- - ignoreStyleIfOnlyBold: aBoolean - IgnoreStyleIfOnlyBold := aBoolean.! Item was removed: - ----- 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 | - "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" - - "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 - - ). - - 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. - - "Text initTextConstants "! Item was removed: - ----- 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 at 5 - fromArray: #(2r001100e26 2r001100e26 2r011110e26 2r111111e26 2r110011e26) - offset: -3 at 0). - self initTextConstants! Item was removed: - ----- Method: Text class>>loremIpsum (in category 'filler text') ----- - loremIpsum - - ^ self fromString: 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, - sed do eiusmod tempor incididunt ut labore et dolore - magna aliqua. Ut enim ad minim veniam, quis nostrud - exercitation ullamco laboris nisi ut aliquip ex ea commodo - consequat. Duis aute irure dolor in reprehenderit in voluptate - velit esse cillum dolore eu fugiat nulla pariatur. Excepteur - sint occaecat cupidatat non proident, sunt in culpa qui - officia deserunt mollit anim id est laborum.'! Item was removed: - ----- Method: Text class>>melvilleSample (in category 'filler text') ----- - melvilleSample - " - https://en.wikipedia.org/wiki/Moby-Dick - " - - ^ self fromString: 'Call me Ishmael. Some years ago - never mind how long - precisely - having little or no money in my purse, and - nothing particular to interest me on shore, I thought I - would sail about a little and see the watery part of the - world. It is a way I have of driving off the spleen and - regulating the circulation. Whenever I find myself growing - grim about the mouth; whenever it is a damp, drizzly - November in my soul; whenever I find myself involuntarily - pausing before coffin warehouses, and bringing up the rear - of every funeral I meet; and especially whenever my hypos - get such an upper hand of me, that it requires a strong - moral principle to prevent me from deliberately stepping - into the street, and methodically knocking people''s hats off - - then, I account it high time to get to sea as soon as I - can. This is my substitute for pistol and ball. With a - philosophical flourish Cato throws himself upon his sword; I - quietly take to the ship. There is nothing surprising in - this. If they but knew it, almost all men in their degree, - some time or other, cherish very nearly the same feelings - towards the ocean with me. - - There now is your insular city of the Manhattoes, belted - round by wharves as Indian isles by coral reefs - commerce - surrounds it with her surf. Right and left, the streets take - you waterward. Its extreme down-town is the battery, where - that noble mole is washed by waves, and cooled by breezes, - which a few hours previous were out of sight of land. Look - at the crowds of water-gazers there. - - -- Herman Melville'! Item was removed: - ----- Method: Text class>>new: (in category 'instance creation') ----- - new: stringSize - - ^self fromString: (String new: stringSize)! Item was removed: - ----- Method: Text class>>new:streamContents: (in category 'instance creation') ----- - new: newSize streamContents: blockWithArg - - | stream | - stream := TextStream on: (self new: newSize). - blockWithArg value: stream. - ^ stream contents! Item was removed: - ----- Method: Text class>>streamContents: (in category 'instance creation') ----- - streamContents: blockWithArg - | stream | - stream := TextStream on: (self new: 400). - blockWithArg value: stream. - ^ stream contents! Item was removed: - ----- 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)! Item was removed: - ----- 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)! Item was removed: - ----- 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! Item was removed: - ----- Method: Text class>>string:runs: (in category 'private') ----- - string: aString runs: anArray - - ^self basicNew setString: aString setRunsChecking: anArray! Item was removed: - ----- Method: Text class>>symbolSample (in category 'filler text') ----- - symbolSample - "Symbols are specific to a font family. We cannot know which code points are supported and how symbols will look like. Thus, you should ask the font of your choice to provide you with a #symbolSample." - - ^ TextStyle defaultFont symbolSample! Item was removed: - ----- Method: Text class>>textSample (in category 'filler text') ----- - textSample - - ^ self streamContents: [:stream | - stream - nextPutAll: self hamburgefonstiv; cr; - nextPutAll: self theQuickBrownFox; cr; - nextPutAll: self THEQUICKBROWNFOX; cr; cr; - nextPutAll: self allDigits; cr; cr; - nextPutAll: self loremIpsum]! Item was removed: - ----- Method: Text class>>theQuickBrownFox (in category 'filler text') ----- - theQuickBrownFox - - ^ self fromString: 'the quick brown fox jumps over the lazy dog'! Item was removed: - ----- Method: Text>><=> (in category 'sorting') ----- - <=> aCharacterArray - "Return a collation order of -1, 0, or 1, indicating whether I should be collated before the receiver, am equal, or after. - See also: http://en.wikipedia.org/wiki/Spaceship_operator" - - aCharacterArray isString ifTrue: [ ^string <=> aCharacterArray ]. - ^string <=> aCharacterArray asString! Item was removed: - ----- 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: [ ^string = other string ]. - other isString ifTrue: [ ^string = other ]. - ^false! Item was removed: - ----- Method: Text>>addAllAttributes: (in category 'emphasis') ----- - addAllAttributes: attributes - - attributes do: [:attribute | - self addAttribute: attribute].! Item was removed: - ----- Method: Text>>addAllAttributes:from:to: (in category 'emphasis') ----- - addAllAttributes: attributes from: start to: stop - - attributes do: [:attribute | - self addAttribute: attribute from: start to: stop].! Item was removed: - ----- Method: Text>>addAttribute: (in category 'emphasis') ----- - addAttribute: att - ^ self addAttribute: att from: 1 to: self size! Item was removed: - ----- 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) - replace: - [:attributes | Text addAttribute: att toArray: attributes]) - ! Item was removed: - ----- Method: Text>>addAttribute:unless: (in category 'emphasis') ----- - addAttribute: anAttribute unless: aBlock - "Only add anAttribute when aBlock evaluates to false. Can be used to avoid overwriting existing attributes without knowing exactly where they are. Kind of complements the #dominates: protocol in TextAttribute." - - | offset | - self flag: #performance. "mt: Can we do this faster?" - runs copy withIndexDo: [:attrs :index | - (aBlock cull: attrs cull: index) - ifFalse: [offset ifNil: [ - offset := index]] - ifTrue: [offset ifNotNil: [ - self addAttribute: anAttribute from: offset to: index - 1. - offset := nil]]]. - offset ifNotNil: [ - self addAttribute: anAttribute from: offset to: self size].! Item was removed: - ----- Method: Text>>alignmentAt:ifAbsent: (in category 'emphasis') ----- - alignmentAt: characterIndex ifAbsent: aBlock - | attributes emph | - self size = 0 ifTrue: [^aBlock value]. - emph := nil. - attributes := runs atPin: characterIndex. - attributes do:[:att | (att isKindOf: TextAlignment) ifTrue:[emph := att]]. - emph ifNil: [ ^aBlock value ]. - ^emph alignment! Item was removed: - ----- 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! Item was removed: - ----- Method: Text>>append: (in category 'accessing') ----- - append: stringOrText - - self replaceFrom: string size + 1 - to: string size with: stringOrText! Item was removed: - ----- Method: Text>>applyLanguageInformation: (in category 'accessing') ----- - applyLanguageInformation: aLanguage - "Apply language-specific information to the receiver. Note that aLanguage can be an instance of Locale or LanguageEnvironment here." - - self flag: #todo. "mt: Add and use a TextLanguage attribute to avoid having to modify the receiver's string contents. Then we could directly use locale or locale-id and avoid Squeak's custom leadingChar. Maybe the some language info (or sane defaults) can be derived from Unicode code points and blocks." - self string applyLanguageInformation: aLanguage.! Item was removed: - ----- Method: Text>>asDisplayText (in category 'converting') ----- - asDisplayText - "Answer a DisplayText whose text is the receiver." - - ^DisplayText text: self! Item was removed: - ----- Method: Text>>asNumber (in category 'converting') ----- - asNumber - "Answer the number created by interpreting the receiver as the textual - representation of a number." - - ^string asNumber! Item was removed: - ----- Method: Text>>asOctetStringText (in category 'converting') ----- - asOctetStringText - - string class == WideString ifTrue: [ - ^ self class string: string asOctetString runs: self runs copy. - ]. - ^self. - ! Item was removed: - ----- Method: Text>>asString (in category 'converting') ----- - asString - "Answer a String representation of the textual receiver." - - ^string! Item was removed: - ----- Method: Text>>asStringOrText (in category 'converting') ----- - asStringOrText - "Answer the receiver itself." - - ^self! Item was removed: - ----- Method: Text>>asStringToHtml (in category 'converting') ----- - asStringToHtml - "Inverse to String >> #asTextFromHtml" - - ^ self printHtmlString! Item was removed: - ----- Method: Text>>asSymbol (in category 'converting') ----- - asSymbol - - ^ self asString asSymbol - ! Item was removed: - ----- Method: Text>>asText (in category 'converting') ----- - asText - "Answer the receiver itself." - - ^self! Item was removed: - ----- Method: Text>>at: (in category 'accessing') ----- - at: index - - ^string at: index! Item was removed: - ----- Method: Text>>at:put: (in category 'accessing') ----- - at: index put: character - - ^string at: index put: character! Item was removed: - ----- 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 atPin: characterIndex. - ^ attributes! Item was removed: - ----- 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 atPin: characterIndex) do: aBlock! Item was removed: - ----- Method: Text>>attributesAt:forStyle: (in category 'emphasis') ----- - attributesAt: characterIndex forStyle: aTextStyle - "Answer text attributes for characters in the run beginning at characterIndex." - - ^ self - ifEmpty: [#("Rely on TextStyle >> #defaultFontIndex")] - ifNotEmpty: [runs atPin: characterIndex]! Item was removed: - ----- Method: Text>>colorAt: (in category 'emphasis') ----- - colorAt: characterIndex - - ^ self colorAt: characterIndex ifNone: [Color black]! Item was removed: - ----- Method: Text>>colorAt:ifNone: (in category 'emphasis') ----- - colorAt: characterIndex ifNone: block - - self size = 0 ifTrue: [^ block value]. "null text tolerates access." - - ^ (runs atPin: characterIndex) - detect: [:attr | attr class == TextColor] - ifFound: [:attr | attr color] - ifNone: block! Item was removed: - ----- 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]. - ^self class - string: (string copyFrom: realStart to: realStop) - runs: (runs copyFrom: realStart to: realStop)! Item was removed: - ----- 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) - ! Item was removed: - ----- 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'"! Item was removed: - ----- 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! Item was removed: - ----- Method: Text>>deepCopy (in category 'copying') ----- - deepCopy - - ^ self copy "Both string and runs are assumed to be read-only"! Item was removed: - ----- Method: Text>>emphasisAt: (in category 'emphasis') ----- - emphasisAt: characterIndex - "Answer the fontfor characters in the run beginning at characterIndex." - | attributes | - self size = 0 ifTrue: [^ 0]. "null text tolerates access" - attributes := runs atPin: characterIndex. - ^attributes inject: 0 into: - [:emph :att | emph bitOr: att emphasisCode]. - ! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- Method: Text>>fontAt:withDefault: (in category 'emphasis') ----- - fontAt: characterIndex withDefault: aFont - "Answer the font for characters in the run beginning at characterIndex." - - | attributes font | - self size = 0 ifTrue: [^ aFont]. "null text tolerates access" - attributes := runs atPin: characterIndex. - font := aFont. "default" - attributes do: [:att | att forFontInStyle: nil do: [:f | font := f]]. - ^ font! Item was removed: - ----- 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 atPin: characterIndex. - font := aTextStyle defaultFont. "default" - attributes do: - [:att | att forFontInStyle: aTextStyle do: [:f | font := f]]. - ^ font! Item was removed: - ----- 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 atPin: characterIndex. - fontNumber := 1. - attributes do: [:att | (att isMemberOf: TextFontChange) ifTrue: [fontNumber := att fontNumber]]. - ^ fontNumber - ! Item was removed: - ----- Method: Text>>format: (in category 'formatting') ----- - format: arguments - "Format the receiver with arguments, respecting the attributes in both receiver and all collection elements that are texts. - - Complete example: - '\{ \} \\ <b>foo {1}</b> <u>bar {2}</u>' asTextFromHtml format: {12. 't<i>ex</i>t' asTextFromHtml}. - " - - ^ self class new: self size * 11 // 10 "+10%" streamContents: [ :output | - | nextIndex | - nextIndex := 1. - [ nextIndex <= self size ] whileTrue: [ - (self at: nextIndex) caseOf: { - [ $\ ] -> [ - nextIndex := nextIndex + 1. - output withAttributes: (runs at: nextIndex) do: [ - output nextPut: (self at: nextIndex) ] ]. - [ ${ ] -> [ - "Parse the index - a positive integer in base 10." - | digitValue collectionIndex attributes | - collectionIndex := 0. - attributes := Set new. - [ (digitValue := string basicAt: (nextIndex := nextIndex + 1)) between: 48 "$0 asciiValue" and: 57 "$9 asciiValue" ] whileTrue: [ - collectionIndex := collectionIndex * 10 + digitValue - 48 "$0 asciiValue". - attributes addAll: (runs at: nextIndex) ]. - digitValue = 125 "$} asciiValue" ifFalse: [ self error: ('{1} expected' translated format: {$}}) ]. - output withAttributes: attributes do: [ - output nextPutAll: (arguments at: collectionIndex) asStringOrText ] ] } - otherwise: [ - output withAttributes: (runs at: nextIndex) do: [ - output nextPut: (self at: nextIndex) ] ]. - nextIndex := nextIndex + 1 ] ]! Item was removed: - ----- Method: Text>>hasClickableAttribute (in category 'testing') ----- - hasClickableAttribute - - ^ self runs anySatisfy: [:attrs | attrs anySatisfy: [:attr | - attr respondsTo: #mayActOnClick]]! Item was removed: - ----- Method: Text>>hasColorAttribute (in category 'testing') ----- - hasColorAttribute - - ^ self runs anySatisfy: [:attrs | attrs anySatisfy: [:attr | - attr respondsTo: #color]]! Item was removed: - ----- Method: Text>>hasFontAttribute (in category 'testing') ----- - hasFontAttribute - - ^ self runs anySatisfy: [:attrs | attrs anySatisfy: [:attr | - (attr respondsTo: #fontNumber) or: [attr respondsTo: #font]]]! Item was removed: - ----- 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! Item was removed: - ----- Method: Text>>hashWithInitialHash: (in category 'comparing') ----- - hashWithInitialHash: initialHash - "Implemented to be polymorphic with String" - ^ self string hashWithInitialHash: initialHash - ! Item was removed: - ----- Method: Text>>howManyMatch: (in category 'comparing') ----- - howManyMatch: aString - - ^ self string howManyMatch: aString! Item was removed: - ----- Method: Text>>indentationAmountAt: (in category 'attributes') ----- - indentationAmountAt: anInterval - anInterval do: - [ : position | self - attributesAt: position - do: [ : attr | attr isTextIndent ifTrue: [ ^ attr amount ] ] ]. - ^ 0! Item was removed: - ----- Method: Text>>isText (in category 'testing') ----- - isText - ^ true! Item was removed: - ----- Method: Text>>isoToSqueak (in category 'converting') ----- - isoToSqueak - ^self "no longer needed"! Item was removed: - ----- Method: Text>>lineCount (in category 'accessing') ----- - lineCount - - ^ string lineCount! Item was removed: - ----- Method: Text>>macToSqueak (in category 'converting') ----- - macToSqueak - "Convert the receiver from MacRoman to Squeak encoding" - ^ self class new setString: string macToSqueak setRuns: runs copy! Item was removed: - ----- Method: Text>>makeBoldFrom:to: (in category 'emphasis') ----- - makeBoldFrom: start to: stop - - ^ self addAttribute: TextEmphasis bold from: start to: stop! Item was removed: - ----- 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 newParser) parseSelector: string] on: Error do: [^ self]. - self makeBoldFrom: 1 to: (parser endOfLastToken min: string size)! Item was removed: - ----- 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 newParser) parseSelector: string. - self makeBoldFrom: 1 to: (parser endOfLastToken min: string size)! Item was removed: - ----- Method: Text>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - string := string copy. - runs := runs copy! Item was removed: - ----- Method: Text>>prepend: (in category 'accessing') ----- - prepend: stringOrText - - self replaceFrom: 1 to: 0 with: stringOrText! Item was removed: - ----- Method: Text>>printHtmlOn: (in category 'html') ----- - printHtmlOn: aStream - - ^ self - printHtmlOn: aStream - breakLines: true! Item was removed: - ----- Method: Text>>printHtmlOn:breakLines: (in category 'html') ----- - printHtmlOn: aStream breakLines: aBoolean - - (HtmlReadWriter on: aStream) - breakLines: aBoolean; - nextPutText: self.! Item was removed: - ----- Method: Text>>printHtmlString (in category 'html') ----- - printHtmlString - "answer a string whose characters are the html representation - of the receiver" - - ^ String streamContents: [:stream | - self printHtmlOn: stream]! Item was removed: - ----- Method: Text>>printOn: (in category 'printing') ----- - printOn: aStream - self printNameOn: aStream. - aStream nextPutAll: ' for '; print: string! Item was removed: - ----- 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]! Item was removed: - ----- Method: Text>>removeAllAttributes (in category 'converting') ----- - removeAllAttributes - - runs := RunArray new: self size withAll: #().! Item was removed: - ----- 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) - replace: - [:attributes | attributes copyWithout: att]) - ! Item was removed: - ----- Method: Text>>removeAttributesThat: (in category 'converting') ----- - removeAttributesThat: removalBlock - "Enumerate all attributes in the receiver. Remove those passing removalBlock." - - self - removeAttributesThat: removalBlock - replaceAttributesThat: [:att | false] - by: nil.! Item was removed: - ----- 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. All blocks may also accept a second and third argument indicating the start and stop positions of the current attribute." - | added removed | - "Deliberately optimized for the no-op default." - added := removed := nil. - runs withStartStopAndValueDo: [ :start :stop :attribs | - attribs do: [ :attrib | | new | - (removalBlock cull: attrib cull: start cull: stop) ifTrue:[ - removed ifNil:[removed := WriteStream on: #()]. - removed nextPut: {start. stop. attrib}. - ] ifFalse:[ - (replaceBlock cull: attrib cull: start cull: stop) ifTrue:[ - removed ifNil:[removed := WriteStream on: #()]. - removed nextPut: {start. stop. attrib}. - new := convertBlock cull: attrib cull: start cull: stop. - 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]].! Item was removed: - ----- Method: Text>>replaceAttributesThat:by: (in category 'converting') ----- - replaceAttributesThat: replaceBlock by: convertBlock - "Enumerate all attributes in the receiver. Replace those passing replaceBlock after converting it through convertBlock." - - self - removeAttributesThat: [:att | false] - replaceAttributesThat: replaceBlock - by: convertBlock.! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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. "! Item was removed: - ----- 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! Item was removed: - ----- Method: Text>>runs (in category 'private') ----- - runs - - ^runs! Item was removed: - ----- Method: Text>>runs: (in category 'accessing') ----- - runs: anArray - - runs := anArray! Item was removed: - ----- Method: Text>>setString:setRuns: (in category 'private') ----- - setString: aString setRuns: anArray - - string := aString. - runs := anArray! Item was removed: - ----- Method: Text>>setString:setRunsChecking: (in category 'private') ----- - setString: aString setRunsChecking: aRunArray - | stringSize runsSize | - string := aString. - aRunArray ifNil: [^ aString asText]. - - "Check runs and do the best you can to make them fit..." - aRunArray runs size = aRunArray values size ifFalse: [^ aString asText]. "raise error here?" - runsSize := aRunArray size. - stringSize := string size. - runs := stringSize = runsSize - ifTrue: [aRunArray] - ifFalse: [ stringSize > runsSize - ifTrue: [aRunArray add: {} withOccurrences: stringSize - runsSize] - ifFalse: [aRunArray copyFrom: 1 to: stringSize]].! Item was removed: - ----- Method: Text>>size (in category 'accessing') ----- - size - - ^string size! Item was removed: - ----- Method: Text>>squeakToIso (in category 'converting') ----- - squeakToIso - ^self "no longer needed"! Item was removed: - ----- Method: Text>>squeakToMac (in category 'converting') ----- - squeakToMac - "Convert the receiver from Squeak to MacRoman encoding" - ^ self class new setString: string squeakToMac setRuns: runs copy! Item was removed: - ----- Method: Text>>storeOn: (in category 'printing') ----- - storeOn: aStream - - aStream nextPutAll: '(Text string: '; - store: string; - nextPutAll: ' runs: '; - store: runs; - nextPut: $)! Item was removed: - ----- Method: Text>>string (in category 'accessing') ----- - string - "Answer the string representation of the receiver." - - ^string! Item was removed: - ----- Method: Text>>unembellished (in category 'testing') ----- - unembellished - "Return true if the only emphases are the default font and bold" - | font1 bold | - font1 := TextFontChange defaultFontChange. - bold := TextEmphasis bold. - Text 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! Item was removed: - ----- Method: Text>>withBlanksTrimmed (in category 'converting') ----- - withBlanksTrimmed - "Return a copy of the receiver from which leading and trailing blanks have been trimmed." - - | first last | - first := string indexOfAnyOf: CharacterSet nonSeparators startingAt: 1. - first = 0 ifTrue: [ ^'' ]. "no non-separator character" - last := string lastIndexOfAnyOf: CharacterSet nonSeparators startingAt: self size ifAbsent: [self size]. - (first = 1 and: [ last = self size ]) ifTrue: [ ^self copy ]. - ^self - copyFrom: first - to: last - ! Item was removed: - ----- Method: Text>>withNoLineLongerThan: (in category 'converting') ----- - withNoLineLongerThan: numChars - "Font-specific version of String >> #withNoLineLongerThan: that supports font family and point size changes throughout the text. Compose the receiver's contents and answer a text that has all soft line breaks converted to hard line breaks. - NOTE THAT while we keep the name from the String protocol, it will happen that some lines are longer or shorter than numChars because composition happens in a rectangle. If you want a character-perfect result, call #withNoLineLongerThan: on the receiver's string contents. The average length of a line, however, will approximate numChars. - (Note that, in Morphic, you can use TextMorph if you want to keep the soft line breaks and not modify the text contents.)" - - | style paragraph | - self ifEmpty: [^ self copy]. - - (self environment classNamed: #NewParagraph) - ifNil: [^ (self asString withNoLineLongerThan: numChars) asText] - ifNotNil: [:paragraphClass | paragraph := paragraphClass new]. - - "Configure the paragraph with a text style. Use the default text style only if the receiver has no custom font set for the first character. In that case, use the style that comes with that custom font. Use #asNewTextStyle to create a copy that has the correct #defaultFont (and point size) set." - paragraph - compose: self - style: (style := (self fontAt: 1 withStyle: TextStyle default) - asNewTextStyle) - from: 1 - in: (0 at 0 extent: (style compositionWidthFor: numChars) @ 9999999). - - ^ paragraph asTextWithLineBreaks! Item was removed: - ----- 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.! Item was removed: - ----- Method: Text>>withoutLeadingBlanks (in category 'converting') ----- - withoutLeadingBlanks - "Return a copy of the receiver from which leading blanks have been trimmed." - - | first | - first := string indexOfAnyOf: CharacterSet nonSeparators startingAt: 1. - first = 0 ifTrue: [ ^'' ]. "no non-separator character" - first = 1 ifTrue: [ ^self copy ]. - ^self - copyFrom: first - to: self size - ! Item was removed: - TextAttribute subclass: #TextAction - instanceVariableNames: '' - classVariableNames: 'Purple' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextAction class>>applyUserInterfaceTheme (in category 'preferences') ----- - applyUserInterfaceTheme - - Purple := nil.! Item was removed: - ----- Method: TextAction class>>initialize (in category 'class initialization') ----- - initialize "TextAction initialize" - Purple := Color r: 0.4 g: 0 b: 1.0! Item was removed: - ----- Method: TextAction class>>themePriority (in category 'preferences') ----- - themePriority - - ^ 60! Item was removed: - ----- Method: TextAction class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ super themeProperties, { - { #color. 'Colors'. 'Color for clickable text links.' } - } ! Item was removed: - ----- Method: TextAction>>actionColor (in category 'accessing') ----- - actionColor - - ^ Purple ifNil: [Purple := self userInterfaceTheme color ifNil: [Color r: 0.4 g: 0.0 b: 1]]! Item was removed: - ----- Method: TextAction>>analyze: (in category 'initialize-release') ----- - 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 multiline or of the form: - 3+4 - <3+4> - Click Here<3+4> - <3+4>Click Here - " - "Obtain the showing text and the instructions" - | b1 b2 singleLine trim param show | - b1 := aString indexOf: $<. - b2 := aString indexOf: $>. - singleLine := aString lineCount = 0. - (singleLine or: [(b1 < b2) & (b1 > 0)]) ifFalse: ["only one part" - param := self validate: aString. - param ifNil: [ ^{ nil. nil } ]. - ^ Array with: param with: (param size = 0 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 ifFalse: [param]] - ifFalse: ["at the front" - param := self validate: (aString copyFrom: b1+1 to: b2-1). - show := param size = 0 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 ifFalse: [aString copyFrom: 1 to: b1-1]] - ifFalse: ["Arbitrary string. Let the compiler handle the complete string" - param := self validate: aString. - param ifNil: [ ^{ nil. nil }]. - show := (param size = 0 ifFalse: [param])]]. - ^ Array with: param with: show - ! Item was removed: - ----- Method: TextAction>>applyUserInterfaceTheme (in category 'updating') ----- - applyUserInterfaceTheme - - "Ignore. Only class-side cache."! Item was removed: - ----- Method: TextAction>>canApplyUserInterfaceTheme (in category 'updating') ----- - canApplyUserInterfaceTheme - - ^ false! Item was removed: - ----- Method: TextAction>>couldDeriveFromPrettyPrinting (in category 'testing') ----- - couldDeriveFromPrettyPrinting - ^ false! Item was removed: - ----- Method: TextAction>>dominatedByCmd0 (in category 'testing') ----- - dominatedByCmd0 - "Cmd-0 should turn off active text" - ^ true! Item was removed: - ----- Method: TextAction>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Set the emphasis for text display" - - scanner textColor: self actionColor.! Item was removed: - ----- Method: TextAction>>info (in category 'accessing') ----- - info - ^ 'no hidden info'! Item was removed: - ----- Method: TextAction>>mayActOnClick (in category 'testing') ----- - mayActOnClick - - ^ true! Item was removed: - ----- Method: TextAction>>validate: (in category 'initialize-release') ----- - validate: aString - "any format is OK with me" - ^ aString! Item was removed: - TextAttribute subclass: #TextAlignment - instanceVariableNames: 'alignment' - classVariableNames: '' - poolDictionaries: 'TextConstants' - category: 'Collections-Text'! Item was removed: - ----- Method: TextAlignment class>>alignmentSymbol: (in category 'as yet unclassified') ----- - alignmentSymbol: alignmentCode - ^#(leftFlush rightFlush centered justified) at: (alignmentCode + 1)! Item was removed: - ----- Method: TextAlignment class>>centered (in category 'instance creation') ----- - centered - ^self new alignment: Centered! Item was removed: - ----- Method: TextAlignment class>>justified (in category 'instance creation') ----- - justified - ^self new alignment: Justified! Item was removed: - ----- Method: TextAlignment class>>leftFlush (in category 'instance creation') ----- - leftFlush - ^self new alignment: LeftFlush! Item was removed: - ----- Method: TextAlignment class>>rightFlush (in category 'instance creation') ----- - rightFlush - ^self new alignment: RightFlush! Item was removed: - ----- Method: TextAlignment class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$a! Item was removed: - ----- Method: TextAlignment class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - ^self new alignment: (Integer readFrom: strm ifFail: [0])! Item was removed: - ----- Method: TextAlignment>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other alignment = alignment]! Item was removed: - ----- Method: TextAlignment>>alignment (in category 'accessing') ----- - alignment - ^alignment! Item was removed: - ----- Method: TextAlignment>>alignment: (in category 'accessing') ----- - alignment: aNumber - alignment := aNumber.! Item was removed: - ----- Method: TextAlignment>>closeHtmlOn: (in category 'html') ----- - closeHtmlOn: aHtmlReadWriter - - self alignment = Centered ifTrue: [aHtmlReadWriter nextPutAll: '</center>']. - ({ Justified. LeftFlush. RightFlush. } includes: self alignment) - ifTrue: [aHtmlReadWriter nextPutAll: '</div>']. - ! Item was removed: - ----- Method: TextAlignment>>dominates: (in category 'testing') ----- - dominates: other - "Alignment dominates other alignments or indentations." - ^ other isTextAlignment or: [ other isTextIndent ]! Item was removed: - ----- Method: TextAlignment>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Set the emphasist for text scanning" - scanner setAlignment: alignment.! Item was removed: - ----- Method: TextAlignment>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^ alignment hash! Item was removed: - ----- Method: TextAlignment>>isTextAlignment (in category 'testing') ----- - isTextAlignment - ^ true! Item was removed: - ----- Method: TextAlignment>>openHtmlOn: (in category 'html') ----- - openHtmlOn: aHtmlReadWriter - - self alignment = Centered ifTrue: [aHtmlReadWriter nextPutAll: '<center>']. - self alignment = Justified ifTrue: [aHtmlReadWriter nextPutAll: '<div align=justify>']. - self alignment = LeftFlush ifTrue: [aHtmlReadWriter nextPutAll: '<div align=left>']. - self alignment = RightFlush ifTrue: [aHtmlReadWriter nextPutAll: '<div align=right>']. - ! Item was removed: - ----- Method: TextAlignment>>shouldFormBlocks (in category 'testing') ----- - shouldFormBlocks - - ^ true! Item was removed: - ----- Method: TextAlignment>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - strm nextPut: self class scanCharacter. - alignment printOn: strm.! Item was removed: - 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. - ! Item was removed: - ----- Method: TextAttribute class>>classFor: (in category 'fileIn/Out') ----- - classFor: scanCharacter - "Answer the class that uses scanCharacter to identify itself in a text fileout" - ^ self allSubclasses detect: [:cls | cls scanCharacters includes: scanCharacter] - ! Item was removed: - ----- Method: TextAttribute class>>consumeIdentifierFrom: (in category 'fileIn/Out') ----- - consumeIdentifierFrom: scanStream. - "When scanning, a subclass may require access to the identifier character. - Otherwise, consume it here." - scanStream next! Item was removed: - ----- Method: TextAttribute class>>newFrom: (in category 'instance creation') ----- - newFrom: scanStream - "scanStream contains a class identifier character possibly followed by data" - | cls | - cls := self classFor: scanStream peek. - cls consumeIdentifierFrom: scanStream. - ^cls scanFrom: scanStream! Item was removed: - ----- Method: TextAttribute class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^nil! Item was removed: - ----- Method: TextAttribute class>>scanCharacters (in category 'fileIn/Out') ----- - scanCharacters - "All scan characters corresponding to the given class. Usually this is an array of one." - ^Array with: self scanCharacter! Item was removed: - ----- Method: TextAttribute class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - "Read the text attribute properties from the stream. When this method has - been called the concrete TextAttribute class has already been selected via - scanCharacter. (see TextAttribute class>>#newFrom:). - For writing the format see TextAttribute>>#writeScanOn:"! Item was removed: - ----- Method: TextAttribute>>actOnClickFor: (in category 'mouse events') ----- - actOnClickFor: model - "Subclasses may override to provide, eg, hot-spot actions" - ^ false! Item was removed: - ----- Method: TextAttribute>>actOnClickFor:in: (in category 'mouse events') ----- - actOnClickFor: model in: aParagraph - ^self actOnClickFor: model! Item was removed: - ----- Method: TextAttribute>>actOnClickFor:in:at: (in category 'mouse events') ----- - actOnClickFor: model in: aParagraph at: clickPoint - ^self actOnClickFor: model in: aParagraph! Item was removed: - ----- Method: TextAttribute>>actOnClickFor:in:at:editor: (in category 'mouse events') ----- - actOnClickFor: model in: aParagraph at: clickPoint editor: editor - ^self actOnClickFor: model in: aParagraph at: clickPoint! Item was removed: - ----- Method: TextAttribute>>anchoredMorph (in category 'accessing') ----- - anchoredMorph - "If one hides here, return it" - ^nil! Item was removed: - ----- 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! Item was removed: - ----- Method: TextAttribute>>couldDeriveFromPrettyPrinting (in category 'testing') ----- - 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! Item was removed: - ----- Method: TextAttribute>>dominatedByCmd0 (in category 'testing') ----- - dominatedByCmd0 - "Subclasses may override if cmd-0 should turn them off" - ^ false! Item was removed: - ----- Method: TextAttribute>>dominates: (in category 'testing') ----- - dominates: another - "Subclasses may override condense multiple attributes" - ^ false! Item was removed: - ----- Method: TextAttribute>>emphasisCode (in category 'accessing') ----- - emphasisCode - "Subclasses may override to add bold, italic, etc" - ^ 0! Item was removed: - ----- Method: TextAttribute>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Subclasses may override to set, eg, font, color, etc"! Item was removed: - ----- Method: TextAttribute>>forFontInStyle:do: (in category 'private') ----- - forFontInStyle: aTextStyle do: aBlock - "No action is the default. Overridden by font specs"! Item was removed: - ----- Method: TextAttribute>>isKern (in category 'testing') ----- - isKern - ^false! Item was removed: - ----- Method: TextAttribute>>isOblivious (in category 'testing') ----- - isOblivious - "Mark text attributes to be removed upon interaction such as copy-and-paste." - - ^ false! Item was removed: - ----- Method: TextAttribute>>isTextAlignment (in category 'testing') ----- - isTextAlignment - ^ false! Item was removed: - ----- Method: TextAttribute>>isTextFontChange (in category 'testing') ----- - isTextFontChange - ^ false! Item was removed: - ----- Method: TextAttribute>>isTextIndent (in category 'testing') ----- - isTextIndent - ^ false! Item was removed: - ----- Method: TextAttribute>>mayActOnClick (in category 'testing') ----- - mayActOnClick - "Subclasses may override to provide, eg, hot-spot actions" - ^ false! Item was removed: - ----- Method: TextAttribute>>mayBeExtended (in category 'testing') ----- - mayBeExtended - "A quality that may be overridden by subclasses, such as TextAnchors, that really only apply to a single character" - ^ true! Item was removed: - ----- Method: TextAttribute>>menu (in category 'accessing') ----- - menu - ^nil! Item was removed: - ----- Method: TextAttribute>>oldEmphasisCode: (in category 'accessing') ----- - oldEmphasisCode: default - "Allows running thorugh possibly multiple attributes - and getting the emphasis out of any that has an emphasis (font number)" - ^ default! Item was removed: - ----- 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! Item was removed: - ----- Method: TextAttribute>>reset (in category 'initialize-release') ----- - reset - "Allow subclasses to prepare themselves for merging attributes"! Item was removed: - ----- Method: TextAttribute>>set (in category 'accessing') ----- - set - "Respond true to include this attribute (as opposed to, eg, a bold - emphasizer that is clearing the property" - ^ true! Item was removed: - ----- Method: TextAttribute>>shouldFormBlocks (in category 'html') ----- - shouldFormBlocks - " whether this attribute should form larger blocks even if split up for combination with other attributes " - ^ false! Item was removed: - ----- Method: TextAttribute>>turnOff (in category 'initialize-release') ----- - turnOff - "Backstop for TextEmphasis. Do nothing." - - self flag: #refactor. "mt: Needs clean-up together with of #dominates: is used in the image." - ! Item was removed: - ----- Method: TextAttribute>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - "Implement this method for a text attribute to define how it it should be written - to a serialized form of a text object. The form should correspond to the source - file format, i.e. use a scan character to denote its subclass. - As TextAttributes are stored in RunArrays, this method is mostly called from RunArray>>#write scan. - For reading the written information see TextAttribute class>>#scanFrom:" - - "Do nothing because of abstract class"! Item was removed: - 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.! Item was removed: - ----- Method: TextColor class>>black (in category 'constants') ----- - black - ^ self new color: Color black! Item was removed: - ----- Method: TextColor class>>blue (in category 'constants') ----- - blue - ^ self new color: Color blue! Item was removed: - ----- Method: TextColor class>>color: (in category 'instance creation') ----- - color: aColor - ^ self new color: aColor! Item was removed: - ----- Method: TextColor class>>cyan (in category 'constants') ----- - cyan - ^ self new color: Color cyan! Item was removed: - ----- Method: TextColor class>>gray (in category 'constants') ----- - gray - ^ self new color: Color gray! Item was removed: - ----- Method: TextColor class>>green (in category 'constants') ----- - green - ^ self new color: Color green! Item was removed: - ----- Method: TextColor class>>magenta (in category 'constants') ----- - magenta - ^ self new color: Color magenta! Item was removed: - ----- Method: TextColor class>>red (in category 'constants') ----- - red - ^ self new color: Color red! Item was removed: - ----- Method: TextColor class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$c! Item was removed: - ----- Method: TextColor class>>scanFrom: (in category 'fileIn/Out') ----- - 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)! Item was removed: - ----- Method: TextColor class>>white (in category 'constants') ----- - white - ^ self new color: Color white! Item was removed: - ----- Method: TextColor class>>yellow (in category 'constants') ----- - yellow - ^ self new color: Color yellow! Item was removed: - ----- Method: TextColor>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other color = color]! Item was removed: - ----- 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>'! Item was removed: - ----- Method: TextColor>>color (in category 'accessing') ----- - color - ^ color! Item was removed: - ----- Method: TextColor>>color: (in category 'accessing') ----- - color: aColor - color := aColor! Item was removed: - ----- Method: TextColor>>dominatedByCmd0 (in category 'testing') ----- - dominatedByCmd0 - "Cmd-0 should remove text color" - ^ true! Item was removed: - ----- Method: TextColor>>dominates: (in category 'scanning') ----- - dominates: other - ^ other class == self class! Item was removed: - ----- Method: TextColor>>emphasizeScanner: (in category 'scanning') ----- - emphasizeScanner: scanner - "Set the emphasis for text display" - scanner textColor: color! Item was removed: - ----- Method: TextColor>>hash (in category 'comparing') ----- - hash - ^ color hash! Item was removed: - ----- 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 , '">'! Item was removed: - ----- Method: TextColor>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPutAll: ' code: '; print: color! Item was removed: - ----- Method: TextColor>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - "Two formats. c125000255 or cblue;" - - | nn | - strm nextPut: self class scanCharacter. - (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 | - str := '000', (float * 255) asInteger printString. - strm nextPutAll: (str copyFrom: str size-2 to: str size)]! Item was removed: - TextAction subclass: #TextDoIt - instanceVariableNames: 'evalString' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextDoIt class>>evalString: (in category 'instance creation') ----- - evalString: str - ^ self new evalString: str! Item was removed: - ----- Method: TextDoIt class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$d! Item was removed: - ----- Method: TextDoIt class>>scanFrom: (in category 'fileIn/Out') ----- - 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! Item was removed: - ----- Method: TextDoIt>>= (in category 'comparing') ----- - = textAttribute - ^ textAttribute class == self class - and: [textAttribute evalString = evalString]! Item was removed: - ----- Method: TextDoIt>>actOnClickFor: (in category 'event handling') ----- - actOnClickFor: anObject - "Note: evalString gets evaluated IN THE CONTEXT OF anObject - -- meaning that self and all instVars are accessible" - Project current addDeferredUIMessage: [Compiler evaluate: evalString for: anObject]. - ^ true ! Item was removed: - ----- Method: TextDoIt>>analyze: (in category 'initialize-release') ----- - analyze: aString - - | list | - list := super analyze: aString. - evalString := (list at: 1) asString. - ^ list at: 2! Item was removed: - ----- Method: TextDoIt>>closeHtmlOn: (in category 'html') ----- - closeHtmlOn: aStream - - self evalString lines size > 1 ifTrue: [ - aStream - breakLines: true; - nextPutAll: '</pre>']. - aStream nextPutAll: '</code>'. - ! Item was removed: - ----- Method: TextDoIt>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - scanner addEmphasis: 4! Item was removed: - ----- Method: TextDoIt>>evalString (in category 'accessing') ----- - evalString - ^evalString! Item was removed: - ----- Method: TextDoIt>>evalString: (in category 'accessing') ----- - evalString: str - evalString := str ! Item was removed: - ----- Method: TextDoIt>>hash (in category 'comparing') ----- - hash - ^evalString hash! Item was removed: - ----- Method: TextDoIt>>info (in category 'accessing') ----- - info - ^ evalString! Item was removed: - ----- Method: TextDoIt>>openHtmlOn: (in category 'html') ----- - openHtmlOn: aStream - - aStream nextPutAll: '<code>'. - self evalString lines size > 1 ifTrue: [ - aStream - breakLines: false; - cr; - nextPutAll: '<pre>'].! Item was removed: - ----- Method: TextDoIt>>shouldFormBlocks (in category 'html') ----- - shouldFormBlocks - - ^ true! Item was removed: - ----- Method: TextDoIt>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - strm nextPut: self class scanCharacter; nextPutAll: evalString; nextPutAll: ';;'! Item was removed: - 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! Item was removed: - ----- Method: TextEmphasis class>>bold (in category 'instance creation') ----- - bold - ^ self new emphasisCode: 1! Item was removed: - ----- Method: TextEmphasis class>>consumeIdentifierFrom: (in category 'fileIn/Out') ----- - consumeIdentifierFrom: scanStream. - "Do not consume the identifier character. Leave it in the stream - for use in identifying the type of emphasis." - ! Item was removed: - ----- Method: TextEmphasis class>>italic (in category 'instance creation') ----- - italic - ^ self new emphasisCode: 2! Item was removed: - ----- Method: TextEmphasis class>>narrow (in category 'instance creation') ----- - narrow - ^ TextKern kern: -1! Item was removed: - ----- Method: TextEmphasis class>>normal (in category 'instance creation') ----- - normal - ^ self new emphasisCode: 0! Item was removed: - ----- Method: TextEmphasis class>>scanCharacters (in category 'fileIn/Out') ----- - scanCharacters - "All scan characters corresponding to this class. See writeScanOn:" - ^ #( $b $i $n $= $u )! Item was removed: - ----- Method: TextEmphasis class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - ^strm next - caseOf: { - [ $b ] -> [ self bold ] . - [ $i ] -> [ self italic ] . - [ $u ] -> [ self underlined ] . - [ $= ] -> [ self struckOut ] . - [ $n ] -> [ self normal ] - } - otherwise: [self error: 'unrecognized identifier ']! Item was removed: - ----- Method: TextEmphasis class>>struckOut (in category 'instance creation') ----- - struckOut - ^ self new emphasisCode: 16! Item was removed: - ----- Method: TextEmphasis class>>underlined (in category 'instance creation') ----- - underlined - ^ self new emphasisCode: 4! Item was removed: - ----- Method: TextEmphasis>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other emphasisCode = emphasisCode]! Item was removed: - ----- 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>']. - emphasisCode = 16 - ifTrue: [aStream nextPutAll: '</s>'].! Item was removed: - ----- Method: TextEmphasis>>dominatedByCmd0 (in category 'testing') ----- - dominatedByCmd0 - "Cmd-0 should turn off emphasis" - ^ true! Item was removed: - ----- Method: TextEmphasis>>dominates: (in category 'testing') ----- - dominates: other - (emphasisCode = 0 and: [other dominatedByCmd0]) ifTrue: [^ true]. - ^ (other class == self class) - and: [emphasisCode = other emphasisCode]! Item was removed: - ----- Method: TextEmphasis>>emphasisCode (in category 'accessing') ----- - emphasisCode - ^ emphasisCode! Item was removed: - ----- Method: TextEmphasis>>emphasisCode: (in category 'initialize-release') ----- - emphasisCode: int - emphasisCode := int. - setMode := true! Item was removed: - ----- Method: TextEmphasis>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Set the emphasist for text scanning" - scanner addEmphasis: emphasisCode! Item was removed: - ----- Method: TextEmphasis>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^emphasisCode hash - ! Item was removed: - ----- 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>']. - emphasisCode = 16 - ifTrue: [aStream nextPutAll: '<s>']! Item was removed: - ----- Method: TextEmphasis>>printOn: (in category 'printing') ----- - printOn: strm - super printOn: strm. - strm nextPutAll: ' code: '; print: emphasisCode! Item was removed: - ----- Method: TextEmphasis>>set (in category 'accessing') ----- - set - ^ setMode and: [emphasisCode ~= 0]! Item was removed: - ----- Method: TextEmphasis>>turnOff (in category 'initialize-release') ----- - turnOff - setMode := false! Item was removed: - ----- Method: TextEmphasis>>writeScanOn: (in category 'fileIn/fileOut') ----- - 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].! Item was removed: - 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.! Item was removed: - ----- Method: TextFontChange class>>defaultFontChange (in category 'instance creation') ----- - defaultFontChange - "Answer a TextFontChange that represents the default font" - - ^ self new fontNumber: TextStyle default defaultFontIndex! Item was removed: - ----- Method: TextFontChange class>>font1 (in category 'instance creation') ----- - font1 - ^ self new fontNumber: 1! Item was removed: - ----- Method: TextFontChange class>>font2 (in category 'instance creation') ----- - font2 - ^ self new fontNumber: 2! Item was removed: - ----- Method: TextFontChange class>>font3 (in category 'instance creation') ----- - font3 - ^ self new fontNumber: 3! Item was removed: - ----- Method: TextFontChange class>>font4 (in category 'instance creation') ----- - font4 - ^ self new fontNumber: 4! Item was removed: - ----- Method: TextFontChange class>>fontNumber: (in category 'instance creation') ----- - fontNumber: n - ^ self new fontNumber: n! Item was removed: - ----- Method: TextFontChange class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$f! Item was removed: - ----- Method: TextFontChange class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - ^self fontNumber: (Integer readFrom: strm ifFail: [0])! Item was removed: - ----- Method: TextFontChange>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other fontNumber = fontNumber]! Item was removed: - ----- Method: TextFontChange>>canFontBeSubstituted (in category 'testing') ----- - canFontBeSubstituted - "Generic font changes rely on text styles, which should always contain generic fonts." - - ^ true! Item was removed: - ----- 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! Item was removed: - ----- Method: TextFontChange>>dominatedByCmd0 (in category 'testing') ----- - dominatedByCmd0 - "Revert to default font using current paragraph's text style. See TextStyle >> #defaultFont." - - ^ true! Item was removed: - ----- Method: TextFontChange>>dominates: (in category 'testing') ----- - dominates: other - ^ other isKindOf: TextFontChange! Item was removed: - ----- Method: TextFontChange>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Set the font for text display" - scanner setFont: fontNumber! Item was removed: - ----- Method: TextFontChange>>fontNumber (in category 'accessing') ----- - fontNumber - ^ fontNumber! Item was removed: - ----- Method: TextFontChange>>fontNumber: (in category 'accessing') ----- - fontNumber: int - fontNumber := int! Item was removed: - ----- Method: TextFontChange>>forFontInStyle:do: (in category 'private') ----- - forFontInStyle: aTextStyleOrNil do: aBlock - - ^ aTextStyleOrNil ifNotNil: [aBlock value: (aTextStyleOrNil fontAt: fontNumber)]! Item was removed: - ----- Method: TextFontChange>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^fontNumber hash! Item was removed: - ----- Method: TextFontChange>>isTextFontChange (in category 'testing') ----- - isTextFontChange - ^ true! Item was removed: - ----- 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! Item was removed: - ----- Method: TextFontChange>>printOn: (in category 'printing') ----- - printOn: strm - super printOn: strm. - strm nextPutAll: ' font: '; print: fontNumber! Item was removed: - ----- Method: TextFontChange>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - strm nextPut: self class scanCharacter. - fontNumber printOn: strm.! Item was removed: - 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.! Item was removed: - ----- Method: TextFontReference class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$F! Item was removed: - ----- Method: TextFontReference class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - ^self toFont: - (StrikeFont familyName: (strm upTo: $#) size: (Number readFrom: strm ifFail: [0]))! Item was removed: - ----- Method: TextFontReference class>>toFont: (in category 'as yet unclassified') ----- - toFont: aFont - ^ self new toFont: aFont! Item was removed: - ----- Method: TextFontReference>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other font = font]! Item was removed: - ----- Method: TextFontReference>>canFontBeSubstituted (in category 'testing') ----- - canFontBeSubstituted - "Absolute font references can only be replaced if the referenced font has different glyphs for different characters." - - ^ (self font class name = #FixedFaceFont "e.g. password font" - or: [self font class name = #FormSetFont "e.g. embedded pictures/forms"]) not! Item was removed: - ----- Method: TextFontReference>>closeHtmlOn: (in category 'html') ----- - closeHtmlOn: aStream - - font closeHtmlOn: aStream.! Item was removed: - ----- Method: TextFontReference>>couldDeriveFromPrettyPrinting (in category 'testing') ----- - couldDeriveFromPrettyPrinting - ^ false! Item was removed: - ----- Method: TextFontReference>>emphasizeScanner: (in category 'initialize-release') ----- - emphasizeScanner: scanner - "Set the actual font for text display" - scanner setActualFont: font! Item was removed: - ----- Method: TextFontReference>>font (in category 'accessing') ----- - font - - ^ font! Item was removed: - ----- Method: TextFontReference>>forFontInStyle:do: (in category 'private') ----- - forFontInStyle: aTextStyle do: aBlock - aBlock value: font! Item was removed: - ----- Method: TextFontReference>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^font hash! Item was removed: - ----- Method: TextFontReference>>openHtmlOn: (in category 'html') ----- - openHtmlOn: aStream - - font openHtmlOn: aStream.! Item was removed: - ----- Method: TextFontReference>>printOn: (in category 'comparing') ----- - printOn: aStream - aStream nextPutAll: 'a TextFontReference('; - print: font; - nextPut: $)! Item was removed: - ----- Method: TextFontReference>>toFont: (in category 'initialize-release') ----- - toFont: aFont - - font := aFont! Item was removed: - ----- Method: TextFontReference>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - strm nextPut: self class scanCharacter. - strm nextPutAll: font familyName; nextPut: $#. - font height printOn: strm.! Item was removed: - TextAttribute subclass: #TextIndent - instanceVariableNames: 'amount' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! - - !TextIndent commentStamp: '<historical>' prior: 0! - create a hanging indent. ! Item was removed: - ----- 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! Item was removed: - ----- 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 at 0 extent: 100 at 200). - pg textStyle alignment: 2. - pg displayAt: 0 at 0. - ! Item was removed: - ----- Method: TextIndent class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^ $I! Item was removed: - ----- Method: TextIndent class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: aStream - - ^ self amount: (Integer readFrom: aStream)! Item was removed: - ----- Method: TextIndent class>>tabs: (in category 'instance creation') ----- - tabs: numTabs - "create an indentation by the given number of tabs" - ^self amount: numTabs! Item was removed: - ----- Method: TextIndent>>amount (in category 'accessing') ----- - amount - "number of tab spaces to indent by" - ^amount! Item was removed: - ----- Method: TextIndent>>amount: (in category 'accessing') ----- - amount: anInteger - "change the number of tabs to indent by" - amount := anInteger! Item was removed: - ----- Method: TextIndent>>dominates: (in category 'condensing') ----- - dominates: aTextAttribute - "Indentation should replace any existing alignment or indentation." - ^ aTextAttribute isTextIndent - or: [ aTextAttribute isTextAlignment ]! Item was removed: - ----- Method: TextIndent>>emphasizeScanner: (in category 'setting indentation') ----- - emphasizeScanner: scanner - scanner indentationLevel: amount! Item was removed: - ----- Method: TextIndent>>isTextIndent (in category 'testing') ----- - isTextIndent - ^ true! Item was removed: - ----- Method: TextIndent>>printOn: (in category 'printing') ----- - printOn: aStream - super printOn: aStream. - aStream nextPutAll: ' amount: '. - amount printOn: aStream! Item was removed: - ----- Method: TextIndent>>shouldFormBlocks (in category 'testing') ----- - shouldFormBlocks - - ^ true! Item was removed: - ----- Method: TextIndent>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: aStream - - aStream - nextPut: self class scanCharacter; - store: self amount.! Item was removed: - TextDoIt subclass: #TextInspectIt - instanceVariableNames: 'target' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextInspectIt class>>on: (in category 'instance creation') ----- - on: anObject - - ^ self new target: anObject; yourself! Item was removed: - ----- Method: TextInspectIt>>actOnClickFor:in:at:editor: (in category 'mouse events') ----- - 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" - Project current addDeferredUIMessage: [ - self target - ifNil: [(Compiler evaluate: evalString for: anObject) inspect] - ifNotNil: [:object | object inspect] ]. - ^ true ! Item was removed: - ----- Method: TextInspectIt>>emphasizeScanner: (in category 'accessing') ----- - emphasizeScanner: scanner - "Set the emphasis for text display" - - scanner textColor: self actionColor.! Item was removed: - ----- Method: TextInspectIt>>isOblivious (in category 'testing') ----- - isOblivious - "Avoid spreading object references by copy-and-paste." - - ^ true! Item was removed: - ----- Method: TextInspectIt>>target (in category 'accessing') ----- - target - - ^ target! Item was removed: - ----- Method: TextInspectIt>>target: (in category 'accessing') ----- - target: anObject - - target := anObject.! Item was removed: - 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. ! Item was removed: - ----- Method: TextKern class>>consumeIdentifierFrom: (in category 'fileIn/Out') ----- - consumeIdentifierFrom: scanStream. - "Do not consume the identifier character. Leave it in the stream - for use in identifying the kern value." - ! Item was removed: - ----- Method: TextKern class>>kern: (in category 'instance creation') ----- - kern: kernValue - ^ self new kern: kernValue! Item was removed: - ----- Method: TextKern class>>scanCharacters (in category 'fileIn/Out') ----- - scanCharacters - "All scan characters corresponding to this class. See writeScanOn:" - ^ #( $- $+ )! Item was removed: - ----- Method: TextKern class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - | char k | - char := strm next. - char = $+ - ifTrue: [ - k := 1. - [strm atEnd not and: [strm peek = char]] - whileTrue: [strm next. k := k + 1]. - ^ self kern: k]. - char = $- - ifTrue: [ - k := -1. - [strm atEnd not and: [strm peek = char]] - whileTrue: [strm next. k := k - 1]. - ^ self kern: k]. - self error: 'invalid identifier character' - - - ! Item was removed: - ----- Method: TextKern>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other kern = kern]! Item was removed: - ----- Method: TextKern>>couldDeriveFromPrettyPrinting (in category 'testing') ----- - couldDeriveFromPrettyPrinting - ^ false! Item was removed: - ----- Method: TextKern>>dominatedByCmd0 (in category 'testing') ----- - dominatedByCmd0 - "Cmd-0 should turn off kerning" - ^ true! Item was removed: - ----- Method: TextKern>>dominates: (in category 'testing') ----- - 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! Item was removed: - ----- Method: TextKern>>emphasizeScanner: (in category 'kerning') ----- - emphasizeScanner: scanner - "Augment (or diminish) the kerning offset for text display" - scanner addKern: kern! Item was removed: - ----- Method: TextKern>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^kern hash! Item was removed: - ----- Method: TextKern>>isKern (in category 'testing') ----- - isKern - ^true! Item was removed: - ----- Method: TextKern>>kern (in category 'accessing') ----- - kern - ^ kern! Item was removed: - ----- Method: TextKern>>kern: (in category 'initialize-release') ----- - kern: kernValue - kern := kernValue. - self reset.! Item was removed: - ----- Method: TextKern>>reset (in category 'initialize-release') ----- - reset - active := true! Item was removed: - ----- Method: TextKern>>set (in category 'initialize-release') ----- - set - ^ active! Item was removed: - ----- Method: TextKern>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - kern > 0 ifTrue: [ - 1 to: kern do: [:kk | strm nextPut: $+]]. - kern < 0 ifTrue: [ - 1 to: 0-kern do: [:kk | strm nextPut: $-]].! Item was removed: - TextAction subclass: #TextLink - instanceVariableNames: 'classAndMethod' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextLink class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$L! Item was removed: - ----- Method: TextLink class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - "read a link in the funny format used by Text styles on files. LPoint +;LPoint Comment;" - - ^ self new classAndMethod: (strm upTo: $;)! Item was removed: - ----- Method: TextLink>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other info = self info]! Item was removed: - ----- Method: TextLink>>actOnClickFor: (in category 'event handling') ----- - actOnClickFor: aMessageSet - "Add to the end of the list. 'aClass selector', 'aClass Comment', 'aClass Definition', 'aClass Hierarchy' are the formats allowed." - - Project current addDeferredUIMessage: [aMessageSet addItem: classAndMethod]. - ^ true! Item was removed: - ----- Method: TextLink>>analyze: (in category 'initialize-release') ----- - analyze: aString - - | list | - list := super analyze: aString. - classAndMethod := list at: 1. - ^ list at: 2! Item was removed: - ----- Method: TextLink>>analyze:with: (in category 'initialize-release') ----- - 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]] - ! Item was removed: - ----- Method: TextLink>>classAndMethod: (in category 'accessing') ----- - classAndMethod: aString - classAndMethod := aString! Item was removed: - ----- Method: TextLink>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^classAndMethod hash! Item was removed: - ----- Method: TextLink>>info (in category 'accessing') ----- - info - ^ classAndMethod! Item was removed: - ----- Method: TextLink>>validate: (in category 'initialize-release') ----- - 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' 'Help') 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]. - first := Symbol lookup: list first. - 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! Item was removed: - ----- Method: TextLink>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - strm nextPut: self class scanCharacter; nextPutAll: classAndMethod; nextPut: $;! Item was removed: - TextDoIt subclass: #TextPrintIt - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextPrintIt class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$P! Item was removed: - ----- Method: TextPrintIt>>actOnClickFor:in:at:editor: (in category 'mouse events') ----- - 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. - 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 ! Item was removed: - Object subclass: #TextReadWriter - instanceVariableNames: 'stream' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! - - !TextReadWriter commentStamp: 'mt 5/7/2016 10:22' prior: 0! - Subclasses of me provide means to create instances of Text from various document formats such as HTML (Hyper Text Markup Language), DOCX (Microsoft Word Document), ODF (Open Document Format), and RTF (Rich Text Format). They should also be able to write such formats.! Item was removed: - ----- Method: TextReadWriter class>>on: (in category 'instance creation') ----- - on: stream - - ^ self new on: stream! Item was removed: - ----- Method: TextReadWriter class>>textFromFileNamed: (in category 'instance creation') ----- - textFromFileNamed: fileName - - ^ self textFromStream: (FileStream readOnlyFileNamed: fileName)! Item was removed: - ----- Method: TextReadWriter class>>textFromStream: (in category 'instance creation') ----- - textFromStream: aBinaryStream - - | reader readerClass text | - readerClass := self. "no auto-detection yet" - aBinaryStream reset. - reader := readerClass new on: aBinaryStream. - Cursor read showWhile: [ - text := reader nextText. - reader close]. - ^ text - ! Item was removed: - ----- Method: TextReadWriter>>close (in category 'initialize-release') ----- - close - - stream close.! Item was removed: - ----- Method: TextReadWriter>>nextPutText: (in category 'accessing') ----- - nextPutText: aText - "Encoding aText on stream." - - self subclassResponsibility.! Item was removed: - ----- Method: TextReadWriter>>nextText (in category 'accessing') ----- - nextText - "Decoding a text object on stream and answer that text object." - - ^ self subclassResponsibility.! Item was removed: - ----- Method: TextReadWriter>>on: (in category 'initialize-release') ----- - on: aStream - - stream := aStream.! Item was removed: - 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:. - ! Item was removed: - ----- Method: TextSqkPageLink class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$q! Item was removed: - WriteStream subclass: #TextStream - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Streams'! Item was removed: - ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'private') ----- - applyAttribute: att beginningAt: startPos - collection addAttribute: att from: startPos to: self position! Item was removed: - ----- Method: TextStream>>nextPutAll: (in category 'writing') ----- - nextPutAll: aCollection - "Optimized access to get around Text at:Put: overhead" - | n | - n := aCollection size. - position + n > writeLimit - ifTrue: - [self growTo: position + n]. - collection - replaceFrom: position+1 - to: position + n - with: aCollection - startingAt: 1. - position := position + n. - ^aCollection! Item was removed: - ----- Method: TextStream>>withAttribute:do: (in category 'private') ----- - withAttribute: att do: strmBlock - | pos1 val | - pos1 := self position. - val := strmBlock value. - collection addAttribute: att from: pos1+1 to: self position. - ^ val! Item was removed: - ----- Method: TextStream>>withAttributes:do: (in category 'private') ----- - 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! Item was removed: - TextAction subclass: #TextURL - instanceVariableNames: 'url' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Text'! Item was removed: - ----- Method: TextURL class>>scanCharacter (in category 'fileIn/Out') ----- - scanCharacter - "The character used to identify a subclass of TextAttribute for filein and fileout" - ^$R! Item was removed: - ----- Method: TextURL class>>scanFrom: (in category 'fileIn/Out') ----- - scanFrom: strm - "read a link in the funny format used by Text styles on files. Rhttp://www.disney.com;" - - ^ self new url: (strm upTo: $;)! Item was removed: - ----- Method: TextURL class>>url: (in category 'instance creation') ----- - url: anUrl - - ^ self new - url: anUrl; - yourself! Item was removed: - ----- Method: TextURL>>= (in category 'comparing') ----- - = other - ^ (other class == self class) - and: [other info = self info]! Item was removed: - ----- Method: TextURL>>analyze: (in category 'initialize-release') ----- - analyze: aString - - | list answer | - list := super analyze: aString. - - answer := Project uiManager multiLineRequest: 'URL to open' translated centerAt: Sensor cursorPoint initialAnswer: (list at: 1) answerHeight: 200. - answer isEmptyOrNil ifTrue: [^ nil]. - url := answer. - - ^ list at: 2! Item was removed: - ----- Method: TextURL>>closeHtmlOn: (in category 'html') ----- - closeHtmlOn: aStream - - aStream nextPutAll: '</a>'.! Item was removed: - ----- Method: TextURL>>hash (in category 'comparing') ----- - hash - "#hash is re-implemented because #= is re-implemented" - ^url hash! Item was removed: - ----- Method: TextURL>>info (in category 'accessing') ----- - info - ^ url! Item was removed: - ----- Method: TextURL>>openHtmlOn: (in category 'html') ----- - openHtmlOn: aStream - - aStream - nextPutAll: '<a href="'; - nextPutAll: self url; - nextPutAll: '">'.! Item was removed: - ----- Method: TextURL>>url (in category 'accessing') ----- - url - ^ url! Item was removed: - ----- Method: TextURL>>url: (in category 'accessing') ----- - url: aString - url := aString! Item was removed: - ----- Method: TextURL>>writeScanOn: (in category 'fileIn/fileOut') ----- - writeScanOn: strm - - strm nextPut: self class scanCharacter; nextPutAll: url; nextPut: $;! Item was removed: - WriteStream subclass: #TranscriptStream - instanceVariableNames: 'lastChar lock' - classVariableNames: 'CharacterLimit ForceUpdate RedirectToStdOut' - poolDictionaries: '' - category: 'Collections-Streams'! - - !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' 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 designed to write to streams.! Item was removed: - ----- Method: TranscriptStream class>>characterLimit (in category 'preferences') ----- - characterLimit - <preference: 'Maximum number of characters in a transcript' - categoryList: #(printing morphic debug) - description: 'When the number of characters in a transcript exceeds this limit, characters at the start of the text are discarded.' - type: #Number> - ^CharacterLimit ifNil: [20000]! Item was removed: - ----- Method: TranscriptStream class>>characterLimit: (in category 'preferences') ----- - characterLimit: anInteger - - CharacterLimit := anInteger.! Item was removed: - ----- Method: TranscriptStream class>>forceUpdate (in category 'preferences') ----- - forceUpdate - - <preference: 'Force transcript updates to screen' - categoryList: #(printing morphic debug) - description: 'When enabled, transcript updates will immediately shown in the screen no matter how busy the UI process is.' - type: #Boolean> - ^ ForceUpdate ifNil: [true]! Item was removed: - ----- Method: TranscriptStream class>>forceUpdate: (in category 'preferences') ----- - forceUpdate: aBoolean - - ForceUpdate := aBoolean.! Item was removed: - ----- Method: TranscriptStream class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry. ! Item was removed: - ----- Method: TranscriptStream class>>new (in category 'instance creation') ----- - 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]]. - "! Item was removed: - ----- Method: TranscriptStream class>>newTranscript: (in category 'instance creation') ----- - newTranscript: aTextCollector - "Store aTextCollector as the value of the system global Transcript." - Smalltalk at: #Transcript put: aTextCollector! Item was removed: - ----- Method: TranscriptStream class>>redirectToStdOut (in category 'preferences') ----- - redirectToStdOut - <preference: 'Redirect transcript to stdout' - categoryList: #(printing morphic debug) - description: 'When enabled, anything sent to the transcript will be redirected to the stdout stream and (hopefully) the OS terminal.' - type: #Boolean> - ^ RedirectToStdOut ifNil: [false]! Item was removed: - ----- Method: TranscriptStream class>>redirectToStdOut: (in category 'preferences') ----- - redirectToStdOut: aBooleanOrNil - "In setting up redirection, first remove all dependents that are stdout, - which may include stale files from the last session. Then add a dependency - only if asked to redirect to stdout. Blithely doing - Transcript removeDependent: FileStream stdout - raises an error if stdout is unavailable." - Transcript dependents do: - [:dep| - (dep isStream and: [dep name = #stdout]) ifTrue: - [Transcript removeDependent: dep]]. - RedirectToStdOut := aBooleanOrNil. - self redirectToStdOut ifTrue: - [Transcript addDependent: FileStream stdout]! Item was removed: - ----- 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' translatedNoop. 'A Transcript is a window usable for logging and debugging; browse references to #Transcript for examples of how to write to it.' translatedNoop} - forFlapNamed: 'Tools'] - ! Item was removed: - ----- Method: TranscriptStream class>>themeProperties (in category 'preferences') ----- - themeProperties - - ^ Model themeProperties! Item was removed: - ----- Method: TranscriptStream class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: TranscriptStream>>addModelItemsToWindowMenu: (in category 'menu') ----- - addModelItemsToWindowMenu: aMenu - - aMenu addLine. - aMenu - add: 'clear' translated - target: self - action: #clear.! Item was removed: - ----- Method: TranscriptStream>>applyUserInterfaceTheme (in category 'model protocol') ----- - applyUserInterfaceTheme - - self dependents do: [:ea | - ea isSystemWindow ifTrue: [ - ea refreshWindowColor]].! Item was removed: - ----- Method: TranscriptStream>>bs (in category 'stream extensions') ----- - bs - self position > 0 ifTrue: [^ self skip: -1]. - self changed: #bs! Item was removed: - ----- Method: TranscriptStream>>characterLimit (in category 'accessing') ----- - characterLimit - "Tell the views how much to retain on screen" - ^self class characterLimit! Item was removed: - ----- Method: TranscriptStream>>clear (in category 'stream extensions') ----- - clear - "Clear all characters and redisplay the view" - self changed: #clearText. - self reset! Item was removed: - ----- Method: TranscriptStream>>closeAllViews (in category 'initialization') ----- - closeAllViews - "Transcript closeAllViews" - - self changed: #close - ! Item was removed: - ----- Method: TranscriptStream>>contents (in category 'accessing') ----- - contents - "Override to update lastChar." - position > 0 ifTrue: - [lastChar := collection at: position]. - ^super contents! Item was removed: - ----- Method: TranscriptStream>>countOpenTranscripts (in category 'private') ----- - countOpenTranscripts - "Transcript countOpenTranscripts" - - ^ (self dependents select: [:e | e isTextView]) size - ! Item was removed: - ----- Method: TranscriptStream>>endEntry (in category 'stream extensions') ----- - endEntry - "Display all the characters since the last endEntry, and reset the stream" - self lock critical: - [(self == Transcript and: [self class redirectToStdOut]) - ifTrue: - [FileStream stdout nextPutAll: self contents; flush] - ifFalse: - [self changed: (self class forceUpdate - ifTrue: [#appendEntry] - ifFalse: [#appendEntryLater])]. - self reset]! Item was removed: - ----- Method: TranscriptStream>>flush (in category 'stream extensions') ----- - flush - self endEntry - ! Item was removed: - ----- Method: TranscriptStream>>lock (in category 'private') ----- - lock - ^lock ifNil:[lock := Mutex new]! Item was removed: - ----- 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! Item was removed: - ----- Method: TranscriptStream>>peekLast (in category 'character writing') ----- - peekLast - "Return that item just put at the end of the stream" - - ^ position > 0 - ifTrue: [collection at: position] - ifFalse: [lastChar]! Item was removed: - ----- Method: TranscriptStream>>release (in category 'model protocol') ----- - release - - self dependents do: - [:view | (view isMorph and: [view isInWorld not]) - ifTrue: [self removeDependent: view]]! Item was removed: - ----- Method: TranscriptStream>>reset (in category 'positioning') ----- - reset - "Override to set lastChar" - position > 0 ifTrue: - [lastChar := collection at: position]. - ^super reset! Item was removed: - ----- Method: TranscriptStream>>show: (in category 'stream extensions') ----- - show: anObject - "TextCollector compatibility" - - [ - self nextPutAll: anObject asString. - self endEntry - ] on: FileWriteError do: [self class redirectToStdOut: false].! Item was removed: - ----- Method: TranscriptStream>>showln: (in category 'stream extensions') ----- - showln: anObject - "TextCollector compatibility. Ensure a new line before inserting a message." - - [ - self - cr; - nextPutAll: anObject asString. - self endEntry. - ] on: FileWriteError do: [self class redirectToStdOut: false].! Item was removed: - ----- Method: TranscriptStream>>step (in category 'model protocol') ----- - step - "Objects that may be models of SystemWindows need to respond to this, albeit vacuously"! Item was removed: - ----- Method: TranscriptStream>>target (in category 'stream extensions') ----- - target - ^(self == Transcript and: [self class redirectToStdOut]) - ifTrue: [FileStream stdout] - ifFalse: [self]! Item was removed: - ----- Method: TranscriptStream>>windowActiveOnFirstClick (in category 'model protocol') ----- - windowActiveOnFirstClick - - ^ Model windowActiveOnFirstClick! Item was removed: - ----- Method: TranscriptStream>>windowColorToUse (in category 'model protocol') ----- - windowColorToUse - - ^ Color colorFrom: (Model useColorfulWindows - ifTrue: [self userInterfaceTheme customWindowColor ifNil: [Color r: 0.9 g: 0.75 b: 0.45]] - ifFalse: [self userInterfaceTheme uniformWindowColor ifNil: [Color veryVeryLightGray]])! Item was removed: - ComposedSortFunction subclass: #UndefinedSortFunction - instanceVariableNames: 'direction' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-SortFunctions'! - - !UndefinedSortFunction commentStamp: 'nice 11/7/2017 22:16' prior: 0! - An UndefinedSortFunction is a specialization usefull for sorting undefined objects (nil), either first or last according to direction. - The non nil objects are sorted according to the baseSortFunction defined in superclass. - - instance variables: - direction <Integer> -1 for sorting nil first, 1 for sorting nil last! Item was removed: - ----- Method: UndefinedSortFunction>>= (in category 'comparing') ----- - = anObject - "Answer whether the receiver and anObject represent the same object." - - self == anObject - ifTrue: [ ^ true ]. - self class = anObject class - ifFalse: [ ^ false ]. - ^ baseSortFunction = anObject baseSortFunction - and: [ direction = anObject direction ]! Item was removed: - ----- Method: UndefinedSortFunction>>collate:with: (in category 'evaluating') ----- - collate: anObject with: another - "Answer the collation order of anObject and another, with nil first or last according to direction" - anObject ifNil: [^another ifNil: [0] ifNotNil: [direction]]. - another ifNil: [^direction negated]. - ^baseSortFunction collate: anObject with: another! Item was removed: - ----- Method: UndefinedSortFunction>>direction (in category 'accessing') ----- - direction - ^direction! Item was removed: - ----- Method: UndefinedSortFunction>>hash (in category 'comparing') ----- - hash - "Answer an integer value that is related to the identity of the receiver." - - ^ super hash bitXor: direction hash! Item was removed: - ----- Method: UndefinedSortFunction>>initialize (in category 'initailize-release') ----- - initialize - super initialize. - direction := -1! Item was removed: - ----- Method: UndefinedSortFunction>>undefinedFirst (in category 'initailize-release') ----- - undefinedFirst - direction := -1! Item was removed: - ----- Method: UndefinedSortFunction>>undefinedLast (in category 'initailize-release') ----- - undefinedLast - direction := 1! Item was removed: - RawBitsArray subclass: #UnsignedIntegerArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !UnsignedIntegerArray commentStamp: 'nice 5/10/2020 16:00' prior: 0! - UnsignedIntegerArray is an abstract class for all arrays of unsigned integer of fixed bit-width. - - ! Item was removed: - ----- Method: UnsignedIntegerArray>>atAllPut: (in category 'accessing') ----- - atAllPut: value - "Fill the receiver with the given value" - - <primitive: 145> - super atAllPut: value! Item was removed: - ----- Method: UnsignedIntegerArray>>defaultElement (in category 'accessing') ----- - defaultElement - "Return the default element of the receiver" - ^0! Item was removed: - ----- Method: UnsignedIntegerArray>>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 ! Item was removed: - Link subclass: #ValueLink - instanceVariableNames: 'value' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! - - !ValueLink commentStamp: 'HenrikSperreJohansen 10/18/2009 15:57' prior: 0! - A ValueLink is a Link containing a Value. - Adding an object to a LinkedList which is not a Link will create a ValueLink containing that object. - - - value - The object this link points to.! Item was removed: - ----- Method: ValueLink class>>value: (in category 'instance creation') ----- - value: aValue - - ^self new value: aValue! Item was removed: - ----- Method: ValueLink>>= (in category 'comparing') ----- - = anotherObject - - ^self species == anotherObject species - and: [self value = anotherObject value - and: [self nextLink == anotherObject nextLink]]! Item was removed: - ----- Method: ValueLink>>hash (in category 'comparing') ----- - hash - - ^self value hash bitXor: self nextLink identityHash - ! Item was removed: - ----- Method: ValueLink>>printOn: (in category 'printing') ----- - printOn: aStream - - super printOn: aStream. - aStream nextPut: $(. - value printOn: aStream. - aStream nextPut: $) - ! Item was removed: - ----- Method: ValueLink>>value (in category 'accessing') ----- - value - - ^ value! Item was removed: - ----- Method: ValueLink>>value: (in category 'accessing') ----- - value: anObject - - value := anObject.! Item was removed: - Array weakSubclass: #WeakArray - instanceVariableNames: '' - classVariableNames: 'FinalizationDependents FinalizationLock FinalizationProcess FinalizationSemaphore' - 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.! Item was removed: - ----- Method: WeakArray class>>addWeakDependent: (in category 'accessing') ----- - addWeakDependent: anObject - - FinalizationLock - critical: [ - | emptySlotIndex | - emptySlotIndex := FinalizationDependents - identityIndexOf: nil - ifAbsent: [ - | newIndex | - newIndex := FinalizationDependents size + 1. - "Grow linearly" - FinalizationDependents := FinalizationDependents grownBy: 10. - newIndex ]. - FinalizationDependents at: emptySlotIndex put: anObject ] - ifError: [ :msg :rcvr | rcvr error: msg ]! Item was removed: - ----- 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.! Item was removed: - ----- Method: WeakArray class>>isFinalizationSupported (in category 'accessing') ----- - isFinalizationSupported - "This method is only here for backwards compatibility, all closure VMs support finalization" - - ^true! Item was removed: - ----- Method: WeakArray class>>primitiveFetchMourner (in category 'private') ----- - primitiveFetchMourner - "Answer the next mourner in the VM's queue of objects to be finalized. - The queue contains weak arrays and ephemerons. If the primitive is - not implemented, raise an error telling people to upgrade the VM. If - implemented, the primitive fails if the queue is empty, with the error - code #'not found'. Primitive. Essential." - - <primitive: 172 error: ec> - ec ifNil: [^self error: 'The primitiveFetchMourner primitive is missing.\Please upgrade your virtual machine to one that has the primitive.' withCRs]. - ^nil! Item was removed: - ----- Method: WeakArray class>>removeWeakDependent: (in category 'accessing') ----- - removeWeakDependent: anObject - - FinalizationLock critical:[ - 1 to: FinalizationDependents size do:[:i| - ((FinalizationDependents at: i) == anObject) ifTrue:[ - FinalizationDependents at: i put: nil. - ]. - ]. - ] ifError:[:msg :rcvr| rcvr error: msg].! Item was removed: - ----- Method: WeakArray class>>restartFinalizationProcess (in category 'private') ----- - restartFinalizationProcess - "kill any old process, just in case" - FinalizationProcess ifNotNil: - [FinalizationProcess terminate. - FinalizationProcess := nil]. - - FinalizationSemaphore := Smalltalk specialObjectsArray at: 42. - FinalizationDependents ifNil: [FinalizationDependents := WeakArray new: 10]. - FinalizationLock := Semaphore forMutualExclusion. - FinalizationProcess := [self finalizationProcess] - forkAt: Processor userInterruptPriority + 1 - named: 'the finalization process'! Item was removed: - ----- Method: WeakArray class>>runningFinalizationProcess (in category 'accessing') ----- - runningFinalizationProcess - "Answer the FinalizationProcess I am running, if any" - ^FinalizationProcess! Item was removed: - ----- Method: WeakArray class>>startUp: (in category 'system startup') ----- - startUp: resuming - resuming ifFalse: [ ^self ]. - self restartFinalizationProcess.! Item was removed: - ----- Method: WeakArray>>copyWith: (in category 'copying') ----- - copyWith: newElement - "Re-implemented to not return a strong copy." - ^ (super copyWith: newElement) as: self class! Item was removed: - ----- Method: WeakArray>>copyWithout: (in category 'copying') ----- - copyWithout: oldElement - "Re-implemented to not return a strong copy." - ^ (super copyWithout: oldElement) as: self class! Item was removed: - ----- Method: WeakArray>>species (in category 'private') ----- - species - "More useful to have strongly-referenced results of #select: and #collect:." - ^ Array! Item was removed: - IdentityDictionary subclass: #WeakIdentityDictionary - instanceVariableNames: 'vacuum' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Weak'! - - !WeakIdentityDictionary commentStamp: 'nice 10/27/2016 20:00' prior: 0! - I am a WeakIdentityDictionary, that is a dictionary pointing weakly to its associations of key->value pairs. - I am especially usefull for handling undeclared bindings that will be naturally garbage collected without having to scan all the CompiledMethods. - - Instance variables: - vacuum <Object> a unique object used for marking empty slots - - Due to usage of WeakArray for my own storage, reclaimed slots will be nilled out. - I cannot consider a nil slot as empty because of garbage collection does not fix collisions. - Thus I need to differentiate empty slots (vacuum) from garbaged collected slots (nil). - - If I did not reclaim the nil slots and make them vacuum again, then my capacity would grow indefinitely. - My strategy to avoid such growth is to randomly cleanup the garbage collected slot encountered when scanning for a key. - It should mitigate the growth since this method is used when adding a new entry. - - Due to those not yet cleaned-up nil slots I might over-estimate my size. Don't take it too literally.! Item was removed: - ----- Method: WeakIdentityDictionary>>add: (in category 'accessing') ----- - add: anAssociation - - | index | - index := self scanFor: anAssociation key. - (array at: index) - ifNil: [ self atNewIndex: index put: anAssociation ] - ifNotNil: [ :element | - element == vacuum - ifTrue: [ self atNewIndex: index put: anAssociation ] - ifFalse: [ element value: anAssociation value ] ]. - ^anAssociation! Item was removed: - ----- Method: WeakIdentityDictionary>>arrayType (in category 'private') ----- - arrayType - ^ WeakArray! Item was removed: - ----- Method: WeakIdentityDictionary>>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." - - ^((array at: (self scanFor: key)) - ifNil: [ aBlock value ] - ifNotNil: [:association | - association == vacuum - ifTrue: [ aBlock value ] - ifFalse: [ association ] ])! Item was removed: - ----- Method: WeakIdentityDictionary>>associationsDo: (in category 'enumerating') ----- - associationsDo: aBlock - "Evaluate aBlock for each of the receiver's elements (key/value - associations)." - - tally = 0 ifTrue: [ ^self]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :element | - element == vacuum ifFalse: [ aBlock value: element ] ] ]! Item was removed: - ----- Method: WeakIdentityDictionary>>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." - - ^((array at: (self scanFor: key)) - ifNil: [ aBlock ] - ifNotNil: [:association | - association == vacuum - ifTrue: [ aBlock ] - ifFalse: [ association ] ]) value "Blocks and Associations expect #value"! Item was removed: - ----- Method: WeakIdentityDictionary>>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." - - ^(array at: (self scanFor: key)) ifNotNil: [ :association | - association == vacuum ifFalse: [ - aBlock value: association value ] ]! Item was removed: - ----- Method: WeakIdentityDictionary>>at:ifPresent:ifAbsent: (in category 'accessing') ----- - at: key ifPresent: oneArgBlock ifAbsent: absentBlock - "Lookup the given key in the receiver. If it is present, answer the - value of evaluating the oneArgBlock with the value associated - with the key, otherwise answer the value of absentBlock." - ^(array at: (self scanFor: key)) - ifNil: [absentBlock value] - ifNotNil: - [:association| - association == vacuum - ifTrue: [absentBlock value] - ifFalse: [oneArgBlock value: association value]]! Item was removed: - ----- Method: WeakIdentityDictionary>>at:ifPresent:ifAbsentPut: (in category 'accessing') ----- - at: key ifPresent: oneArgBlock ifAbsentPut: absentBlock - "Lookup the given key in the receiver. If it is present, answer the value of - evaluating oneArgBlock with the value associated with the key. Otherwise - add the value of absentBlock under the key, and answer that value." - - | index value | - index := self scanFor: key. - (array at: index) ifNotNil: - [:element| - element == vacuum ifFalse: [^oneArgBlock value: element value] ]. - value := absentBlock value. - self atNewIndex: index put: (self associationClass key: key value: value). - ^value! Item was removed: - ----- Method: WeakIdentityDictionary>>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 | - index := self scanFor: key. - (array at: index) - ifNil: - ["it's possible to get here if the association just died" - self atNewIndex: index put: (self associationClass key: key value: anObject) ] - ifNotNil: [ :association | - association == vacuum - ifTrue: [ self atNewIndex: index put: (self associationClass key: key value: anObject) ] - ifFalse: [association value: anObject ] ]. - ^anObject! Item was removed: - ----- Method: WeakIdentityDictionary>>fixCollisionsFrom: (in category 'private') ----- - fixCollisionsFrom: start - "The element at start has been removed and replaced by vacuum. - 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 := array at: (index := index \\ array size + 1)) == vacuum ] whileFalse: [ - element - ifNil: - [ "The binding at this slot was reclaimed - finish the cleanup" - array at: index put: vacuum. - tally := tally - 1 ] - ifNotNil: - [| newIndex | - (newIndex := self scanFor: element key) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: vacuum ] ] ]! Item was removed: - ----- Method: WeakIdentityDictionary>>growTo: (in category 'private') ----- - growTo: anInteger - "Grow the elements array and reinsert the old elements" - - | oldElements | - oldElements := array. - array := self arrayType new: anInteger withAll: vacuum. - self noCheckNoGrowFillFrom: oldElements! Item was removed: - ----- Method: WeakIdentityDictionary>>includesKey: (in category 'testing') ----- - includesKey: key - "Answer whether the receiver has a key equal to the argument, key." - - (array at: (self scanFor: key)) - ifNil: [ - "it just has been reclaimed" - ^false] - ifNotNil: [ :element | - element == vacuum - ifTrue: [ ^false ] - ifFalse: [ ^true ] ]! Item was removed: - ----- Method: WeakIdentityDictionary>>initialize: (in category 'private') ----- - initialize: n - vacuum := Object new. - array := self arrayType new: n withAll: vacuum. - tally := 0! Item was removed: - ----- Method: WeakIdentityDictionary>>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." - - tally := 0. - 1 to: anArray size do: [ :index | - (anArray at: index) ifNotNil: [ :association | - association == vacuum ifFalse: [ - array - at: (self scanForEmptySlotFor: association key) - put: association. - tally := tally + 1 ] ] ]! Item was removed: - ----- Method: WeakIdentityDictionary>>postCopy (in category 'copying') ----- - postCopy - "Beware: do share the bindings, so changing a binding value in the copy will also change it in the original. - Copying the bindings would not make sense: we hold weakly on them, so they would die at first garbage collection." - - | oldVacuum | - super postCopy. - oldVacuum := vacuum. - vacuum := Object new. - array := array collect: [ :association | - association ifNotNil: [ - association == oldVacuum - ifTrue: [ vacuum ] - ifFalse: [ association ] ] ]! Item was removed: - ----- Method: WeakIdentityDictionary>>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)) == vacuum ifTrue: [ ^aBlock value ]. - tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: vacuum. - self fixCollisionsFrom: index. - ^association value! Item was removed: - ----- Method: WeakIdentityDictionary>>removeUnreferencedKeys (in category 'removing') ----- - removeUnreferencedKeys - "Make sure tally is set to the right size by #compact." - - super removeUnreferencedKeys. - self compact! Item was removed: - ----- Method: WeakIdentityDictionary>>scanFor: (in category 'private') ----- - scanFor: anObject - "Scan the array for the first slot containing either - - a vacuum object indicating an empty slot - - or a binding whose key matches anObject. - Answer the index of that slot or raise an error if no slot is found which should never happen." - - | index start size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - (array at: index) ifNotNil: [ :element | - (element == vacuum or: [ element key == anObject ]) - ifTrue: [ ^index ] ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- Method: WeakIdentityDictionary>>scanForEmptySlotFor: (in category 'private') ----- - scanForEmptySlotFor: anObject - "Scan the array for the first empty slot marked by vacuum object or nil. - Answer the index of that slot or raise an error if no slot is found, which should never happen." - - | index start | - index := start := anObject scaledIdentityHash \\ array size + 1. - [ - | element | - ((element := array at: index) == vacuum or: [ element == nil ]) ifTrue: [ ^index ]. - (index := index \\ array size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- Method: WeakIdentityDictionary>>slowSize (in category 'accessing') ----- - slowSize - "Careful!! Answer the maximum amount - of elements in the receiver, not the - exact amount" - - | count | - count := 0. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :object | - object == vacuum ifFalse: [ - count := count + 1 ] ] ]. - ^count! Item was removed: - WeakKeyDictionary subclass: #WeakIdentityKeyDictionary - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Weak'! - - !WeakIdentityKeyDictionary commentStamp: '<historical>' prior: 0! - This class represents an identity dictionary with weak keys.! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == nil or: [ element key == anObject ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := anObject scaledIdentityHash \\ (size := array size) + 1. - [ - (array at: index) ifNil: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - Association subclass: #WeakKeyAssociation - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! - - !WeakKeyAssociation commentStamp: '<historical>' prior: 0! - I am an association holding only weakly on my key.! Item was removed: - ----- Method: WeakKeyAssociation>>< (in category 'comparing') ----- - < aLookupKey - "Refer to the comment in Magnitude|<." - - ^self key < aLookupKey key! Item was removed: - ----- Method: WeakKeyAssociation>>= (in category 'comparing') ----- - = aLookupKey - - self species = aLookupKey species - ifTrue: [^self key = aLookupKey key] - ifFalse: [^false]! Item was removed: - ----- Method: WeakKeyAssociation>>hash (in category 'comparing') ----- - hash - "Hash is reimplemented because = is implemented." - - ^self key hash! Item was removed: - ----- Method: WeakKeyAssociation>>key (in category 'accessing') ----- - key - - ^key ifNotNil: [ key at: 1 ]! Item was removed: - ----- Method: WeakKeyAssociation>>key: (in category 'accessing') ----- - key: aKey - key := WeakArray with: aKey! Item was removed: - ----- Method: WeakKeyAssociation>>key:value: (in category 'accessing') ----- - key: aKey value: anObject - key := WeakArray with: aKey. - value := anObject.! Item was removed: - ----- Method: WeakKeyAssociation>>printOn: (in category 'printing') ----- - printOn: aStream - self key printOn: aStream. - aStream nextPutAll: '->'. - self value printOn: aStream! Item was removed: - ----- 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: $)! Item was removed: - Dictionary subclass: #WeakKeyDictionary - instanceVariableNames: 'finalizer' - 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. - ! Item was removed: - ----- Method: WeakKeyDictionary>>add: (in category 'adding') ----- - add: anAssociation - self at: anAssociation key put: anAssociation value. - ^ anAssociation! Item was removed: - ----- Method: WeakKeyDictionary>>associationClass (in category 'accessing') ----- - associationClass - - ^WeakKeyAssociation! Item was removed: - ----- Method: WeakKeyDictionary>>associationsDo: (in category 'enumerating') ----- - associationsDo: aBlock - "Evaluate aBlock for each of the receiver's elements (key/value - associations)." - - tally = 0 ifTrue: [ ^self]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :association | - association key ifNotNil: [ :key | "Don't let the key go away." - aBlock value: association ] ] ]! Item was removed: - ----- Method: WeakKeyDictionary>>at:ifAbsent: (in category 'accessing') ----- - at: key ifAbsent: aBlock - "While no nil key can be added, keys become nil when they are garbage collected. - This must not let nil accidentally 'inherit' the value of such a stale association." - key ifNil: [^ aBlock value]. - ^ super at: key ifAbsent: aBlock! Item was removed: - ----- Method: WeakKeyDictionary>>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. - While no nil key can be added, keys become nil when they are garbage collected. - This must not let nil accidentally 'inherit' the value of such a stale association." - - ^key ifNotNil: [ super at: key ifPresent: aBlock ]! Item was removed: - ----- Method: WeakKeyDictionary>>at:ifPresent:ifAbsent: (in category 'accessing') ----- - at: key ifPresent: oneArgBlock ifAbsent: absentBlock - "Lookup the given key in the receiver. If it is present, answer the - value of evaluating the oneArgBlock with the value associated - with the key, otherwise answer the value of absentBlock." - - ^key ifNotNil: [ super at: key ifPresent: oneArgBlock ifAbsent: absentBlock ]! Item was removed: - ----- 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." - - key ifNil: [ ^anObject ]. - ^super at: key put: anObject! Item was removed: - ----- Method: WeakKeyDictionary>>finalizeValues (in category 'finalization') ----- - finalizeValues - "Remove and finalize all elements which have nil key" - - | cleanUpAfterRemove | - tally = 0 ifTrue: [ ^self ]. - cleanUpAfterRemove := false. - 1 to: array size do: [ :index | - (array at: index) - ifNil: [ cleanUpAfterRemove := false ] - ifNotNil: [ :element | - element key - ifNil: [ - finalizer ifNotNil: [ finalizer value: element value ]. - array at: index put: nil. - tally := tally - 1. - cleanUpAfterRemove := true ] - ifNotNil: [ :key | - cleanUpAfterRemove ifTrue: [ - | newIndex | - (newIndex := self scanFor: key) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: nil ] ] ] ] ]. - cleanUpAfterRemove ifTrue: [ "Continue rehashing at the front of array" - self fixCollisionsFrom: array size ] - ! Item was removed: - ----- Method: WeakKeyDictionary>>finalizer: (in category 'accessing') ----- - finalizer: aValueable - - finalizer := aValueable! Item was removed: - ----- Method: WeakKeyDictionary>>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 := array at: (index := index \\ array size + 1)) == nil ] whileFalse: [ - element key - ifNil: [ - finalizer ifNotNil: [ finalizer value: element value ]. - array at: index put: nil. - tally := tally - 1 ] - ifNotNil: [ :key | "Don't let the key go away" - | newIndex | - (newIndex := self scanFor: key) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: nil ] ] ]! Item was removed: - ----- 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: [ :index | - (anArray at: index) ifNotNil: [ :association | - association key - ifNil: [ finalizer ifNotNil: [ finalizer value: association value ] ] - ifNotNil: [ :key | "Don't let the key go away" - array - at: (self scanForEmptySlotFor: key) - put: association. - tally := tally + 1 ] ] ]! Item was removed: - ----- Method: WeakKeyDictionary>>replace: (in category 'enumerating') ----- - replace: aBlock - "Like super except that aBlock shouldn't be invoked for any reclaimed (nil) key." - - tally = 0 ifTrue: [ ^self]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :association | - association key ifNotNil: [ :key | "Don't let the key go away." - association value: (aBlock value: association value) ] ] ]! Item was removed: - ----- Method: WeakKeyDictionary>>slowSize (in category 'public') ----- - slowSize - "Careful!! Answer the maximum amount - of elements in the receiver, not the - exact amount" - - | count | - count := 0. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :object | - object key ifNotNil: [ - count := count + 1 ] ] ]. - ^count! Item was removed: - 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.! Item was removed: - ----- Method: WeakKeyToCollectionDictionary>>noCheckNoGrowFillFrom: (in category 'private') ----- - 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: [ :index | - (anArray at: index) ifNotNil: [ :association | - association key ifNotNil: [ :key | "Don't let the key go away" - | cleanedValue | - (cleanedValue := association value copyWithout: nil) isEmpty - ifFalse: [ - association value: cleanedValue. - array - at: (self scanForEmptySlotFor: key) - put: association. - tally := tally + 1 ] ] ] ]! Item was removed: - OrderedCollection subclass: #WeakOrderedCollection - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Weak'! Item was removed: - ----- Method: WeakOrderedCollection>>arrayType (in category 'private') ----- - arrayType - ^ WeakArray! Item was removed: - Set subclass: #WeakSet - instanceVariableNames: 'flag' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Weak'! - - !WeakSet commentStamp: 'ul 11/20/2009 22:51' prior: 0! - I'm like Set but my instances only hold weakly to their elements. - - Instance Variables: - flag: an Object which marks the empty slot in this instance. This object shouldn't be used anywhere else in the system. Every WeakSet has a different flag. - - Differences from Set: - array is a WeakArray filled with flag initially. flag marks the empty slots, because elements which become garbage will be replaced with nil by the garbage collector. Besides nil, flag cannot be added to my instances.! Item was removed: - ----- Method: WeakSet>>add: (in category 'adding') ----- - add: newObject - "Include newObject as one of the receiver's elements, but only if - not already present. Answer newObject" - - | index element | - index := self scanFor: newObject. - ((element := array at: index) == flag or: [ element == nil ]) - ifTrue: [self atNewIndex: index put: newObject asSetElement]. - ^newObject! Item was removed: - ----- Method: WeakSet>>arrayType (in category 'private') ----- - arrayType - - ^WeakArray! Item was removed: - ----- Method: WeakSet>>collect: (in category 'enumerating') ----- - collect: aBlock - - | newSet | - newSet := self species new: self size. - tally = 0 ifTrue: [ ^newSet ]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :object | - object == flag ifFalse: [ - newSet add: (aBlock value: object enclosedSetElement) ] ] ]. - ^newSet! Item was removed: - ----- Method: WeakSet>>do: (in category 'enumerating') ----- - do: aBlock - - tally = 0 ifTrue: [ ^self ]. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :object | - object == flag ifFalse: [ - aBlock value: object enclosedSetElement] ] ]! Item was removed: - ----- Method: WeakSet>>do:after: (in category 'public') ----- - do: aBlock after: anElement - - | index endIndex | - tally = 0 ifTrue: [ ^self ]. - anElement - ifNil: [ index := 0 ] - ifNotNil: [ - index := self scanFor: anElement. - (array at: index) == flag ifTrue: [ - index := 0 ] ]. - endIndex := array size. - [ (index := index + 1) <= endIndex ] whileTrue: [ - (array at: index) ifNotNil: [ :object | - object == flag ifFalse: [ - aBlock value: object enclosedSetElement] ] ]! Item was removed: - ----- 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 := array at: (index := index \\ array size + 1)) == flag ] whileFalse: [ - element - ifNil: [ "This object is gone" - array at: index put: flag. - tally := tally - 1 ] - ifNotNil: [ - | newIndex | - (newIndex := self scanFor: element enclosedSetElement) = index ifFalse: [ - array - at: newIndex put: element; - at: index put: flag ] ] ] - ! Item was removed: - ----- Method: WeakSet>>growTo: (in category 'private') ----- - growTo: anInteger - "Grow the elements array and reinsert the old elements" - - | oldElements | - oldElements := array. - array := self arrayType new: anInteger withAll: flag. - self noCheckNoGrowFillFrom: oldElements! Item was removed: - ----- Method: WeakSet>>includes: (in category 'testing') ----- - includes: anObject - - (array at: (self scanFor: anObject)) - ifNil: [ ^false ] - ifNotNil: [ :object | - object == flag - ifTrue: [ ^false ] - ifFalse: [ ^true ] ]! Item was removed: - ----- Method: WeakSet>>initialize: (in category 'private') ----- - initialize: n - "Initialize array to an array size of n" - - super initialize: n. - flag := Object new. - array atAllPut: flag! Item was removed: - ----- Method: WeakSet>>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" - - | element | - ^(element := array at: (self scanFor: anObject)) == flag - ifFalse: [ element enclosedSetElement]! Item was removed: - ----- Method: WeakSet>>like:ifAbsent: (in category 'accessing') ----- - like: anObject ifAbsent: aBlock - "Answer an object in the receiver that is equal to anObject, - or evaluate the block if not found. Relies heavily on hash properties" - - | element | - ((element := array at: (self scanFor: anObject)) == flag or: [ element == nil ]) - ifTrue: [ ^aBlock value ] - ifFalse: [ ^element enclosedSetElement ]! Item was removed: - ----- 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 | - (anArray at: index) ifNotNil: [ :object | - object == flag ifFalse: [ - array - at: (self scanForEmptySlotFor: object enclosedSetElement) - put: object. - tally := tally + 1 ] ] ]! Item was removed: - ----- Method: WeakSet>>postCopy (in category 'copying') ----- - postCopy - - | oldFlag | - super postCopy. - oldFlag := flag. - flag := Object new. - 1 to: array size do: [ :index | - (array at: index) == oldFlag ifTrue: [ - array at: index put: flag ] ]! Item was removed: - ----- Method: WeakSet>>remove:ifAbsent: (in category 'removing') ----- - remove: oldObject ifAbsent: aBlock - - | index | - index := self scanFor: oldObject. - (array at: index) == flag ifTrue: [ ^ aBlock value ]. - tally := tally - 1. "Update tally first, so that read-only hashed collections raise an error before modifying array." - array at: index put: flag. - self fixCollisionsFrom: index. - ^oldObject! Item was removed: - ----- 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 size | - index := start := anObject hash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == flag or: [ element enclosedSetElement = anObject ]) - ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 size | - index := start := anObject hash \\ (size := array size) + 1. - [ - | element | - ((element := array at: index) == flag or: [ element == nil ]) ifTrue: [ ^index ]. - (index := index \\ size + 1) = start ] whileFalse. - self errorNoFreeSpace! Item was removed: - ----- 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 enclosedSetElement 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 enclosedSetElement asString = anObject asString]) - ifTrue: [^ index ]]. - - ^ 0 "No match AND no empty slot"! Item was removed: - ----- Method: WeakSet>>size (in category 'accessing') ----- - size - "Careful!! Answer the maximum amount - of elements in the receiver, not the - exact amount" - - ^tally! Item was removed: - ----- Method: WeakSet>>slowSize (in category 'public') ----- - slowSize - "Careful!! Answer the maximum amount - of elements in the receiver, not the - exact amount" - - | count | - count := 0. - 1 to: array size do: [ :index | - (array at: index) ifNotNil: [ :object | - object == flag ifFalse: [ - count := count + 1 ] ] ]. - ^count! Item was removed: - 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.! Item was removed: - ----- Method: WeakValueAssociation class>>key:value: (in category 'instance creation') ----- - key: anObject value: bObject - ^ self new key: anObject value: bObject! Item was removed: - ----- Method: WeakValueAssociation class>>new (in category 'as yet unclassified') ----- - new - ^ self new: 1! Item was removed: - ----- 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! Item was removed: - ----- Method: WeakValueAssociation>>value (in category 'accessing') ----- - value - ^self at: 1! Item was removed: - ----- Method: WeakValueAssociation>>value: (in category 'accessing') ----- - value: anObject - "Store the argument, anObject, as the value of the receiver." - - self at: 1 put: anObject! Item was removed: - 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.! Item was removed: - ----- Method: WeakValueDictionary>>add: (in category 'adding') ----- - add: anAssociation - self at: anAssociation key put: anAssociation value. - ^ anAssociation! Item was removed: - ----- Method: WeakValueDictionary>>associationClass (in category 'accessing') ----- - associationClass - - ^WeakValueAssociation! Item was removed: - CharacterSet subclass: #WideCharacterSet - instanceVariableNames: 'map bitsetCapacity highBitsShift lowBitsMask' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Support'! - - !WideCharacterSet commentStamp: 'nice 12/10/2009 19:17' 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 ByteArray. - If a bit is set to 1, this indicate that corresponding character is present. - 8192 bytes are necessary in each lowmap. - Empty lowmap are removed from the map Dictionary. - - A byteArrayMap is maintained in parallel with map for fast handling of ByteString. - (byteArrayMap at: i+1) = 0 means that character of asciiValue i is absent, = 1 means present.! Item was removed: - ----- Method: WideCharacterSet class>>newFrom: (in category 'instance creation') ----- - newFrom: aCollection - | newCollection | - newCollection := self new. - newCollection addAll: aCollection. - ^newCollection! Item was removed: - ----- Method: WideCharacterSet>>= (in category 'comparing') ----- - = anObject - ^self species == anObject species - and: [ anObject canBeEnumerated - and: [ self wideCharacterMap = anObject wideCharacterMap ] ]! Item was removed: - ----- Method: WideCharacterSet>>add: (in category 'adding') ----- - add: aCharacter - - | value highBits lowBits | - (value := aCharacter asInteger) < 256 ifTrue: [ - byteArrayMap at: value + 1 put: 1 ]. - highBits := value bitShift: highBitsShift. - lowBits := value bitAnd: lowBitsMask. - (map at: highBits ifAbsentPut: [ Bitset new: bitsetCapacity ]) - setBitAt: lowBits. - ^aCharacter! Item was removed: - ----- 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" - - ^byteArrayMap! Item was removed: - ----- Method: WideCharacterSet>>do: (in category 'enumerating') ----- - do: aBlock - - map keysAndValuesDo: [ :index :bitset | - | highBits | - highBits := index * bitsetCapacity. - bitset do: [ :lowBits | - aBlock value: (Character value: highBits + lowBits) ] ]! Item was removed: - ----- Method: WideCharacterSet>>enumerationCost (in category 'private') ----- - enumerationCost - "Medium cost. I can hold many characters eventually." - - ^50! Item was removed: - ----- Method: WideCharacterSet>>hasWideCharacters (in category 'testing') ----- - hasWideCharacters - "Answer true if i contain any wide character" - - self do: [:e | e asciiValue >= 256 ifTrue: [^true]]. - ^false! Item was removed: - ----- 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 ]. - ^byteArrayMap hash! Item was removed: - ----- Method: WideCharacterSet>>includesCode: (in category 'testing') ----- - includesCode: anInteger - anInteger < 256 ifTrue: [ ^(byteArrayMap at: anInteger + 1) ~= 0 ]. - ^((map at: (anInteger bitShift: highBitsShift) ifAbsent: nil) ifNil: [ ^false ]) - includes: (anInteger bitAnd: lowBitsMask)! Item was removed: - ----- Method: WideCharacterSet>>initialize (in category 'initialize-release') ----- - initialize - - map := PluggableDictionary integerDictionary. - byteArrayMap := ByteArray new: 256. - self initializeWithLowBits: 8! Item was removed: - ----- Method: WideCharacterSet>>initializeWithLowBits: (in category 'initialize-release') ----- - initializeWithLowBits: lowBits - - bitsetCapacity := 1 bitShift: lowBits. - highBitsShift := 0 - lowBits. - lowBitsMask := bitsetCapacity - 1. - ! Item was removed: - ----- Method: WideCharacterSet>>postCopy (in category 'copying') ----- - postCopy - super postCopy. - map := map collect: [:each | each copy]! Item was removed: - ----- Method: WideCharacterSet>>remove: (in category 'removing') ----- - remove: aCharacter - "Don't signal an error when aCharacter is not present." - - ^self remove: aCharacter ifAbsent: aCharacter! Item was removed: - ----- Method: WideCharacterSet>>remove:ifAbsent: (in category 'removing') ----- - remove: aCharacter ifAbsent: aBlock - - | value highBits lowBits bitset | - (value := aCharacter asInteger) < 256 ifTrue: [ - (byteArrayMap at: value + 1) = 0 ifTrue: [ ^aBlock value ]. - byteArrayMap at: value + 1 put: 0 ]. - highBits := value bitShift: highBitsShift. - lowBits := value bitAnd: lowBitsMask. - bitset := (map at: highBits ifAbsent: nil) ifNil: [ ^aBlock value ]. - ((bitset clearBitAt: lowBits) and: [ bitset size = 0 ]) ifTrue: [ - map removeKey: highBits ]. - ^aCharacter! Item was removed: - ----- Method: WideCharacterSet>>removeAll (in category 'removing') ----- - removeAll - - map isEmpty ifTrue: [ ^self ]. - map removeAll. - byteArrayMap atAllPut: 0! Item was removed: - ----- Method: WideCharacterSet>>size (in category 'accessing') ----- - size - - ^map detectSum: [ :each | each size ]! Item was removed: - ----- Method: WideCharacterSet>>wideCharacterMap (in category 'comparing') ----- - wideCharacterMap - ^map! Item was removed: - 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. - ! Item was removed: - ----- Method: WideString class>>allMultiStringMethods (in category 'enumeration') ----- - allMultiStringMethods - - ^CurrentReadOnlySourceFiles cacheDuring: [ - self systemNavigation allMethodsSelect: [ :method | - method getSource asString isOctetString not ] ]! Item was removed: - ----- Method: WideString class>>allNonAsciiMethods (in category 'enumeration') ----- - allNonAsciiMethods - - ^CurrentReadOnlySourceFiles cacheDuring: [ - self systemNavigation allMethodsSelect: [ :method | - method getSource asString isAsciiString not ] ]! Item was removed: - ----- 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 - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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 - ! Item was removed: - ----- 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" - ! Item was removed: - ----- 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. - ! Item was removed: - ----- 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 - ! Item was removed: - ----- Method: WideString>>asLowercase (in category 'converting') ----- - asLowercase - ^self collect: [:e | e asLowercase]! Item was removed: - ----- Method: WideString>>asPacked (in category 'converting') ----- - asPacked - ^self inject: 0 into: [:pack :next | pack * 16r100000000 + next asInteger].! Item was removed: - ----- Method: WideString>>asUppercase (in category 'converting') ----- - asUppercase - ^self collect: [:e | e asUppercase]! Item was removed: - ----- Method: WideString>>at: (in category 'accessing') ----- - at: index - "Answer the Character stored in the field of the receiver indexed by the - argument. Primitive. Fail if the index argument is not an Integer or is out - of bounds. Essential. See Object documentation whatIsAPrimitive." - - <primitive: 63> - ^index isInteger - ifTrue: - [self errorSubscriptBounds: index] - ifFalse: - [index isNumber - ifTrue: [self at: index asInteger] - ifFalse: [self errorNonIntegerIndex]]! Item was removed: - ----- Method: WideString>>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, or if the receiver is read-only. - Essential. See Object documentation whatIsAPrimitive." - - <primitive: 64 error: ec> - aCharacter isCharacter ifFalse: - [^self errorImproperStore]. - index isInteger - ifTrue: - [ec == #'no modification' ifTrue: - [^thisContext modificationForbiddenFor: self at: index putCharacter: aCharacter]. - self errorSubscriptBounds: index] - ifFalse: [self errorNonIntegerIndex]! Item was removed: - ----- 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). - ! Item was removed: - ----- 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. - ! Item was removed: - ----- Method: WideString>>byteSize (in category 'accessing') ----- - byteSize - - ^ self size * 4. - ! Item was removed: - ----- Method: WideString>>copyFrom:to: (in category 'converting') ----- - copyFrom: start to: stop - - | n | - n := super copyFrom: start to: stop. - n isOctetString ifTrue: [^ n asOctetString]. - ^ n. - ! Item was removed: - ----- Method: WideString>>includesUnifiedCharacter (in category 'testing') ----- - includesUnifiedCharacter - - ^ self isUnicodeStringWithCJK - ! Item was removed: - ----- Method: WideString>>isUnicodeStringWithCJK (in category 'testing') ----- - isUnicodeStringWithCJK - - self do: [:c | - (c isTraditionalDomestic not and: [Unicode isUnifiedKanji: c charCode]) ifTrue: [ - ^ true - ]. - ]. - - ^ false. - ! Item was removed: - ----- Method: WideString>>isWideString (in category 'testing') ----- - isWideString - "Answer whether the receiver is a WideString" - ^true! Item was removed: - ----- 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. - ] - ]. - ! Item was removed: - ----- Method: WideString>>replaceFrom:to:with:startingAt: (in category 'accessing') ----- - replaceFrom: start to: stop with: replacement startingAt: repStart - - <primitive: 105> - replacement class == ByteString ifTrue: [ - ^self replaceFrom: start to: stop with: replacement asWideString startingAt: repStart ]. - ^super replaceFrom: start to: stop with: replacement startingAt: repStart. - ! Item was removed: - ----- Method: WideString>>wordAt: (in category 'accessing') ----- - wordAt: index - <primitive: 60> - ^ (self basicAt: index). - ! Item was removed: - ----- Method: WideString>>wordAt:put: (in category 'accessing') ----- - wordAt: index put: anInteger - <primitive: 61> - self basicAt: index put: anInteger. - ! Item was removed: - Symbol variableWordSubclass: #WideSymbol - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Strings'! - - !WideSymbol commentStamp: '<historical>' prior: 0! - This class represents the symbols containing 32bit characters.! Item was removed: - ----- 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). - ! Item was removed: - ----- Method: WideSymbol>>at:put: (in category 'accessing') ----- - at: anInteger put: anObject - "You cannot modify the receiver." - - self errorNoModification - ! Item was removed: - ----- 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). - ! Item was removed: - ----- Method: WideSymbol>>byteAt:put: (in category 'accessing') ----- - byteAt: index put: aByte - self errorNoModification.! Item was removed: - ----- Method: WideSymbol>>byteSize (in category 'accessing') ----- - byteSize - - ^ self size * 4. - ! Item was removed: - ----- 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" - ! Item was removed: - ----- Method: WideSymbol>>isWideString (in category 'testing') ----- - isWideString - "Answer whether the receiver is a WideString" - ^true! Item was removed: - ----- 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. - ] - ]. - ! Item was removed: - ----- Method: WideSymbol>>species (in category 'accessing') ----- - species - "Answer the preferred class for reconstructing the receiver." - ^WideString - ! Item was removed: - ----- Method: WideSymbol>>wordAt: (in category 'accessing') ----- - wordAt: index - <primitive: 60> - ^ (self basicAt: index). - ! Item was removed: - ----- Method: WideSymbol>>wordAt:put: (in category 'accessing') ----- - wordAt: index put: anInteger - self errorNoModification.! Item was removed: - UnsignedIntegerArray variableWordSubclass: #WordArray - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! - - !WordArray commentStamp: '<historical>' prior: 0! - WordArrays store 32-bit unsigned Integer values. - ! Item was removed: - ----- Method: WordArray class>>bobsTest (in category 'as yet unclassified') ----- - bobsTest - | wa answer | - " - WordArray bobsTest - " - answer := OrderedCollection new. - wa := WordArray with: 16r01020304 with: 16r05060708. - {false. true} do: [ :pad | | rawData s1 s2 wa2 | - 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! Item was removed: - ----- Method: WordArray>>asWordArray (in category 'converting') ----- - asWordArray - ^self! Item was removed: - ----- 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! Item was removed: - WordArray variableWordSubclass: #WordArrayForSegment - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Collections-Arrayed'! Item was removed: - ----- Method: WordArrayForSegment>>restoreEndianness (in category 'objects from disk') ----- - 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" - ! Item was removed: - ----- Method: WordArrayForSegment>>writeOn: (in category 'objects from disk') ----- - 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 - ! Item was removed: - PositionableStream subclass: #WriteStream - instanceVariableNames: 'writeLimit initialPositionOrNil' - 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.! Item was removed: - ----- 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! Item was removed: - ----- 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! Item was removed: - ----- 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)! Item was removed: - ----- Method: WriteStream>><< (in category 'printing') ----- - << aCollection - "we want a readable version of nextPutAll however it may be difficult to fully recreate nextPutAll: - for all the different types of stream. Rather then simply send to nextPutAll: - we handle the String (or ByteArray) argument - as fast as possible - the rest we delegate to putOn: This means that we handle single characters and bytes - whereas nextPutAll: is only for sequencable collections. - . - Note this may not work in every case that nextPutAll: does subject to extensive testing, - but it should work in the important cases" - - | newEnd | - collection class == aCollection class ifFalse: - [ aCollection putOn: self. ^ self ]. - - newEnd := position + aCollection size. - newEnd > writeLimit ifTrue: - [self growTo: newEnd]. - - collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. - position := newEnd. - - ! Item was removed: - ----- Method: WriteStream>>braceArray (in category 'private') ----- - braceArray - "This method is used in compilation of brace constructs. - It MUST NOT be deleted or altered." - - ^ collection! Item was removed: - ----- 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.! Item was removed: - ----- Method: WriteStream>>contents (in category 'accessing') ----- - contents - "Answer with a copy of my collection from the start to the current position." - readLimit := readLimit max: position. - ^collection copyFrom: (initialPositionOrNil ifNil: [1]) to: position! Item was removed: - ----- Method: WriteStream>>cr (in category 'character writing') ----- - cr - "Append a carriage return character to the receiver." - - self nextPut: Character cr! Item was removed: - ----- Method: WriteStream>>crlf (in category 'character writing') ----- - crlf - "Append a carriage return and a line feed to the receiver." - - self nextPut: Character cr; nextPut: Character lf! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- 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! Item was removed: - ----- Method: WriteStream>>ensureCr (in category 'character writing') ----- - ensureCr - "Append a cr character to the receiver IFF there is not one on the end." - - self ensureEndsWith: Character cr! Item was removed: - ----- Method: WriteStream>>ensureEndsWith: (in category 'accessing') ----- - ensureEndsWith: anObject - "Append anObject to the receiver IFF there is not one on the end." - - self peekLast = anObject ifFalse: - [self nextPut: anObject]! Item was removed: - ----- 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].! Item was removed: - ----- Method: WriteStream>>growTo: (in category 'private') ----- - growTo: anInteger - " anInteger is the required minimal new size of the collection " - - | oldSize newSize | - oldSize := collection size. - newSize := anInteger + (oldSize // 4 max: 20). - collection := collection grownBy: newSize - oldSize. - writeLimit := collection size. - ! Item was removed: - ----- Method: WriteStream>>lf (in category 'character writing') ----- - lf - "Append a line feed character to the receiver." - - self nextPut: Character lf! Item was removed: - ----- Method: WriteStream>>next (in category 'accessing') ----- - next - - self shouldNotImplement! Item was removed: - ----- Method: WriteStream>>next:putAll:startingAt: (in category 'accessing') ----- - next: anInteger putAll: aCollection startingAt: startIndex - "Store the next anInteger elements from the given collection." - - | newEnd | - anInteger > 0 ifFalse: [ ^aCollection ]. - (collection class == aCollection class - or: [ collection isString - and: [ aCollection isString - and: [ collection class format = aCollection class format ] ] ]) "Let Strings with the same field size as collection take the quick route too." - ifFalse: [ ^super next: anInteger putAll: aCollection startingAt: startIndex ]. - - newEnd := position + anInteger. - newEnd > writeLimit ifTrue: - [self growTo: newEnd]. - - collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: startIndex. - position := newEnd. - - ^aCollection! Item was removed: - ----- Method: WriteStream>>nextChunkPut: (in category 'fileIn/Out') ----- - nextChunkPut: aString - "Append the argument, aString, to the receiver, doubling embedded terminators." - - | start matchIndex | - start := 1. - [ (matchIndex := aString indexOf: $!! startingAt: start) = 0 ] whileFalse: [ - self - next: matchIndex - start + 1 putAll: aString startingAt: start; - nextPut: $!!. - start := matchIndex + 1 ]. - self next: aString size - start + 1 putAll: aString startingAt: start. - aString includesUnifiedCharacter ifTrue: [ - self nextPutAll: '!!]lang['. - aString writeLeadingCharRunsOn: self ]. - self nextPut: $!! - ! Item was removed: - ----- 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]). - ! Item was removed: - ----- 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> - position >= writeLimit - ifTrue: [^ self pastEndPut: anObject] - ifFalse: - [position := position + 1. - ^collection at: position put: anObject]! Item was removed: - ----- Method: WriteStream>>nextPutAll: (in category 'accessing') ----- - nextPutAll: aCollection - - | newEnd | - (collection class == aCollection class - or: [ collection class isBits - and: [ aCollection isString - and: [ collection class format = aCollection class format ] ] ]) "Let Strings with the same field size as collection take the quick route too." - ifFalse: [ ^ super nextPutAll: aCollection ]. - - newEnd := position + aCollection size. - newEnd > writeLimit ifTrue: - [self growTo: newEnd]. - - collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. - position := newEnd. - ^aCollection! Item was removed: - ----- Method: WriteStream>>on: (in category 'private') ----- - on: aCollection - - super on: aCollection. - readLimit := 0. - writeLimit := aCollection size! Item was removed: - ----- 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]. - initialPositionOrNil := position + 1! Item was removed: - ----- 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! Item was removed: - ----- 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]! Item was removed: - ----- Method: WriteStream>>position: (in category 'positioning') ----- - position: anInteger - "Refer to the comment in PositionableStream|position:." - - readLimit := readLimit max: position. - super position: anInteger! Item was removed: - ----- Method: WriteStream>>readStream (in category 'converting') ----- - readStream - "Answer a readStream on my contents truncated to current position. - Beware, the readStream shares the contents, so it will be modified if I'm written backward." - readLimit := readLimit max: position. - ^ReadStream on: collection from: (initialPositionOrNil ifNil: [1]) to: position! Item was removed: - ----- Method: WriteStream>>reset (in category 'positioning') ----- - reset - "Refer to the comment in PositionableStream|reset." - - readLimit := readLimit max: position. - position := 0! Item was removed: - ----- Method: WriteStream>>resetToStart (in category 'positioning') ----- - resetToStart - readLimit := position := 0.! Item was removed: - ----- Method: WriteStream>>setToEnd (in category 'positioning') ----- - setToEnd - "Refer to the comment in PositionableStream|setToEnd." - - readLimit := readLimit max: position. - super setToEnd.! Item was removed: - ----- Method: WriteStream>>size (in category 'accessing') ----- - size - - ^readLimit := readLimit max: position! Item was removed: - ----- Method: WriteStream>>space (in category 'character writing') ----- - space - "Append a space character to the receiver." - - self nextPut: Character space! Item was removed: - ----- Method: WriteStream>>space: (in category 'character writing') ----- - space: anInteger - "Append anInteger space characters to the receiver." - - anInteger timesRepeat: [self space]! Item was removed: - ----- Method: WriteStream>>store: (in category 'printing') ----- - store: anObject - "Have anObject print on the receiver for purposes of rereading." - - anObject storeOn: self! Item was removed: - ----- Method: WriteStream>>tab (in category 'character writing') ----- - tab - "Append a tab character to the receiver." - - self nextPut: Character tab! Item was removed: - ----- Method: WriteStream>>tab: (in category 'character writing') ----- - tab: anInteger - "Append anInteger tab characters to the receiver." - - anInteger timesRepeat: [self tab]! Item was removed: - ----- 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 | Smalltalk timeStamp: s]) printString. - self cr! Item was removed: - ----- Method: WriteStream>>with: (in category 'private') ----- - with: aCollection - - super on: aCollection. - position := readLimit := writeLimit := aCollection size! Item was removed: - ----- Method: WriteStream>>withAttribute:do: (in category 'private') ----- - withAttribute: att do: strmBlock - "No-op here is overriden in TextStream for font emphasis" - ^ strmBlock value! Item was removed: - ----- Method: WriteStream>>withAttributes:do: (in category 'private') ----- - withAttributes: attributes do: strmBlock - "No-op here is overriden in TextStream for font emphasis" - ^ strmBlock value! Item was removed: - (PackageInfo named: 'Collections') postscript: '"Make sure the symbol table consists of immutable sets" - #(SymbolTable NewSymbols) do: [ :variableName | - (Symbol classPool at: variableName) beReadOnlyObject ]'!
More information about the Squeak-dev mailing list |
