Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1283.mcz

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

Name: Morphic-mt.1283
Author: mt
Time: 16 August 2016, 10:26:56.894039 am
UUID: 193d4a20-8085-d040-a108-f7b7747f14bf
Ancestors: Morphic-mt.1282

This fixes a bug that became clear in UserInputEventTests where ActiveWorld was broken after these tests ran.

Due to the latest refactorings in the Project mechanism, we can implement the set/clear of ActiveWorld, ActiveHand, and ActiveEvent more safely.

Tell me if I am mistaken, but #ensure: should not slow down event dispatch to a notable extent -- not even on ARM platforms.

=============== Diff against Morphic-mt.1282 ===============

Item was added:
+ ----- Method: HandMorph>>becomeActiveDuring: (in category 'initialization') -----
+ becomeActiveDuring: aBlock
+ 	"Make the receiver the ActiveHand during the evaluation of aBlock."
+ 
+ 	| priorHand |
+ 	priorHand := ActiveHand.
+ 	ActiveHand := self.
+ 	^ aBlock ensure: [ActiveHand := priorHand].!

Item was changed:
  ----- Method: HandMorph>>sendEvent:focus:clear: (in category 'private events') -----
  sendEvent: anEvent focus: focusHolder clear: aBlock
  	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
+ 
+ 	| result w |
- 	| result |
  	focusHolder ifNotNil:[^self sendFocusEvent: anEvent to: focusHolder clear: aBlock].
+ 	w := self world.
+ 	w becomeActiveDuring: [
+ 		self becomeActiveDuring: [
+ 				anEvent becomeActiveDuring: [
+ 					result := w processEvent: anEvent]]].
- 	ActiveEvent := anEvent.
- 	[result := owner processEvent: anEvent]
- 		ensure: [ActiveEvent := nil].
  	^ result == #rejected ifTrue: [anEvent] ifFalse: [result "filtered event"]!

Item was changed:
  ----- Method: HandMorph>>sendFocusEvent:to:clear: (in category 'private events') -----
  sendFocusEvent: anEvent to: focusHolder clear: aBlock
  	"Send the event to the morph currently holding the focus"
  
  	| result w |
+ 	w := focusHolder world ifNil: [aBlock value. ^ anEvent].
+ 	w becomeActiveDuring: [
+ 		self becomeActiveDuring: [
+ 			anEvent becomeActiveDuring: [
+ 				result := focusHolder processFocusEvent: anEvent]]].
- 	w := focusHolder world ifNil:[aBlock value. ^ anEvent].
- 	w becomeActiveDuring:[
- 		ActiveHand := self.
- 		ActiveEvent := anEvent.
- 		result := focusHolder processFocusEvent: anEvent.
- 	].
  	^ result == #rejected ifTrue: [anEvent] ifFalse: [result "filtered event"]!

Item was added:
+ ----- Method: MorphicEvent>>becomeActiveDuring: (in category 'initialize') -----
+ becomeActiveDuring: aBlock
+ 	"Make the receiver the ActiveEvent during the evaluation of aBlock."
+ 
+ 	| priorEvent |
+ 	priorEvent := ActiveEvent.
+ 	ActiveEvent := self.
+ 	^ aBlock ensure: [ActiveEvent := priorEvent].!

Item was changed:
  ----- Method: MorphicProject>>exportSegmentWithChangeSet:fileName:directory: (in category 'file in/out') -----
  exportSegmentWithChangeSet: aChangeSetOrNil fileName: aFileName
  directory: aDirectory
  	"Store my project out on the disk as an *exported*
  ImageSegment.  All outPointers will be in a form that can be resolved
  in the target image.  Name it <project name>.extSeg.  Whatdo we do
  about subProjects, especially if they are out as local image
  segments?  Force them to come in?
  	Player classes are included automatically."
  
  	| is str ans revertSeg roots holder collector fd mgr stacks |
  
  	"Files out a changeSet first, so that a project can contain
  its own classes"
  	world ifNil: [^ false].
  	world presenter ifNil: [^ false].
  
  	ScrapBook default emptyScrapBook.
  	world currentHand pasteBuffer: nil.	  "don't write the paste buffer."
  	world currentHand mouseOverHandler initialize.	  "forget about any
  	references here"
  		"Display checkCurrentHandForObjectToPaste."
  	Command initialize.
  	world clearCommandHistory.
  	world fullReleaseCachedState; releaseViewers.
  	world cleanseStepList.
  	world localFlapTabs size = world flapTabs size ifFalse: [
  		self error: 'Still holding onto Global flaps'].
  	world releaseSqueakPages.
  	holder := Project allProjects.	"force them in to outPointers, where
  	DiskProxys are made"
  
  	"Just export me, not my previous version"
  	revertSeg := self parameterAt: #revertToMe.
  	self removeParameter: #revertToMe.
  
  	roots := OrderedCollection new.
  	roots add: self; add: world; add: transcript; add: aChangeSetOrNil; add: thumbnail; add: world activeHand.
  
  		"; addAll: classList; addAll: (classList collect: [:cls | cls class])"
  
  	roots := roots reject: [ :x | x isNil].	"early saves may not have
  	active hand or thumbnail"
  
  	fd := aDirectory directoryNamed: self resourceDirectoryName.
  	fd assureExistence.
  	"Clean up resource references before writing out"
  	mgr := self resourceManager.
  	self resourceManager: nil.
  	ResourceCollector current: ResourceCollector new.
  	ResourceCollector current localDirectory: fd.
  	ResourceCollector current baseUrl: self resourceUrl.
  	ResourceCollector current initializeFrom: mgr.
  	ProgressNotification signal: '2:findingResources' extra:
  '(collecting resources...)' translated.
  	"Must activate old world because this is run at #armsLength.
  	Otherwise references to ActiveWorld, ActiveHand, or ActiveEvent
  	will not be captured correctly if referenced from blocks or user code."
