A new version of Morphic was added to project The Inbox:
http://source.squeak.org/inbox/Morphic-mt.1626.mcz

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

Name: Morphic-mt.1626
Author: mt
Time: 19 February 2020, 9:43:16.812957 am
UUID: fca656a7-fd5f-a64e-87fe-e0575eb7e9af
Ancestors: Morphic-mt.1625

(Updates for after the Squeak 5.3 release.)

Refactors mouse-over handling. Documents an unwanted side-effect in MorphicEventDispatcher. Fixes unnecessary early exit in Morphic's main event loop, which had strange side effects on high-frequency mouse-wheel events coming from the VM.

=============== Diff against Morphic-mt.1625 ===============

Item was changed:
  ----- Method: HandMorph>>processEvents (in category 'event handling') -----
  processEvents
  	"Process user input events from the local input devices."
  
+ 	| evt evtBuf type |
+ 	[(evtBuf := EventSensor default nextEvent) isNil] whileFalse: [
+ 		
+ 		evt := nil.	"for unknown event types"
+ 		type := evtBuf first.
- 	| evt evtBuf type hadAny |
- 	ActiveEvent ifNotNil: 
- 			["Meaning that we were invoked from within an event response.
- 		Make sure z-order is up to date"
  
+ 		type = EventTypeMouse
+ 			ifTrue: [evt := self generateMouseEvent: evtBuf].
+ 		type = EventTypeMouseWheel
+ 			ifTrue: [evt := self generateMouseWheelEvent: evtBuf].
+ 		type = EventTypeKeyboard 
+ 			ifTrue: [evt := self generateKeyboardEvent: evtBuf].
- 			self mouseOverHandler processMouseOver: lastMouseEvent].
- 	hadAny := false.
- 	[(evtBuf := Sensor nextEvent) isNil] whileFalse: 
- 			[evt := nil.	"for unknown event types"
- 			type := evtBuf first.
- 			type = EventTypeMouse
- 				ifTrue: [evt := self generateMouseEvent: evtBuf].
- 			type = EventTypeMouseWheel
- 				ifTrue: [evt := self generateMouseWheelEvent: evtBuf].
- 			type = EventTypeKeyboard 
- 				ifTrue: [evt := self generateKeyboardEvent: evtBuf].
- 			type = EventTypeDragDropFiles 
- 				ifTrue: [evt := self generateDropFilesEvent: evtBuf].
- 			type = EventTypeWindow
- 				ifTrue:[evt := self generateWindowEvent: evtBuf].
- 			"All other events are ignored"
- 			(type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self].
- 			evt isNil 
- 				ifFalse: 
- 					["Finally, handle it"
  
+ 		type = EventTypeDragDropFiles 
+ 			ifTrue: [evt := self generateDropFilesEvent: evtBuf].
+ 		type = EventTypeWindow
+ 			ifTrue:[evt := self generateWindowEvent: evtBuf].
- 					self handleEvent: evt.
- 					hadAny := true.
  
+ 		evt ifNotNil: [self handleEvent: evt]].
- 					"For better user feedback, return immediately after a mouse event has been processed."
- 					evt isMouse ifTrue: [^self]]].
- 	"note: if we come here we didn't have any mouse events"
- 	mouseClickState notNil 
- 		ifTrue: 
- 			["No mouse events during this cycle. Make sure click states time out accordingly"
  
+ 	(evt isNil or: [evt isMouse not]) ifTrue: [
+ 		mouseClickState ifNotNil: [
+ 			"No mouse events during this cycle. Make sure click states time out accordingly"
+ 			mouseClickState handleEvent: lastMouseEvent asMouseMove from: self]].!
- 			mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
- 	hadAny 
- 		ifFalse: 
- 			["No pending events. Make sure z-order is up to date"
- 
- 			self mouseOverHandler processMouseOver: lastMouseEvent]!

Item was changed:
  ----- Method: Morph>>handleMouseEnter: (in category 'events-processing') -----
  handleMouseEnter: anEvent
  	"System level event handling."
+ 	anEvent wasHandled ifTrue: [^ self].
  	(anEvent isDraggingEvent) ifTrue:[
  		(self handlesMouseOverDragging: anEvent) ifTrue:[
  			anEvent wasHandled: true.
  			self mouseEnterDragging: anEvent].
  		^self].
  	self wantsHalo "If receiver wants halo and balloon, trigger balloon after halo"
  		ifTrue:[anEvent hand triggerHaloFor: self after: self haloDelayTime]
  		ifFalse:[self wantsBalloon
  			ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]].
  	(self handlesMouseOver: anEvent) ifTrue:[
  		anEvent wasHandled: true.
  		self mouseEnter: anEvent.
  	].!

