Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-mt.265.mcz
==================== Summary ====================
Name: MorphicExtras-mt.265
Author: mt
Time: 26 September 2019, 1:54:11.371102 pm
UUID: cdf603c6-b37f-4141-802b-98bc37b28605
Ancestors: MorphicExtras-kfr.264
Use system scale for paint-box morph instead of new preference. Note that this code still as etoys dependencies that need to be resolved.
=============== Diff against MorphicExtras-kfr.264 ===============
Item was added:
+ ----- Method: PaintBoxMorph>>beSupersized (in category 'initialization') -----
+ beSupersized
+ | scaleFactor |
+ scaleFactor := RealEstateAgent scaleFactor.
+ self isFlexed
+ ifFalse: [self scaleFactor: scaleFactor.
+ self position: self position / scaleFactor.
+ self changed]!
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph:paintBoxPosition: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: aPosition
"NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case. The palette needs already to be in the world for this to work."
| w |
(w := aPasteUpMorph world) addMorphInLayer: self. "in back of palette"
enclosingPasteUpMorph := aPasteUpMorph.
hostView := aSketchMorph. "may be ownerless"
self bounds: boundsToUse.
palette := w paintBox focusMorph: self.
palette beStatic. "give Nebraska whatever help we can"
palette addWeakDependent: self.
aPosition ifNotNil:
[w addMorphFront: palette. "bring to front"
palette position: aPosition.
+ palette beSupersized].
- Preferences useBiggerPaintingBox ifTrue: [palette beSupersized]].
paintingForm := Form extent: bounds extent depth: w assuredCanvas depth.
self dimTheWindow.
self addRotationScaleHandles.
aSketchMorph ifNotNil:
[
aSketchMorph form
displayOn: paintingForm
at: (hostView boundsInWorld origin - bounds origin - hostView form offset)
clippingBox: (0@0 extent: paintingForm extent)
rule: Form over
fillColor: nil. "assume they are the same depth".
undoBuffer := paintingForm deepCopy.
rotationCenter := aSketchMorph rotationCenter]!
Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk:
http://source.squeak.org/trunk/MorphicExtras-kfr.264.mcz
==================== Summary ====================
Name: MorphicExtras-kfr.264
Author: kfr
Time: 23 September 2019, 8:11:15.349115 pm
UUID: 8d0cb732-a340-be45-b4a7-73e70163ce63
Ancestors: MorphicExtras-mt.263
Honor preference useBiggerPaintingBox
=============== Diff against MorphicExtras-mt.263 ===============
Item was changed:
----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph:paintBoxPosition: (in category 'initialization') -----
initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: aPosition
"NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case. The palette needs already to be in the world for this to work."
| w |
(w := aPasteUpMorph world) addMorphInLayer: self. "in back of palette"
enclosingPasteUpMorph := aPasteUpMorph.
hostView := aSketchMorph. "may be ownerless"
self bounds: boundsToUse.
palette := w paintBox focusMorph: self.
palette beStatic. "give Nebraska whatever help we can"
palette addWeakDependent: self.
aPosition ifNotNil:
[w addMorphFront: palette. "bring to front"
+ palette position: aPosition.
+ Preferences useBiggerPaintingBox ifTrue: [palette beSupersized]].
- palette position: aPosition].
paintingForm := Form extent: bounds extent depth: w assuredCanvas depth.
self dimTheWindow.
self addRotationScaleHandles.
aSketchMorph ifNotNil:
[
aSketchMorph form
displayOn: paintingForm
at: (hostView boundsInWorld origin - bounds origin - hostView form offset)
clippingBox: (0@0 extent: paintingForm extent)
rule: Form over
fillColor: nil. "assume they are the same depth".
undoBuffer := paintingForm deepCopy.
rotationCenter := aSketchMorph rotationCenter]!
Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.894.mcz
==================== Summary ====================
Name: Tools-mt.894
Author: mt
Time: 26 September 2019, 11:51:47.732232 am
UUID: 49cc71d2-c009-b546-a310-b7bc31cd2eb0
Ancestors: Tools-mt.893
Fixes recent regression with "create" button in debugger notifier. Cleans up message categories to make the notifier functionality more clear.
=============== Diff against Tools-mt.893 ===============
Item was changed:
+ ----- Method: Debugger>>askForCategoryIn:default: (in category 'notifier support') -----
- ----- Method: Debugger>>askForCategoryIn:default: (in category 'context stack menu') -----
askForCategoryIn: aClass default: aString
| categories index category |
categories := OrderedCollection with: 'new ...'.
categories addAll: (aClass allMethodCategoriesIntegratedThrough: Object).
index := UIManager default
chooseFrom: categories
title: 'Please provide a good category for the new method!!' translated.
index = 0 ifTrue: [^ aString].
category := index = 1 ifTrue: [UIManager default request: 'Enter category name:']
ifFalse: [categories at: index].
^ category isEmpty ifTrue: [^ aString] ifFalse: [category]!
Item was changed:
+ ----- Method: Debugger>>askForSuperclassOf:toImplement:ifCancel: (in category 'notifier support') -----
- ----- Method: Debugger>>askForSuperclassOf:toImplement:ifCancel: (in category 'private') -----
askForSuperclassOf: aClass toImplement: aSelector ifCancel: cancelBlock
| classes chosenClassIndex |
classes := aClass withAllSuperclasses.
chosenClassIndex := UIManager default
chooseFrom: (classes collect: [:c | c name])
title: 'Define #', aSelector, ' in which class?'.
chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
^ classes at: chosenClassIndex!
Item was changed:
+ ----- Method: Debugger>>askForSuperclassOf:upTo:toImplement:ifCancel: (in category 'notifier support') -----
- ----- Method: Debugger>>askForSuperclassOf:upTo:toImplement:ifCancel: (in category 'private') -----
askForSuperclassOf: aClass upTo: superclass toImplement: aSelector ifCancel: cancelBlock
| classes chosenClassIndex |
classes := aClass withAllSuperclasses reject: [:cls | aClass isKindOf: cls].
chosenClassIndex := UIManager default
chooseFrom: (classes collect: [:c | c name])
title: 'Define #', aSelector, ' in which class?'.
chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
^ classes at: chosenClassIndex!
Item was changed:
+ ----- Method: Debugger>>contextStackIndex (in category 'context stack - message list') -----
- ----- Method: Debugger>>contextStackIndex (in category 'context stack (message list)') -----
contextStackIndex
"Answer the index of the selected context."
^contextStackIndex!
Item was changed:
+ ----- Method: Debugger>>contextStackList (in category 'context stack - message list') -----
- ----- Method: Debugger>>contextStackList (in category 'context stack (message list)') -----
contextStackList
"Answer the array of contexts."
^contextStackList!
Item was changed:
+ ----- Method: Debugger>>createImplementingMethod (in category 'notifier buttons') -----
- ----- Method: Debugger>>createImplementingMethod (in category 'private') -----
createImplementingMethod
"Should only be called when this Debugger was created in response to a
NotYetImplemented exception. All we need to do is pop the signalling context off the stack and open the #notYetImplemented method."
| signallingContext |
+ self initializeFull.
signallingContext := self selectedContext sender.
"Pop the signalling context off the stack"
self resetContext: signallingContext.
self debug.!
Item was changed:
+ ----- Method: Debugger>>createMethod (in category 'notifier buttons') -----
- ----- Method: Debugger>>createMethod (in category 'private') -----
createMethod
"Should only be called when this Debugger was created in response to a
MessageNotUnderstood exception. Create a stub for the method that was
missing and proceed into it."
| msg chosenClass |
+ self initializeFull.
msg := self contextStackTop exceptionMessage.
chosenClass := self
askForSuperclassOf: self contextStackTop receiver class
toImplement: msg selector
ifCancel: [^self].
self implementMissingMethod: msg inClass: chosenClass.!
Item was changed:
+ ----- Method: Debugger>>createOverridingMethod (in category 'notifier buttons') -----
- ----- Method: Debugger>>createOverridingMethod (in category 'private') -----
createOverridingMethod
"Should only be called when this Debugger was created in response to a
SubclassResponsibility exception. Create a stub for the method that needs
overriding and proceed into it. Let the user only select a class in the
inheritance chain between the actual class and the class declaring the
subclassResponsibility."
| chosenClass msg category |
+ self initializeFull.
msg := self contextStackTop exceptionMessage.
chosenClass := self
askForSuperclassOf: self contextStackTop receiver class
upTo: self contextStackTop sender method methodClass
toImplement: msg selector
ifCancel: [^self].
"Use the same category as the marker method."
category := self contextStackTop sender selectorCategory.
self implementOverridingMethod: msg inClass: chosenClass inCategory: category.!
Item was changed:
+ ----- Method: Debugger>>debugAt: (in category 'notifier buttons') -----
- ----- Method: Debugger>>debugAt: (in category 'initialize') -----
debugAt: anInteger
"Opens a full debugger with the given index selected. See #initializeFull to understand why contextStackIndex is set directly."
contextStackIndex := anInteger.
^ self debug!
Item was changed:
+ ----- Method: Debugger>>expandNotifierStack (in category 'context stack - message list') -----
- ----- Method: Debugger>>expandNotifierStack (in category 'context stack (message list)') -----
expandNotifierStack
"Show a small amount of stack in the context pane. Useful for notifiers."
self okToChange ifFalse: [^ self].
self newStack: (self contextStackTop stackOfSize: self class notifierStackSize).
self changed: #contextStackList.
!
Item was changed:
+ ----- Method: Debugger>>expandStack (in category 'context stack - message list') -----
- ----- Method: Debugger>>expandStack (in category 'context stack (message list)') -----
expandStack
"Show a substantial amount of stack in the context pane."
self okToChange ifFalse: [^ self].
self newStack: (self contextStackTop stackOfSize: self class fullStackSize).
self changed: #contextStackList.
!
Item was changed:
+ ----- Method: Debugger>>fullyExpandStack (in category 'context stack - message list') -----
- ----- Method: Debugger>>fullyExpandStack (in category 'context stack (message list)') -----
fullyExpandStack
"Expand the stack to include all of it. Well, almost all of it, we better maintain sane limits too."
self okToChange ifFalse: [^ self].
self newStack: (self contextStackTop stackOfSize: self class stackSizeLimit - contextStack size).
self changed: #contextStackList.!
Item was changed:
+ ----- Method: Debugger>>implementMissingMethod:inClass: (in category 'notifier support') -----
- ----- Method: Debugger>>implementMissingMethod:inClass: (in category 'context stack menu') -----
implementMissingMethod: aMessage inClass: aClass
^ self
implementMissingMethod: aMessage
inClass: aClass
inCategory: (self askForCategoryIn: aClass default: 'as yet unclassified').!
Item was changed:
+ ----- Method: Debugger>>implementMissingMethod:inClass:inCategory: (in category 'notifier support') -----
- ----- Method: Debugger>>implementMissingMethod:inClass:inCategory: (in category 'context stack menu') -----
implementMissingMethod: aMessage inClass: aClass inCategory: aSymbol
"Create a stub implementation of the missing message and sew it onto the top of the stack, ensuring the context's arguments are set correctly. Debug the new context."
self pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol.
"Cut out the sender context. This is the context that signalled the MessageNotUnderstood."
self selectedContext privSender: self selectedContext sender.
self resetContext: self selectedContext.
self debug.!
Item was changed:
+ ----- Method: Debugger>>implementOverridingMethod:inClass:inCategory: (in category 'notifier support') -----
- ----- Method: Debugger>>implementOverridingMethod:inClass:inCategory: (in category 'context stack menu') -----
implementOverridingMethod: aMessage inClass: aClass inCategory: aSymbol
"Create a stub implementation of the overriding message and sew it onto the top of the stack, ensuring the context's arguments are set correctly. Debug the new context."
self pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol.
"Cut out the sender context. This is the context that signalled the SubclassResponsibility."
self selectedContext privSender: self selectedContext sender sender.
self resetContext: self selectedContext.
self debug.!
Item was changed:
+ ----- Method: Debugger>>messageHelpAt: (in category 'context stack - message list') -----
- ----- Method: Debugger>>messageHelpAt: (in category 'context stack (message list)') -----
messageHelpAt: anIndex
"Show the first n lines of the sources code of the selected message."
| method |
Preferences balloonHelpInMessageLists ifFalse: [^ nil].
contextStack size < anIndex ifTrue: [^ nil].
method := (contextStack at: anIndex) method.
^ self messageHelpForMethod: method.!
Item was changed:
+ ----- Method: Debugger>>messageIconAt: (in category 'context stack - message list') -----
- ----- Method: Debugger>>messageIconAt: (in category 'context stack (message list)') -----
messageIconAt: anIndex
Browser showMessageIcons
ifFalse: [^ nil].
^ ToolIcons iconNamed: (ToolIcons
iconForClass: (contextStack at: anIndex) method methodClass
selector: (contextStack at: anIndex) method selector)!
Item was changed:
+ ----- Method: Debugger>>messageListIndex (in category 'context stack - message list') -----
- ----- Method: Debugger>>messageListIndex (in category 'context stack (message list)') -----
messageListIndex
"Answer the index of the currently selected context."
^contextStackIndex!
Item was removed:
- ----- Method: Debugger>>populateImplementInMenu: (in category 'context stack menu') -----
- populateImplementInMenu: aMenu
-
- | msg |
- msg := self selectedContext at: 1.
- self selectedContext receiver class withAllSuperclasses do:
- [:each |
- aMenu add: each name target: self selector: #implementMissingMethod:inClass: argumentList: (Array with: msg with: each)].
- ^ aMenu
-
- !
Item was changed:
+ ----- Method: Debugger>>selectedMessage (in category 'context stack - message list') -----
- ----- Method: Debugger>>selectedMessage (in category 'context stack (message list)') -----
selectedMessage
"Answer the source code of the currently selected context."
| aContext |
^contents := (aContext := self selectedContext) debuggerMap sourceText asText makeSelectorBoldIn: aContext home receiver class!
Item was changed:
+ ----- Method: Debugger>>selectedMessageName (in category 'context stack - message list') -----
- ----- Method: Debugger>>selectedMessageName (in category 'context stack (message list)') -----
selectedMessageName
"Answer the message selector of the currently selected context.
If the method is unbound we can still usefully answer its old selector."
| selector |
selector := self selectedContext selector.
^(selector ~~ self selectedContext method selector
and: [selector beginsWith: 'DoIt'])
ifTrue: [self selectedContext method selector]
ifFalse: [selector]!
Item was changed:
+ ----- Method: Debugger>>toggleContextStackIndex: (in category 'context stack - message list') -----
- ----- Method: Debugger>>toggleContextStackIndex: (in category 'context stack (message list)') -----
toggleContextStackIndex: anInteger
"If anInteger is the same as the index of the selected context, deselect it.
Otherwise, the context whose index is anInteger becomes the selected
context."
self contextStackIndex:
(contextStackIndex = anInteger
ifTrue: [0]
ifFalse: [anInteger])
oldContextWas:
(contextStackIndex = 0
ifTrue: [nil]
ifFalse: [contextStack at: contextStackIndex])!
Marcel Taeumel uploaded a new version of CollectionsTests to project The Trunk:
http://source.squeak.org/trunk/CollectionsTests-jr.320.mcz
==================== Summary ====================
Name: CollectionsTests-jr.320
Author: jr
Time: 25 September 2019, 3:41:23.707261 pm
UUID: 54df98c0-c984-3b45-b189-dc267b743422
Ancestors: CollectionsTests-dtl.318
Add test for change in Collections-jr.855
=============== Diff against CollectionsTests-dtl.318 ===============
Item was added:
+ ClassTestCase subclass: #WeakKeyDictionaryTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'CollectionsTests-Weak'!
Item was added:
+ ----- Method: WeakKeyDictionaryTest>>testNilDoesNotInheritValueOfGarbageCollectedObject (in category 'tests') -----
+ testNilDoesNotInheritValueOfGarbageCollectedObject
+ "When the keys are garbage collected, they become nil in the associations.
+ This must not mislead the dictionary to answer that nil had one of the values of these
+ associations!!"
+ | dictionary hashTable |
+ dictionary := self targetClass new.
+ "Craft a hash table where all keys were freed."
+ hashTable := dictionary array.
+ self assert: hashTable size > 0.
+ hashTable replace: [:each | WeakKeyAssociation key: nil value: 1].
+ self assert: (dictionary at: nil ifAbsent: []) isNil. "and not 1"!
Marcel Taeumel uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-jr.855.mcz
==================== Summary ====================
Name: Collections-jr.855
Author: jr
Time: 25 September 2019, 3:23:14.995261 pm
UUID: 9a5b562f-ca9a-624c-9012-7840cb25db4e
Ancestors: Collections-mt.854
Catch the lookup of nil in WeakKeyDictionary
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.
It only happens in unfortunate situations when nil and the collected key would hash to the same place in the hash table (array). Yet it does happen.
=============== Diff against Collections-mt.854 ===============
Item was added:
+ ----- 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!
Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1541.mcz
==================== Summary ====================
Name: Morphic-mt.1541
Author: mt
Time: 25 September 2019, 11:24:23.707838 am
UUID: 077a67ab-387d-a449-b28f-518ba8f9eda4
Ancestors: Morphic-mt.1540
Fixes #subProjects to not only rely on project viewers.
=============== Diff against Morphic-mt.1540 ===============
Item was changed:
----- Method: MorphicProject>>subProjects (in category 'subprojects') -----
subProjects
"Answer a list of all the subprojects of the receiver. "
+ ^ (super subProjects, (world submorphs
- self flag: #fix. "mt: Collect other projects that have this as parent. See Project >> #allProjects"
- ^world submorphs
select: [:m | (m isSystemWindow) and: [m model isKindOf: Project]]
+ thenCollect: [:m | m model])) asSet asArray.!
- thenCollect: [:m | m model].!
Marcel Taeumel uploaded a new version of ST80 to project The Trunk:
http://source.squeak.org/trunk/ST80-mt.241.mcz
==================== Summary ====================
Name: ST80-mt.241
Author: mt
Time: 25 September 2019, 11:23:50.807838 am
UUID: f846aea5-4fcf-304c-b51e-8d99299a2662
Ancestors: ST80-mt.240
Fixes #subProjects to not only rely on project viewers.
=============== Diff against ST80-mt.240 ===============
Item was changed:
----- Method: MVCProject>>subProjects (in category 'utilities') -----
subProjects
"Answer a list of all the subprojects of the receiver. "
+ ^ (super subProjects, ((self world controllersSatisfying: [:m | m model isKindOf: Project])
+ collect: [:controller | controller model])) asSet asArray!
- ^ (self world controllersSatisfying: [:m | m model isKindOf: Project])
- collect: [:controller | controller model]!