+ 	world becomeActiveDuring: [world firstHand becomeActiveDuring: [
- 	world becomeActiveDuring:[
  		is := ImageSegment new copySmartRootsExport: roots asArray.
  		"old way was (is := ImageSegment new
  copyFromRootsForExport: roots asArray)"
+ 	]].
- 	].
  	self resourceManager: mgr.
  	collector := ResourceCollector current.
  	ResourceCollector current: nil.
  	ProgressNotification signal: '2:foundResources' extra: ''.
  	is state = #tooBig ifTrue: [
  		collector replaceAll.
  		^ false].
  
  	str := ''.
  	"considered legal to save a project that has never been entered"
  	(is outPointers includes: world) ifTrue: [
  		str := str, '\Project''s own world is not in the segment.' translated withCRs].
  	str isEmpty ifFalse: [
  		ans := UIManager default chooseFrom: {
  			'Do not write file' translated.
  			'Write file anyway' translated.
  			'Debug' translated.
  		} title: str.
  		ans = 1 ifTrue: [
  			revertSeg ifNotNil: [projectParameters at:
  	#revertToMe put: revertSeg].
  			collector replaceAll.
  			^ false].
  		ans = 3 ifTrue: [
  			collector replaceAll.
  			self halt: 'Segment not written' translated]].
  		stacks := is findStacks.
  
  		is
  			writeForExportWithSources: aFileName
  			inDirectory: fd
  			changeSet: aChangeSetOrNil.
  		SecurityManager default signFile: aFileName directory: fd.
  		"Compress all files and update check sums"
  		collector forgetObsolete.
  		self storeResourceList: collector in: fd.
  		self storeHtmlPageIn: fd.
  		self storeManifestFileIn: fd.
  		self writeStackText: stacks in: fd registerIn: collector.
  		"local proj.005.myStack.t"
  		self compressFilesIn: fd to: aFileName in: aDirectory
  	resources: collector.
  				"also deletes the resource directory"
  		"Now update everything that we know about"
  		mgr updateResourcesFrom: collector.
  
  	revertSeg ifNotNil: [projectParameters at: #revertToMe put: revertSeg].
  	holder.
  
  	collector replaceAll.
  
  	world flapTabs do: [:ft |
  			(ft respondsTo: #unhibernate) ifTrue: [ft unhibernate]].
  	is arrayOfRoots do: [:obj |
  		obj isScriptEditorMorph ifTrue: [obj unhibernate]].
  	^ true
  !

Item was changed:
  ----- Method: PasteUpMorph>>becomeActiveDuring: (in category 'initialization') -----
  becomeActiveDuring: aBlock
+ 	"Make the receiver the ActiveWorld during the evaluation of aBlock."
+ 
+ 	| priorWorld |
- 	"Make the receiver the ActiveWorld during the evaluation of aBlock.
- 	Note that this method does deliberately *not* use #ensure: to prevent
- 	re-installation of the world on project switches."
- 	| priorWorld priorHand priorEvent |
  	priorWorld := ActiveWorld.
- 	priorHand := ActiveHand.
- 	priorEvent := ActiveEvent.
  	ActiveWorld := self.
+ 	^ aBlock ensure: [ActiveWorld := priorWorld].!
- 	ActiveHand := self hands first. "default"
- 	ActiveEvent := nil. "not in event cycle"
- 	aBlock
- 		on: Error
- 		do: [:ex | 
- 			ActiveWorld := priorWorld.
- 			ActiveEvent := priorEvent.
- 			ActiveHand := priorHand.
- 			ex pass]!