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

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

Name: Morphic-mt.1732
Author: mt
Time: 2 March 2021, 5:06:00.167687 pm
UUID: cb835785-768b-fd48-8eef-af27742a70dc
Ancestors: Morphic-mt.1731

Encapsulates most of the logic for halo invocation (and transfer) from Morph and PasteUpMorph into a new MorphicHaloDispatcher.

Hopefully no new bugs introduced. Yet, there is still this issue with protruding submorphs due to the logic in #dispatchHalo:createFor: ... :-)

PasteUpMorph #tryInvokeHalo: --> #dispatchHalo:createFor:
Morph #transferHalo:from: --> #dispatchHalo:transferFrom:

It always starts in #dispatchHalo:with: --- either called from the world's event filter or the current halo's mouse-down handling code.

=============== Diff against Morphic-mt.1731 ===============

Item was removed:
- ----- Method: Morph>>addHalo:from: (in category 'halos and balloon help') -----
- addHalo: evt from: formerHaloOwner
- 	"Transfer a halo from the former halo owner to the receiver"
- 	^self addHalo: evt!

Item was added:
+ ----- Method: Morph>>defaultHaloDispatcher (in category 'halos and balloon help') -----
+ defaultHaloDispatcher
+ 
+ 	^ MorphicHaloDispatcher new!