Item was changed:
  ----- Method: Morph>>handleMouseLeave: (in category 'events-processing') -----
  handleMouseLeave: anEvent
  	"System level event handling."
+ 	anEvent wasHandled ifTrue: [^ self].
  	anEvent hand removePendingBalloonFor: self.
  	anEvent hand removePendingHaloFor: self.
  	anEvent isDraggingEvent ifTrue:[
  		(self handlesMouseOverDragging: anEvent) ifTrue:[
  			anEvent wasHandled: true.
  			self mouseLeaveDragging: anEvent].
  		^self].
  	(self handlesMouseOver: anEvent) ifTrue:[
  		anEvent wasHandled: true.
  		self mouseLeave: anEvent.
  	].
  !

Item was changed:
  ----- Method: Morph>>handleMouseOver: (in category 'events-processing') -----
  handleMouseOver: anEvent
  	"System level event handling."
+ 	anEvent hand noticeMouseOver: self event: anEvent.!
- 	anEvent hand mouseFocus == self ifTrue:[
- 		"Got this directly through #handleFocusEvent: so check explicitly"
- 		(self containsPoint: anEvent position event: anEvent) ifFalse:[^self]].
- 	anEvent hand noticeMouseOver: self event: anEvent!

Item was changed:
  ----- Method: MorphicEventDispatcher>>dispatchFocusEventAllOver:with: (in category 'focus events') -----
  dispatchFocusEventAllOver: evt with: focusMorph
  	"Like a full event dispatch BUT adds regular dispatch if the focus morph did nothing with the event. This is useful for letting the focusMorph's siblings handle the events instead. Take halo invocation as an example. See senders of me."
  	
  	| result hand mouseFocus |
  	result := self dispatchFocusEventFully: evt with: focusMorph.
  	
+ 	self flag: #todo. "mt: Too many enter/leave events for halo. Try to patch the mouse-over handler from here."
+ 	"evt isMouseOver ifTrue: [^ result]."
- 	evt isMouseOver ifTrue: [^ result]. 
  	
  	result == #rejected ifTrue: [^ result].
  	result wasIgnored ifTrue: [^ result].
  	result wasHandled ifTrue: [^ result].
  
  	hand := evt hand.
  	mouseFocus := hand mouseFocus.
+ 	
- 
  	[
  		"Avoid re-dispatching the event to the focus morph. See Morph >> #rejectsEvent:."
  		focusMorph lock.
  		hand newMouseFocus: nil.
  		
  		"Give the event's hand a chance to normally dispatch it."
  		^ hand handleEvent: evt
  	] ensure: [
  		focusMorph unlock.
  		hand newMouseFocus: mouseFocus].!

Item was changed:
  ----- Method: MorphicEventDispatcher>>dispatchFocusEventFully:with: (in category 'focus events') -----
  dispatchFocusEventFully: anEventWithGlobalPosition with: focusMorph
  	"Dispatch the given event to the given morph. Do capturing, processing in sub-tree, and bubbling."
  	
  	| currentEvent |
  	"1) Capturing phase."
  	currentEvent := self doCapturingForFocusEvent: anEventWithGlobalPosition with: focusMorph.
  	currentEvent == #rejected ifTrue: [
  		"See implementors of #rejectsEvent:, which is usually based on receiver state and not event state. Thus, reset foci to avoid unresponsive environment."
  		anEventWithGlobalPosition hand
  			releaseKeyboardFocus: focusMorph;
  			releaseMouseFocus: focusMorph.
  		^ #rejected].
  	"No need to reset foci here for ignored events because not all events might be ignored. Unlike #rejected."
  	currentEvent wasIgnored ifTrue: [^ currentEvent].
  	
  	"2) Sub-tree processing."
  	currentEvent := self doProcessingForFocusEvent: currentEvent with: focusMorph.
  	currentEvent wasIgnored ifTrue: [^ currentEvent].
  
  	"3) Let the focus morph handle the event. Usually no effect because previous sub-tree processing involved the focus morph already -- at least in the bubbling phase. Skip it?"
+ 	self flag: #todo. "mt: This duplicates mouse-over events."
  	currentEvent := self doHandlingForFocusEvent: currentEvent with: focusMorph.
  	currentEvent wasIgnored ifTrue: [^ currentEvent].
  	
  	"4) Bubbling phase."
  	^ self doBubblingForFocusEvent: currentEvent with: focusMorph!

