The Trunk: Morphic-mt.1732.mcz

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!