Item was removed:
- ----- Method: Morph>>invokeHaloOrMove: (in category 'meta-actions') -----
- invokeHaloOrMove: anEvent
- 	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
- 	| h tfm doNotDrag |
- 	h := anEvent hand halo.
- 	"Prevent wrap around halo transfers originating from throwing the event back in"
- 	doNotDrag := false.
- 	h ifNotNil:[
- 		(h innerTarget == self) ifTrue:[doNotDrag := true].
- 		(h innerTarget hasOwner: self) ifTrue:[doNotDrag := true].
- 		(self hasOwner: h target) ifTrue:[doNotDrag := true]].
- 
- 	tfm := (self transformedFrom: nil) inverseTransformation.
- 
- 	"cmd-drag on flexed morphs works better this way"
- 	h := self addHalo: (anEvent transformedBy: tfm).
- 	h ifNil: [^ self].
- 	doNotDrag ifTrue:[^self].
- 	"Initiate drag transition if requested"
- 	anEvent hand 
- 		waitForClicksOrDrag: h
- 		event: (anEvent transformedBy: tfm)
- 		selectors: { nil. nil. nil. #startDragTarget:. }
- 		threshold: HandMorph dragThreshold.
- 	"Pass focus explicitly here"
- 	anEvent hand newMouseFocus: h.
- 	"Reset temporary cursors to make available halo interaction visible."
- 	anEvent hand showTemporaryCursor: nil.!

Item was added:
+ ----- Method: Morph>>transferHalo: (in category 'halos and balloon help') -----
+ transferHalo: event
+ 
+ 	^ self transferHalo: event using: self defaultHaloDispatcher!

Item was removed:
- ----- Method: Morph>>transferHalo:from: (in category 'halos and balloon help') -----
- transferHalo: event from: formerHaloOwner
- 	"Progressively transfer the halo to the next likely recipient"
- 	| localEvt w target |
- 
- 	self flag: #workAround. "For halo's distinction between 'target' and 'innerTarget' we need to bypass any renderers."
- 	(formerHaloOwner == self and:[self isRenderer and:[self wantsHaloFromClick not]]) ifTrue:[
- 		event shiftPressed ifTrue:[
- 			target := owner.
- 			localEvt := event transformedBy: (self transformedFrom: owner).
- 		] ifFalse:[
- 			target := self renderedMorph.
- 			localEvt := event transformedBy: (target transformedFrom: self).
- 		].
- 		^target transferHalo: localEvt from: target].
- 
- "	formerHaloOwner == self ifTrue:[^ self removeHalo]."
- 
- 	"Never transfer halo to top-most world"
- 	(self isWorldMorph and:[owner isNil]) ifFalse:[
- 		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
- 			ifTrue:[^self addHalo: event from: formerHaloOwner]].
- 
- 	event shiftPressed ifTrue:[
- 		"Pass it outwards"
- 		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
- 		"We're at the top level; throw the event back in to find recipient"
- 		formerHaloOwner removeHalo.
- 		^self processEvent: event copy resetHandlerFields.
- 	].
- 	self submorphsDo:[:m|
- 		localEvt := event transformedBy: (m transformedFrom: self).
- 		(m fullContainsPoint: localEvt position) 
- 			ifTrue:[^m transferHalo: event from: formerHaloOwner].
- 	].
- 	"We're at the bottom most level; throw the event back up to the root to find recipient"
- 	formerHaloOwner removeHalo.
- 
- 	Preferences maintainHalos ifFalse:[
- 		(w := self world) ifNil: [ ^self ].
- 		localEvt := event transformedBy: (self transformedFrom: w) inverseTransformation.
- 		^w processEvent: localEvt resetHandlerFields.
- 	].
- !

Item was added:
+ ----- Method: Morph>>transferHalo:using: (in category 'halos and balloon help') -----
+ transferHalo: event using: dispatcher
+ 
+ 	^ dispatcher dispatchHalo: event with: self!

Item was added:
+ Object subclass: #MorphicHaloDispatcher
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Morphic-Events'!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>dispatchHalo:createFor: (in category 'dispatching') -----
+ dispatchHalo: anEvent createFor: aMorph
+ 	"Invoke halos around the top-most world container at aUserInputEvent's #position.  If it was already halo'd, zero-in on its next inward component morph at that position.  Holding Shift during the click reverses this traversal order."
+ 
+ 	| stack innermost haloTarget |
+ 	"the stack is the top-most morph to bottom-most."
+ 	stack := (aMorph morphsAt: anEvent position unlocked: true) select:
+ 		[ : each | each wantsHaloFromClick or: [ each handlesMouseDown: anEvent ] ].
+ 	innermost := anEvent hand halo
+ 		ifNil: [ stack first ]
+ 		ifNotNil:
+ 			[ : existingHalo | 
+ 			(stack := stack copyWithout: existingHalo) "No halos on halos"
+ 				detect: [ : each | each owner == aMorph ]
+ 				ifFound:
+ 					[ : worldContainer | "Is existingHalo's target part of the same worldContainer as the morph clicked?"
+ 					(existingHalo target withAllOwners includes: worldContainer)
+ 						ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now."  ^ false ]
+ 						ifFalse:
+ 							[ "different hierarchy, remove + add."
+ 							anEvent hand removeHalo.
+ 							anEvent shiftPressed
+ 								ifTrue: [ stack first ]
+ 								ifFalse: [ worldContainer ] ] ]
+ 				ifNone: [ "existingHalo is on the World, defer to #transferHalo: for now." ^ false ] ].
+ 
+ 	"If modifier key is pressed, start at innermost (the target), otherwise the outermost (direct child of the world (self))."
+ 	haloTarget := (innermost == aMorph or: [anEvent shiftPressed])
+ 		ifTrue: [ innermost ]
+ 		ifFalse:
+ 			 [ "Find the outermost owner that wants it."
+ 			innermost withAllOwners reversed allButFirst
+ 				detect: [ : each | each wantsHaloFromClick ]
+ 				ifNone: [ "haloTarget has its own mouseDown handler, don't halo."  ^ false ] ].
+ 	"Now that we have the haloTarget, show the halo."
+ 	self invokeHaloOrMove: anEvent on: haloTarget.
+ 	^ true!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>dispatchHalo:transferFrom: (in category 'dispatching') -----
+ dispatchHalo: event transferFrom: morph
+ 	"Progressively transfer the halo to the next likely recipient"
+ 
+ 	^ event shiftPressed
+ 		ifTrue: [self dispatchHalo: event transferOutwardsFrom: morph]
+ 		ifFalse: [self dispatchHalo: event transferInwardsFrom: morph]!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>dispatchHalo:transferInwardsFrom: (in category 'dispatching') -----
+ dispatchHalo: event transferInwardsFrom: currentTarget
+ 
+ 	| localEvent world |
+ 	currentTarget submorphsDo: [:nextTarget |
+ 		localEvent := event transformedBy: (nextTarget transformedFrom: currentTarget).
+ 		(nextTarget fullContainsPoint: localEvent position) ifTrue: [
+ 			^ nextTarget wantsHaloFromClick
+ 				ifTrue: [self invokeHalo: localEvent on: nextTarget]
+ 				ifFalse: [self dispatchHalo: localEvent transferInwardsFrom: nextTarget]]].
+ 		
+ 	"We're at the bottom most level; throw the event back up to the root to find recipient"
+ 	event hand removeHalo.
+ 	Preferences maintainHalos ifFalse: [
+ 		(world := currentTarget world) ifNil: [ ^ false ].
+ 		localEvent := event transformedBy: (currentTarget transformedFrom: world) inverseTransformation.
+ 		world processEvent: localEvent resetHandlerFields].
+ 
+ 	^ false!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>dispatchHalo:transferOutwardsFrom: (in category 'dispatching') -----
+ dispatchHalo: event transferOutwardsFrom: currentTarget
+ 
+ 	| localEvent |
+ 	currentTarget owner ifNotNil: [:nextTarget |
+ 		localEvent := event transformedBy: (currentTarget transformedFrom: nextTarget).
+ 		"Never transfer halo to top-most world"
+ 		^ (nextTarget isWorldMorph not and: [nextTarget wantsHaloFromClick])
+ 			ifTrue: [self invokeHalo: localEvent on: nextTarget]
+ 			ifFalse: [self dispatchHalo: localEvent transferOutwardsFrom: nextTarget]].
+ 	
+ 	"We're at the top level; throw the event back in to find recipient"
+ 	event hand removeHalo.
+ 	currentTarget isWorldMorph
+ 		ifTrue: [currentTarget processEvent: event copy resetHandlerFields].
+ 			
+ 	^ false!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>dispatchHalo:with: (in category 'dispatching') -----
+ dispatchHalo: anEvent with: aMorph
+ 
+ 	| halo successful |
+ 	halo := anEvent hand halo.
+ 	successful := (halo isNil or: [halo target ~~ aMorph])
+ 		ifTrue: [self dispatchHalo: anEvent createFor: aMorph]
+ 		ifFalse: [self dispatchHalo: anEvent transferFrom: aMorph].
+ 	successful ifTrue: [
+ 		self assert: [halo ~~ anEvent hand halo].
+ 		anEvent hand halo setProperty: #lastHaloDispatcher toValue: self].
+ 	^ successful!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>invokeHalo:on: (in category 'invoking') -----
+ invokeHalo: anEvent on: aMorph
+ 
+ 	aMorph addHalo: anEvent.
+ 	^ true!

Item was added:
+ ----- Method: MorphicHaloDispatcher>>invokeHaloOrMove:on: (in category 'invoking') -----
+ invokeHaloOrMove: anEvent on: aMorph
+ 	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
+ 	| h tfm doNotDrag |
+ 	anEvent hand newMouseFocus: aMorph event: anEvent.
+ 	h := anEvent hand halo.
+ 	"Prevent wrap around halo transfers originating from throwing the event back in"
+ 	doNotDrag := false.
+ 	h ifNotNil:[
+ 		(h innerTarget == aMorph) ifTrue:[doNotDrag := true].
+ 		(h innerTarget hasOwner: aMorph) ifTrue:[doNotDrag := true].
+ 		(aMorph hasOwner: h target) ifTrue:[doNotDrag := true]].
+ 
+ 	tfm := (aMorph transformedFrom: nil) inverseTransformation.
+ 
+ 	"cmd-drag on flexed morphs works better this way"
+ 	h := aMorph addHalo: (anEvent transformedBy: tfm).
+ 	h setProperty: #lastHaloDispatcher toValue: self.
+ 	doNotDrag ifTrue:[^ true].
+ 	"Initiate drag transition if requested"
+ 	anEvent hand 
+ 		waitForClicksOrDrag: h
+ 		event: (anEvent transformedBy: tfm)
+ 		selectors: { nil. nil. nil. #startDragTarget:. }
+ 		threshold: HandMorph dragThreshold.
+ 	"Pass focus explicitly here"
+ 	anEvent hand newMouseFocus: h.
+ 	"Reset temporary cursors to make available halo interaction visible."
+ 	anEvent hand showTemporaryCursor: nil.
+ 	^ true!

Item was changed:
  ----- Method: PasteUpMorph>>tryInvokeHalo: (in category 'events-processing') -----
  tryInvokeHalo: aUserInputEvent 
+ 
- 	"Invoke halos around the top-most world container at aUserInputEvent's #position.  If it was already halo'd, zero-in on its next inward component morph at that position.  Holding Shift during the click reverses this traversal order."
- 	| stack innermost haloTarget |
  	Preferences noviceMode ifTrue: [ ^ self ].
  	Morph haloForAll ifFalse: [ ^ self ].
+ 
+ 	(self transferHalo: aUserInputEvent)
+ 		ifTrue: "The event was handled, don't let it cause any further side-effects."
+ 			[ aUserInputEvent ignore ].!
- 	"the stack is the top-most morph to bottom-most."
- 	stack := (self morphsAt: aUserInputEvent position unlocked: true) select:
- 		[ : each | each wantsHaloFromClick or: [ each handlesMouseDown: aUserInputEvent ] ].
- 	innermost := aUserInputEvent hand halo
- 		ifNil: [ stack first ]
- 		ifNotNil:
- 			[ : existingHalo | (stack copyWithout: existingHalo) "No halos on halos"
- 				detect: [ : each | each owner == self ]
- 				ifFound:
- 					[ : worldContainer | "Is existingHalo's target part of the same worldContainer as the morph clicked?"
- 					(existingHalo target withAllOwners includes: worldContainer)
- 						ifTrue: [ "same hierarchy, let #transferHalo: continue to handle it for now."  ^self ]
- 						ifFalse:
- 							[ "different hierarchy, remove + add."
- 							aUserInputEvent hand removeHalo.
- 							aUserInputEvent shiftPressed
- 								ifTrue: [ stack second "first is still the just removed halo" ]
- 								ifFalse: [ worldContainer ] ] ]
- 				ifNone: [ "existingHalo is on the World, defer to #transferHalo: for now."  ^self ] ].
- 	"If modifier key is pressed, start at innermost (the target), otherwise the outermost (direct child of the world (self))."
- 	haloTarget := (innermost == self or: [aUserInputEvent shiftPressed])
- 		ifTrue: [ innermost ]
- 		ifFalse:
- 			 [ "Find the outermost owner that wants it."
- 			innermost withAllOwners reversed allButFirst
- 				detect: [ : each | each wantsHaloFromClick ]
- 				ifNone: [ "haloTarget has its own mouseDown handler, don't halo."  ^ self ] ].
- 	"Now that we have the haloTarget, show the halo."
- 	aUserInputEvent hand
- 		newMouseFocus: haloTarget
- 		event: aUserInputEvent.
- 	haloTarget invokeHaloOrMove: aUserInputEvent.
- 	"aUserInputEvent has been consumed, don't let it cause any further side-effects."
- 	aUserInputEvent ignore!

Item was changed:
  ----- Method: SimpleHaloMorph>>transferHalo: (in category 'pop up') -----
  transferHalo: event
  	"Transfer the halo to the next likely recipient"
  
+ 	^ self
+ 		transferHalo: event
+ 		using: (self
+ 			valueOfProperty: #lastHaloDispatcher
+ 			ifAbsent: [self target defaultHaloDispatcher])!
- 	self target
- 		transferHalo: (event transformedBy: (self target transformedFrom: self))
- 		from: self target.!

Item was removed:
- ----- Method: SimpleHaloMorph>>transferHalo:from: (in category 'halos and balloon help') -----
- transferHalo: event from: formerHaloOwner
- 	"If my world tries to open on me, pass it on to the next sibling after me."
- 	
- 	formerHaloOwner == self world ifTrue: [
- 		self world submorphsDo: [:m |
- 			(m ~~ self and: [m fullContainsPoint: event position]) ifTrue: [
- 				m comeToFront.
- 				^ m transferHalo: event from: formerHaloOwner]]].!

Item was added:
+ ----- Method: SimpleHaloMorph>>transferHalo:using: (in category 'pop up') -----
+ transferHalo: event using: dispatcher
+ 	"Transfer the halo to the next likely recipient. Call the target again so that it may change the dispatcher."
+ 		
+ 	^ self target
+ 		transferHalo: (event transformedBy: (self target transformedFrom: self))
+ 		using: dispatcher!

Item was added:
+ ----- Method: SimpleHaloMorph>>wantsHaloFromClick (in category 'halos and balloon help') -----
+ wantsHaloFromClick
+ 
+ 	^ false!