[etoys-dev] Etoys: System-kfr.46.mcz

[commits at source.squeak.org]

Karl Ramberg uploaded a new version of System to project Etoys:
http://source.squeak.org/etoys/System-kfr.46.mcz

==================== Summary ====================

Name: System-kfr.46
Author: kfr
Time: 28 May 2011, 4:45:13 pm
UUID: 723d8ef4-5d2b-2b48-a272-aefa8826415f
Ancestors: System-bf.45

Put Kedama object in category UserObjects

=============== Diff against System-bf.45 ===============

Item was changed:
  ----- Method: ImageSegment>>declareAndPossiblyRename: (in category 'fileIn/Out') -----
  declareAndPossiblyRename: classThatIsARoot
  	| existing catInstaller |
  	"The class just arrived in this segment.  How fit it into the Smalltalk dictionary?  If it had an association, that was installed with associationDeclareAt:."
  
  	catInstaller _ [
  		classThatIsARoot superclass name == #Player 
  			ifTrue: [classThatIsARoot category: Object categoryForUniclasses]
  			ifFalse: [(classThatIsARoot superclass name beginsWith: 'WonderLandActor')
  				ifTrue: [classThatIsARoot category: 'Balloon3D-UserObjects']
+ 				ifFalse: [classThatIsARoot category: Object categoryForUniclasses]].
- 				ifFalse: [classThatIsARoot category: 'Morphic-Imported']].
  	].
  	classThatIsARoot superclass addSubclass: classThatIsARoot.
  	(Smalltalk includesKey: classThatIsARoot name) ifFalse: [
  		"Class entry in Smalltalk not referred to in Segment, install anyway."
  		catInstaller value.
  		^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  	existing _ Smalltalk at: classThatIsARoot name.
  	existing xxxClass == ImageSegmentRootStub ifTrue: [
  		"We are that segment!!  Must ask it carefully!!"
  		catInstaller value.
  		^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  	existing == false | (existing == nil) ifTrue: [
  		"association is in outPointers, just installed"
  		catInstaller value.
  		^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  	"Conflict with existing global or copy of the class"
  	(existing isKindOf: Class) ifTrue: [
  		classThatIsARoot isSystemDefined not ifTrue: [
  			"UniClass.  give it a new name"
  			classThatIsARoot setName: classThatIsARoot baseUniclass chooseUniqueClassName.
  			catInstaller value.	"must be after new name"
  			^ Smalltalk at: classThatIsARoot name put: classThatIsARoot].
  		"Take the incoming one"
  		self inform: 'Using newly arrived version of ', classThatIsARoot name.
  		classThatIsARoot superclass removeSubclass: classThatIsARoot.	"just in case"
  		(Smalltalk at: classThatIsARoot name) becomeForward: classThatIsARoot.
  		catInstaller value.
  		^ classThatIsARoot superclass addSubclass: classThatIsARoot].
  	self error: 'Name already in use by a non-class: ', classThatIsARoot name.
  !