[squeak-dev] The Trunk: EToys-ul.40.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Dec 12 14:20:56 UTC 2009


Levente Uzonyi uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-ul.40.mcz

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

Name: EToys-ul.40
Author: ul
Time: 12 December 2009, 2:21:34 am
UUID: c9e2203b-cf9a-0943-ae2e-0d37a0633f69
Ancestors: EToys-nice.39

- replace sends of #ifNotNilDo: to #ifNotNil:, #ifNil:ifNotNilDo: to #ifNil:ifNotNil:, #ifNotNilDo:ifNil: to #ifNotNil:ifNil:

=============== Diff against EToys-nice.39 ===============

Item was changed:
  ----- Method: NumericReadoutTile>>literal: (in category 'accessing') -----
  literal: anObject 
  	literal := anObject.
  	self updateLiteralLabel.
  	self labelMorph
+ 		ifNotNil: [:label | label informTarget]!
- 		ifNotNilDo: [:label | label informTarget]!

Item was changed:
  ----- Method: CategoryViewer>>makeSetterForGetPatchValue:event:from: (in category 'get/set slots') -----
  makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph 
  
  	| argType m argTile selfTile argValue actualGetter |
  	argType := selectorAndTypePair second.
  	actualGetter := #patchValueIn:.
  	m := PhraseTileMorph new 
  				setPixelValueRoot: actualGetter
  				type: #command
  				rcvrType: #Player
  				argType: argType
  				vocabulary: self currentVocabulary.
  	argValue := self scriptedPlayer 
  				perform: selectorAndTypePair first asSymbol with: nil.
  	(argValue isPlayerLike) 
  		ifTrue: [argTile := argValue tileReferringToSelf]
  		ifFalse: 
  			[argTile := ScriptingSystem tileForArgType: argType.
  			(argType == #Number and: [argValue isNumber]) 
  				ifTrue: 
  					[(scriptedPlayer decimalPlacesForGetter: actualGetter) 
+ 						ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
- 						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
  			argTile
  				setLiteral: argValue;
  				updateLiteralLabel].
  	argTile position: m lastSubmorph position.
  	m lastSubmorph addMorph: argTile.
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: m firstSubmorph position.
  	m firstSubmorph addMorph: selfTile.
  	m enforceTileColorPolicy.
  	m submorphs second setPatchDefaultTo: scriptedPlayer defaultPatchPlayer.
  
  	m openInHand!

Item was changed:
  ----- Method: Player>>assignStatus:toAllFor: (in category 'scripts-standard') -----
  assignStatus: newStatus toAllFor: scriptName
  	"Change the status of my script of the given name to be as specified in me and all of my siblings."
  
  	| aWorld |
+ 	(self existingScriptInstantiationForSelector: scriptName) ifNotNil:
- 	(self existingScriptInstantiationForSelector: scriptName) ifNotNilDo:
  		[:scriptInstantiation |
  				scriptInstantiation status: newStatus.
  				scriptInstantiation assignStatusToAllSiblings.
  				^ (aWorld := self costume world) ifNotNil:
  					[aWorld updateStatusForAllScriptEditors]]!

Item was changed:
  ----- Method: TileMorph>>acceptNewLiteral (in category 'code generation') -----
  acceptNewLiteral
  	"Tell the scriptEditor who I belong to that I have a new literal value."
  
  	| topScript |
  	topScript := self outermostMorphThat:
  		[:m | m isKindOf: ScriptEditorMorph].
  	topScript ifNotNil: [topScript installWithNewLiteral].
+ 	(self ownerThatIsA: ViewerLine) ifNotNil:
- 	(self ownerThatIsA: ViewerLine) ifNotNilDo:
  		[:aLine |
  			(self ownerThatIsA: PhraseTileMorph) ifNotNil:
  				[aLine removeHighlightFeedback.
  				self layoutChanged.
  				ActiveWorld doOneSubCycle.
  				aLine addCommandFeedback]]!

Item was changed:
  ----- Method: ParameterTile>>assureTypeStillValid (in category 'type') -----
  assureTypeStillValid
  	"Consider the possibility that the parameter type of my surrounding method has changed and that hence I no longer represent a possible value for the parameter of the script.  If this condition obtains, then banish me in favor of a default literal tile of the correct type"
  
+ 	(self ownerThatIsA: TilePadMorph) ifNotNil:
- 	(self ownerThatIsA: TilePadMorph) ifNotNilDo:
  		[:aPad | aPad type = self scriptEditor typeForParameter ifFalse:
  			[aPad setToBearDefaultLiteral]]!

Item was changed:
  ----- Method: Player>>overlapsAny: (in category 'scripts-standard') -----
  overlapsAny: aPlayer 
  	"Answer true if my costume overlaps that of aPlayer, or any of its  
  	siblings (if aPlayer is a scripted player)  
  	or if my costume overlaps any morphs of the same class (if aPlayer is  
  	unscripted)."
  	| possibleCostumes itsCostume itsCostumeClass myShadow |
  	(self ~= aPlayer
  			and: [self overlaps: aPlayer])
  		ifTrue: [^ true].
  	possibleCostumes := IdentitySet new.
  	aPlayer belongsToUniClass
  		ifTrue: [aPlayer class
  				allSubInstancesDo: [:anInstance | (anInstance ~~ aPlayer
  							and: [itsCostume := anInstance costume.
  								(itsCostume bounds intersects: costume bounds)
  									and: [itsCostume world == costume world]])
  						ifTrue: [possibleCostumes add: itsCostume]]]
  		ifFalse: [itsCostumeClass := aPlayer costume class.
  			self costume world presenter allExtantPlayers
  				do: [:ep | ep costume
+ 						ifNotNil: [:ea | (ea class == itsCostumeClass
- 						ifNotNilDo: [:ea | (ea class == itsCostumeClass
  									and: [ea bounds intersects: costume bounds])
  								ifTrue: [possibleCostumes add: ea]]]].
  	possibleCostumes isEmpty
  		ifTrue: [^ false].
  	myShadow := costume shadowForm.
  	^ possibleCostumes
  		anySatisfy: [:m | m overlapsShadowForm: myShadow bounds: costume fullBounds]!

Item was changed:
  ----- Method: Player>>existingScriptInstantiationForSelector: (in category 'customevents-scripts-kernel') -----
  existingScriptInstantiationForSelector: scriptName
  	"Answer the existing script instantiation for the given selector, or nil if none"
  
  	scriptName ifNil: [^ nil].
  	Symbol hasInterned: scriptName
  		ifTrue: [ :sym |
+ 			self costume actorStateOrNil ifNotNil: [ :actorState |
- 			self costume actorStateOrNil ifNotNilDo: [ :actorState |
  				^actorState instantiatedUserScriptsDictionary at: sym ifAbsent: [nil]]].
  	^ nil!

Item was changed:
  ----- Method: AssignmentTileMorph>>addArrowsIfAppropriate (in category 'arrow') -----
  addArrowsIfAppropriate
  	"If the receiver's slot is of an appropriate type, add arrows to the tile."
  
  	(Vocabulary vocabularyForType: dataType)
+ 		ifNotNil:
- 		ifNotNilDo:
  			[:aVocab | aVocab wantsAssignmentTileVariants ifTrue:
  				[self addArrows]].
  	(assignmentSuffix = ':') ifTrue:
  		[ self addMorphBack: (ImageMorph new image: (ScriptingSystem formAtKey: #NewGets)).
+ 		(self findA: StringMorph) ifNotNil: [ :sm |
- 		(self findA: StringMorph) ifNotNilDo: [ :sm |
  			(sm contents endsWith: ' :') ifTrue: [ sm contents: (sm contents allButLast: 2) ]]]!

Item was changed:
  ----- Method: Morph>>instantiatedUserScriptsDo: (in category '*eToys-customevents-scripting') -----
  instantiatedUserScriptsDo: aBlock
+ 	self actorStateOrNil ifNotNil: [ :aState | aState instantiatedUserScriptsDictionary do: aBlock]!
- 	self actorStateOrNil ifNotNilDo: [ :aState | aState instantiatedUserScriptsDictionary do: aBlock]!

Item was changed:
  ----- Method: KedamaCategoryViewer>>makeSetter:event:from: (in category 'get/set slots') -----
  makeSetter: selectorAndTypePair event: evt from: aMorph 
  	"Classic tiles: make a Phrase that comprises a setter of a slot, and hand it to the user."
  
  	| argType m argTile selfTile argValue actualGetter |
  	selectorAndTypePair first = #getPatchValueIn: ifTrue: [^ self makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph].
  	selectorAndTypePair first = #getRedComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #red event: evt from: aMorph].
  	selectorAndTypePair first = #getBlueComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #blue event: evt from: aMorph].
  	selectorAndTypePair first = #getGreenComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #green event: evt from: aMorph].
  	
  	argType := selectorAndTypePair second.
  	actualGetter := selectorAndTypePair first asSymbol.
  	m := PhraseTileMorph new 
  				setAssignmentRoot: (Utilities inherentSelectorForGetter: actualGetter)
  				type: #command
  				rcvrType: #Player
  				argType: argType
  				vocabulary: self currentVocabulary.
  	argValue := self scriptedPlayer 
  				perform: selectorAndTypePair first asSymbol.
  	(argValue isKindOf: Player) 
  		ifTrue: [argTile := argValue tileReferringToSelf]
  		ifFalse: 
  			[argTile := ScriptingSystem tileForArgType: argType.
  			(argType == #Number and: [argValue isNumber]) 
  				ifTrue: 
  					[(scriptedPlayer decimalPlacesForGetter: actualGetter) 
+ 						ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
- 						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
  			argTile
  				setLiteral: argValue;
  				updateLiteralLabel].
  	argTile position: m lastSubmorph position.
  	m lastSubmorph addMorph: argTile.
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: m firstSubmorph position.
  	m firstSubmorph addMorph: selfTile.
  	m enforceTileColorPolicy.
  	m replacePlayerInReadoutWith: scriptedPlayer.
  	m openInHand!

Item was changed:
  ----- Method: TileMorph>>playerBearingCode (in category 'accessing') -----
  playerBearingCode
  	"Answer the actual Player object who will be the 'self' when the receiver is being asked to generate code"
  
+ 	self topEditor ifNotNil:
- 	self topEditor ifNotNilDo:
  		[:anEditor | ^ anEditor playerScripted].
  	(self nearestOwnerThat: [:m | m isAViewer]) 
+ 		ifNotNil:
- 		ifNotNilDo:
  			[:aViewer | ^ aViewer scriptedPlayer].
  	^ actualObject!

Item was changed:
  ----- Method: SyntaxMorph>>setSelector:in: (in category 'pop ups') -----
  setSelector: stringLike in: stringMorph
  	"Store the new selector and accept method."
  
  	| aSymbol myType str |
  	aSymbol := stringLike asSymbol.
+ 	(ScriptingSystem helpStringOrNilFor: aSymbol) ifNotNil:
- 	(ScriptingSystem helpStringOrNilFor: aSymbol) ifNotNilDo:
  		[:aString |
  			self setBalloonText: aString translated].
  	myType := stringMorph valueOfProperty: #syntacticReformatting ifAbsent: [#none].
  	str := aSymbol.
  	(self isStandardSetterKeyword: str) ifTrue: [str := self translateToWordySetter: str].
  	(self isStandardGetterSelector: str) ifTrue: [str := self translateToWordyGetter: str].
  	(self shouldBeBrokenIntoWords: myType) 
  		ifTrue: [str := self substituteKeywordFor: str].
  	stringMorph contents: str.
  	"parseNode key: aSymbol code: nil."
  	str = stringLike ifFalse:
  		[stringMorph setProperty: #syntacticallyCorrectContents toValue: aSymbol].
  	self acceptSilently!

Item was changed:
  ----- Method: SyntaxMorph>>mouseMove: (in category 'event handling') -----
  mouseMove: evt
  	| dup selection |
  	owner isSyntaxMorph ifFalse: [^ self].
  
  false ifTrue: ["for now, do not drag off a tile"
  	self currentSelectionDo:
  		[:innerMorph :mouseDownLoc :outerMorph |
  		mouseDownLoc ifNotNil: [
  			(evt cursorPoint dist: mouseDownLoc) > 4 ifTrue:
  				["If drag 5 pixels, then tear off a copy of outer selection."
  				selection := outerMorph ifNil: [self].
  				selection deletePopup.
  				evt hand attachMorph: (dup := selection duplicate).
  				Preferences tileTranslucentDrag
  					ifTrue: [dup lookTranslucent]
  					ifFalse: [dup align: dup topLeft
  								with: evt hand position + self cursorBaseOffset].
  				self setSelection: nil.	"Why doesn't this deselect?"
  				(self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m isBlockNode]])
+ 					ifNotNil: [:m | "Activate enclosing block."
- 					ifNotNilDo: [:m | "Activate enclosing block."
  								m startStepping]]]].
  	].!

Item was changed:
  ----- Method: Player>>typeforParameterFor: (in category 'costume') -----
  typeforParameterFor: aSelector
  	"Answer the type of the parameter for the given selector"
  
+ 	(self class scripts at: aSelector ifAbsent: [nil]) ifNotNil:
- 	(self class scripts at: aSelector ifAbsent: [nil]) ifNotNilDo:
  		[:aScript | ^ aScript argumentVariables first variableType].
  	self error: 'No parameter type for ', aSelector.
  	^ #Number!

Item was changed:
  ----- Method: PhraseTileMorph>>duplicate (in category 'kedama') -----
  duplicate
  	"Make and return a duplicate of the receiver."
  
  	| newMorph |
  	newMorph := super duplicate.
+ 	(self ownerThatIsA: Viewer) ifNotNil:
- 	(self ownerThatIsA: Viewer) ifNotNilDo:
  		[:aViewer | newMorph replacePlayerInReadoutWith: aViewer scriptedPlayer].
  
  	^ newMorph!

Item was changed:
  ----- Method: Player>>changeTypesInWatchersOf: (in category 'translation') -----
  changeTypesInWatchersOf: slotName
  	"The type of a variable has changed; adjust watchers to that fact."
  
  	| aGetter newWatcher |
  	aGetter := Utilities getterSelectorFor: slotName.
  	self allPossibleWatchersFromWorld do: [:aWatcher |
  		(aWatcher getSelector = aGetter) ifTrue:
+ 			[(aWatcher ownerThatIsA: WatcherWrapper) ifNotNil:
- 			[(aWatcher ownerThatIsA: WatcherWrapper) ifNotNilDo:
  				[:aWrapper |
  					newWatcher := (aWrapper submorphs size = 1)
  						ifTrue:
  							[WatcherWrapper new unlabeledForPlayer: self getter: aGetter]
  						ifFalse:
  							[WatcherWrapper new fancyForPlayer: self getter: aGetter].
  					newWatcher position: aWatcher position.
  					aWrapper owner replaceSubmorph: aWrapper by: newWatcher]]]
  !

Item was changed:
  ----- Method: Player>>renameSlotInWatchersOld:new: (in category 'translation') -----
  renameSlotInWatchersOld: oldName new: newName
  	"A variable has been renamed; get all relevant extant watchers updated.  All this assumed to be happening in the ActiveWorld"
  
  	| wasStepping oldGetter |
  	oldGetter := Utilities getterSelectorFor: oldName.
  	self allPossibleWatchersFromWorld do: [:aWatcher |
  		(aWatcher getSelector = oldGetter) ifTrue:
  			[(wasStepping := aWatcher isStepping) ifTrue: [aWatcher stopStepping].
  			aWatcher getSelector: (Utilities getterSelectorFor: newName).
  			aWatcher putSelector ifNotNil:
  				[aWatcher putSelector: (Utilities setterSelectorFor: newName)].
  			((aWatcher isKindOf: UpdatingStringMorph) and: [aWatcher hasStructureOfComplexWatcher]) ifTrue:  "Old style fancy watcher"
  				[aWatcher owner owner traverseRowTranslateSlotOld: oldName to: newName.
  				(aWatcher target labelFromWatcher: aWatcher) contents: newName, ' = '].
+ 			(aWatcher ownerThatIsA: WatcherWrapper) ifNotNil:
- 			(aWatcher ownerThatIsA: WatcherWrapper) ifNotNilDo:
  				[:wrapper | wrapper player: self variableName: newName].
  			wasStepping ifTrue: [aWatcher startStepping]]]!

Item was changed:
  ----- Method: CategoryViewer>>getterTilesFor:type: (in category 'get/set slots') -----
  getterTilesFor: getterSelector type: aType 
  	"Answer classic getter for the given name/type"
  
  	"aPhrase := nil, assumed"
  
  	| selfTile selector aPhrase |
  	(#(#color:sees: #colorSees) includes: getterSelector) 
  		ifTrue: [aPhrase := self colorSeesPhrase].
  	(#(#getPatchValueIn:) includes: getterSelector)
  		ifTrue: [aPhrase := self patchValuePhrase].
  	(#(#getRedComponentIn:) includes: getterSelector)
  		ifTrue: [aPhrase := self colorComponentPhraseFor: #red].
  	(#(#getGreenComponentIn:) includes: getterSelector)
  		ifTrue: [aPhrase := self colorComponentPhraseFor: #green].
  	(#(#getBlueComponentIn:) includes: getterSelector)
  		ifTrue: [aPhrase := self colorComponentPhraseFor: #blue].
  	(#(#getUphillIn:) includes: getterSelector)
  		ifTrue: [aPhrase := self patchUphillPhrase].
  	(#(#bounceOn:) includes: getterSelector)
  		ifTrue: [aPhrase := self bounceOnPhrase].
  	(#(#bounceOn:color: #bounceOnColor:) includes: getterSelector)
  		ifTrue: [aPhrase := self bounceOnColorPhrase].
  	(getterSelector = #getDistanceTo:)
  		ifTrue: [aPhrase := self distanceToPhrase].
  	(getterSelector = #getAngleTo:)
  		ifTrue: [aPhrase := self angleToPhrase].
  	(getterSelector = #getTurtleOf:)
  		ifTrue: [aPhrase := self turtleOfPhrase].
  	(#(#seesColor: #isOverColor) includes: getterSelector) 
  		ifTrue: [aPhrase := self seesColorPhrase].
  	(#(#overlaps: #overlaps) includes: getterSelector) 
  		ifTrue: [aPhrase := self overlapsPhrase].
  	(#(#overlapsAny: #overlapsAny) includes: getterSelector) 
  		ifTrue: [aPhrase := self overlapsAnyPhrase].
  	(#(#touchesA: #touchesA) includes: getterSelector) 
  		ifTrue: [aPhrase := self touchesAPhrase].
  	aPhrase ifNil: 
  			[aPhrase := PhraseTileMorph new setSlotRefOperator: getterSelector asSymbol
  						type: aType].
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: aPhrase firstSubmorph position.
  	aPhrase firstSubmorph addMorph: selfTile.
  	selector := aPhrase submorphs second.
  	(#(#getPatchValueIn: getUphillIn:) includes: getterSelector) ifFalse: [
  		(Vocabulary vocabularyNamed: aType capitalized) 
+ 			ifNotNil: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]].
- 			ifNotNilDo: [:aVocab | aVocab wantsSuffixArrow ifTrue: [selector addSuffixArrow]].
  	].
  	selector updateLiteralLabel.
  	aPhrase enforceTileColorPolicy.
  	^aPhrase!

Item was changed:
  ----- Method: Presenter>>updateViewer:forceToShow: (in category 'viewer') -----
  updateViewer: aViewer forceToShow: aCategorySymbol
  	"Update the given viewer to make sure it is in step with various possible changes in the outside world, and when reshowing it be sure it shows the given category"
  
  	| aPlayer aPosition newViewer oldOwner wasSticky barHeight itsVocabulary aCategory categoryInfo restrictedIndex |
  	aCategory := aCategorySymbol ifNotNil: [aViewer currentVocabulary translatedWordingFor: aCategorySymbol].
  	categoryInfo := aViewer categoryMorphs  asOrderedCollection collect:
  		[:aMorph | aMorph categoryRestorationInfo].
  
  	itsVocabulary := aViewer currentVocabulary.
  	aCategory ifNotNil: [(categoryInfo includes: aCategorySymbol) ifFalse: [categoryInfo addFirst: aCategorySymbol]].
  	aPlayer := aViewer scriptedPlayer.
  	aPosition := aViewer position.
  	wasSticky := aViewer isSticky.
  	newViewer := aViewer species new visible: false.
  	(aViewer isMemberOf: KedamaStandardViewer)
  		ifTrue: [restrictedIndex := aViewer restrictedIndex].
  	barHeight := aViewer submorphs first listDirection == #topToBottom
  		ifTrue:
  			[aViewer submorphs first submorphs first height]
  		ifFalse:
  			[0].
  	Preferences viewersInFlaps ifTrue:
  		[newViewer setProperty: #noInteriorThumbnail toValue: true].
  
  	newViewer rawVocabulary: itsVocabulary.
  	newViewer limitClass: aViewer limitClass.
  	newViewer initializeFor: aPlayer barHeight: barHeight includeDismissButton: aViewer hasDismissButton showCategories: categoryInfo.
  	(newViewer isMemberOf: KedamaStandardViewer)
  		ifTrue: [
  			newViewer providePossibleRestrictedView: 0.
  			newViewer providePossibleRestrictedView: restrictedIndex].
  	wasSticky ifTrue: [newViewer beSticky].
  	oldOwner := aViewer owner.
  	oldOwner ifNotNil:
  		[oldOwner replaceSubmorph: aViewer by: newViewer].
  	
  	"It has happened that old readouts are still on steplist.  We may see again!!"
  
  	newViewer position: aPosition.
  	newViewer enforceTileColorPolicy.
  	newViewer visible: true.
+ 	newViewer world ifNotNil: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer].
- 	newViewer world ifNotNilDo: [:aWorld | aWorld startSteppingSubmorphsOf: newViewer].
  	newViewer layoutChanged!

Item was changed:
  ----- Method: SyntaxMorph>>mouseEnterDragging: (in category 'event handling') -----
  mouseEnterDragging: evt
  	"Highlight this level as a potential drop target"
  
  "self isBlockNode ifTrue: [Transcript cr; print: self; show: ' enterDragging']."
  	self rootTile isMethodNode ifFalse: [^ self]. 	"not in a script"
  
  	evt hand hasSubmorphs ifFalse: [^ self].  "Don't react to empty hand"
  	self unhighlightOwnerBorder.
  	self isBlockNode ifFalse: [self highlightForDrop: evt.
  		(self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m color = self dropColor]])
+ 			ifNotNil: [:m | m unhighlight]].
- 			ifNotNilDo: [:m | m unhighlight]].
  
  	self isBlockNode ifTrue:
  		[(self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m isBlockNode]])
+ 			ifNotNil: [:m | "Suspend outer block."
- 			ifNotNilDo: [:m | "Suspend outer block."
  						m stopStepping; removeDropZones].
  		self startStepping]
  !

Item was changed:
  ----- Method: Presenter>>viewMorph: (in category 'viewer') -----
  viewMorph: aMorph 
  	| aPlayer openViewers aViewer aPalette aRect aPoint nominalHeight aFlapTab topItem flapLoc |
  	Sensor leftShiftDown 
  		ifFalse: 
  			[((aPalette := aMorph standardPalette) notNil and: [aPalette isInWorld]) 
  				ifTrue: [^aPalette viewMorph: aMorph]].
  	aPlayer := (topItem := aMorph topRendererOrSelf) assuredPlayer.
  	openViewers := aPlayer allOpenViewers.
  	aViewer := openViewers isEmpty ifFalse: [ openViewers first ] ifTrue: [ self nascentPartsViewer ].
  	self cacheSpecs: topItem.	"redo the spec cache once in a while"
  
  	"19 sept 2000 - allow flaps in any paste up"
  	flapLoc := associatedMorph.	"world"
  	Preferences viewersInFlaps  ifTrue:  [
+ 		aViewer owner ifNotNil: [ :f | ^f flapTab showFlap; yourself ].
- 		aViewer owner ifNotNilDo: [ :f | ^f flapTab showFlap; yourself ].
  		aViewer setProperty: #noInteriorThumbnail toValue: true.
  			aViewer initializeFor: aPlayer barHeight: 0.
  			aViewer enforceTileColorPolicy.
  			aViewer fullBounds.	"force layout"
  			"associatedMorph addMorph: aViewer."	"why???"
  			flapLoc hideViewerFlapsOtherThanFor: aPlayer.
  			aFlapTab := flapLoc viewerFlapTabFor: topItem.
  			aFlapTab referent submorphs 
  				do: [:m | (m isKindOf: Viewer) ifTrue: [m delete]].
  			aViewer visible: true.
  			aFlapTab applyThickness: aViewer width + 25.
  			aFlapTab spanWorld.
  			aFlapTab showFlap.
  			aViewer position: aFlapTab referent position.
  			aFlapTab referent addMorph: aViewer beSticky.	"moved"
  			flapLoc startSteppingSubmorphsOf: aFlapTab.
  			flapLoc startSteppingSubmorphsOf: aViewer.
  			^aFlapTab].
  	aViewer initializeFor: aPlayer barHeight: 6.
  	aViewer enforceTileColorPolicy.
  	aViewer fullBounds.	"force layout"
  	Preferences automaticViewerPlacement 
  		ifTrue: 
  			[aPoint := aMorph bounds right 
  						@ (aMorph center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)).
  			aRect := (aPoint extent: aViewer width @ nominalHeight) 
  						translatedToBeWithin: flapLoc bounds.
  			aViewer position: aRect topLeft.
  			aViewer visible: true.
  			associatedMorph addMorph: aViewer.
  			flapLoc startSteppingSubmorphsOf: aViewer.
  			"it's already in the world, somewhat coincidentally"
  			^aViewer].
  	aMorph primaryHand attachMorph: (aViewer visible: true).
  	^aViewer!

Item was changed:
  ----- Method: SyntaxMorph>>mouseLeaveDragging: (in category 'event handling') -----
  mouseLeaveDragging: evt 
  	"Transcript cr; print: self; show: ' leaveDragging'."
  
  	self rootTile isMethodNode ifFalse: [^self].	"not in a script"
  	self isBlockNode 
  		ifTrue: 
  			[self
  				stopStepping;
  				removeDropZones.
  			(self firstOwnerSuchThat: [:m | m isSyntaxMorph and: [m isBlockNode]]) 
+ 				ifNotNil: [:m | m startStepping].	"Activate outer block."
- 				ifNotNilDo: [:m | m startStepping].	"Activate outer block."
  			self submorphs do: 
  					[:ss | 
  					"cancel drop color in line beside mouse"
  
  					ss color = self dropColor ifTrue: [ss setDeselectedColor]]].
  
  	"Move drop highlight back out a level"
  	self unhighlight.
  	(owner notNil and: [owner isSyntaxMorph]) 
  		ifTrue: [owner isBlockNode ifFalse: [owner highlightForDrop: evt]]!

Item was changed:
  ----- Method: CompoundTileMorph>>updateWordingToMatchVocabulary (in category 'initialization') -----
  updateWordingToMatchVocabulary
  	| labels |
  	labels := OrderedCollection new.
  	self submorphs do: [:submorph |
  		submorph submorphs do: [:subsubmorph |
  			subsubmorph class == StringMorph ifTrue: [labels add: subsubmorph]]].
+ 	labels do: [:label | label knownName ifNotNil: [ :nm | label acceptValue: nm translated ]]
- 	labels do: [:label | label knownName ifNotNilDo: [ :nm | label acceptValue: nm translated ]]
  !

Item was changed:
  ----- Method: WatcherWrapper>>reconstituteName (in category 'updating') -----
  reconstituteName
  	"Reconstitute the external name of the receiver"
  
  	variableName ifNotNil:
  		[self setNameTo: ('{1}''s {2}' translated format: {player externalName. variableName translated}).
+ 		(self submorphWithProperty: #watcherLabel) ifNotNil:
- 		(self submorphWithProperty: #watcherLabel) ifNotNilDo:
  			[:aLabel | aLabel contents: variableName asString, ' = ']]!

Item was changed:
  ----- Method: TilePadMorph>>restoreDefaultTile (in category 'miscellaneous') -----
  restoreDefaultTile
  	"Restore the receiver to showing only its default literal tile"
  
  	self setToBearDefaultLiteral.
+ 	(self ownerThatIsA: ScriptEditorMorph) ifNotNil:
- 	(self ownerThatIsA: ScriptEditorMorph) ifNotNilDo:
  		[:aScriptEditor | aScriptEditor install]!

Item was changed:
  ----- Method: CategoryViewer>>makeSetterForColorComponent:componentName:event:from: (in category 'get/set slots') -----
  makeSetterForColorComponent: selectorAndTypePair componentName: componentName event: evt from: aMorph 
  
  	| argType m argTile selfTile argValue actualGetter |
  	argType := selectorAndTypePair second.
  	componentName = #red ifTrue: [actualGetter := #setRedComponentIn:].
  	componentName = #green ifTrue: [actualGetter := #setGreenComponentIn:].
  	componentName = #blue ifTrue: [actualGetter := #setBlueComponentIn:].
  	m := PhraseTileMorph new 
  				setColorComponentRoot: actualGetter
  				componentName: componentName
  				type: #command
  				rcvrType: #Patch
  				argType: argType
  				vocabulary: self currentVocabulary.
  	argValue := self scriptedPlayer 
  				perform: selectorAndTypePair first asSymbol with: nil.
  	(argValue isKindOf: Player) 
  		ifTrue: [argTile := argValue tileReferringToSelf]
  		ifFalse: 
  			[argTile := ScriptingSystem tileForArgType: argType.
  			(argType == #Number and: [argValue isNumber]) 
  				ifTrue: 
  					[(scriptedPlayer decimalPlacesForGetter: actualGetter) 
+ 						ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
- 						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
  			argTile
  				setLiteral: argValue;
  				updateLiteralLabel].
  	argTile position: m lastSubmorph position.
  	m lastSubmorph addMorph: argTile.
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: m firstSubmorph position.
  	m firstSubmorph addMorph: selfTile.
  	m enforceTileColorPolicy.
  	m submorphs second setPatchDefaultTo: scriptedPlayer defaultPatchPlayer.
  
  	m openInHand!

Item was changed:
  ----- Method: SyntaxMorph>>setSelection: (in category 'selection') -----
  setSelection: newSpec 
  	"A selectionSpec is {Inner morph.  Where clicked.  Outer morph}.
  	First mouseDown starts a selection (with outerMorph isNil).
  	Dragging more than 4 pixels means to grab a copy of the current outer selection.
  		The current selection is the outerMorph, or the inner if it is nil.
  	Each mouseUp extends the selection to the next outer morph that is selectable.
  		Except if this is the first click."
  
  	| rootTile |
  	(rootTile := self rootTile) valueOfProperty: #selectionSpec
+ 		ifPresentDo: [:oldSpec | oldSpec third ifNotNil: [:m | m deselect]].
- 		ifPresentDo: [:oldSpec | oldSpec third ifNotNilDo: [:m | m deselect]].
  	(newSpec isNil or: [newSpec third isNil and: [self isMethodNode]]) 
  		ifTrue: 
  			[self deselect.
  			^rootTile removeProperty: #selectionSpec].
  
  	"Select outer morph of the new selection"
  	newSpec third isNil 
  		ifTrue: [self select	"first click down"]
  		ifFalse: [newSpec third select	"subsequent clicks"].
  	rootTile setProperty: #selectionSpec toValue: newSpec!

Item was changed:
  ----- Method: SymbolListTile>>adjustHelpMessage (in category 'user interface') -----
  adjustHelpMessage
  	"Adjust the help message to reflect the new literal"
  
+ 	(ScriptingSystem helpStringOrNilForOperator: literal) ifNotNil:
- 	(ScriptingSystem helpStringOrNilForOperator: literal) ifNotNilDo:
  		[:aString |
  			self labelMorph setBalloonText: aString]!

Item was changed:
  ----- Method: Player>>getNewClone (in category 'slot getters/setters') -----
  getNewClone
  	"Answer a new player of the same class as the receiver, with a costume much like mine"
  
  	| clone |
  	clone :=  costume usableSiblingInstance.
+ 	costume pasteUpMorph ifNotNil: [:parent | parent addMorph: clone].
- 	costume pasteUpMorph ifNotNilDo: [:parent | parent addMorph: clone].
  	^ clone player
  !

Item was changed:
  ----- Method: Presenter>>allExtantPlayers (in category 'intialize') -----
  allExtantPlayers
  	"The initial intent here was to produce a list of Player objects associated with any Morph in the tree beneath the receiver's associatedMorph.  whether it is the submorph tree or perhaps off on unseen bookPages.  We have for the moment moved away from that initial intent, and in the current version we only deliver up players associated with the submorph tree only.  <-- this note dates from 4/21/99
  
  Call #flushPlayerListCache; to force recomputation."
  
  	| fullList objectsReferredToByTiles |
  	playerList ifNotNil:
  		[^ playerList].
  
  	fullList := associatedMorph allMorphs select: 
  		[:m | m player ~~ nil] thenCollect: [:m | m player].
  	fullList copy do:
  		[:aPlayer |
  			aPlayer class scripts do:
  				[:aScript |  aScript isTextuallyCoded ifFalse:
+ 					[aScript currentScriptEditor ifNotNil: [:ed |
- 					[aScript currentScriptEditor ifNotNilDo: [:ed |
  						objectsReferredToByTiles := ed allMorphs
  							select:
  								[:aMorph | (aMorph isKindOf: TileMorph) and: [aMorph type == #objRef]]
  							thenCollect:
  								[:aMorph | aMorph actualObject].
  						fullList addAll: objectsReferredToByTiles]]]].
  
  	^ playerList := (fullList asSet asSortedCollection:
  			[:a :b | a externalName < b externalName]) asArray!

Item was changed:
  ----- Method: CategoryViewer>>makeSetter:event:from: (in category 'get/set slots') -----
  makeSetter: selectorAndTypePair event: evt from: aMorph 
  	"Classic tiles: make a Phrase that comprises a setter of a slot, and hand it to the user."
  
  	| argType m argTile selfTile argValue actualGetter |
  	selectorAndTypePair first = #getPatchValueIn: ifTrue: [^ self makeSetterForGetPatchValue: selectorAndTypePair event: evt from: aMorph].
  	selectorAndTypePair first = #getRedComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #red event: evt from: aMorph].
  	selectorAndTypePair first = #getBlueComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #blue event: evt from: aMorph].
  	selectorAndTypePair first = #getGreenComponentIn: ifTrue: [^ self makeSetterForColorComponent: selectorAndTypePair componentName: #green event: evt from: aMorph].
  	
  	argType := selectorAndTypePair second.
  	actualGetter := selectorAndTypePair first asSymbol.
  	m := PhraseTileMorph new 
  				setAssignmentRoot: (Utilities inherentSelectorForGetter: actualGetter)
  				type: #command
  				rcvrType: #Player
  				argType: argType
  				vocabulary: self currentVocabulary.
  	argValue := self scriptedPlayer 
  				perform: selectorAndTypePair first asSymbol.
  	argValue isPlayerLike
  		ifTrue: [argTile := argValue tileReferringToSelf]
  		ifFalse: 
  			[argTile := ScriptingSystem tileForArgType: argType.
  			(argType == #Number and: [argValue isNumber]) 
  				ifTrue: 
  					[(scriptedPlayer decimalPlacesForGetter: actualGetter) 
+ 						ifNotNil: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
- 						ifNotNilDo: [:places | (argTile findA: UpdatingStringMorph) decimalPlaces: places]].
  			argTile
  				setLiteral: argValue;
  				updateLiteralLabel].
  	argTile position: m lastSubmorph position.
  	m lastSubmorph addMorph: argTile.
  	selfTile := self tileForSelf bePossessive.
  	selfTile position: m firstSubmorph position.
  	m firstSubmorph addMorph: selfTile.
  	m enforceTileColorPolicy.
  	m openInHand!

Item was changed:
  ----- Method: SoundReadoutTile>>mouseDown: (in category 'arrows') -----
  mouseDown: evt
  	"Handle a mouse down event"
  
  	| aPoint index isUp soundChoices adjustment |
  	upArrow ifNotNil: [((isUp := upArrow containsPoint: (aPoint := evt cursorPoint)) or:  [downArrow containsPoint: aPoint])
  		ifTrue:
  			[soundChoices := self soundChoices.
  			index := soundChoices indexOf: literal ifAbsent: [1].
  			index > 0 ifTrue:
  				[adjustment := isUp ifTrue: [1] ifFalse: [-1].
  				self literal: (soundChoices atWrap: (index + adjustment))].
  			self playSoundNamed: literal.
  			^ self]].
+ 	self soundNameFromUser ifNotNil:
- 	self soundNameFromUser ifNotNilDo:
  		[:aSoundName |
  			self literal: aSoundName.
  			self playSoundNamed: literal]!




More information about the Squeak-dev mailing list