Item was changed:
  ----- Method: MouseEvent>>asMouseEnter (in category 'converting') -----
  asMouseEnter
+ 	^self shallowCopy
+ 		setType: #mouseEnter;
+ 		wasHandled: false;
+ 		wasIgnored: false;
+ 		yourself!
- 	^self shallowCopy setType: #mouseEnter!

Item was changed:
  ----- Method: MouseEvent>>asMouseLeave (in category 'converting') -----
  asMouseLeave
+ 	^self shallowCopy
+ 		setType: #mouseLeave;
+ 		wasHandled: false;
+ 		wasIgnored: false;
+ 		yourself!
- 	^self shallowCopy setType: #mouseLeave!

Item was changed:
  ----- Method: MouseOverHandler>>processMouseOver: (in category 'event handling') -----
  processMouseOver: anEvent 
  	"Re-establish the z-order for all morphs wrt the given event"
  
+ 	| hand localEvent over left entered |
- 	| hand localEvt focus evt |
  	anEvent ifNil: [^ self].
+ 	
  	hand := anEvent hand.
+ 	leftMorphs := mouseOverMorphs asOrderedCollection.
+ 	
- 	leftMorphs := mouseOverMorphs asIdentitySet.
  	"Assume some coherence for the number of objects in over list"
  	overMorphs := WriteStream on: (Array new: leftMorphs size).
  	enteredMorphs := WriteStream on: #().
+ 
  	"Now go looking for eventual mouse overs"
  	hand handleEvent: anEvent asMouseOver.
+ 
+ 	"Preserve state to make the following pieces re-entrant."
+ 	over := overMorphs contents.
+ 	entered := enteredMorphs contents.
+ 	left := leftMorphs.
+ 	self initializeTrackedMorphs.
+ 
  	"Get out early if there's no change"
+ 	(left isEmpty and: [ entered isEmpty ]) 
+ 		ifTrue: [ ^self  ].
+ 
+ 	"Send mouse-leave events directly. Transform coordinates as necessary. Such events do not bubble up."
+ 	left do: [ :m |
+ 		localEvent := anEvent asMouseLeave transformedBy: (m transformedFrom: hand).
+ 		m handleEvent: localEvent ].
+ 	"Send mouse-enter events directly. Transform coordinates as necessary. Such events do not bubble up."
+ 	entered reverseDo: [ :m |
+ 		localEvent := anEvent asMouseEnter transformedBy: (m transformedFrom: hand).
+ 		m handleEvent: localEvent ].
+ 	
- 	(leftMorphs isEmpty and: [ enteredMorphs position = 0 ]) 
- 		ifTrue: [ ^self initializeTrackedMorphs ].
- 	focus := hand mouseFocus.
- 	"Send #mouseLeave as appropriate"
- 	evt := anEvent asMouseLeave.
- 	"Keep the order of the left morphs by recreating it from the mouseOverMorphs"
- 	leftMorphs size > 1 
- 		ifTrue:
- 			[leftMorphs := mouseOverMorphs select: [:m | leftMorphs includes: m]].
- 			leftMorphs do: [ :m | 
- 			(m == focus or: [m hasOwner: focus])
- 				ifFalse: [ overMorphs nextPut: m ]
- 				ifTrue: 
- 					[ localEvt := evt transformedBy: (m transformedFrom: hand).
- 					m handleEvent: localEvt ] ].
- 	enteredMorphs ifNil: [ "inform: was called in handleEvent:"
- 		^self initializeTrackedMorphs ].
- 	"Send #mouseEnter as appropriate"
- 	evt := anEvent asMouseEnter.
- 	enteredMorphs contents reverseDo: [ :m | 
- 		(m == focus or: [m hasOwner: focus]) ifTrue: [
- 			localEvt := evt transformedBy: (m transformedFrom: hand).
- 			m handleEvent: localEvt ] ].
  	"And remember the over list"
+ 	mouseOverMorphs := over.
+ !
- 	overMorphs ifNotNil: [ mouseOverMorphs := overMorphs contents ].
- 	self initializeTrackedMorphs!

Item was added:
+ ----- Method: PasteUpMorph>>handleMouseOver: (in category 'event handling') -----
+ handleMouseOver: anEvent
+ 
+ 	self == Project current world
+ 		ifFalse: [super handleMouseOver: anEvent].!