[squeak-dev] The Trunk: EToys-lrnp.480.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 11 14:41:16 UTC 2023


Marcel Taeumel uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-lrnp.480.mcz

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

Name: EToys-lrnp.480
Author: lrnp
Time: 26 August 2022, 11:47:02.877549 pm
UUID: e04524d0-88db-4a63-b14b-26df11f31df2
Ancestors: EToys-ct.479

fix code rot in StackMorph logic

StackMorph works!

The book controls also had their text fixed: section symbol instead of complement german uppercase double ess and the like.

Also, because this makes a great recipe for a memory leak... #setNewInstVarNames: no longer deletes the uniclass from the global environment. Try a Browse Hierarchy with and without.

The change to not use #subclass:... in #setNewInstVarNames: is not a stylistic choice! The new code updates the uniclass in-place, while the old code created an entirely new class... that was then never used. This is why the menu 'background field, individual values' was a no-op.

For some reason, #variableDocks was stubbed but #variableDocks: still worked. It might make sense to move the variable docks method category into CardPlayer.

=============== Diff against EToys-ct.479 ===============

Item was changed:
  ----- Method: Morph>>assuredCardPlayer (in category '*Etoys-card in a stack') -----
  assuredCardPlayer
  	"Answer the receiver's player, creating a new one if none currently exists"
  
  	| aPlayer |
  	(aPlayer := self player) ifNotNil: [
  		(aPlayer isKindOf: CardPlayer) 
+ 				ifTrue: [aPlayer]
- 				ifTrue: [^ aPlayer]
  				ifFalse: [self error: 'Must convert to a CardPlayer']
  					"later convert using as: and remove the error"].
  	self assureExternalName.  "a default may be given if not named yet"
+ 	self player: CardPlayer newUserInstance.
- 	self player: (aPlayer := UnscriptedPlayer newUserInstance).
  		"Force it to be a CardPlayer.  Morph class no longer dictates what kind of player"
+ 	self player costume: self.
- 	aPlayer costume: self.
  	self presenter ifNotNil: [self presenter flushPlayerListCache].
+ 	^ self player!
- 	^ aPlayer!

Item was changed:
  ----- Method: Morph>>reassessBackgroundShape (in category '*Etoys-card in a stack') -----
  reassessBackgroundShape
  	"A change has been made which may affect the instance structure of the Card uniclass that holds the instance state, which can also be thought of as the 'card data'."
  
