This is also required for interactionMode.cs. :)

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

Change Set:        lastEvent
Date:            26 March 2022
Author:            Christoph Thiede

Revises HandMorph>>#lastEvent to honor all real user events and refactors several senders.

* HandMorph>>#lastEvent now is no longer restricted to mouse events but may answer all user events (except for virtual mouseOver events).
* Refactored several senders to make use of MenuMorph>>#popUpInWorld:, Morph>>#cursorPoint, and Morph>>#currentEvent.

=============== Diff ===============

BookMorph>>invokeBookMenu {menu} · ct 3/26/2022 20:58 (changed)
invokeBookMenu
    "Invoke the book's control panel menu."
    | aMenu |
    aMenu := MenuMorph new defaultTarget: self.
    aMenu addTitle: 'Book' translated.
    Preferences noviceMode
        ifFalse:[aMenu addStayUpItem].
    aMenu add: 'find...' translated action: #textSearch.
    aMenu add: 'go to page...' translated action: #goToPage.
    aMenu addLine.

    aMenu addList: {
        {'sort pages' translated.        #sortPages}.
        {'uncache page sorter' translated.    #uncachePageSorter}}.
    (self hasProperty: #dontWrapAtEnd)
        ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true]
        ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
    aMenu addList: {
        {'make bookmark' translated.        #bookmarkForThisPage}.
        {'make thumbnail' translated.        #thumbnailForThisPage}}.
    aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls.
    aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen.

    aMenu addLine.
    aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:.
    aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:.
    aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:.
    aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.

    aMenu addLine.
    (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue:
        [aMenu add: 'paste book page' translated   action: #pasteBookPage].

    aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype.
    newPagePrototype ifNotNil: [
        aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].

    aMenu add: (self dragNDropEnabled ifTrue: ['close dragNdrop'] ifFalse: ['open dragNdrop']) translated
            action: #changeDragAndDrop.
    aMenu add: 'make all pages this size' translated action: #makeUniformPageSize.
    
    aMenu
        addUpdating: #keepingUniformPageSizeString
        target: self
        action: #toggleMaintainUniformPageSize.
    aMenu addLine.

    aMenu add: 'send all pages to server' translated action: #savePagesOnURL.
    aMenu add: 'send this page to server' translated action: #saveOneOnURL.
    aMenu add: 'reload all from server' translated action: #reload.
    aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
    aMenu add: 'keep in one file' translated action: #keepTogether.

    aMenu addLine.
    aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook.
    aMenu add: 'background color for all pages...' translated action: #setPageColor.
    aMenu add: 'make a thread of projects in this book' translated action: #buildThreadOfProjects.

-     aMenu popUpEvent: self world activeHand lastEvent in: self world
+     aMenu popUpInWorld: self world.


FlapTab>>hideFlapUnlessOverReferent {show & hide} · ct 3/26/2022 20:57 (changed)
hideFlapUnlessOverReferent
    "Hide the flap unless the mouse is over my referent."

    | aWorld where |
    (referent isInWorld and: 
-         [where := self outermostWorldMorph activeHand lastEvent cursorPoint.
+         [where := self cursorPoint.
            referent bounds containsPoint: (referent globalPointToLocal: where)])
                ifTrue: [^ self].
    (aWorld := self world) ifNil: [^ self].  "In case flap tabs just got hidden"
    self referent delete.
    aWorld removeAccommodationForFlap: self.
    flapShowing := false.
    self isInWorld ifFalse:
        [self inboard ifTrue: [aWorld addMorphFront: self]].
    self adjustPositionAfterHidingFlap

HandMorph (changed)
Morph subclass: #HandMorph
-     instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastMouseEvent lastKeyDownEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter externalDropMorph'
+     instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners eventCaptureFilters mouseCaptureFilters keyboardCaptureFilters mouseClickState mouseOverHandler targetOffset lastEvent lastMouseEvent lastKeyDownEvent damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter externalDropMorph'
    classVariableNames: 'CompositionWindowManager DoubleClickTime DragThreshold EventStats MinimalWheelDelta NewEventRules NormalCursor PasteBuffer SendMouseWheelToKeyboardFocus ShowEvents SynthesizeMouseWheelEvents'
    poolDictionaries: 'EventSensorConstants'
    category: 'Morphic-Kernel'

HandMorph class 
    instanceVariableNames: ''

"The cursor may be thought of as the HandMorph.  The hand's submorphs hold anything being carried by dragging.  

There is some minimal support for multiple hands in the same world."

HandMorph>>handleEvent: {events-processing} · ct 3/26/2022 21:15 (changed)
handleEvent: unfilteredEvent

    | filteredEvent |
    owner ifNil: [^ unfilteredEvent  "not necessary but good style -- see Morph >> #handleEvent:"].
    
    self logEvent: unfilteredEvent.

    "Mouse-over events occur really, really, really often. They are kind of the heart beat of the Morphic UI process."
    unfilteredEvent isMouseOver ifTrue: [^ self sendMouseEvent: unfilteredEvent].

+     lastEvent := unfilteredEvent.
    self showEvent: unfilteredEvent.
    self sendListenEvents: unfilteredEvent.
    
    filteredEvent := self sendFilterEventCapture: unfilteredEvent for: nil.
    "filteredEvent := unfilteredEvent" " <-- use this to disable global capture filters"
    
    filteredEvent wasIgnored ifTrue: [
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].
    
    filteredEvent isWindowEvent ifTrue: [
        self sendEvent: filteredEvent focus: nil.
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].

    filteredEvent isKeyboard ifTrue: [
        filteredEvent isKeyDown ifTrue: [lastKeyDownEvent := filteredEvent].
        self sendKeyboardEvent: filteredEvent.
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].
            
    filteredEvent isDropEvent ifTrue:[
        self sendEvent: filteredEvent focus: nil.
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].

    filteredEvent isMouse ifFalse: [
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].

    " ********** MOUSE EVENT *********** "

    lastMouseEvent := filteredEvent.

    "Check for pending drag or double click operations."
    mouseClickState ifNotNil:[
        (mouseClickState handleEvent: filteredEvent from: self) ifFalse:[
            "Possibly dispatched #click: or something and will not re-establish otherwise"
            self mouseOverHandler processMouseOver: lastMouseEvent.
            ^ filteredEvent]].

    filteredEvent isMouseWheel ifTrue: [
        self class sendMouseWheelToKeyboardFocus
            ifFalse: [self sendMouseEvent: filteredEvent]
            ifTrue: [self sendEvent: filteredEvent focus: self keyboardFocus clear: [self keyboardFocus: nil]].
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].

    filteredEvent isMove ifTrue:[
        self position: filteredEvent position.
        self sendMouseEvent: filteredEvent.
        self mouseOverHandler processMouseOver: lastMouseEvent.
        ^ filteredEvent].

    "Issue a synthetic move event if we're not at the position of the event"
    self flag: #bug. "mt: Incompatible with how #mouseMove: is handled when #wantsEveryMouseMove: answers false. Handler might think that #mouseDown: was already received. For example, TextEditor and HaloMorph will issue drags in their #mouseMove: based on old data. That is, the first #mouseMove: appears to come before #mouseDown: while actually sent due to #moveToEvent:."
    filteredEvent position = self position
        ifFalse: [self moveToEvent: filteredEvent].
    
    "Drop submorphs on button events"
    self hasSubmorphs
        ifTrue:[self dropMorphs: filteredEvent]
        ifFalse:[self sendMouseEvent: filteredEvent].

    self mouseOverHandler processMouseOver: lastMouseEvent.
    ^ filteredEvent "not necessary but good style -- see Morph >> #handleEvent:"    

HandMorph>>initForEvents {initialization} · ct 3/26/2022 21:03 (changed)
- initForEvents
+ initForEvents 
    mouseOverHandler := nil.
-     lastMouseEvent := MouseEvent new setType: #mouseMove position: 0 at 0 buttons: 0 hand: self.
+     lastEvent := lastMouseEvent := MouseEvent new setType: #mouseMove position: 0 at 0 buttons: 0 hand: self.
    lastKeyDownEvent := KeyboardEvent new setType: #keyDown buttons: 0 position: 0 at 0 keyValue: 0 hand: self stamp: 0.
    lastEventBuffer := {1. 0. 0. 0. 0. 0. nil. nil}.
    self resetClickState.
    self addKeyboardCaptureFilter: self. "to convert unusual VM events"

HandMorph>>lastEvent {accessing} · ct 3/26/2022 21:03 (changed)
lastEvent
-     ^ lastMouseEvent
+ 
+     ^ lastEvent

InternalThreadNavigationMorph>>jumpWithinThread {navigation} · ct 3/26/2022 20:57 (changed)
jumpWithinThread

    | aMenu me weHaveOthers myIndex |

    me := Project current name.
    aMenu := MenuMorph new defaultTarget: self.
    weHaveOthers := false.
    myIndex := self currentIndex.
    listOfPages withIndexDo: [ :each :index |
        index = myIndex ifTrue: [
            aMenu add: 'you are here' translated action: #yourself.
            aMenu lastSubmorph color: Color red.
        ] ifFalse: [
            weHaveOthers := true.
            aMenu add: ('jump to <{1}>' translated format:{each first}) selector: #jumpToIndex: argument: index.
            myIndex = (index - 1) ifTrue: [
                aMenu lastSubmorph color: Color blue
            ].
            myIndex = (index + 1) ifTrue: [
                aMenu lastSubmorph color: Color orange
            ].
        ].
    ].
    weHaveOthers ifFalse: [^self inform: 'This is the only project in this thread' translated].
-     aMenu popUpEvent: self world primaryHand lastEvent in: self world
+     aMenu popUpInWorld: self world

Morph>>cursorPoint {event handling} · ct 3/26/2022 20:52 (changed)
cursorPoint
-     ^ self currentHand lastEvent cursorPoint
+ 
+     ^ self currentEvent position

ScrollPane>>yellowButtonActivity: {scroll bar events} · ct 3/26/2022 20:53 (changed)
yellowButtonActivity: shiftKeyState
    | menu |
    (menu := self getMenu: shiftKeyState) ifNotNil:
        [menu setInvokingView: self.
-         menu popUpEvent: self activeHand lastEvent in: self world]
+         menu popUpInWorld: self world]

StackMorph>>invokeBookMenu {menu} · ct 3/26/2022 20:55 (changed)
invokeBookMenu
    "Invoke the book's control panel menu."

    | aMenu |
    aMenu := MenuMorph new defaultTarget: self.
    aMenu addTitle: 'Stack' translated.
    Preferences noviceMode
        ifFalse: [aMenu addStayUpItem].
    aMenu addList: {
        {'find...' translated.                    #textSearch}.
        {'find via this template' translated.            #findViaTemplate}.
        {'show designations' translated.             #showDesignationsOfObjects}.
        {'explain designations' translated.            #explainDesignations}.
        #-.
        {'previous card' translated.                 #goToPreviousCardInStack}.
        {'next card' translated.                 #goToNextCardInStack}.
        {'first card' translated.                 #goToFirstCardOfStack}.
        {'last card' translated.                 #goToLastCardOfStack}.
        {'go to card...' translated.                 #goToCard}.
        #-.
        {'add a card of this background' translated.         #insertCard}.
        {'add a card of background...' translated.        #insertCardOfBackground}.
        {'make a new background...' translated.         #makeNewBackground}.
        #-.
        {'insert cards from clipboard data' translated.        #addCardsFromClipboardData.    'Create new cards from a formatted string on the clipboard' translated}.
        {'insert cards from a file...' translated.        #addCardsFromAFile.        'Create new cards from data in a file' translated}.
        #-.
        {'instance variable order...' translated.        #changeInstVarOrder.        'Caution -- DANGER. Change the order of the variables on the cards' translated}.
        {'be defaults for new cards' translated.         #beDefaultsForNewCards.        'Make these current field values be the defaults for their respective fields on new cards' translated}.
            {'sort cards by...' translated.            #sortCards.            'Sort all the cards of the current background using some field as the sort key' translated}.
        #-.
        {'delete this card' translated.             #deleteCard}.
        {'delete all cards *except* this one' translated.    #deleteAllCardsExceptThisOne}.
        #-.
        {'move card to front of stack' translated.        #makeCurrentCardFirstInStack}.
        {'move card to back of stack' translated.        #makeCurrentCardLastInStack}.
        {'move card one position earlier' translated.        #moveCardOnePositionEarlier}.
        {'move card one position later' translated.        #moveCardOnePositionLater}.
        #-.
        {'scripts for this background' translated.        #browseCardClass}.
        #-.
        {'debug...' translated.                    #offerStackDebugMenu}.
        {'bookish items...' translated.             #offerBookishMenu}}.

    aMenu addUpdating: #showingPageControlsString action: #toggleShowingOfPageControls.
    aMenu addUpdating: #showingFullScreenString action: #toggleFullScreen.

-     aMenu popUpEvent: self world activeHand lastEvent in: self world
+     aMenu popUpInWorld: self world.


StackMorph>>offerBookishMenu {menu} · ct 3/26/2022 20:55 (changed)
offerBookishMenu
    "Offer a menu with book-related items in it"

    | aMenu |
    aMenu := MenuMorph new defaultTarget: self.
    aMenu addTitle: 'Stack / Book' translated.
    aMenu addStayUpItem.
    aMenu addList:
        #(('sort pages' sortPages)
        ('uncache page sorter' uncachePageSorter)).
    (self hasProperty: #dontWrapAtEnd)
        ifTrue: [aMenu add: 'wrap after last page' translated selector: #setWrapPages: argument: true]
        ifFalse: [aMenu add: 'stop at last page' translated selector: #setWrapPages: argument: false].
    aMenu addList:
        #(('make bookmark'     bookmarkForThisPage)
        ('make thumbnail' thumbnailForThisPage)).

    aMenu addLine.
    aMenu add: 'sound effect for all pages' translated action: #menuPageSoundForAll:.
    aMenu add: 'sound effect this page only' translated action: #menuPageSoundForThisPage:.
    aMenu add: 'visual effect for all pages' translated action: #menuPageVisualForAll:.
    aMenu add: 'visual effect this page only' translated action: #menuPageVisualForThisPage:.

    aMenu addLine.
    (self primaryHand pasteBuffer class isKindOf: PasteUpMorph class) ifTrue:
        [aMenu add: 'paste book page'   translated action: #pasteBookPage].

    aMenu add: 'save as new-page prototype' translated action: #setNewPagePrototype.
    newPagePrototype ifNotNil: [
        aMenu add: 'clear new-page prototype' translated action: #clearNewPagePrototype].

    aMenu add: (self dragNDropEnabled ifTrue: ['close' translated ] ifFalse: ['open' translated]) , ' dragNdrop' translated
            action: #changeDragAndDrop.
    aMenu addLine.
    aMenu add: 'make all pages this size' translated action: #makeUniformPageSize.
    aMenu addUpdating: #keepingUniformPageSizeString target: self action: #toggleMaintainUniformPageSize.
    aMenu addLine.
    aMenu add: 'send all pages to server' translated action: #savePagesOnURL.
    aMenu add: 'send this page to server' translated action: #saveOneOnURL.
    aMenu add: 'reload all from server' translated action: #reload.
    aMenu add: 'copy page url to clipboard' translated action: #copyUrl.
    aMenu add: 'keep in one file' translated action: #keepTogether.

    aMenu addLine.
    aMenu add: 'load PPT images from slide #1' translated action: #loadImagesIntoBook.
    aMenu add: 'background color for all pages...' translated action: #setPageColor.

-     aMenu popUpEvent: self world activeHand lastEvent in: self world
- 
- 
+     aMenu popUpInWorld: self world.


SugarNavigatorBar>>doNewPainting {button actions} · ct 3/26/2022 20:55 (changed)
doNewPainting
    
    | w |

    w := self world.
    w assureNotPaintingElse: [^ self].
-     w makeNewDrawing: (self primaryHand lastEvent copy setPosition: w center)
+     w makeNewDrawing: (self currentEvent copy setPosition: w center)


SyntaxMorph>>wantsKeyboardFocusFor: {event handling} · ct 3/26/2022 20:55 (changed)
wantsKeyboardFocusFor: aSubmorph
    | doEdit |
    "only let strings edit on shift-click.  Editing on ordinary click defeats the brown selection and tile dragging."

-     doEdit := self world primaryHand lastEvent shiftPressed.
+     doEdit := self currentEvent shiftPressed.
    doEdit ifTrue: ["remove the arrows during editing"
        self valueOfProperty: #myPopup ifPresentDo: [:panel |
            panel delete. self removeProperty: #myPopup]].
    ^ doEdit

TileMorph>>showSuffixChoices {arrows} · ct 3/26/2022 20:54 (changed)
showSuffixChoices
    "The suffix arrow has been hit, so respond appropriately"

    | plusPhrase phrase pad outer num |
    self currentEvent shiftPressed ifTrue: [^ self wrapPhraseInFunction].

    (phrase := self ownerThatIsA: PhraseTileMorph orA: FunctionTile) ifNil: [nil].

    (type == #literal) & (literal isNumber) ifTrue: ["Tile is a constant number"
        (phrase isNil or: [phrase finalTilePadSubmorph == owner]) "pad"
            ifTrue: ["we are adding the first time (at end of our phrase)"
                plusPhrase := self phraseForOp: #+ arg: 1 resultType: #Number.
                plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
-                 owner acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
+                 owner acceptDroppingMorph: plusPhrase event: self currentEvent.
                num := plusPhrase firstSubmorph firstSubmorph.
                num deleteSuffixArrow]].

    (#(function expression parameter) includes: type) ifTrue:
            [pad := self ownerThatIsA: TilePadMorph.
            plusPhrase := self presenter phraseForReceiver: 1  op: #+ arg: 1 resultType: #Number.
            plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
-             pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
+             pad acceptDroppingMorph: plusPhrase event: self currentEvent.
            plusPhrase firstSubmorph removeAllMorphs; addMorph: self.
            pad topEditor scriptEdited "recompile"].

    type = #operator ifTrue: ["Tile is accessor of an expression"
        phrase resultType == #Number ifTrue:
            [outer := phrase ownerThatIsA: PhraseTileMorph orA: TimesRepeatTile.
            pad := self ownerThatIsA: TilePadMorph.
            outer ifNotNil:
                [(outer lastSubmorph == pad or: [true]) ifTrue: [ "first time"
                    plusPhrase := self presenter phraseForReceiver: 1 
                            op: #+ arg: 1 resultType: #Number.
                    plusPhrase submorphs second submorphs last setBalloonText: (ScriptingSystem helpStringForOperator: #+).
-                     pad acceptDroppingMorph: plusPhrase event: self primaryHand lastEvent.
+                     pad acceptDroppingMorph: plusPhrase event: self currentEvent.
                    plusPhrase firstSubmorph removeAllMorphs; addMorph: phrase.    "car's heading"
                    pad topEditor scriptEdited "recompile & deal with carets"]]]].

    (self topEditor ifNil: [phrase ifNil: [^ self]]) enforceTileColorPolicy

TwoWayScrollPane>>yellowButtonActivity: {scroll bar events} · ct 3/26/2022 20:54 (changed)
yellowButtonActivity: shiftKeyState
    | menu |
    (menu := self getMenu: shiftKeyState) ifNotNil:
        [menu setInvokingView: self.
-         menu popUpEvent: self activeHand lastEvent in: self world]
+         menu popUpInWorld: self world]

["lastEvent.1.cs"]

---
Sent from Squeak Inbox Talk
["lastEvent.1.cs"]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220401/da5bbbe4/attachment.html>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: lastEvent.1.cs
Type: application/octet-stream
Size: 17655 bytes
Desc: not available
URL: <http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20220401/da5bbbe4/attachment.obj>