--- a/AbstractOperatingSystem.st Fri Jan 20 20:17:13 2017 +0000
+++ b/AbstractOperatingSystem.st Wed Jan 25 14:28:27 2017 +0000
@@ -186,23 +186,29 @@
!AbstractOperatingSystem class methodsFor:'initialization'!
getConcreteClass
+ "called at early startup to determine the kind of OS we are running on,
+ and assigning a concrete subclass of me (remember: I am abstract) to the
+ global 'OperatingSystem'.
+ Programs should never refer to any of my concrete classes directly, as
+ they may not (will not) be present when ST/X is executed under anther OS."
+
|osType|
osType := self getSystemType.
osType = 'win32' ifTrue:[
- ^ Win32OperatingSystem
+ ^ Win32OperatingSystem
].
osType = 'osx' ifTrue:[
- ^ OSXOperatingSystem
+ ^ OSXOperatingSystem
].
osType = 'os2' ifTrue:[
- ^ OS2OperatingSystem
+ ^ OS2OperatingSystem
].
osType = 'macos' ifTrue:[
- ^ MacOperatingSystem
+ ^ MacOperatingSystem
].
((osType = 'VMS') or:[osType = 'openVMS']) ifTrue:[
- ^ OpenVMSOperatingSystem
+ ^ OpenVMSOperatingSystem
].
^ UnixOperatingSystem
!
--- a/AutoDeletedFilename.st Fri Jan 20 20:17:13 2017 +0000
+++ b/AutoDeletedFilename.st Wed Jan 25 14:28:27 2017 +0000
@@ -1,5 +1,3 @@
-"{ Encoding: utf8 }"
-
"
COPYRIGHT (c) 2007 by eXept Software AG
All Rights Reserved
@@ -41,8 +39,13 @@
documentation
"
Used with temporary files - these will automatically delete themself,
- when no longer referenced.
+ when no longer referenced (i.e. when finalized)
+
See -> Filename asAutoDeletedFilename
+
+ [author:]
+ cg - original code
+ sv - fixed and enhanced
"
!
--- a/Behavior.st Fri Jan 20 20:17:13 2017 +0000
+++ b/Behavior.st Wed Jan 25 14:28:27 2017 +0000
@@ -2984,16 +2984,16 @@
This is the reverse operation to 'storeOn:'.
WARNING: storeOn: does not handle circular references and multiple
- references to the same object.
- Use #storeBinary:/readBinaryFrom: for this."
+ references to the same object.
+ Use #storeBinary:/readBinaryFrom: for this."
^ [
- |newObject|
-
- newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
- ((newObject class == self) or:[newObject isKindOf:self])
- ifTrue:[newObject]
- ifFalse:[exceptionBlock value].
+ |newObject|
+
+ newObject := self evaluatorClass evaluateFrom:aStream ifFail:exceptionBlock.
+ ((newObject class == self) or:[newObject isKindOf:self])
+ ifTrue:[newObject]
+ ifFalse:[^ exceptionBlock value].
] on:Error do:exceptionBlock.
"
@@ -3001,7 +3001,7 @@
s := WriteStream on:String new.
#(1 2 3 4) storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
@@ -3009,7 +3009,7 @@
s := WriteStream on:String new.
#[1 2 3 4] storeOn:s.
Transcript showCR:(
- Array readFrom:(ReadStream on:s contents) onError:'not an Array'
+ Array readFrom:(ReadStream on:s contents) onError:'not an Array'
)
"
"
--- a/CharacterArray.st Fri Jan 20 20:17:13 2017 +0000
+++ b/CharacterArray.st Wed Jan 25 14:28:27 2017 +0000
@@ -359,6 +359,7 @@
"Created: 3.8.1997 / 18:16:40 / cg"
! !
+
!CharacterArray class methodsFor:'cleanup'!
lowSpaceCleanup
@@ -643,6 +644,7 @@
"
! !
+
!CharacterArray class methodsFor:'pattern matching'!
matchEscapeCharacter
@@ -1048,6 +1050,7 @@
^ Unicode32String
! !
+
!CharacterArray methodsFor:'Compatibility-ANSI'!
addLineDelimiters
@@ -4994,6 +4997,8 @@
! !
+
+
!CharacterArray methodsFor:'matching - glob expressions'!
compoundMatch:aString
@@ -6431,6 +6436,14 @@
"Modified: / 06-03-2007 / 11:51:15 / cg"
!
+speciesForSubcollection
+ "answer the class, when splitting instances into subcollections"
+
+ ^ StringCollection
+
+ "Created: / 24-01-2017 / 18:54:18 / stefan"
+!
+
stringSpecies
"return the underlying strings bitsPerCharacter
(i.e. is it a regular String or a TwoByteString)"
@@ -6471,6 +6484,7 @@
"Modified: 17.4.1997 / 12:50:23 / cg"
! !
+
!CharacterArray methodsFor:'special string converting'!
asUnixFilenameString
@@ -7518,6 +7532,7 @@
"
! !
+
!CharacterArray methodsFor:'substring searching'!
findRangeOfString:subString
@@ -8331,6 +8346,7 @@
^ aVisitor visitString:self with:aParameter
! !
+
!CharacterArray class methodsFor:'documentation'!
version
--- a/Collection.st Fri Jan 20 20:17:13 2017 +0000
+++ b/Collection.st Wed Jan 25 14:28:27 2017 +0000
@@ -343,7 +343,6 @@
^ self
! !
-
!Collection methodsFor:'Compatibility-ANSI'!
identityIncludes:anObject
@@ -426,11 +425,13 @@
difference: aCollection
"Answer the set-theoretic difference of two collections."
- ^ self reject:[:each | aCollection includes: each]
+ ^ self \ aCollection
"
#(0 2 4 6 8) difference:#(2 4)
"
+
+ "Modified: / 20-01-2017 / 19:21:35 / stefan"
!
gather:aBlock
@@ -3553,7 +3554,7 @@
|newCollection|
- newCollection := self species new.
+ newCollection := self speciesForAdding new.
self do:[:each |
(aBlock value:each) ifTrue:[newCollection add:each].
].
@@ -3565,6 +3566,7 @@
"
"Modified: / 07-08-2010 / 16:26:40 / cg"
+ "Modified: / 20-01-2017 / 17:42:33 / stefan"
!
select:aBlock as:aCollectionClass
@@ -5281,43 +5283,36 @@
which are NOT also contained in the aCollection
For large collections you better use a Set for aCollection"
-
- |newCollection|
-
- newCollection := self speciesForAdding new.
- self do:[:element |
- (aCollection includes:element) ifFalse:[
- newCollection add:element
- ]
- ].
- ^ newCollection
+ ^ self select:[:eachElement | (aCollection includes:eachElement) not].
"
#(0 1 2 3 4 5 6 7 8 9) \ #(1 2 3) asSet
#(0 1 2 3 4 5 6 7 8 9) \ #(1 2 3)
- ('hello' \ 'l') asString
- "
+ ('hello' \ 'l')
+
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ \ (Dictionary withKeysAndValues:#(1 'uno' 4 'quatro'))
+ "
+
+ "Modified (comment): / 20-01-2017 / 19:28:00 / stefan"
!
intersect:aCollection
"return a new set containing all elements of the receiver,
which are also contained in the argument collection.
- For large collections you better use a Set for self"
-
- |newCollection|
-
- newCollection := self speciesForAdding new.
- aCollection do:[:element |
- (self includes:element) ifTrue:[
- newCollection add:element
- ]
- ].
- ^ newCollection
+ For large collections you better use a Set for aCollection"
+
+ ^ aCollection select:[:eachElement | self includes:eachElement].
"
#(0 1 2 3 4 5 6 7 8 9) asSet intersect:#(1 2 3 11)
#(0 1 2 3 4 5 6 7 8 9) intersect:#(1 2 3 11)
- "
+
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ intersect:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+ "
+
+ "Modified: / 20-01-2017 / 19:33:14 / stefan"
!
union:aCollection
@@ -5334,7 +5329,12 @@
"
#(0 2 4 6 8) union:#(1 3 5 7)
#(0 2 4 6 8) union:#(0 1 3 5 7)
- "
+
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ union:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+ "
+
+ "Modified (comment): / 20-01-2017 / 19:35:23 / stefan"
!
xor:aCollection
@@ -5361,6 +5361,9 @@
"
#(0 1 2 3 4 5 6 7 8 9) xor:#(1 2 3 11)
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ xor:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+
"
"
@@ -5371,6 +5374,8 @@
c1 symmetricDifference:c2.
self assert:(c1 symmetricDifference:c2) asSet = (c2 symmetricDifference:c1) asSet
"
+
+ "Modified (comment): / 20-01-2017 / 19:37:58 / stefan"
! !
!Collection methodsFor:'sorting & reordering'!
--- a/Dictionary.st Fri Jan 20 20:17:13 2017 +0000
+++ b/Dictionary.st Wed Jan 25 14:28:27 2017 +0000
@@ -1802,28 +1802,6 @@
"Modified: 20.4.1996 / 11:31:15 / cg"
!
-collect:aBlock
- "for each element in the receiver, evaluate the argument, aBlock
- and return a Bag with the results.
-
- See also:
- #associationsCollect: (which passes key-value associations)
- #keysAndValuesCollect: (which passes keys & values separately)
-
- WARNING: do not add/remove elements while iterating over the receiver.
- Iterate over a copy to do this."
-
- |newCollection|
-
- newCollection := Bag new.
- self do:[:each |
- newCollection add:(aBlock value:each)
- ].
- ^ newCollection
-
- "Modified: 20.4.1996 / 11:29:58 / cg"
-!
-
do:aBlock
"perform the block for all values in the collection.
@@ -2036,6 +2014,34 @@
Same as #do: - for VisualWorks compatibility"
^ self do:aBlock
+!
+
+xor:aCollection
+ "return a new set containing all elements,
+ which are contained in either the receiver or aCollection, but not in both."
+
+ |newCollection|
+
+ newCollection := self species new.
+ self keysAndValuesDo:[:key :value |
+ (aCollection includes:value) ifFalse:[
+ newCollection at:key put:value
+ ]
+ ].
+ aCollection keysAndValuesDo:[:key :value |
+ (self includes:value) ifFalse:[
+ newCollection at:key put:value
+ ]
+ ].
+
+ ^ newCollection
+
+ "
+ (Dictionary withKeysAndValues:#(1 'uno' 2 'due' 3 'tre' 4 'quatro'))
+ xor:(Dictionary withKeysAndValues:#(1 'uno' 4 'quatro' 5 'cinque'))
+ "
+
+ "Created: / 20-01-2017 / 19:43:48 / stefan"
! !
@@ -2242,6 +2248,17 @@
^ Array basicNew:n
! !
+!Dictionary methodsFor:'queries'!
+
+speciesForCollecting
+ "like species, but used when doing collect operations.
+ Redefined for collections which return a different classes object when doing collect."
+
+ ^ Bag
+
+ "Created: / 20-01-2017 / 17:46:16 / stefan"
+! !
+
!Dictionary methodsFor:'searching'!
findFirst:aBlock ifNone:exceptionValue
--- a/LimitedPrecisionReal.st Fri Jan 20 20:17:13 2017 +0000
+++ b/LimitedPrecisionReal.st Wed Jan 25 14:28:27 2017 +0000
@@ -312,7 +312,7 @@
|num|
- num := super readFrom:aStringOrStream onError:exceptionBlock.
+ num := super readFrom:aStringOrStream onError:[^ exceptionBlock value].
^ self coerce:num
"
@@ -327,6 +327,10 @@
LongFloat readFrom:'.1'
LongFloat readFrom:'0.1'
LongFloat readFrom:'0'
+
+ LimitedPrecisionReal readFrom:'bla' onError:nil
+ Float readFrom:'bla' onError:nil
+ ShortFloat readFrom:'bla' onError:nil
"
"Created: / 07-01-1998 / 16:17:19 / cg"
@@ -1193,6 +1197,7 @@
! !
+
!LimitedPrecisionReal methodsFor:'printing & storing'!
printOn:aStream
@@ -1263,6 +1268,7 @@
^ 0
! !
+
!LimitedPrecisionReal methodsFor:'testing'!
isFinite
--- a/MethodDictionary.st Fri Jan 20 20:17:13 2017 +0000
+++ b/MethodDictionary.st Wed Jan 25 14:28:27 2017 +0000
@@ -235,22 +235,6 @@
!MethodDictionary methodsFor:'enumerating'!
-collect:aBlock
- "for each element in the receiver, evaluate the argument, aBlock
- and return a Bag with the results."
-
- |newCollection|
-
- newCollection := Bag new.
- self do:[:value |
- newCollection add:(aBlock value:value)
- ].
- ^ newCollection
-
- "Created: / 24-06-1996 / 17:41:41 / cg"
- "Modified: / 08-08-2006 / 16:12:04 / cg"
-!
-
do:aBlock
"evaluate aBlock for each value (i.e. each method)"
@@ -330,6 +314,12 @@
"return the number of elements (associations) in the receiver"
^ self basicSize // 2
+!
+
+speciesForCollecting
+ ^ Bag
+
+ "Created: / 20-01-2017 / 18:07:53 / stefan"
! !
!MethodDictionary methodsFor:'removing'!
--- a/NoHandlerError.st Fri Jan 20 20:17:13 2017 +0000
+++ b/NoHandlerError.st Wed Jan 25 14:28:27 2017 +0000
@@ -520,6 +520,7 @@
!
unhandledException
+ <resource: #obsolete>
"the original exception, which was responsible for this.
Obsolete: use #exception for ANSI comatibility."
--- a/Object.st Fri Jan 20 20:17:13 2017 +0000
+++ b/Object.st Wed Jan 25 14:28:27 2017 +0000
@@ -14,22 +14,22 @@
"{ NameSpace: Smalltalk }"
nil subclass:#Object
- instanceVariableNames:''
- classVariableNames:'AbortAllSignal AbortSignal ActivityNotificationSignal
- DebuggerHooks DeepCopyErrorSignal Dependencies
- ElementOutOfBoundsSignal EnabledBreakPoints ErrorRecursion
- ErrorSignal FinalizationLobby HaltSignal IndexNotFoundSignal
- InfoPrinting InformationSignal InternalErrorSignal
- KeyNotFoundSignal MessageNotUnderstoodSignal
- NonIntegerIndexSignal NonWeakDependencies NotFoundSignal
- OSSignalInterruptSignal ObjectAttributes
- ObjectAttributesAccessLock PartialErrorPrintLine
- PartialInfoPrintLine PrimitiveFailureSignal
- RecursionInterruptSignal RecursiveStoreStringSignal
- SubscriptOutOfBoundsSignal SynchronizationSemaphores
- UserInterruptSignal UserNotificationSignal WarningSignal'
- poolDictionaries:''
- category:'Kernel-Objects'
+ instanceVariableNames:''
+ classVariableNames:'AbortAllSignal AbortSignal ActivityNotificationSignal
+ DebuggerHooks DeepCopyErrorSignal Dependencies
+ ElementOutOfBoundsSignal EnabledBreakPoints ErrorRecursion
+ ErrorSignal FinalizationLobby HaltSignal IndexNotFoundSignal
+ InfoPrinting InformationSignal InternalErrorSignal
+ KeyNotFoundSignal MessageNotUnderstoodSignal
+ NonIntegerIndexSignal NonWeakDependencies NotFoundSignal
+ OSSignalInterruptSignal ObjectAttributes
+ ObjectAttributesAccessLock PartialErrorPrintLine
+ PartialInfoPrintLine PrimitiveFailureSignal
+ RecursionInterruptSignal RecursiveStoreStringSignal
+ SubscriptOutOfBoundsSignal SynchronizationSemaphores
+ UserInterruptSignal UserNotificationSignal WarningSignal'
+ poolDictionaries:''
+ category:'Kernel-Objects'
!
!Object class methodsFor:'documentation'!
@@ -257,6 +257,7 @@
"Modified: / 4.8.1999 / 08:54:06 / stefan"
! !
+
!Object class methodsFor:'Compatibility-ST80'!
rootError
@@ -495,6 +496,7 @@
InfoPrinting := aBoolean
! !
+
!Object class methodsFor:'queries'!
isAbstract
@@ -517,6 +519,8 @@
! !
+
+
!Object methodsFor:'Compatibility-Dolphin'!
stbFixup: anSTBInFiler at: newObjectIndex
@@ -1784,6 +1788,8 @@
"
! !
+
+
!Object methodsFor:'attributes access'!
objectAttributeAt:attributeKey
@@ -1911,6 +1917,8 @@
! !
+
+
!Object methodsFor:'change & update'!
broadcast:aSelectorSymbol
@@ -2091,6 +2099,7 @@
^ aBlock ensure:[ self addDependent:someone ]
! !
+
!Object methodsFor:'comparing'!
= anObject
@@ -3392,7 +3401,9 @@
!
todo
- "used to mark code pieces that have to be implemented"
+ "used to mark code pieces that have to be implemented.
+ Halts when reached in development mode;
+ ignored in deployed production code."
<resource: #skipInDebuggersWalkBack>
@@ -3408,7 +3419,8 @@
!
todo:aBlock
- "used to mark code pieces that have to be implemented"
+ "used to mark code pieces that have to be implemented.
+ The coe in aBlock is ignored."
<resource: #skipInDebuggersWalkBack>
@@ -8187,6 +8199,7 @@
^ self
! !
+
!Object methodsFor:'secure message sending'!
?:selector
@@ -8792,6 +8805,7 @@
"
! !
+
!Object methodsFor:'synchronized evaluation'!
freeSynchronizationSemaphore
@@ -10013,13 +10027,6 @@
^ false
!
-isSocket
- "return true, if the receiver is some kind of socket;
- false returned here - the method is only redefined in Socket."
-
- ^ false
-!
-
isSocketAddress
^ false
!
@@ -10531,7 +10538,7 @@
notify:aString
"launch a Notifier, telling user something.
Use #information: for ignorable messages.
- If nobody handles the exception, the dafault action of UserNotification
+ If nobody handles the exception, the default action of UserNotification
pops up a warn dialog."
@@ -10547,7 +10554,8 @@
self notify:'hello there'
"
- "Modified: 20.5.1996 / 10:28:48 / cg"
+ "Modified: / 20-05-1996 / 10:28:48 / cg"
+ "Modified (comment): / 23-01-2017 / 16:17:50 / stefan"
!
warn:aString
@@ -10593,6 +10601,9 @@
^ aVisitor visitObject:self with:aParameter
! !
+
+
+
!Object class methodsFor:'documentation'!
version
--- a/OrderedDictionary.st Fri Jan 20 20:17:13 2017 +0000
+++ b/OrderedDictionary.st Wed Jan 25 14:28:27 2017 +0000
@@ -313,6 +313,28 @@
"
!
+firstKey
+ "Return the first key of the receiver.
+ Raises an error if the receiver contains no elements."
+
+ ^ order first
+
+ "
+ OrderedDictionary new first
+ OrderedDictionary new firstKey
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ first
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ firstKey
+ "
+!
+
keyAt:index
"get the key at the given index"
@@ -354,6 +376,28 @@
"
!
+lastKey
+ "Return the last key of the receiver.
+ Raises an error if the receiver contains no elements."
+
+ ^ order last
+
+ "
+ OrderedDictionary new last
+ OrderedDictionary new lastKey
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ last
+
+ OrderedDictionary new
+ at:'foo' put:'Foo';
+ at:'bar' put:'Bar';
+ lastKey
+ "
+!
+
order
"returns the keys in the order of their appearance"
--- a/Rectangle.st Fri Jan 20 20:17:13 2017 +0000
+++ b/Rectangle.st Wed Jan 25 14:28:27 2017 +0000
@@ -1518,31 +1518,128 @@
"Created: 25.1.1997 / 17:30:21 / cg"
!
-areasOutside: aRectangle
- "Answer an Array of Rectangles comprising the parts of the receiver not
- intersecting aRectangle."
+areasOutside:aRectangle
+ "Answer an Array of Rectangles comprising the parts of the receiver
+ not intersecting aRectangle.
+ That is all areas with no common pixels."
+
+ |areas|
+
+ "Make sure the intersection is non-empty"
+ (self origin <= aRectangle corner and: [aRectangle origin <= self corner]) ifFalse: [
+ ^ Array with: self
+ ].
+ areas := OrderedCollection new.
+ self areasOutside:aRectangle do:[:r | areas add:r].
+ ^ areas asArray
+
+ "/ cg: the old code below was wrong ...
- | areas yOrigin yCorner origin corner|
+"/ "----------------------------------------------------------------
+"/ | added for GNU-ST compatibility
+"/ |
+"/ | author: Doug McCallum <uunet!!ico.isc.com!!dougm>
+"/ |
+"/ |areasOutside: aRectangle
+"/ | most complicated of the Rectangle primitives
+"/ | The basic methodology is to first determine that there is an
+"/ | intersection by finding the overlapping rectangle. From the
+"/ | overlapping rectangle, first determine if it runs along an edge.
+"/ | If it doesn't, extend the rectangle up to the top edge and add
+"/ | the new rectangle to the collection and start the rest of the
+"/ | process. If the left edge does not touch the left edge of self,
+"/ | extend it to the edge saving the new rectangle. Then do the
+"/ | same to the right edge. Then check top and bottom edges. Most
+"/ | of the time only 2 or 3 rectangles get formed, occasionally 4.
+"/ | It should be possible to never get more than 3 but requires more
+"/ | work.
+"/ ----------------------------------------------------------------"
+"/
+"/ | collect iRect tmp |
+"/
+"/ iRect := self intersect: aRectangle.
+"/ iRect isNil ifTrue: [^nil]. "case of no intersection"
+"/ "the collect collection gathers Rectangles"
+"/ collect := OrderedCollection new: 4.
+"/ "is it floating or on the edge?"
+"/ (((((iRect top) ~= self top)
+"/ and: [ (iRect bottom) ~= self bottom ])
+"/ and: [ (iRect left) ~= self left ])
+"/ and: [ (iRect right) ~= self right ] )
+"/ ifTrue: "entirely in the center."
+"/ [tmp := Rectangle origin: (Point x: iRect left y: self top)
+"/ corner: iRect bottomRight.
+"/ collect add: tmp.
+"/ iRect := iRect merge: tmp].
+"/ ((iRect left) ~= self left)
+"/ ifTrue: "doesn't touch left edge so make it touch"
+"/ [tmp := Rectangle origin: (Point x: self left y: iRect top)
+"/ corner: iRect bottomLeft.
+"/ collect add: tmp.
+"/ "merge new (tmp) with overlap to keep track"
+"/ iRect := iRect merge: tmp].
+"/ ((iRect right) ~= self right)
+"/ ifTrue: "doesn't touch right edge so extend it"
+"/ [tmp := Rectangle origin: iRect topRight
+"/ corner: (Point x: self right y: iRect bottom).
+"/ collect add: tmp.
+"/ iRect := iRect merge: tmp].
+"/ (((iRect left) ~= self left) or: [(iRect top) ~= self top])
+"/ ifTrue: "whole top part can be taken now"
+"/ [tmp := Rectangle origin: self origin corner: iRect topRight.
+"/ collect add: tmp].
+"/ (((iRect right) ~= self right) or: [(iRect bottom) ~= self bottom])
+"/ ifTrue: "whole bottom open and can be taken"
+"/ [tmp := Rectangle origin: iRect bottomLeft corner: self corner.
+"/ collect add: tmp].
+"/ ^collect
+!
+
+areasOutside:aRectangle do:aBlock
+ "evaluate aBlock for Rectangles comprising the parts of the receiver
+ not intersecting aRectangle.
+ That is all areas with no common pixels."
+
+ |yOrigin yCorner origin corner|
origin := self origin.
corner := self corner.
"Make sure the intersection is non-empty"
(origin <= aRectangle corner and: [aRectangle origin <= corner])
- ifFalse: [^ Array with: self].
- areas := OrderedCollection new.
- aRectangle origin y > origin y
- ifTrue: [areas addLast: (origin corner: corner x @ (yOrigin := aRectangle origin y))]
- ifFalse: [yOrigin := origin y].
- aRectangle corner y < corner y
- ifTrue: [areas addLast: (origin x @ (yCorner := aRectangle corner y) corner: corner)]
- ifFalse: [yCorner := corner y].
- aRectangle origin x > origin x
- ifTrue: [areas addLast: (origin x @ yOrigin corner: aRectangle origin x @ yCorner)].
- aRectangle corner x < corner x
- ifTrue: [areas addLast: (aRectangle corner x @ yOrigin corner: corner x @ yCorner)].
- ^areas
+ ifFalse: [ aBlock value:self. ^ self].
+ aRectangle origin y > origin y ifTrue: [
+ aBlock value: (origin corner: corner x @ (yOrigin := aRectangle origin y))
+ ] ifFalse: [
+ yOrigin := origin y
+ ].
+ aRectangle corner y < corner y ifTrue: [
+ aBlock value: (origin x @ (yCorner := aRectangle corner y) corner: corner)
+ ] ifFalse: [
+ yCorner := corner y
+ ].
+ aRectangle origin x > origin x ifTrue: [
+ aBlock value: (origin x @ yOrigin corner: aRectangle origin x @ yCorner)
+ ].
+ aRectangle corner x < corner x ifTrue: [
+ aBlock value: (aRectangle corner x @ yOrigin corner: corner x @ yCorner)
+ ].
+
+ "
+ self assert:
+ ((0@0 corner:100@100) areasOutside:(0@0 corner:50@50)) asArray
+ = { (Rectangle origin:0@50 extent:100@50) . (Rectangle origin:50@0 extent:50@50) }
+
+ self assert:
+ ((0@0 corner:150@100) areasOutside:(0@0 corner:100@100)) asArray
+ = { (Rectangle origin:100@0 extent:50@100) }
+
+ self assert:
+ ((0@0 corner:100@150) areasOutside:(0@0 corner:100@100)) asArray
+ = { (Rectangle origin:0@100 extent:100@50) }
+ "
+
"/ cg: the old code below was wrong ...
"/ "----------------------------------------------------------------
--- a/SequenceableCollection.st Fri Jan 20 20:17:13 2017 +0000
+++ b/SequenceableCollection.st Wed Jan 25 14:28:27 2017 +0000
@@ -2484,7 +2484,7 @@
stop "{ Class:SmallInteger }"
mySize "{ Class:SmallInteger }"|
- pieces := OrderedCollection new.
+ pieces := self speciesForSubcollection new.
start := 1. stop := start + pieceSize - 1.
mySize := self size.
[stop <= mySize] whileTrue:[
@@ -2501,6 +2501,8 @@
'123123123123123123' asCollectionOfSubCollectionsOfSize:3
'12312312312312312312' asCollectionOfSubCollectionsOfSize:3
"
+
+ "Modified: / 24-01-2017 / 18:55:07 / stefan"
!
asCollectionOfSubCollectionsSeparatedBy:anElement
@@ -2513,7 +2515,7 @@
mySize "{ Class:SmallInteger }" startIndex "{ Class:SmallInteger }"
stopIndex "{ Class:SmallInteger }" |
- cols := OrderedCollection new.
+ cols := self speciesForSubcollection new.
myClass := self species.
mySize := self size.
@@ -2544,6 +2546,8 @@
'foobarbaz' asCollectionOfSubCollectionsSeparatedBy: $-.
'' asCollectionOfSubCollectionsSeparatedBy: $-.
"
+
+ "Modified (format): / 24-01-2017 / 18:55:53 / stefan"
!
asCollectionOfSubCollectionsSeparatedBy:anElement do:aBlock
@@ -2612,33 +2616,36 @@
startIndex "{ Class:SmallInteger }"
stopIndex "{ Class:SmallInteger }" |
- items := OrderedCollection new.
+ items := self speciesForSubcollection new.
myClass := self species.
startIndex := 1.
done := false.
[done] whileFalse:[
- stopIndex := self indexOfSubCollection:aSeparatorCollection startingAt:startIndex.
- stopIndex == 0 ifTrue:[
- stopIndex := self size.
- done := true.
- ] ifFalse: [
- stopIndex := stopIndex - 1.
- ].
-
- (stopIndex < startIndex) ifTrue: [
- items add:(myClass new:0)
- ] ifFalse: [
- items add:(self copyFrom:startIndex to:stopIndex)
- ].
- startIndex := stopIndex + (aSeparatorCollection size) + 1.
+ stopIndex := self indexOfSubCollection:aSeparatorCollection startingAt:startIndex.
+ stopIndex == 0 ifTrue:[
+ stopIndex := self size.
+ done := true.
+ ] ifFalse: [
+ stopIndex := stopIndex - 1.
+ ].
+
+ (stopIndex < startIndex) ifTrue: [
+ items add:(myClass new:0)
+ ] ifFalse: [
+ items add:(self copyFrom:startIndex to:stopIndex)
+ ].
+ startIndex := stopIndex + (aSeparatorCollection size) + 1.
].
^ items
"
'1::2::3::4::5::' asCollectionOfSubCollectionsSeparatedByAll:'::'
#(1 2 3 1 2 3 4 3 1 1 2 3 1 4 5) asCollectionOfSubCollectionsSeparatedByAll:#(3 1)
- "
+ 'hello+#world+#here' asCollectionOfSubCollectionsSeparatedByAll:'+#'
+ "
+
+ "Modified (comment): / 24-01-2017 / 18:57:03 / stefan"
!
asCollectionOfSubCollectionsSeparatedByAny:aCollectionOfSeparators
@@ -2669,25 +2676,25 @@
stop "{ Class:SmallInteger }"
mySize "{ Class:SmallInteger }"|
- words := OrderedCollection new.
+ words := self speciesForSubcollection new.
start := 1.
mySize := self size.
[start <= mySize] whileTrue:[
- "skip multiple separators"
- [ aBlock value:(self at:start)] whileTrue:[
- start := start + 1 .
- start > mySize ifTrue:[
- ^ words
- ].
- ].
-
- stop := self findFirst:aBlock startingAt:start.
- stop == 0 ifTrue:[
- words add:(self copyFrom:start to:mySize).
- ^ words
- ].
- words add:(self copyFrom:start to:(stop - 1)).
- start := stop
+ "skip multiple separators"
+ [ aBlock value:(self at:start)] whileTrue:[
+ start := start + 1 .
+ start > mySize ifTrue:[
+ ^ words
+ ].
+ ].
+
+ stop := self findFirst:aBlock startingAt:start.
+ stop == 0 ifTrue:[
+ words add:(self copyFrom:start to:mySize).
+ ^ words
+ ].
+ words add:(self copyFrom:start to:(stop - 1)).
+ start := stop
].
^ words
@@ -2696,6 +2703,8 @@
'h1e2l3l4o' asCollectionOfSubCollectionsSeparatedByAnyForWhich:[:ch | ch isDigit]
#(1 9 2 8 3 7 4 6 5 5) asCollectionOfSubCollectionsSeparatedByAnyForWhich:[:n | n odd]
"
+
+ "Modified (format): / 24-01-2017 / 18:57:57 / stefan"
!
asSequenceableCollection
@@ -7852,6 +7861,14 @@
^ self subclassResponsibility
!
+speciesForSubcollection
+ "answer the class, when splitting instances into subcollections"
+
+ ^ OrderedCollection
+
+ "Created: / 24-01-2017 / 18:53:44 / stefan"
+!
+
zeroIndex
"return the index value which is returned when nothing
is found in an indexOf* kind of search.
@@ -9307,6 +9324,26 @@
"Modified: / 22-10-2008 / 15:37:48 / cg"
!
+removeAndAddFirst:anElement
+ "if the anElement is in the receiver collection, remove it (compare by equality);
+ then add it to the beginning.
+ Effectively moving the element to the beginning if it is already present,
+ or adding it to the beginning if not already there"
+
+ self remove:anElement ifAbsent:[].
+ self addFirst:anElement.
+!
+
+removeAndAddLast:anElement
+ "if the anElement is in the receiver collection, remove it (compare by equality);
+ then add it to the end.
+ Effectively moving the element to the end if it is already present,
+ or adding it to the end if not already there"
+
+ self remove:anElement ifAbsent:[].
+ self addLast:anElement.
+!
+
reverse
"destructively reverse the order of the elements inplace.
WARNING: this is a destructive operation, which modifies the receiver.
--- a/Smalltalk.st Fri Jan 20 20:17:13 2017 +0000
+++ b/Smalltalk.st Wed Jan 25 14:28:27 2017 +0000
@@ -2249,7 +2249,10 @@
<resource: #obsolete>
"evaluate the argument, aBlock for all keys in the Smalltalk dictionary"
+ self obsoleteMethodWarning:'please use #keysDo:'.
self keysDo:aBlock
+
+ "Modified: / 20-01-2017 / 17:52:40 / stefan"
!
allMethodCategories
--- a/SystemChangeNotifier.st Fri Jan 20 20:17:13 2017 +0000
+++ b/SystemChangeNotifier.st Wed Jan 25 14:28:27 2017 +0000
@@ -1,5 +1,14 @@
-"{ Encoding: utf8 }"
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+ All Rights Reserved
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
@@ -13,6 +22,21 @@
!SystemChangeNotifier class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 2009 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+
+"
+!
+
documentation
"
For now, this implementation is mostly for squeak compatibility.
--- a/UnixFilename.st Fri Jan 20 20:17:13 2017 +0000
+++ b/UnixFilename.st Wed Jan 25 14:28:27 2017 +0000
@@ -45,7 +45,7 @@
examples
"
- (self named:'/tmp/äöü') writeStream close
+ (self named:'/tmp/') writeStream close
"
! !
@@ -144,13 +144,14 @@
!UnixFilename methodsFor:'file queries'!
fileType
- "this returns a string describing the type of contents of
- the file. This is done using the unix 'file' command,
+ "this returns a string describing the type of contents of the file.
+ This is done using the unix 'file' command,
(which usually is configurable by /etc/magic).
Warning:
Since the returned string differs among systems (and language settings),
it is only useful for user-information;
- NOT as a tag to be used by a program."
+ NOT as a tag to be used by a program.
+ For this, use mimeType or mimeTypeOfContents."
|typeString|
--- a/UserMessage.st Fri Jan 20 20:17:13 2017 +0000
+++ b/UserMessage.st Wed Jan 25 14:28:27 2017 +0000
@@ -1,3 +1,14 @@
+"
+ COPYRIGHT (c) 2001 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
"{ Package: 'stx:libbasic' }"
"{ NameSpace: Smalltalk }"
@@ -11,6 +22,20 @@
!UserMessage class methodsFor:'documentation'!
+copyright
+"
+ COPYRIGHT (c) 2001 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
documentation
"
added for vw5i compatibility, which accesses messageCatalogs