- 	"Caution: still to be done: the mechanism so that when a new instance variable is added, it gets initialized in all subinstances of the receiver's player, which are the cards of this shape.  One needs to take into account here the instance variable names coming in; those that are unchanged should keep their values, but those that have newly arrived should obtain their default values from the morphs on whose behalf they are being maintained in the model"
- 
  	| requestedName |
  	self isStackBackground ifFalse: [^Beeper beep].	"bulletproof against deconstruction"
  	Cursor wait showWhile: 
  			[ | variableDocks takenNames sepDataMorphs existing |variableDocks := OrderedCollection new.	"This will be stored in the uniclass's 
  			class-side inst var #variableDocks"
  			takenNames := OrderedCollection new.
  			sepDataMorphs := OrderedCollection new.	"fields, holders of per-card data"
  			self submorphs do: 
  					[:aMorph | 
  					aMorph renderedMorph holdsSeparateDataForEachInstance 
  						ifTrue: [sepDataMorphs add: aMorph renderedMorph]
  						ifFalse: 
  							["look for buried fields, inside a frame"
  
  							aMorph renderedMorph isShared 
  								ifTrue: 
  									[aMorph allMorphs do: 
  											[:mm | 
  											mm renderedMorph holdsSeparateDataForEachInstance 
  												ifTrue: [sepDataMorphs add: mm renderedMorph]]]]].
  			sepDataMorphs 
  				sort: [:a :b | (a valueOfProperty: #cardInstance) notNil];	"puts existing ones first"
  				do: 
  					[:aMorph | | docks | 
  					docks := aMorph variableDocks.
  					"Each morph can request multiple variables.  
  	This complicates matters somewhat but creates a generality for Fabrk-like uses.
  	Each spec is an instance of VariableDock, and it provides a point of departure
  	for the negotiation between the PasteUp and its constitutent morphs"
  					docks do: 
  							[:aVariableDock | | uniqueName | 
  							uniqueName := self player 
  										uniqueInstanceVariableNameLike: (requestedName := aVariableDock 
  														variableName)
  										excluding: takenNames.
  							uniqueName ~= requestedName 
  								ifTrue: 
  									[aVariableDock variableName: uniqueName.
  									aMorph noteNegotiatedName: uniqueName for: requestedName].
  							takenNames add: uniqueName].
  					variableDocks addAll: docks].
  			existing := self player class instVarNames.
  			variableDocks sort:
  				[:dock1 :dock2 | | name2 name1 | 
  				name1 := dock1 variableName.
  				name2 := dock2 variableName.
  				(existing indexOf: name1) 
  					< (existing indexOf: name2 ifAbsent: [variableDocks size])].
  			self player class setNewInstVarNames: (variableDocks 
  						collect: [:info | info variableName asString]).
  			"NB: sets up accessors, and removes obsolete ones"
  			self player class newVariableDocks: variableDocks]!

Item was changed:
  ----- Method: Player class>>setNewInstVarNames: (in category 'user-defined inst vars') -----
  setNewInstVarNames: listOfStrings
  	"Make listOfStrings be the new list of instance variable names for the receiver"
  
+ 	| disappearing firstAppearing instVarList |
- 	| disappearing firstAppearing instVarString instVarList |
  	instVarList := self instVarNames asOrderedCollection.
  	disappearing := instVarList copy.
  	disappearing removeAllFoundIn: listOfStrings.
  	disappearing do:
+ 		[:oldName | 	self removeAccessorsFor: oldName.
+ 			self removeInstVarName: oldName].
- 		[:oldName | 	self removeAccessorsFor: oldName].
  	firstAppearing := listOfStrings copy.
  	firstAppearing removeAllFoundIn: instVarList.
+ 	firstAppearing do: [:newName |
+ 		self addInstVarName: newName.
+ 		self compileAccessorsFor: newName].!
- 	instVarString := String streamContents:
- 		[:aStream | listOfStrings do: [:aString | aStream nextPutAll: aString; nextPut: $ ]].
- 
- 	superclass subclass: self name instanceVariableNames: instVarString 
- 		classVariableNames: '' poolDictionaries: '' category: self categoryForUniclasses.
- 	self flag: #todo. self flag: #uniclasses. "Discuss if we really want to hide uniclasses again"
- 	superclass environment forgetClass: self logged: false.
- 	superclass removeSubclass: self.
- 	firstAppearing do:
- 		[:newName | self compileAccessorsFor: newName].
- !

Item was changed:
  ----- Method: Player class>>variableDocks (in category 'other') -----
  variableDocks
  	"Backward compatibility -- answer the formal list of VariableDocks associated with the class, assuming the class to be a CardPlayer subclass.  Somewhere a long time ago evidently the players assigned to Worlds stopped being CardPlayers, so this method is now provided as a backstop."
  
+ 	^ variableDocks ifNil: [#()] ifNotNil: [:it | it]!
- 	^ #()!

Item was changed:
  ----- Method: StackMorph>>fullControlSpecs (in category 'page controls') -----
  fullControlSpecs
  	"Answer specifications for the long form of iconic stack/book controls"
  
  	^ {
  		#spacer.
  		#variableSpacer.
  		{'-'.			#deleteCard.			'Delete this card' translated}.
  		#spacer.
+ 		{ '«'	.		#goToFirstCardOfStack.	'First card' translated}.
- 		{ '¬´'	.		#goToFirstCardOfStack.	'First card' translated}.
  		#spacer.
  		{ '<'. 		#goToPreviousCardInStack.		'Previous card' translated}.
  		#spacer.
+ 		{'·'.			#invokeBookMenu. 	'Click here to get a menu of options for this stack.' translated}.
- 		{'¬'.			#invokeBookMenu. 	'Click here to get a menu of options for this stack.' translated}.
  		"#spacer.	{'¬Ž'.			#reshapeBackground.  'Reshape' translated}.	"
  
  		#spacer.
+ 		{'§'.			#showDesignationsOfObjects. 	'Show designations' translated}.
- 		{'§'.			#showDesignationsOfObjects. 	'Show designations' translated}.
  		#spacer.
  		{'>'	.		#goToNextCardInStack.	'Next card' translated}.
  		#spacer.
+ 		{ '»'.		#goToLastCardOfStack.	'Final card' translated}.
- 		{ '»'.		#goToLastCardOfStack.	'Final card' translated}.
  		#spacer.
  		{'+'.		#insertCard.			'Add a new card after this one' translated}.
  		#variableSpacer.
+ 		{'o'.			#fewerPageControls.			'Fewer controls
- 		{'¬'.			#fewerPageControls.			'Fewer controls
  (if shift key pressed,
  deletes controls)' translated}
  }!

Item was changed:
  ----- Method: StackMorph>>shortControlSpecs (in category 'page controls') -----
  shortControlSpecs
  	"Answer specficiations for the shorter form of stack controls"
  
  	^ {
  		#spacer.
  		#variableSpacer.
+ 		{ #PrevPage.	#goToPreviousCardInStack.		'Previous card' translated}.
- 		{ '<'.	#goToPreviousCardInStack.		'Previous card' translated}.
  		#spacer.
+ 		{#MenuIcon.		#invokeBookMenu. 			'Click here to get a menu for this stack.' translated}.
- 		{'¬'.		#invokeBookMenu. 			'Click here to get a menu for this stack.' translated}.
  		#spacer.
+ 		{#NextPage.	#goToNextCardInStack.		'Next card' translated}.
- 		{'>'.	#goToNextCardInStack.		'Next card' translated}.
  		#variableSpacer.
+ 		{'...'.		#showMoreControls.			'More controls
- 		{'¬'.		#showMoreControls.			'More controls
  (if shift key pressed,
  deletes controls)' translated}
  }!



More information about the Squeak-dev mailing list