diff --git a/Cuis5.0-4507-32.changes b/Cuis5.0-4520-32.changes similarity index 98% rename from Cuis5.0-4507-32.changes rename to Cuis5.0-4520-32.changes index b1154f99..822416a2 100644 --- a/Cuis5.0-4507-32.changes +++ b/Cuis5.0-4520-32.changes @@ -174738,4 +174738,2105 @@ for $"" rather than blindly adding it to the comment being collected." ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4507-findSelectorFix-JuanVuletich-2020Dec30-14h38m-jmv.001.cs.st----! -----SNAPSHOT----(30 December 2020 14:47:39) Cuis5.0-4507-32.image priorSource: 7148984! \ No newline at end of file +----SNAPSHOT----(30 December 2020 14:47:39) Cuis5.0-4507-32.image priorSource: 7148984! + +----STARTUP---- (7 January 2021 16:17:31) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4507-32.image! + + +'From Cuis 5.0 [latest update: #4506] on 29 December 2020 at 7:19:51 pm'! +!MethodContext methodsFor: 'instruction decoding (closures)' stamp: 'HAW 12/29/2020 19:19:31'! + callPrimitive: primNumber + "Evaluate the primitive, either normal or inlined, and answer the new context resulting from that + (either the sender if a successful non-inlined primitive, or the current context, if not)." + "Copied from Squeak, Context>>#callPrimitive: + The message callInlinedPrimitive: is not implemented in Squeak also - Hernan" + + | maybePrimFailToken | + primNumber >= (1 << 15) ifTrue: "Inlined primitive, cannot fail" + [^self callInlinedPrimitive: primNumber]. + maybePrimFailToken := self doPrimitive: primNumber + method: method + receiver: receiver + args: self arguments. + "Normal primitive. Always at the beginning of methods." + (self isPrimFailToken: maybePrimFailToken) ifFalse: "On success return the result" + [^self methodReturnTop]. + "On failure, store the error code if appropriate and keep interpreting the method" + (method encoderClass isStoreAt: pc in: method) ifTrue: + [self at: stackp put: maybePrimFailToken last]. + ^self! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4508-callPrimitive-HernanWilkinson-2020Dec29-19h19m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4384] on 30 December 2020 at 7:32:37 pm'! +!ContextPart methodsFor: 'closure support' stamp: 'HAW 12/30/2020 19:31:45'! + contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! ! + +MethodContext removeSelector: #contextTag! + +!methodRemoval: MethodContext #contextTag stamp: 'Install-4509-contextTagMovedToSuper-HernanWilkinson-2020Dec30-19h30m-HAW.001.cs.st 1/7/2021 16:17:35'! +contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4509-contextTagMovedToSuper-HernanWilkinson-2020Dec30-19h30m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4384] on 30 December 2020 at 7:34:30 pm'! +!TestCase methodsFor: 'assertions' stamp: 'HAW 12/30/2020 19:33:44' prior: 16927604! + assert: expected equals: actual + ^ self + assert: expected = actual + description: [ self comparingStringBetween: expected and: actual ] +! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4510-assertEqualsDescriptionsDelayedUntilNeccesary-HernanWilkinson-2020Dec30-19h32m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4494] on 1 January 2021 at 3:56:49 pm'! + +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings ' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +!classDefinition: #PluggableListMorph category: 'Morphic-Widgets' stamp: 'Install-4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st 1/7/2021 16:17:35'! +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! +!PluggableListMorph commentStamp: '' prior: 16888551! + ... + +When a PluggableListMorph is in focus, type in a letter (or several +letters quickly) to go to the next item that begins with that letter. +Special keys (up, down, home, etc.) are also supported. + +leftSibling and rightSibling have two uses. + [A] One can use left and right arrow keys to shift focus to a sibling + [B] When scrollSiblings is true, one can do "multiscrolling" -- vertical scroll siblings with self + +For [B] Sample usage see: CodePackageListWindow >>buildMorphicWindow! +!PluggableScrollPane methodsFor: 'access options' stamp: 'KenD 12/31/2020 13:05:54'! + alwaysHideVerticalScrollbar + + hideScrollBars _ #alwaysHideVertical. + self vHideScrollBar.! ! +!PluggableListMorph methodsFor: 'siblings' stamp: 'KenD 1/1/2021 13:10:42'! + scrollSiblings + "Do I scroll my siblings with myself?" + ^ scrollSiblings! ! +!PluggableListMorph methodsFor: 'siblings' stamp: 'KenD 1/1/2021 13:11:00'! + scrollSiblings: aBoolean + "Do I scroll my siblings with myself?" + scrollSiblings := aBoolean! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:57' overrides: 50406131! + scrollBy: delta + "Scroll self and any siblings" + super scrollBy: delta. + self scrollMySiblings! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:34:25'! + scrollMySiblings + "vertical scroll my siblings along with my self" + | yOffset | + yOffset := self scrollerOffset y. + scrollSiblings ifTrue: [ + self vScrollLeftSibling: yOffset; + vScrollRightSibling: yOffset + ]! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:49' prior: 50365049 overrides: 16889986! + scrollSelectionIntoView + "make sure that the current selection is visible" + | row r | + row _ self getCurrentSelectionIndex. + row = 0 + ifTrue: [ + "Value is 0, but we need to propagate it to model" + scrollBar internalScrollValue: scrollBar scrollValue ] + ifFalse: [ + self flag: #jmvVer2. + r _ self listMorph drawBoundsForRow: row. + r _ ((self listMorph externalize: r origin) extent: r extent). + self scrollToShow: r ]. + self scrollMySiblings +! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:29' overrides: 50455277! + scrollToShow: aRectangle + + super scrollToShow: aRectangle. + self scrollMySiblings ! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:41:31'! + vPrivateScrollTo: scrollValue + + self scrollerOffset: (self scrollerOffset x @ scrollValue)! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:43:22' overrides: 16890025! + vScrollBarValue: scrollValue + + super vScrollBarValue: scrollValue. + self scrollMySiblings! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:32:18'! + vScrollLeftSibling: yOffset + "vertical scroll my LEFT siblings along with my self" + self vPrivateScrollTo: yOffset. + scrollSiblings ifTrue: [ + leftSibling ifNotNil: [ :left | + left vScrollLeftSibling: yOffset ] + ]! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:32:25'! + vScrollRightSibling: yOffset + "vertical scroll my RIGHT siblings along with my self" + self vPrivateScrollTo: yOffset. + scrollSiblings ifTrue: [ + rightSibling ifNotNil: [ :left | + left vScrollRightSibling: yOffset ] + ]! ! +!PluggableScrollPane methodsFor: 'geometry' stamp: 'KenD 12/31/2020 13:09:16' prior: 50556221! + updateScrollBarsBounds + + | t | + hideScrollBars = #hide ifTrue: [^self]. + t _ self scrollBarClass scrollbarThickness. + (hideScrollBars = #hideVertical) + ifFalse: [ + scrollBar + morphPosition: extent x - t - borderWidth @ borderWidth + extent: t @ self vScrollBarHeight. + ]. + hScrollBar + morphPosition: borderWidth @ (extent y - t - borderWidth) + extent: self hScrollBarWidth@t! ! +!PluggableScrollPane methodsFor: 'scrolling' stamp: 'KenD 12/31/2020 13:18:18' prior: 50556266! + vIsScrollbarNeeded + "Return whether the vertical scrollbar is needed" + + "Don't show it if we were told not to." + hideScrollBars = #hide ifTrue: [ ^false ]. + + hideScrollBars = #alwaysHideVertical ifTrue: [ ^false ]. + + hideScrollBars = #alwaysShowVertical ifTrue: [ ^true ]. + + ^self vLeftoverScrollRange > 0! ! +!PluggableListMorph methodsFor: 'initialization' stamp: 'KenD 1/1/2021 13:11:40' prior: 50492520 overrides: 50556236! + initialize + super initialize. + scroller morphWidth: extent x. + scrollSiblings := false. "user must override"! ! +!CodePackageListWindow methodsFor: 'GUI building' stamp: 'KenD 1/1/2021 15:49:40' prior: 50547698! + buildMorphicWindow + " + CodePackageListWindow open: CodePackageList new + " + | dirtyFlags names fileNames dirtyFlagsPane namesPane fileNamesPane + upperRow description summary backColor labelBackground | + backColor := self textBackgroundColor. + labelBackground := Theme current background. + + dirtyFlags := PluggableListMorph + model: model + listGetter: #packageDirtyFlags + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + dirtyFlags color: backColor; + hideScrollBarsIndefinitely. + dirtyFlagsPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Unsaved?'); + addMorphUseAll: dirtyFlags. + + names := PluggableListMorph + model: model + listGetter: #packageNames + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + names color: backColor. + namesPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Package Name'); + addMorphUseAll: names. + + fileNames := PluggableListMorph + model: model + listGetter: #packageFullNames + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + fileNames color: backColor; + alwaysHideVerticalScrollbar. + fileNamesPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' File Name'); + addMorphUseAll: fileNames. + + upperRow := LayoutMorph newRow. + upperRow + addMorph: dirtyFlagsPane proportionalWidth: 0.13; + addAdjusterAndMorph: namesPane proportionalWidth: 0.27; + addAdjusterAndMorph: fileNamesPane proportionalWidth: 0.6. + + description := (TextModelMorph + textProvider: model + textGetter: #description + textSetter: #description:) emptyTextDisplayMessage: 'Please enter a description for this package'. + + summary := (TextModelMorph + textProvider: model + textGetter: #summary) emptyTextDisplayMessage: 'Package summary (No package selected?)'. + + names leftSibling: dirtyFlags rightSibling: fileNames; scrollSiblings: true. + dirtyFlags rightSibling: names; scrollSiblings: true. + fileNames leftSibling: names; scrollSiblings: true. + + self layoutMorph + addMorph: upperRow proportionalHeight: 0.6; + addAdjusterAndMorph: self buildButtonPane fixedHeight: Theme current buttonPaneHeight; + addAdjusterAndMorph: summary fixedHeight: 60; + addAdjusterAndMorph: description proportionalHeight: 0.25; + addAdjusterAndMorph: self buildRequirementsPane proportionalHeight: 0.15. + self setLabel: 'Installed Packages'! ! +!CodePackageListWindow methodsFor: 'GUI building' stamp: 'KenD 12/31/2020 11:40:22' prior: 50519859! + buildRequirementsPane + + | requirements deleteReqButton "editReqButton" reqLayout buttonLayout updateReqButton | + requirements := PluggableListMorph + model: (PackageRequirementsList fromCodePackageList: model) + listGetter: #requirementsStrings + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + requirements color: Theme current textPane. + + deleteReqButton := PluggableButtonMorph + model: requirements model + action: #deleteSelectedRequirement + label: 'delete':: + setBalloonText: 'Remove selected Feature requirement'. + deleteReqButton color: self widgetsColor. + updateReqButton _ PluggableButtonMorph + model: requirements model + action: #updateSelectedRequirement + label: 'update':: + setBalloonText: 'Update requirement to current Feature revision'. + updateReqButton color: self widgetsColor. + + buttonLayout := LayoutMorph newRow. + buttonLayout + addMorph: deleteReqButton + layoutSpec: (LayoutSpec + proportionalWidth: 1.0 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + color: self widgetsColor quiteWhiter; + addMorph: updateReqButton + layoutSpec: (LayoutSpec + proportionalWidth: 1.0 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + color: self widgetsColor quiteWhiter. + + model when: #changed: send: #updateRequirementsFromPackageList to: requirements model. + self when: #changed: send: #updateRequirementsFromPackageList to: requirements model. + requirements model when: #changed: send: #verifyContents to: requirements. + self when: #changed: send: #verifyContents to: requirements. + + reqLayout := LayoutMorph newRow. + ^ reqLayout + doAdoptWidgetsColor; + addMorph: requirements + layoutSpec: (LayoutSpec + proportionalWidth: 0.8 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + addMorph: buttonLayout + layoutSpec: (LayoutSpec + proportionalWidth: 0.2 + proportionalHeight: 1.0 + offAxisEdgeWeight: #rightOrBottom); + color: `Color transparent`; + yourself + ! ! +!ChangeSorterWindow methodsFor: 'GUI building' stamp: 'KenD 1/1/2021 15:54:53' prior: 50547776! + buildMorphicWindow + "Add a set of change sorter views to the given top view offset by the given amount. To create a single change sorter, call this once with an offset of 0@0. To create a dual change sorter, call it twice with offsets of 0@0 and 0.5@0." + + | dirtyFlags changeSetList classList dirtyFlagsPane changeSetListPane classListPane + messageList upperPanes backColor labelBackground | + backColor _ self textBackgroundColor. + labelBackground _ Theme current background. + model myChangeSet ifNil: [ + self flag: #ojo. "Or whatever was last changed, or is top of list, or whatever" + model myChangeSet: ChangeSet changeSetForBaseSystem ]. + + dirtyFlags _ PluggableListMorph + model: model + listGetter: #changeSetDirtyFlags + indexGetter: nil + indexSetter: nil. + dirtyFlags color: backColor. + dirtyFlagsPane _ LayoutMorph newColumn + color: Theme current background; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Unsaved?'); + addMorphUseAll: dirtyFlags. + + changeSetList _ (PluggableListMorphByItem + model: model + listGetter: #changeSetList + indexGetter: #currentCngSet + indexSetter: #showChangeSetNamed: + mainView: self + menuGetter: #changeSetMenu + keystrokeAction: #changeSetListKey:from:) + autoDeselect: false. + changeSetList color: backColor. + changeSetListPane _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Change Set name'); + addMorphUseAll: changeSetList. + + classList _ PluggableListMorphByItem + model: model + listGetter: #classList + indexGetter: #currentClassName + indexSetter: #currentClassName: + mainView: self + menuGetter: #classListMenu + keystrokeAction: #classListKey:from:. + classList color: backColor. + classListPane _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Classes'); + addMorphUseAll: classList. + + upperPanes _ LayoutMorph newRow. + upperPanes + addMorph: dirtyFlagsPane proportionalWidth: 0.13; + addAdjusterAndMorph: changeSetListPane proportionalWidth: 0.47; + addAdjusterAndMorph: classListPane proportionalWidth: 0.4. + + "Scroll Sibling Panes together." + changeSetList leftSibling: dirtyFlags; scrollSiblings: true. + dirtyFlags rightSibling: changeSetList; scrollSiblings: true. + + messageList _ PluggableListMorphByItem + model: model + listGetter: #messageList + indexGetter: #currentSelector + indexSetter: #currentSelector: + mainView: self + menuGetter: #messageMenu + keystrokeAction: #messageListKey:from:. + messageList color: backColor. + messageList _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Methods'); + addMorphUseAll: messageList. + + + self layoutMorph + addMorph: upperPanes proportionalHeight: 0.25; + addAdjusterAndMorph: messageList proportionalHeight: 0.2; + addAdjusterAndMorph: self buildLowerPanes proportionalHeight: 0.55. + + self setLabel: model labelString! ! + +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +!classDefinition: #PluggableListMorph category: 'Morphic-Widgets' stamp: 'Install-4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st 1/7/2021 16:17:35'! +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st----! + +'From Cuis 5.0 [latest update: #4511] on 5 January 2021 at 10:59:27 am'! +!HandMorph methodsFor: 'events-processing' stamp: 'KenD 1/4/2021 11:09:49' prior: 50373838! + startMouseDispatch: aMouseEvent + + aMouseEvent isMouseOver ifTrue: [ + ^self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ]]. + + "any mouse event but mouseOver" + lastMouseEvent _ aMouseEvent. + lastMouseEventTime _ Time localMillisecondClock. + + "Check for pending drag or double click operations." + mouseClickState ifNotNil: [ + (mouseClickState handleEvent: aMouseEvent from: self) ifTrue: [ + "Possibly dispatched #click: or something. Do not further process this event." + ^self mouseOverHandler processMouseOver: lastMouseEvent ]]. + + aMouseEvent isMove + ifTrue: [ + self morphPosition: aMouseEvent eventPosition. + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ] + ] ifFalse: [ + aMouseEvent isMouseScroll ifTrue: [ + owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition + ] ifFalse: [ + "Issue a synthetic move event if we're not at the position of the event" + aMouseEvent eventPosition = self morphPosition ifFalse: [ + "Issue a mouse move event to make the receiver appear at the given position" + self startMouseDispatch: (MouseMoveEvent new + setType: #mouseMove + position: aMouseEvent eventPosition + buttons: aMouseEvent buttons + hand: self + stamp: aMouseEvent timeStamp) ]. + "Drop submorphs on button events" + self hasSubmorphs + ifTrue: [ + "Not if we are grabbing them" + mouseClickState ifNil: [ + "Want to drop on mouseUp, NOT mouseDown" + aMouseEvent isMouseUp ifTrue: [ + self dropMorphs: aMouseEvent ] + ] + ] ifFalse: [ + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ]]]]. + self mouseOverHandler processMouseOver: self lastMouseEvent! ! +!HandMorph methodsFor: 'grabbing/dropping' stamp: 'KenD 1/3/2021 13:44:18' prior: 50559742! + grabMorph: aMorph moveUnderHand: moveUnderHand + "Grab the given morph (i.e., add it to this hand and remove it from its current owner). + If moveUnderHand is requested or it seems neccesary anyway, move the grabbed morph under the hand." + + | grabbed positionInHandCoordinates tx | + self releaseMouseFocus. "Break focus" + grabbed _ aMorph. + aMorph owner ifNotNil: [ :o | grabbed _ o aboutToGrab: aMorph ]. + grabbed ifNil: [ ^ self ]. + grabbed _ grabbed aboutToBeGrabbedBy: self. + grabbed ifNil: [ ^ self ]. + + moveUnderHand + ifTrue: [ + "We can possibly do better, especially for non WidgetMorphs" + positionInHandCoordinates _ -30 @ -10. + grabbed isInWorld ifTrue: [ + grabbed displayBounds ifNotNil: [ :r | + positionInHandCoordinates _ (r extent // 2) negated ]]. + self + grabMorph: grabbed + delta: positionInHandCoordinates. + ^self ]. + + positionInHandCoordinates _ (grabbed isInWorld ifTrue: [grabbed] ifFalse: [aMorph]) + morphPositionInWorld - self morphPositionInWorld. + + tx _ GeometryTransformation identity. + aMorph withAllOwnersDo: [ :o | + tx _ o location composedWith: tx ]. + self withAllOwnersReverseDo: [ :o | + tx _ o location inverseTransformation composedWith: tx ]. + + self + grabMorph: grabbed + delta: positionInHandCoordinates. + + grabbed location: tx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4512-HandMorph-fixes-KenDickey-2021Jan05-10h58m-KenD.001.cs.st----! + +'From Cuis 5.0 [latest update: #4512] on 5 January 2021 at 11:26:28 am'! +!Morph methodsFor: 'geometry testing' stamp: 'jmv 1/5/2021 11:20:58'! + containsGlobalPoint: worldPoint + + "If not visible, won't contain any point at all." + | canvas | + self visible ifFalse: [ ^false ]. + + canvas _ self world canvas. + canvas isNil ifTrue: [ ^false ]. + (canvas morph: self isAtPoint: worldPoint) ifTrue: [ ^ true ]. + ^ false! ! +!Morph methodsFor: 'geometry testing' stamp: 'jmv 1/5/2021 11:21:34' prior: 50537192! + fullContainsGlobalPoint: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape." + + "If not visible, won't contain any point at all." + | canvas | + self visible ifFalse: [ ^false ]. + + canvas _ self world canvas. + canvas isNil ifTrue: [ ^false ]. + (canvas morph: self isAtPoint: worldPoint) ifTrue: [ ^ true ]. + self submorphsDo: [ :m | + (m fullContainsGlobalPoint: worldPoint) ifTrue: [ ^ true ]]. + ^ false! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:11' prior: 16851032! + doRecolor: event with: aHandle + "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" + + event hand obtainHalo: self. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ "only do it if mouse still in handle on mouse up" + self delete. + target addHalo: event] + ifTrue: [ + target changeColor]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:14' prior: 16851082! + maybeCollapse: event with: aHandle + "Ask hand to collapse my target if mouse comes up in it." + + event hand obtainHalo: self. + self delete. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ + target addHalo: event ] + ifTrue: [ + target collapse ]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:19' prior: 16851094! + maybeDismiss: event with: aHandle + "Ask hand to dismiss my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ + self delete. + target addHalo: event] + ifTrue: [ + target resistsRemoval ifTrue: [ + (PopUpMenu + confirm: 'Really throw this away' + trueChoice: 'Yes' + falseChoice: 'Um, no, let me reconsider') ifFalse: [^ self]]. + + self delete. + target dismissViaHalo]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:25' prior: 50388484! + setDismissColor: event with: aHandle + "Called on mouseStillDown in the dismiss handle; set the color appropriately." + + | colorToUse | + event hand obtainHalo: self. + colorToUse _ (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ `Color red muchLighter` ] + ifTrue: [ `Color lightGray` ]. + aHandle color: colorToUse! ! +!LayoutAdjustingMorph methodsFor: 'stepping' stamp: 'jmv 1/5/2021 11:24:34' prior: 50535215 overrides: 50547622! + stepAt: millisecondSinceLast + "got the #mouseLeave: message" + | p | + hand ifNil: [ + Cursor currentCursor == self cursor ifTrue: [ Cursor defaultCursor activateCursor ]. + ^ self stopStepping ]. + "hasn't got the #mouseLeave: message (yet)" + p _ hand morphPosition. + hand lastMouseEvent mouseButton1Pressed + ifTrue: [ + self adjustOwnerAt: p. + (Preferences cheapWindowReframe or: [ millisecondSinceLast > 200]) ifTrue: [ + owner displayBounds newRectFrom: [ :f | + self adjustOwnerAt: Sensor mousePoint. + owner morphPosition extent: owner morphExtent ]]] + ifFalse: [ + self stopStepping. + "If the button was unpressed outside the morph (can happen if you try to go outside container), + we might not get the #mouseLeave: message" + (self containsGlobalPoint: p) ifFalse: [ + hand _ nil. + Cursor defaultCursor activateCursor ]].! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:24:48' prior: 50341032! + activateOwnerMenu: evt + "Activate our owner menu; e.g., pass control to it" + owner ifNil: [ ^false ]. "not applicable" + (owner containsGlobalPoint: evt eventPosition) + ifFalse: [ ^false ]. + owner activate: evt. + ^true! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:25:19' prior: 50408564! + activateSubmenu: event + "Activate our submenu; e.g., pass control to it" + + subMenu ifNil: [ ^false ]. "not applicable" + (subMenu containsGlobalPoint: event eventPosition) ifFalse: [^false]. + subMenu activate: event. + ^true! ! +!PluggableButtonMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:22:49' prior: 16888243 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + isPressed _ false. + mouseIsOver _ false. + (actWhen == #buttonUp and: [ + self containsGlobalPoint: aMouseButtonEvent eventPosition ]) + ifTrue: [ self performAction ]. + self redrawNeeded! ! +!AutoCompleterMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:24:01' prior: 50436630 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + (self containsGlobalPoint: aMouseButtonEvent eventPosition) + ifTrue: [ + ((self upButtonPosition extent: ScrollBar scrollbarThickness) containsPoint: localEventPosition) + ifTrue: [ ^self stillActive; goUp ]. + ((self downButtonPosition extent: ScrollBar scrollbarThickness) containsPoint: localEventPosition) + ifTrue: [ ^self stillActive; goDown ]. + self selected: (localEventPosition y // self itemHeight) + self firstVisible. + completer insertSelected ] + ifFalse: [ self delete. completer menuClosed ]! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 1/5/2021 11:23:35' prior: 50455368! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w containsGlobalPoint: self eventPosition) + ifTrue: [ w delete ] ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4513-avoid-morphContainsPoint-JuanVuletich-2021Jan05-11h12m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 11:35:12 am'! +!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 1/5/2021 11:33:43' prior: 50544297! + transferHalo: event from: formerHaloOwner + "Progressively transfer the halo to the next likely recipient" + + formerHaloOwner == self + ifFalse: [ ^self addHalo: event ]. + + event shiftPressed ifTrue: [ + "Pass it outwards" + owner ifNotNil: [ ^owner transferHalo: event from: formerHaloOwner ]. + "We're at the top level; just keep it on ourselves" + ^self ]. + + self submorphsDo: [ :m | + (m wantsHalo and: [ m fullContainsGlobalPoint: event eventPosition ]) + ifTrue: [ ^m transferHalo: event from: formerHaloOwner ]]. + "We're at the bottom most level; just keep halo on ourselves"! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4514-avoid-fullContainsPoint-JuanVuletich-2021Jan05-11h33m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 11:46:24 am'! +!MorphicEvent methodsFor: 'accessing' stamp: 'jmv 1/5/2021 11:42:09'! + eventPosition + self subclassResponsibility! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:44:31' prior: 50530975! + processMouseOver: aMouseEvent localPosition: localEventPosition + "System level event handling." + self hasMouseFocus ifTrue: [ + "Got this directly through #handleFocusEvent: so check explicitly" + ((self rejectsEvent: aMouseEvent) not and: [self fullContainsGlobalPoint: aMouseEvent eventPosition]) ifFalse: [ + ^self ]]. + aMouseEvent hand noticeMouseOver: self event: aMouseEvent. + "Open question: should any unhandled mouse move events be filtered out? (i.e. should mouseHover:localPosition: be called when a mouse button is pressed but the morph doesn't have mouse button handlers? Essentially, what are the limits of what is considered 'hovering'?" + (self handlesMouseHover and: [aMouseEvent wasHandled not]) ifTrue: [ + self + mouseHover: aMouseEvent + localPosition: localEventPosition ].! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:43:53' prior: 16866892 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + (stayUp or: [ self fullContainsGlobalPoint: aMouseButtonEvent eventPosition ]) + ifFalse: [ ^self deleteIfPopUp: aMouseButtonEvent ]. "click outside" + + "Grab the menu and drag it to some other place + This is reimplemented here because we handle the event, and if the following lines are commented, a menu can't be grabbed with the hand. This is not nice and shouldn't be needed" + self isSticky ifTrue: [ ^self ]. + aMouseButtonEvent hand grabMorph: self! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:44:12' prior: 16866911 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse up event. + Note: This might be sent from a modal shell." + (self fullContainsGlobalPoint: aMouseButtonEvent eventPosition) ifFalse:[ + "Mouse up outside. Release eventual focus and delete if pop up." + aMouseButtonEvent hand ifNotNil: [ :h | h releaseMouseFocus: self ]. + ^ self deleteIfPopUp: aMouseButtonEvent ]. + stayUp ifFalse: [ + "Still in pop-up transition; keep focus" + aMouseButtonEvent hand newMouseFocus: self ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:44:50' prior: 50531017! + dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sentTo: aMorph localPosition: positionInAMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:39:39' prior: 50531051 overrides: 50562736! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sentTo: aMorph localPosition: positionInAMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:40:08' prior: 50531084 overrides: 50562736! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sentTo: aMorph localPosition: positionInAMorph ]. + + ^#rejected! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 1/5/2021 11:39:47' prior: 50562619! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w containsGlobalPoint: position) + ifTrue: [ w delete ] ].! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:45:08' prior: 50531110 overrides: 50562736! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sentTo: aMorph localPosition: positionInAMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:45:22' prior: 50531210 overrides: 50562736! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self + sentTo: aMorph + localPosition: positionInAMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! + +Morph removeSelector: #fullContainsPoint:! + +!methodRemoval: Morph #fullContainsPoint: stamp: 'Install-4515-remove-fullContainsPoint-JuanVuletich-2021Jan05-11h35m-jmv.001.cs.st 1/7/2021 16:17:36'! +fullContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in some submorph, regardless of being also inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + ^self fullContainsGlobalPoint: (self externalizeToWorld: aLocalPoint).! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4515-remove-fullContainsPoint-JuanVuletich-2021Jan05-11h35m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4515] on 5 January 2021 at 12:53:31 pm'! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:09'! + processDropFiles: aDropFilesEvent + "Handle a dropping file." + + aDropFilesEvent wasHandled ifTrue: [ ^self ]. + + aDropFilesEvent wasHandled: true. + self dropFiles: aDropFilesEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:50:19'! + processDropMorph: aDropEvent + "Handle a dropping morph." + | aMorph | + + aDropEvent wasHandled ifTrue: [ ^self ]. "Do it just once, for one drop destination" + + aMorph _ aDropEvent contents. + aDropEvent wasHandled: true. + self acceptDroppingMorph: aMorph event: aDropEvent. + aMorph justDroppedInto: self event: aDropEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:52:40'! + processKeyDown: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyDown: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:52:57'! + processKeyUp: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyUp: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:54'! + processKeystroke: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyStroke: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:53:33'! + processUnknownEvent: aMorphicEvent + "An event of an unknown type was sent to the receiver. What shall we do?!!" + + Smalltalk beep. + aMorphicEvent printString displayAt: `0@0`. + aMorphicEvent wasHandled: true! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:03:21'! + processWindowEvent: aWindowEvent + "Handle an event concerning our host window" + + aWindowEvent wasHandled ifTrue: [^self]. "not interested" + (self wantsWindowEvent: aWindowEvent) ifFalse: [^self]. + aWindowEvent wasHandled: true. + self windowEvent: aWindowEvent. +! ! +!InnerTextMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:44' overrides: 50563070! + processKeystroke: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue:[^self]. + self handlesKeyboard ifFalse: [^ self]. + aKeyboardEvent wasHandled: true. + self keyStroke: aKeyboardEvent! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:53:47'! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^ aMorph processUnknownEvent: self! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:50:38' overrides: 50563111! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropMorph: self! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:51:15' overrides: 50563111! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropFiles: self! ! +!KeyboardEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:53:19' overrides: 50563111! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + type == #keystroke ifTrue: [ + self isFindClassShortcut + ifTrue: [ ^ BrowserWindow findClass]. + self isCloseWindowShortcut + ifTrue: [ ^ self closeCurrentWindowOf: aMorph ]. + ^ aMorph processKeystroke: self ]. + type == #keyDown ifTrue: [ + ^ aMorph processKeyDown: self ]. + type == #keyUp ifTrue: [ + ^ aMorph processKeyUp: self ]. + ^ super sendEventTo: aMorph.! ! +!MouseEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:02:08' overrides: 50563111! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + type == #mouseOver ifTrue: [ + ^aMorph processMouseOver: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseEnter ifTrue: [ + ^ aMorph processMouseEnter: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseLeave ifTrue: [ + ^aMorph processMouseLeave: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^ super sendEventTo: aMorph! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:00:01' overrides: 50563146! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + type == #mouseDown ifTrue: [ + ^aMorph processMouseDown: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseUp ifTrue: [ + ^aMorph processMouseUp: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^super sendEventTo: aMorph! ! +!MouseMoveEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:02:43' overrides: 50563146! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + type == #mouseMove ifTrue: [ + ^aMorph processMouseMove: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^ super sendEventTo: aMorph! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:02' overrides: 50563146! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + ^ aMorph + processMouseScroll: self + localPosition: (aMorph internalizeFromWorld: position).! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:28' overrides: 50563111! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + ^ aMorph processWindowEvent: self! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:04:44' prior: 16874935! + handleFocusEvent: aMorphicEvent + "Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand." + + ^aMorphicEvent sendEventTo: self! ! +!MenuMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:04:29' prior: 50341085 overrides: 50563202! + handleFocusEvent: aMorphicEvent + "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." + | eventPositionInOurCoordinates | + eventPositionInOurCoordinates _ self internalizeFromWorld: aMorphicEvent eventPosition. + + self dispatchEvent: aMorphicEvent localPosition: eventPositionInOurCoordinates. + + "Need to handle keyboard input if we have the focus." + aMorphicEvent isKeyboard ifTrue: [ ^ aMorphicEvent sendEventTo: self ]. + + "We need to handle button clicks outside and transitions to local popUps so throw away everything else" + (aMorphicEvent isMouseOver or: [aMorphicEvent isMouse not]) ifTrue: [ ^self ]. + "What remains are mouse buttons and moves" + aMorphicEvent isMove ifFalse: [ ^ aMorphicEvent sendEventTo: self ]. "handle clicks outside by regular means" + "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil:[(selectedItem activateSubmenu: aMorphicEvent) ifTrue: [^self]]. + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: aMorphicEvent) ifTrue: [^self]].! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:04:55' prior: 50562736! + dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:56' prior: 50562770 overrides: 50563258! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:04:05' prior: 50562803 overrides: 50563258! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:05:04' prior: 50562836 overrides: 50563258! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:06:25' prior: 50562936 overrides: 50563258! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:06:35' prior: 16945210 overrides: 50563258! + dispatchWith: aMorph localPosition: positionInAMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! ! +!MouseOverHandler methodsFor: 'event handling' stamp: 'jmv 1/5/2021 12:06:07' prior: 16879290! + processMouseOver: aMouseEvent + "Re-establish the z-order for all morphs wrt the given event" + + | hand focus evt | + hand := aMouseEvent hand. + 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 startEventDispatch: aMouseEvent asMouseOver. + "Get out early if there's no change" + (leftMorphs isNil or: [ "Should never happen, but it could if you halt during layout." + (leftMorphs isEmpty and: [enteredMorphs position = 0])]) + ifTrue: [^leftMorphs := enteredMorphs := overMorphs := nil]. + focus := hand mouseFocus. + "Send #mouseLeave as appropriate" + evt := aMouseEvent 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]) + ifTrue: [ + evt sendEventTo: m ] + ifFalse: [overMorphs nextPut: m]]. + "Send #mouseEnter as appropriate" + evt := aMouseEvent asMouseEnter. + enteredMorphs ifNil: [ + "inform: was called in handleEvent:" + ^ leftMorphs := enteredMorphs := overMorphs := nil]. + enteredMorphs := enteredMorphs contents. + enteredMorphs reverseDo: [ :m | + (m == focus or: [m hasOwner: focus]) + ifTrue: [ + evt sendEventTo: m ]]. + "And remember the over list" + overMorphs ifNil: [ + "inform: was called in handleEvent:" + ^leftMorphs := enteredMorphs := overMorphs := nil]. + mouseOverMorphs := overMorphs contents. + leftMorphs := enteredMorphs := overMorphs := nil! ! + +WindowEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: WindowEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + ^ aMorph processWindowEvent: self localPosition: positionInAMorph! + +MouseScrollEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseScrollEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + ^ aMorph + processMouseScroll: self + localPosition: positionInAMorph.! + +MouseMoveEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseMoveEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + type == #mouseMove ifTrue: [ + ^aMorph processMouseMove: self localPosition: positionInAMorph ]. + ^ super sentTo: aMorph localPosition: positionInAMorph! + +MouseButtonEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseButtonEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + type == #mouseDown ifTrue: [ + ^aMorph processMouseDown: self localPosition: positionInAMorph ]. + type == #mouseUp ifTrue: [ + ^aMorph processMouseUp: self localPosition: positionInAMorph ]. + ^super sentTo: aMorph localPosition: positionInAMorph! + +MouseEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + type == #mouseOver ifTrue: [ + ^aMorph processMouseOver: self localPosition: positionInAMorph ]. + type == #mouseEnter ifTrue: [ + ^ aMorph processMouseEnter: self localPosition: positionInAMorph ]. + type == #mouseLeave ifTrue: [ + ^aMorph processMouseLeave: self localPosition: positionInAMorph ]. + ^ super sentTo: aMorph localPosition: positionInAMorph! + +KeyboardEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: KeyboardEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + type == #keystroke ifTrue: [ + self isFindClassShortcut + ifTrue: [ ^ BrowserWindow findClass]. + self isCloseWindowShortcut + ifTrue: [ ^ self closeCurrentWindowOf: aMorph ]. + ^ aMorph + processKeystroke: self + localPosition: positionInAMorph ]. + type == #keyDown ifTrue: [ + ^ aMorph + processKeyDown: self + localPosition: positionInAMorph ]. + type == #keyUp ifTrue: [ + ^ aMorph + processKeyUp: self + localPosition: positionInAMorph ]. + ^ super + sentTo: aMorph + localPosition: positionInAMorph.! + +DropFilesEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: DropFilesEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropFiles: self localPosition: positionInAMorph! + +DropEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: DropEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropMorph: self localPosition: positionInAMorph! + +MorphicEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MorphicEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^ aMorph processUnknownEvent: self localPosition: positionInAMorph! + +InnerTextMorph removeSelector: #processKeystroke:localPosition:! + +!methodRemoval: InnerTextMorph #processKeystroke:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processKeystroke: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue:[^self]. + self handlesKeyboard ifFalse: [^ self]. + aKeyboardEvent wasHandled: true. + self keyStroke: aKeyboardEvent! + +Morph removeSelector: #processWindowEvent:localPosition:! + +!methodRemoval: Morph #processWindowEvent:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processWindowEvent: aWindowEvent localPosition: localEventPosition + "Handle an event concerning our host window" + + aWindowEvent wasHandled ifTrue: [^self]. "not interested" + (self wantsWindowEvent: aWindowEvent) ifFalse: [^self]. + aWindowEvent wasHandled: true. + self windowEvent: aWindowEvent. +! + +Morph removeSelector: #processKeyDown:localPosition:! + +!methodRemoval: Morph #processKeyDown:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processKeyDown: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyDown: aKeyboardEvent! + +Morph removeSelector: #processDropFiles:localPosition:! + +!methodRemoval: Morph #processDropFiles:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processDropFiles: aDropFilesEvent localPosition: localEventPosition + "Handle a dropping file." + + aDropFilesEvent wasHandled ifTrue: [ ^self ]. + + aDropFilesEvent wasHandled: true. + self dropFiles: aDropFilesEvent! + +Morph removeSelector: #processDropMorph:localPosition:! + +!methodRemoval: Morph #processDropMorph:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processDropMorph: aDropEvent localPosition: localEventPosition + "Handle a dropping morph." + | aMorph | + + aDropEvent wasHandled ifTrue: [ ^self ]. "Do it just once, for one drop destination" + + aMorph _ aDropEvent contents. + aDropEvent wasHandled: true. + self acceptDroppingMorph: aMorph event: aDropEvent. + aMorph justDroppedInto: self event: aDropEvent! + +Morph removeSelector: #processKeystroke:localPosition:! + +!methodRemoval: Morph #processKeystroke:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processKeystroke: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyStroke: aKeyboardEvent! + +Morph removeSelector: #processKeyUp:localPosition:! + +!methodRemoval: Morph #processKeyUp:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processKeyUp: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyUp: aKeyboardEvent! + +Morph removeSelector: #processUnknownEvent:localPosition:! + +!methodRemoval: Morph #processUnknownEvent:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:17:36'! +processUnknownEvent: aMorphicEvent localPosition: localEventPosition + "An event of an unknown type was sent to the receiver. What shall we do?!!" + + Smalltalk beep. + aMorphicEvent printString displayAt: `0@0`. + aMorphicEvent wasHandled: true! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 12:15:13 pm'! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:08:39'! + dispatchEvent: aMorphicEvent + "This is the central entry for dispatching events in morphic. Given some event, find the right receiver and let him handle it." + + ^ (self rejectsEventFully: aMorphicEvent) + ifTrue: [ #rejected ] + ifFalse: [ aMorphicEvent dispatchWith: self ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:09:46'! + dispatchWith: aMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:08:46' overrides: 50563868! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + | dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:09:18' overrides: 50563868! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + (eachChild dispatchEvent: self) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:10:27' overrides: 50563868! + dispatchWith: aMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:10:57' overrides: 50563868! + dispatchWith: aMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:11:04' overrides: 50563868! + dispatchWith: aMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:30' prior: 16851794! + startDropEventDispatch: aDropEvent + + owner dispatchEvent: aDropEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:36' prior: 50424827! + startDropFilesEventDispatch: aDropFilesEvent + + owner dispatchEvent: aDropFilesEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:13:52' prior: 50562332! + startMouseDispatch: aMouseEvent + + aMouseEvent isMouseOver ifTrue: [ + ^self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ]]. + + "any mouse event but mouseOver" + lastMouseEvent _ aMouseEvent. + lastMouseEventTime _ Time localMillisecondClock. + + "Check for pending drag or double click operations." + mouseClickState ifNotNil: [ + (mouseClickState handleEvent: aMouseEvent from: self) ifTrue: [ + "Possibly dispatched #click: or something. Do not further process this event." + ^self mouseOverHandler processMouseOver: lastMouseEvent ]]. + + aMouseEvent isMove + ifTrue: [ + self morphPosition: aMouseEvent eventPosition. + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ] + ] ifFalse: [ + aMouseEvent isMouseScroll ifTrue: [ + owner dispatchEvent: aMouseEvent + ] ifFalse: [ + "Issue a synthetic move event if we're not at the position of the event" + aMouseEvent eventPosition = self morphPosition ifFalse: [ + "Issue a mouse move event to make the receiver appear at the given position" + self startMouseDispatch: (MouseMoveEvent new + setType: #mouseMove + position: aMouseEvent eventPosition + buttons: aMouseEvent buttons + hand: self + stamp: aMouseEvent timeStamp) ]. + "Drop submorphs on button events" + self hasSubmorphs + ifTrue: [ + "Not if we are grabbing them" + mouseClickState ifNil: [ + "Want to drop on mouseUp, NOT mouseDown" + aMouseEvent isMouseUp ifTrue: [ + self dropMorphs: aMouseEvent ] + ] + ] ifFalse: [ + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ]]]]. + self mouseOverHandler processMouseOver: self lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:53' prior: 16851875! + startWindowEventDispatch: aWindowEvent + + owner dispatchEvent: aWindowEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'grabbing/dropping' stamp: 'jmv 1/5/2021 12:12:23' prior: 16852020! + dropMorph: aMorph event: aMouseEvent + "Drop the given morph which was carried by the hand" + | morphData dropEvent | + morphData := self grabMorphDataFor: aMorph. + dropEvent _ DropEvent new + setPosition: self morphPosition + contents: aMorph + hand: self + formerOwner: (morphData at: 1) + formerPosition: (morphData at: 2). + owner dispatchEvent: dropEvent. + dropEvent wasHandled ifFalse: [ aMorph rejectDropMorphEvent: dropEvent ]. + self forgetGrabMorphDataFor: aMorph. + self mouseOverHandler processMouseOver: aMouseEvent! ! +!MenuMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:13:16' prior: 50563213 overrides: 50563202! + handleFocusEvent: aMorphicEvent + "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." + + self dispatchEvent: aMorphicEvent. + + "Need to handle keyboard input if we have the focus." + aMorphicEvent isKeyboard ifTrue: [ ^ aMorphicEvent sendEventTo: self ]. + + "We need to handle button clicks outside and transitions to local popUps so throw away everything else" + (aMorphicEvent isMouseOver or: [aMorphicEvent isMouse not]) ifTrue: [ ^self ]. + "What remains are mouse buttons and moves" + aMorphicEvent isMove ifFalse: [ ^ aMorphicEvent sendEventTo: self ]. "handle clicks outside by regular means" + "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil:[(selectedItem activateSubmenu: aMorphicEvent) ifTrue: [^self]]. + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: aMorphicEvent) ifTrue: [^self]].! ! + +WindowEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: WindowEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchWith: aMorph localPosition: positionInAMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! + +MouseScrollEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MouseScrollEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! + +MouseButtonEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MouseButtonEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! + +DropFilesEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: DropFilesEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! + +DropEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: DropEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! + +MorphicEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MorphicEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! + +Morph removeSelector: #dispatchEvent:localPosition:! + +!methodRemoval: Morph #dispatchEvent:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +dispatchEvent: aMorphicEvent localPosition: localPosition + "This is the central entry for dispatching events in morphic. Given some event, find the right receiver and let him handle it. + localPosition is in our coordinates." + + ^ (self rejectsEventFully: aMorphicEvent) + ifTrue: [ #rejected ] + ifFalse: [ aMorphicEvent dispatchWith: self localPosition: localPosition ]! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4517] on 5 January 2021 at 1:15:41 pm'! +!TextEditor methodsFor: 'typing support' stamp: 'jmv 1/5/2021 13:14:39'! + processKeystrokeEvent: aKeyboardEvent + "Key struck on the keyboard. Find out which one and, if special, carry + out the associated special action. Otherwise, add the character to the + stream of characters." + + (self dispatchOn: aKeyboardEvent) ifTrue: [ + self storeSelectionInComposition. + ^self]. + + markBlock _ pointBlock. + self storeSelectionInComposition! ! +!InnerTextMorph methodsFor: 'event handling' stamp: 'jmv 1/5/2021 13:14:54'! + processKeystrokeEvent: evt + | action | + + (acceptOnCR and: [evt isReturnKey]) ifTrue: [^ self acceptContents]. + + self pauseBlinking. + + "Return - check for special action" + evt isReturnKey ifTrue: [ + action _ self crAction. + action ifNotNil: [ ^action value]]. + + "Esc - check for special action" + evt isEsc ifTrue: [ + action _ self escAction. + action ifNotNil: [ ^action value]]. + + self handleInteraction: [ editor processKeystrokeEvent: evt ]. + self scrollSelectionIntoView! ! +!InnerTextMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 13:14:49' prior: 50466047 overrides: 50449239! + keyStroke: aKeyboardEvent + + (self focusKeyboardFor: aKeyboardEvent) + ifTrue: [ ^ self ]. + + autoCompleter + ifNil: [ self processKeystrokeEvent: aKeyboardEvent ] + ifNotNil: [ + autoCompleter + autoCompletionAround: [ self processKeystrokeEvent: aKeyboardEvent ] + keyStroke: aKeyboardEvent ]. + + super keyStroke: aKeyboardEvent! ! + +InnerTextMorph removeSelector: #processKeyStroke:! + +!methodRemoval: InnerTextMorph #processKeyStroke: stamp: 'Install-4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +processKeyStroke: evt + | action | + + (acceptOnCR and: [evt isReturnKey]) ifTrue: [^ self acceptContents]. + + self pauseBlinking. + + "Return - check for special action" + evt isReturnKey ifTrue: [ + action _ self crAction. + action ifNotNil: [ ^action value]]. + + "Esc - check for special action" + evt isEsc ifTrue: [ + action _ self escAction. + action ifNotNil: [ ^action value]]. + + self handleInteraction: [ editor processKeyStroke: evt ]. + self scrollSelectionIntoView! + +TextEditor removeSelector: #processKeyStroke:! + +!methodRemoval: TextEditor #processKeyStroke: stamp: 'Install-4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st 1/7/2021 16:17:36'! +processKeyStroke: aKeyboardEvent + "Key struck on the keyboard. Find out which one and, if special, carry + out the associated special action. Otherwise, add the character to the + stream of characters." + + (self dispatchOn: aKeyboardEvent) ifTrue: [ + self storeSelectionInComposition. + ^self]. + + markBlock _ pointBlock. + self storeSelectionInComposition! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4518] on 5 January 2021 at 2:48:26 pm'! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 14:47:51'! + sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^ self wasHandled: true! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +[ + (Delay forSeconds: 1) wait. + SystemChangeNotifier uniqueInstance doSilently: [ + MorphicEvent removeSelector: #sentTo:localPosition:. + SmalltalkCompleter initialize] +] fork! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4519-AvoidWalkback-JuanVuletich-2021Jan05-14h47m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4519] on 6 January 2021 at 12:01:26 pm'! +!String methodsFor: 'converting' stamp: 'jmv 1/6/2021 11:51:13'! + findPositiveInteger + "Answer the Integer created by interpreting the receiver as the string representation of an integer. + Answer nil if no digits, else find the first digit and then all consecutive digits after that" + + | startPosition tail endPosition | + startPosition _ self findFirst: [:ch | ch isDigit]. + startPosition = 0 ifTrue: [^ nil]. + tail _ self copyFrom: startPosition to: self size. + endPosition _ tail findFirst: [:ch | ch isDigit not]. + endPosition = 0 ifTrue: [endPosition _ tail size + 1]. + ^ Number readFrom: (tail copyFrom: 1 to: endPosition - 1) readStream + +" +'1796exportFixes-tkMX' findPositiveInteger +'1848recentLogFile-sw' findPositiveInteger +'donald' findPositiveInteger +'abc234def567' findPositiveInteger +"! ! + +String removeSelector: #asInteger! + +!methodRemoval: String #asInteger stamp: 'Install-4520-Rename-String-asInteger-to-findPositiveInteger-JuanVuletich-2021Jan06-11h51m-jmv.001.cs.st 1/7/2021 16:17:36'! +asInteger + "Answer the Integer created by interpreting the receiver as the string representation of an integer. Answer nil if no digits, else find the first digit and then all consecutive digits after that" + + | startPosition tail endPosition | + startPosition _ self findFirst: [:ch | ch isDigit]. + startPosition = 0 ifTrue: [^ nil]. + tail _ self copyFrom: startPosition to: self size. + endPosition _ tail findFirst: [:ch | ch isDigit not]. + endPosition = 0 ifTrue: [endPosition _ tail size + 1]. + ^ Number readFrom: (tail copyFrom: 1 to: endPosition - 1) readStream + +" +'1796exportFixes-tkMX' asInteger +'1848recentLogFile-sw' asInteger +'donald' asInteger +'abc234def567' asInteger +"! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4520-Rename-String-asInteger-to-findPositiveInteger-JuanVuletich-2021Jan06-11h51m-jmv.001.cs.st----! + +----SNAPSHOT----(7 January 2021 16:17:59) Cuis5.0-4520-32.image priorSource: 7363541! \ No newline at end of file diff --git a/Cuis5.0-4507-32.image b/Cuis5.0-4520-32.image similarity index 68% rename from Cuis5.0-4507-32.image rename to Cuis5.0-4520-32.image index cb5865f6..56c281cf 100644 Binary files a/Cuis5.0-4507-32.image and b/Cuis5.0-4520-32.image differ diff --git a/Cuis5.0-4507-v3.changes b/Cuis5.0-4520-v3.changes similarity index 98% rename from Cuis5.0-4507-v3.changes rename to Cuis5.0-4520-v3.changes index 4d7341b2..378e83f5 100644 --- a/Cuis5.0-4507-v3.changes +++ b/Cuis5.0-4520-v3.changes @@ -174796,4 +174796,2105 @@ for $"" rather than blindly adding it to the comment being collected." ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4507-findSelectorFix-JuanVuletich-2020Dec30-14h38m-jmv.001.cs.st----! -----SNAPSHOT----(30 December 2020 14:48:23) Cuis5.0-4507-v3.image priorSource: 7151512! \ No newline at end of file +----SNAPSHOT----(30 December 2020 14:48:23) Cuis5.0-4507-v3.image priorSource: 7151512! + +----STARTUP---- (7 January 2021 16:18:25) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4507-v3.image! + + +'From Cuis 5.0 [latest update: #4506] on 29 December 2020 at 7:19:51 pm'! +!MethodContext methodsFor: 'instruction decoding (closures)' stamp: 'HAW 12/29/2020 19:19:31'! + callPrimitive: primNumber + "Evaluate the primitive, either normal or inlined, and answer the new context resulting from that + (either the sender if a successful non-inlined primitive, or the current context, if not)." + "Copied from Squeak, Context>>#callPrimitive: + The message callInlinedPrimitive: is not implemented in Squeak also - Hernan" + + | maybePrimFailToken | + primNumber >= (1 << 15) ifTrue: "Inlined primitive, cannot fail" + [^self callInlinedPrimitive: primNumber]. + maybePrimFailToken := self doPrimitive: primNumber + method: method + receiver: receiver + args: self arguments. + "Normal primitive. Always at the beginning of methods." + (self isPrimFailToken: maybePrimFailToken) ifFalse: "On success return the result" + [^self methodReturnTop]. + "On failure, store the error code if appropriate and keep interpreting the method" + (method encoderClass isStoreAt: pc in: method) ifTrue: + [self at: stackp put: maybePrimFailToken last]. + ^self! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4508-callPrimitive-HernanWilkinson-2020Dec29-19h19m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4384] on 30 December 2020 at 7:32:37 pm'! +!ContextPart methodsFor: 'closure support' stamp: 'HAW 12/30/2020 19:31:45'! + contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! ! + +MethodContext removeSelector: #contextTag! + +!methodRemoval: MethodContext #contextTag stamp: 'Install-4509-contextTagMovedToSuper-HernanWilkinson-2020Dec30-19h30m-HAW.001.cs.st 1/7/2021 16:18:30'! +contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4509-contextTagMovedToSuper-HernanWilkinson-2020Dec30-19h30m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4384] on 30 December 2020 at 7:34:30 pm'! +!TestCase methodsFor: 'assertions' stamp: 'HAW 12/30/2020 19:33:44' prior: 16927604! + assert: expected equals: actual + ^ self + assert: expected = actual + description: [ self comparingStringBetween: expected and: actual ] +! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4510-assertEqualsDescriptionsDelayedUntilNeccesary-HernanWilkinson-2020Dec30-19h32m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4494] on 1 January 2021 at 3:56:49 pm'! + +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings ' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +!classDefinition: #PluggableListMorph category: 'Morphic-Widgets' stamp: 'Install-4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st 1/7/2021 16:18:30'! +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! +!PluggableListMorph commentStamp: '' prior: 16888551! + ... + +When a PluggableListMorph is in focus, type in a letter (or several +letters quickly) to go to the next item that begins with that letter. +Special keys (up, down, home, etc.) are also supported. + +leftSibling and rightSibling have two uses. + [A] One can use left and right arrow keys to shift focus to a sibling + [B] When scrollSiblings is true, one can do "multiscrolling" -- vertical scroll siblings with self + +For [B] Sample usage see: CodePackageListWindow >>buildMorphicWindow! +!PluggableScrollPane methodsFor: 'access options' stamp: 'KenD 12/31/2020 13:05:54'! + alwaysHideVerticalScrollbar + + hideScrollBars _ #alwaysHideVertical. + self vHideScrollBar.! ! +!PluggableListMorph methodsFor: 'siblings' stamp: 'KenD 1/1/2021 13:10:42'! + scrollSiblings + "Do I scroll my siblings with myself?" + ^ scrollSiblings! ! +!PluggableListMorph methodsFor: 'siblings' stamp: 'KenD 1/1/2021 13:11:00'! + scrollSiblings: aBoolean + "Do I scroll my siblings with myself?" + scrollSiblings := aBoolean! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:57' overrides: 50406125! + scrollBy: delta + "Scroll self and any siblings" + super scrollBy: delta. + self scrollMySiblings! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:34:25'! + scrollMySiblings + "vertical scroll my siblings along with my self" + | yOffset | + yOffset := self scrollerOffset y. + scrollSiblings ifTrue: [ + self vScrollLeftSibling: yOffset; + vScrollRightSibling: yOffset + ]! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:49' prior: 50365043 overrides: 16889986! + scrollSelectionIntoView + "make sure that the current selection is visible" + | row r | + row _ self getCurrentSelectionIndex. + row = 0 + ifTrue: [ + "Value is 0, but we need to propagate it to model" + scrollBar internalScrollValue: scrollBar scrollValue ] + ifFalse: [ + self flag: #jmvVer2. + r _ self listMorph drawBoundsForRow: row. + r _ ((self listMorph externalize: r origin) extent: r extent). + self scrollToShow: r ]. + self scrollMySiblings +! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:29' overrides: 50455272! + scrollToShow: aRectangle + + super scrollToShow: aRectangle. + self scrollMySiblings ! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:41:31'! + vPrivateScrollTo: scrollValue + + self scrollerOffset: (self scrollerOffset x @ scrollValue)! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:43:22' overrides: 16890025! + vScrollBarValue: scrollValue + + super vScrollBarValue: scrollValue. + self scrollMySiblings! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:32:18'! + vScrollLeftSibling: yOffset + "vertical scroll my LEFT siblings along with my self" + self vPrivateScrollTo: yOffset. + scrollSiblings ifTrue: [ + leftSibling ifNotNil: [ :left | + left vScrollLeftSibling: yOffset ] + ]! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:32:25'! + vScrollRightSibling: yOffset + "vertical scroll my RIGHT siblings along with my self" + self vPrivateScrollTo: yOffset. + scrollSiblings ifTrue: [ + rightSibling ifNotNil: [ :left | + left vScrollRightSibling: yOffset ] + ]! ! +!PluggableScrollPane methodsFor: 'geometry' stamp: 'KenD 12/31/2020 13:09:16' prior: 50556300! + updateScrollBarsBounds + + | t | + hideScrollBars = #hide ifTrue: [^self]. + t _ self scrollBarClass scrollbarThickness. + (hideScrollBars = #hideVertical) + ifFalse: [ + scrollBar + morphPosition: extent x - t - borderWidth @ borderWidth + extent: t @ self vScrollBarHeight. + ]. + hScrollBar + morphPosition: borderWidth @ (extent y - t - borderWidth) + extent: self hScrollBarWidth@t! ! +!PluggableScrollPane methodsFor: 'scrolling' stamp: 'KenD 12/31/2020 13:18:18' prior: 50556345! + vIsScrollbarNeeded + "Return whether the vertical scrollbar is needed" + + "Don't show it if we were told not to." + hideScrollBars = #hide ifTrue: [ ^false ]. + + hideScrollBars = #alwaysHideVertical ifTrue: [ ^false ]. + + hideScrollBars = #alwaysShowVertical ifTrue: [ ^true ]. + + ^self vLeftoverScrollRange > 0! ! +!PluggableListMorph methodsFor: 'initialization' stamp: 'KenD 1/1/2021 13:11:40' prior: 50492522 overrides: 50556315! + initialize + super initialize. + scroller morphWidth: extent x. + scrollSiblings := false. "user must override"! ! +!CodePackageListWindow methodsFor: 'GUI building' stamp: 'KenD 1/1/2021 15:49:40' prior: 50547700! + buildMorphicWindow + " + CodePackageListWindow open: CodePackageList new + " + | dirtyFlags names fileNames dirtyFlagsPane namesPane fileNamesPane + upperRow description summary backColor labelBackground | + backColor := self textBackgroundColor. + labelBackground := Theme current background. + + dirtyFlags := PluggableListMorph + model: model + listGetter: #packageDirtyFlags + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + dirtyFlags color: backColor; + hideScrollBarsIndefinitely. + dirtyFlagsPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Unsaved?'); + addMorphUseAll: dirtyFlags. + + names := PluggableListMorph + model: model + listGetter: #packageNames + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + names color: backColor. + namesPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Package Name'); + addMorphUseAll: names. + + fileNames := PluggableListMorph + model: model + listGetter: #packageFullNames + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + fileNames color: backColor; + alwaysHideVerticalScrollbar. + fileNamesPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' File Name'); + addMorphUseAll: fileNames. + + upperRow := LayoutMorph newRow. + upperRow + addMorph: dirtyFlagsPane proportionalWidth: 0.13; + addAdjusterAndMorph: namesPane proportionalWidth: 0.27; + addAdjusterAndMorph: fileNamesPane proportionalWidth: 0.6. + + description := (TextModelMorph + textProvider: model + textGetter: #description + textSetter: #description:) emptyTextDisplayMessage: 'Please enter a description for this package'. + + summary := (TextModelMorph + textProvider: model + textGetter: #summary) emptyTextDisplayMessage: 'Package summary (No package selected?)'. + + names leftSibling: dirtyFlags rightSibling: fileNames; scrollSiblings: true. + dirtyFlags rightSibling: names; scrollSiblings: true. + fileNames leftSibling: names; scrollSiblings: true. + + self layoutMorph + addMorph: upperRow proportionalHeight: 0.6; + addAdjusterAndMorph: self buildButtonPane fixedHeight: Theme current buttonPaneHeight; + addAdjusterAndMorph: summary fixedHeight: 60; + addAdjusterAndMorph: description proportionalHeight: 0.25; + addAdjusterAndMorph: self buildRequirementsPane proportionalHeight: 0.15. + self setLabel: 'Installed Packages'! ! +!CodePackageListWindow methodsFor: 'GUI building' stamp: 'KenD 12/31/2020 11:40:22' prior: 50519861! + buildRequirementsPane + + | requirements deleteReqButton "editReqButton" reqLayout buttonLayout updateReqButton | + requirements := PluggableListMorph + model: (PackageRequirementsList fromCodePackageList: model) + listGetter: #requirementsStrings + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + requirements color: Theme current textPane. + + deleteReqButton := PluggableButtonMorph + model: requirements model + action: #deleteSelectedRequirement + label: 'delete':: + setBalloonText: 'Remove selected Feature requirement'. + deleteReqButton color: self widgetsColor. + updateReqButton _ PluggableButtonMorph + model: requirements model + action: #updateSelectedRequirement + label: 'update':: + setBalloonText: 'Update requirement to current Feature revision'. + updateReqButton color: self widgetsColor. + + buttonLayout := LayoutMorph newRow. + buttonLayout + addMorph: deleteReqButton + layoutSpec: (LayoutSpec + proportionalWidth: 1.0 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + color: self widgetsColor quiteWhiter; + addMorph: updateReqButton + layoutSpec: (LayoutSpec + proportionalWidth: 1.0 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + color: self widgetsColor quiteWhiter. + + model when: #changed: send: #updateRequirementsFromPackageList to: requirements model. + self when: #changed: send: #updateRequirementsFromPackageList to: requirements model. + requirements model when: #changed: send: #verifyContents to: requirements. + self when: #changed: send: #verifyContents to: requirements. + + reqLayout := LayoutMorph newRow. + ^ reqLayout + doAdoptWidgetsColor; + addMorph: requirements + layoutSpec: (LayoutSpec + proportionalWidth: 0.8 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + addMorph: buttonLayout + layoutSpec: (LayoutSpec + proportionalWidth: 0.2 + proportionalHeight: 1.0 + offAxisEdgeWeight: #rightOrBottom); + color: `Color transparent`; + yourself + ! ! +!ChangeSorterWindow methodsFor: 'GUI building' stamp: 'KenD 1/1/2021 15:54:53' prior: 50547778! + buildMorphicWindow + "Add a set of change sorter views to the given top view offset by the given amount. To create a single change sorter, call this once with an offset of 0@0. To create a dual change sorter, call it twice with offsets of 0@0 and 0.5@0." + + | dirtyFlags changeSetList classList dirtyFlagsPane changeSetListPane classListPane + messageList upperPanes backColor labelBackground | + backColor _ self textBackgroundColor. + labelBackground _ Theme current background. + model myChangeSet ifNil: [ + self flag: #ojo. "Or whatever was last changed, or is top of list, or whatever" + model myChangeSet: ChangeSet changeSetForBaseSystem ]. + + dirtyFlags _ PluggableListMorph + model: model + listGetter: #changeSetDirtyFlags + indexGetter: nil + indexSetter: nil. + dirtyFlags color: backColor. + dirtyFlagsPane _ LayoutMorph newColumn + color: Theme current background; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Unsaved?'); + addMorphUseAll: dirtyFlags. + + changeSetList _ (PluggableListMorphByItem + model: model + listGetter: #changeSetList + indexGetter: #currentCngSet + indexSetter: #showChangeSetNamed: + mainView: self + menuGetter: #changeSetMenu + keystrokeAction: #changeSetListKey:from:) + autoDeselect: false. + changeSetList color: backColor. + changeSetListPane _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Change Set name'); + addMorphUseAll: changeSetList. + + classList _ PluggableListMorphByItem + model: model + listGetter: #classList + indexGetter: #currentClassName + indexSetter: #currentClassName: + mainView: self + menuGetter: #classListMenu + keystrokeAction: #classListKey:from:. + classList color: backColor. + classListPane _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Classes'); + addMorphUseAll: classList. + + upperPanes _ LayoutMorph newRow. + upperPanes + addMorph: dirtyFlagsPane proportionalWidth: 0.13; + addAdjusterAndMorph: changeSetListPane proportionalWidth: 0.47; + addAdjusterAndMorph: classListPane proportionalWidth: 0.4. + + "Scroll Sibling Panes together." + changeSetList leftSibling: dirtyFlags; scrollSiblings: true. + dirtyFlags rightSibling: changeSetList; scrollSiblings: true. + + messageList _ PluggableListMorphByItem + model: model + listGetter: #messageList + indexGetter: #currentSelector + indexSetter: #currentSelector: + mainView: self + menuGetter: #messageMenu + keystrokeAction: #messageListKey:from:. + messageList color: backColor. + messageList _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Methods'); + addMorphUseAll: messageList. + + + self layoutMorph + addMorph: upperPanes proportionalHeight: 0.25; + addAdjusterAndMorph: messageList proportionalHeight: 0.2; + addAdjusterAndMorph: self buildLowerPanes proportionalHeight: 0.55. + + self setLabel: model labelString! ! + +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +!classDefinition: #PluggableListMorph category: 'Morphic-Widgets' stamp: 'Install-4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st 1/7/2021 16:18:30'! +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st----! + +'From Cuis 5.0 [latest update: #4511] on 5 January 2021 at 10:59:27 am'! +!HandMorph methodsFor: 'events-processing' stamp: 'KenD 1/4/2021 11:09:49' prior: 50373832! + startMouseDispatch: aMouseEvent + + aMouseEvent isMouseOver ifTrue: [ + ^self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ]]. + + "any mouse event but mouseOver" + lastMouseEvent _ aMouseEvent. + lastMouseEventTime _ Time localMillisecondClock. + + "Check for pending drag or double click operations." + mouseClickState ifNotNil: [ + (mouseClickState handleEvent: aMouseEvent from: self) ifTrue: [ + "Possibly dispatched #click: or something. Do not further process this event." + ^self mouseOverHandler processMouseOver: lastMouseEvent ]]. + + aMouseEvent isMove + ifTrue: [ + self morphPosition: aMouseEvent eventPosition. + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ] + ] ifFalse: [ + aMouseEvent isMouseScroll ifTrue: [ + owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition + ] ifFalse: [ + "Issue a synthetic move event if we're not at the position of the event" + aMouseEvent eventPosition = self morphPosition ifFalse: [ + "Issue a mouse move event to make the receiver appear at the given position" + self startMouseDispatch: (MouseMoveEvent new + setType: #mouseMove + position: aMouseEvent eventPosition + buttons: aMouseEvent buttons + hand: self + stamp: aMouseEvent timeStamp) ]. + "Drop submorphs on button events" + self hasSubmorphs + ifTrue: [ + "Not if we are grabbing them" + mouseClickState ifNil: [ + "Want to drop on mouseUp, NOT mouseDown" + aMouseEvent isMouseUp ifTrue: [ + self dropMorphs: aMouseEvent ] + ] + ] ifFalse: [ + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ]]]]. + self mouseOverHandler processMouseOver: self lastMouseEvent! ! +!HandMorph methodsFor: 'grabbing/dropping' stamp: 'KenD 1/3/2021 13:44:18' prior: 50559821! + grabMorph: aMorph moveUnderHand: moveUnderHand + "Grab the given morph (i.e., add it to this hand and remove it from its current owner). + If moveUnderHand is requested or it seems neccesary anyway, move the grabbed morph under the hand." + + | grabbed positionInHandCoordinates tx | + self releaseMouseFocus. "Break focus" + grabbed _ aMorph. + aMorph owner ifNotNil: [ :o | grabbed _ o aboutToGrab: aMorph ]. + grabbed ifNil: [ ^ self ]. + grabbed _ grabbed aboutToBeGrabbedBy: self. + grabbed ifNil: [ ^ self ]. + + moveUnderHand + ifTrue: [ + "We can possibly do better, especially for non WidgetMorphs" + positionInHandCoordinates _ -30 @ -10. + grabbed isInWorld ifTrue: [ + grabbed displayBounds ifNotNil: [ :r | + positionInHandCoordinates _ (r extent // 2) negated ]]. + self + grabMorph: grabbed + delta: positionInHandCoordinates. + ^self ]. + + positionInHandCoordinates _ (grabbed isInWorld ifTrue: [grabbed] ifFalse: [aMorph]) + morphPositionInWorld - self morphPositionInWorld. + + tx _ GeometryTransformation identity. + aMorph withAllOwnersDo: [ :o | + tx _ o location composedWith: tx ]. + self withAllOwnersReverseDo: [ :o | + tx _ o location inverseTransformation composedWith: tx ]. + + self + grabMorph: grabbed + delta: positionInHandCoordinates. + + grabbed location: tx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4512-HandMorph-fixes-KenDickey-2021Jan05-10h58m-KenD.001.cs.st----! + +'From Cuis 5.0 [latest update: #4512] on 5 January 2021 at 11:26:28 am'! +!Morph methodsFor: 'geometry testing' stamp: 'jmv 1/5/2021 11:20:58'! + containsGlobalPoint: worldPoint + + "If not visible, won't contain any point at all." + | canvas | + self visible ifFalse: [ ^false ]. + + canvas _ self world canvas. + canvas isNil ifTrue: [ ^false ]. + (canvas morph: self isAtPoint: worldPoint) ifTrue: [ ^ true ]. + ^ false! ! +!Morph methodsFor: 'geometry testing' stamp: 'jmv 1/5/2021 11:21:34' prior: 50537194! + fullContainsGlobalPoint: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape." + + "If not visible, won't contain any point at all." + | canvas | + self visible ifFalse: [ ^false ]. + + canvas _ self world canvas. + canvas isNil ifTrue: [ ^false ]. + (canvas morph: self isAtPoint: worldPoint) ifTrue: [ ^ true ]. + self submorphsDo: [ :m | + (m fullContainsGlobalPoint: worldPoint) ifTrue: [ ^ true ]]. + ^ false! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:11' prior: 16851032! + doRecolor: event with: aHandle + "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" + + event hand obtainHalo: self. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ "only do it if mouse still in handle on mouse up" + self delete. + target addHalo: event] + ifTrue: [ + target changeColor]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:14' prior: 16851082! + maybeCollapse: event with: aHandle + "Ask hand to collapse my target if mouse comes up in it." + + event hand obtainHalo: self. + self delete. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ + target addHalo: event ] + ifTrue: [ + target collapse ]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:19' prior: 16851094! + maybeDismiss: event with: aHandle + "Ask hand to dismiss my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ + self delete. + target addHalo: event] + ifTrue: [ + target resistsRemoval ifTrue: [ + (PopUpMenu + confirm: 'Really throw this away' + trueChoice: 'Yes' + falseChoice: 'Um, no, let me reconsider') ifFalse: [^ self]]. + + self delete. + target dismissViaHalo]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:25' prior: 50388478! + setDismissColor: event with: aHandle + "Called on mouseStillDown in the dismiss handle; set the color appropriately." + + | colorToUse | + event hand obtainHalo: self. + colorToUse _ (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ `Color red muchLighter` ] + ifTrue: [ `Color lightGray` ]. + aHandle color: colorToUse! ! +!LayoutAdjustingMorph methodsFor: 'stepping' stamp: 'jmv 1/5/2021 11:24:34' prior: 50535217 overrides: 50547624! + stepAt: millisecondSinceLast + "got the #mouseLeave: message" + | p | + hand ifNil: [ + Cursor currentCursor == self cursor ifTrue: [ Cursor defaultCursor activateCursor ]. + ^ self stopStepping ]. + "hasn't got the #mouseLeave: message (yet)" + p _ hand morphPosition. + hand lastMouseEvent mouseButton1Pressed + ifTrue: [ + self adjustOwnerAt: p. + (Preferences cheapWindowReframe or: [ millisecondSinceLast > 200]) ifTrue: [ + owner displayBounds newRectFrom: [ :f | + self adjustOwnerAt: Sensor mousePoint. + owner morphPosition extent: owner morphExtent ]]] + ifFalse: [ + self stopStepping. + "If the button was unpressed outside the morph (can happen if you try to go outside container), + we might not get the #mouseLeave: message" + (self containsGlobalPoint: p) ifFalse: [ + hand _ nil. + Cursor defaultCursor activateCursor ]].! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:24:48' prior: 50341030! + activateOwnerMenu: evt + "Activate our owner menu; e.g., pass control to it" + owner ifNil: [ ^false ]. "not applicable" + (owner containsGlobalPoint: evt eventPosition) + ifFalse: [ ^false ]. + owner activate: evt. + ^true! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:25:19' prior: 50408559! + activateSubmenu: event + "Activate our submenu; e.g., pass control to it" + + subMenu ifNil: [ ^false ]. "not applicable" + (subMenu containsGlobalPoint: event eventPosition) ifFalse: [^false]. + subMenu activate: event. + ^true! ! +!PluggableButtonMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:22:49' prior: 16888243 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + isPressed _ false. + mouseIsOver _ false. + (actWhen == #buttonUp and: [ + self containsGlobalPoint: aMouseButtonEvent eventPosition ]) + ifTrue: [ self performAction ]. + self redrawNeeded! ! +!AutoCompleterMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:24:01' prior: 50436625 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + (self containsGlobalPoint: aMouseButtonEvent eventPosition) + ifTrue: [ + ((self upButtonPosition extent: ScrollBar scrollbarThickness) containsPoint: localEventPosition) + ifTrue: [ ^self stillActive; goUp ]. + ((self downButtonPosition extent: ScrollBar scrollbarThickness) containsPoint: localEventPosition) + ifTrue: [ ^self stillActive; goDown ]. + self selected: (localEventPosition y // self itemHeight) + self firstVisible. + completer insertSelected ] + ifFalse: [ self delete. completer menuClosed ]! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 1/5/2021 11:23:35' prior: 50455363! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w containsGlobalPoint: self eventPosition) + ifTrue: [ w delete ] ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4513-avoid-morphContainsPoint-JuanVuletich-2021Jan05-11h12m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 11:35:12 am'! +!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 1/5/2021 11:33:43' prior: 50544299! + transferHalo: event from: formerHaloOwner + "Progressively transfer the halo to the next likely recipient" + + formerHaloOwner == self + ifFalse: [ ^self addHalo: event ]. + + event shiftPressed ifTrue: [ + "Pass it outwards" + owner ifNotNil: [ ^owner transferHalo: event from: formerHaloOwner ]. + "We're at the top level; just keep it on ourselves" + ^self ]. + + self submorphsDo: [ :m | + (m wantsHalo and: [ m fullContainsGlobalPoint: event eventPosition ]) + ifTrue: [ ^m transferHalo: event from: formerHaloOwner ]]. + "We're at the bottom most level; just keep halo on ourselves"! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4514-avoid-fullContainsPoint-JuanVuletich-2021Jan05-11h33m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 11:46:24 am'! +!MorphicEvent methodsFor: 'accessing' stamp: 'jmv 1/5/2021 11:42:09'! + eventPosition + self subclassResponsibility! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:44:31' prior: 50530977! + processMouseOver: aMouseEvent localPosition: localEventPosition + "System level event handling." + self hasMouseFocus ifTrue: [ + "Got this directly through #handleFocusEvent: so check explicitly" + ((self rejectsEvent: aMouseEvent) not and: [self fullContainsGlobalPoint: aMouseEvent eventPosition]) ifFalse: [ + ^self ]]. + aMouseEvent hand noticeMouseOver: self event: aMouseEvent. + "Open question: should any unhandled mouse move events be filtered out? (i.e. should mouseHover:localPosition: be called when a mouse button is pressed but the morph doesn't have mouse button handlers? Essentially, what are the limits of what is considered 'hovering'?" + (self handlesMouseHover and: [aMouseEvent wasHandled not]) ifTrue: [ + self + mouseHover: aMouseEvent + localPosition: localEventPosition ].! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:43:53' prior: 16866892 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + (stayUp or: [ self fullContainsGlobalPoint: aMouseButtonEvent eventPosition ]) + ifFalse: [ ^self deleteIfPopUp: aMouseButtonEvent ]. "click outside" + + "Grab the menu and drag it to some other place + This is reimplemented here because we handle the event, and if the following lines are commented, a menu can't be grabbed with the hand. This is not nice and shouldn't be needed" + self isSticky ifTrue: [ ^self ]. + aMouseButtonEvent hand grabMorph: self! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:44:12' prior: 16866911 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse up event. + Note: This might be sent from a modal shell." + (self fullContainsGlobalPoint: aMouseButtonEvent eventPosition) ifFalse:[ + "Mouse up outside. Release eventual focus and delete if pop up." + aMouseButtonEvent hand ifNotNil: [ :h | h releaseMouseFocus: self ]. + ^ self deleteIfPopUp: aMouseButtonEvent ]. + stayUp ifFalse: [ + "Still in pop-up transition; keep focus" + aMouseButtonEvent hand newMouseFocus: self ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:44:50' prior: 50531019! + dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sentTo: aMorph localPosition: positionInAMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:39:39' prior: 50531053 overrides: 50562815! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sentTo: aMorph localPosition: positionInAMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:40:08' prior: 50531086 overrides: 50562815! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sentTo: aMorph localPosition: positionInAMorph ]. + + ^#rejected! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 1/5/2021 11:39:47' prior: 50562698! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w containsGlobalPoint: position) + ifTrue: [ w delete ] ].! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:45:08' prior: 50531112 overrides: 50562815! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sentTo: aMorph localPosition: positionInAMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:45:22' prior: 50531212 overrides: 50562815! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self + sentTo: aMorph + localPosition: positionInAMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! + +Morph removeSelector: #fullContainsPoint:! + +!methodRemoval: Morph #fullContainsPoint: stamp: 'Install-4515-remove-fullContainsPoint-JuanVuletich-2021Jan05-11h35m-jmv.001.cs.st 1/7/2021 16:18:30'! +fullContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in some submorph, regardless of being also inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + ^self fullContainsGlobalPoint: (self externalizeToWorld: aLocalPoint).! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4515-remove-fullContainsPoint-JuanVuletich-2021Jan05-11h35m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4515] on 5 January 2021 at 12:53:31 pm'! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:09'! + processDropFiles: aDropFilesEvent + "Handle a dropping file." + + aDropFilesEvent wasHandled ifTrue: [ ^self ]. + + aDropFilesEvent wasHandled: true. + self dropFiles: aDropFilesEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:50:19'! + processDropMorph: aDropEvent + "Handle a dropping morph." + | aMorph | + + aDropEvent wasHandled ifTrue: [ ^self ]. "Do it just once, for one drop destination" + + aMorph _ aDropEvent contents. + aDropEvent wasHandled: true. + self acceptDroppingMorph: aMorph event: aDropEvent. + aMorph justDroppedInto: self event: aDropEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:52:40'! + processKeyDown: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyDown: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:52:57'! + processKeyUp: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyUp: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:54'! + processKeystroke: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyStroke: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:53:33'! + processUnknownEvent: aMorphicEvent + "An event of an unknown type was sent to the receiver. What shall we do?!!" + + Smalltalk beep. + aMorphicEvent printString displayAt: `0@0`. + aMorphicEvent wasHandled: true! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:03:21'! + processWindowEvent: aWindowEvent + "Handle an event concerning our host window" + + aWindowEvent wasHandled ifTrue: [^self]. "not interested" + (self wantsWindowEvent: aWindowEvent) ifFalse: [^self]. + aWindowEvent wasHandled: true. + self windowEvent: aWindowEvent. +! ! +!InnerTextMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:44' overrides: 50563149! + processKeystroke: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue:[^self]. + self handlesKeyboard ifFalse: [^ self]. + aKeyboardEvent wasHandled: true. + self keyStroke: aKeyboardEvent! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:53:47'! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^ aMorph processUnknownEvent: self! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:50:38' overrides: 50563190! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropMorph: self! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:51:15' overrides: 50563190! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropFiles: self! ! +!KeyboardEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:53:19' overrides: 50563190! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + type == #keystroke ifTrue: [ + self isFindClassShortcut + ifTrue: [ ^ BrowserWindow findClass]. + self isCloseWindowShortcut + ifTrue: [ ^ self closeCurrentWindowOf: aMorph ]. + ^ aMorph processKeystroke: self ]. + type == #keyDown ifTrue: [ + ^ aMorph processKeyDown: self ]. + type == #keyUp ifTrue: [ + ^ aMorph processKeyUp: self ]. + ^ super sendEventTo: aMorph.! ! +!MouseEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:02:08' overrides: 50563190! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + type == #mouseOver ifTrue: [ + ^aMorph processMouseOver: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseEnter ifTrue: [ + ^ aMorph processMouseEnter: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseLeave ifTrue: [ + ^aMorph processMouseLeave: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^ super sendEventTo: aMorph! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:00:01' overrides: 50563225! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + type == #mouseDown ifTrue: [ + ^aMorph processMouseDown: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseUp ifTrue: [ + ^aMorph processMouseUp: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^super sendEventTo: aMorph! ! +!MouseMoveEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:02:43' overrides: 50563225! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + type == #mouseMove ifTrue: [ + ^aMorph processMouseMove: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^ super sendEventTo: aMorph! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:02' overrides: 50563225! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + ^ aMorph + processMouseScroll: self + localPosition: (aMorph internalizeFromWorld: position).! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:28' overrides: 50563190! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + ^ aMorph processWindowEvent: self! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:04:44' prior: 16874935! + handleFocusEvent: aMorphicEvent + "Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand." + + ^aMorphicEvent sendEventTo: self! ! +!MenuMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:04:29' prior: 50341083 overrides: 50563281! + handleFocusEvent: aMorphicEvent + "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." + | eventPositionInOurCoordinates | + eventPositionInOurCoordinates _ self internalizeFromWorld: aMorphicEvent eventPosition. + + self dispatchEvent: aMorphicEvent localPosition: eventPositionInOurCoordinates. + + "Need to handle keyboard input if we have the focus." + aMorphicEvent isKeyboard ifTrue: [ ^ aMorphicEvent sendEventTo: self ]. + + "We need to handle button clicks outside and transitions to local popUps so throw away everything else" + (aMorphicEvent isMouseOver or: [aMorphicEvent isMouse not]) ifTrue: [ ^self ]. + "What remains are mouse buttons and moves" + aMorphicEvent isMove ifFalse: [ ^ aMorphicEvent sendEventTo: self ]. "handle clicks outside by regular means" + "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil:[(selectedItem activateSubmenu: aMorphicEvent) ifTrue: [^self]]. + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: aMorphicEvent) ifTrue: [^self]].! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:04:55' prior: 50562815! + dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:56' prior: 50562849 overrides: 50563337! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:04:05' prior: 50562882 overrides: 50563337! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:05:04' prior: 50562915 overrides: 50563337! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:06:25' prior: 50563015 overrides: 50563337! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:06:35' prior: 16945210 overrides: 50563337! + dispatchWith: aMorph localPosition: positionInAMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! ! +!MouseOverHandler methodsFor: 'event handling' stamp: 'jmv 1/5/2021 12:06:07' prior: 16879290! + processMouseOver: aMouseEvent + "Re-establish the z-order for all morphs wrt the given event" + + | hand focus evt | + hand := aMouseEvent hand. + 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 startEventDispatch: aMouseEvent asMouseOver. + "Get out early if there's no change" + (leftMorphs isNil or: [ "Should never happen, but it could if you halt during layout." + (leftMorphs isEmpty and: [enteredMorphs position = 0])]) + ifTrue: [^leftMorphs := enteredMorphs := overMorphs := nil]. + focus := hand mouseFocus. + "Send #mouseLeave as appropriate" + evt := aMouseEvent 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]) + ifTrue: [ + evt sendEventTo: m ] + ifFalse: [overMorphs nextPut: m]]. + "Send #mouseEnter as appropriate" + evt := aMouseEvent asMouseEnter. + enteredMorphs ifNil: [ + "inform: was called in handleEvent:" + ^ leftMorphs := enteredMorphs := overMorphs := nil]. + enteredMorphs := enteredMorphs contents. + enteredMorphs reverseDo: [ :m | + (m == focus or: [m hasOwner: focus]) + ifTrue: [ + evt sendEventTo: m ]]. + "And remember the over list" + overMorphs ifNil: [ + "inform: was called in handleEvent:" + ^leftMorphs := enteredMorphs := overMorphs := nil]. + mouseOverMorphs := overMorphs contents. + leftMorphs := enteredMorphs := overMorphs := nil! ! + +WindowEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: WindowEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + ^ aMorph processWindowEvent: self localPosition: positionInAMorph! + +MouseScrollEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseScrollEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + ^ aMorph + processMouseScroll: self + localPosition: positionInAMorph.! + +MouseMoveEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseMoveEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + type == #mouseMove ifTrue: [ + ^aMorph processMouseMove: self localPosition: positionInAMorph ]. + ^ super sentTo: aMorph localPosition: positionInAMorph! + +MouseButtonEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseButtonEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + type == #mouseDown ifTrue: [ + ^aMorph processMouseDown: self localPosition: positionInAMorph ]. + type == #mouseUp ifTrue: [ + ^aMorph processMouseUp: self localPosition: positionInAMorph ]. + ^super sentTo: aMorph localPosition: positionInAMorph! + +MouseEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + type == #mouseOver ifTrue: [ + ^aMorph processMouseOver: self localPosition: positionInAMorph ]. + type == #mouseEnter ifTrue: [ + ^ aMorph processMouseEnter: self localPosition: positionInAMorph ]. + type == #mouseLeave ifTrue: [ + ^aMorph processMouseLeave: self localPosition: positionInAMorph ]. + ^ super sentTo: aMorph localPosition: positionInAMorph! + +KeyboardEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: KeyboardEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + type == #keystroke ifTrue: [ + self isFindClassShortcut + ifTrue: [ ^ BrowserWindow findClass]. + self isCloseWindowShortcut + ifTrue: [ ^ self closeCurrentWindowOf: aMorph ]. + ^ aMorph + processKeystroke: self + localPosition: positionInAMorph ]. + type == #keyDown ifTrue: [ + ^ aMorph + processKeyDown: self + localPosition: positionInAMorph ]. + type == #keyUp ifTrue: [ + ^ aMorph + processKeyUp: self + localPosition: positionInAMorph ]. + ^ super + sentTo: aMorph + localPosition: positionInAMorph.! + +DropFilesEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: DropFilesEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropFiles: self localPosition: positionInAMorph! + +DropEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: DropEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropMorph: self localPosition: positionInAMorph! + +MorphicEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MorphicEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^ aMorph processUnknownEvent: self localPosition: positionInAMorph! + +InnerTextMorph removeSelector: #processKeystroke:localPosition:! + +!methodRemoval: InnerTextMorph #processKeystroke:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processKeystroke: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue:[^self]. + self handlesKeyboard ifFalse: [^ self]. + aKeyboardEvent wasHandled: true. + self keyStroke: aKeyboardEvent! + +Morph removeSelector: #processWindowEvent:localPosition:! + +!methodRemoval: Morph #processWindowEvent:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processWindowEvent: aWindowEvent localPosition: localEventPosition + "Handle an event concerning our host window" + + aWindowEvent wasHandled ifTrue: [^self]. "not interested" + (self wantsWindowEvent: aWindowEvent) ifFalse: [^self]. + aWindowEvent wasHandled: true. + self windowEvent: aWindowEvent. +! + +Morph removeSelector: #processKeyDown:localPosition:! + +!methodRemoval: Morph #processKeyDown:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processKeyDown: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyDown: aKeyboardEvent! + +Morph removeSelector: #processDropFiles:localPosition:! + +!methodRemoval: Morph #processDropFiles:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processDropFiles: aDropFilesEvent localPosition: localEventPosition + "Handle a dropping file." + + aDropFilesEvent wasHandled ifTrue: [ ^self ]. + + aDropFilesEvent wasHandled: true. + self dropFiles: aDropFilesEvent! + +Morph removeSelector: #processDropMorph:localPosition:! + +!methodRemoval: Morph #processDropMorph:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processDropMorph: aDropEvent localPosition: localEventPosition + "Handle a dropping morph." + | aMorph | + + aDropEvent wasHandled ifTrue: [ ^self ]. "Do it just once, for one drop destination" + + aMorph _ aDropEvent contents. + aDropEvent wasHandled: true. + self acceptDroppingMorph: aMorph event: aDropEvent. + aMorph justDroppedInto: self event: aDropEvent! + +Morph removeSelector: #processKeystroke:localPosition:! + +!methodRemoval: Morph #processKeystroke:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processKeystroke: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyStroke: aKeyboardEvent! + +Morph removeSelector: #processKeyUp:localPosition:! + +!methodRemoval: Morph #processKeyUp:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processKeyUp: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyUp: aKeyboardEvent! + +Morph removeSelector: #processUnknownEvent:localPosition:! + +!methodRemoval: Morph #processUnknownEvent:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:18:30'! +processUnknownEvent: aMorphicEvent localPosition: localEventPosition + "An event of an unknown type was sent to the receiver. What shall we do?!!" + + Smalltalk beep. + aMorphicEvent printString displayAt: `0@0`. + aMorphicEvent wasHandled: true! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 12:15:13 pm'! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:08:39'! + dispatchEvent: aMorphicEvent + "This is the central entry for dispatching events in morphic. Given some event, find the right receiver and let him handle it." + + ^ (self rejectsEventFully: aMorphicEvent) + ifTrue: [ #rejected ] + ifFalse: [ aMorphicEvent dispatchWith: self ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:09:46'! + dispatchWith: aMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:08:46' overrides: 50563947! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + | dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:09:18' overrides: 50563947! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + (eachChild dispatchEvent: self) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:10:27' overrides: 50563947! + dispatchWith: aMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:10:57' overrides: 50563947! + dispatchWith: aMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:11:04' overrides: 50563947! + dispatchWith: aMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:30' prior: 16851794! + startDropEventDispatch: aDropEvent + + owner dispatchEvent: aDropEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:36' prior: 50424822! + startDropFilesEventDispatch: aDropFilesEvent + + owner dispatchEvent: aDropFilesEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:13:52' prior: 50562411! + startMouseDispatch: aMouseEvent + + aMouseEvent isMouseOver ifTrue: [ + ^self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ]]. + + "any mouse event but mouseOver" + lastMouseEvent _ aMouseEvent. + lastMouseEventTime _ Time localMillisecondClock. + + "Check for pending drag or double click operations." + mouseClickState ifNotNil: [ + (mouseClickState handleEvent: aMouseEvent from: self) ifTrue: [ + "Possibly dispatched #click: or something. Do not further process this event." + ^self mouseOverHandler processMouseOver: lastMouseEvent ]]. + + aMouseEvent isMove + ifTrue: [ + self morphPosition: aMouseEvent eventPosition. + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ] + ] ifFalse: [ + aMouseEvent isMouseScroll ifTrue: [ + owner dispatchEvent: aMouseEvent + ] ifFalse: [ + "Issue a synthetic move event if we're not at the position of the event" + aMouseEvent eventPosition = self morphPosition ifFalse: [ + "Issue a mouse move event to make the receiver appear at the given position" + self startMouseDispatch: (MouseMoveEvent new + setType: #mouseMove + position: aMouseEvent eventPosition + buttons: aMouseEvent buttons + hand: self + stamp: aMouseEvent timeStamp) ]. + "Drop submorphs on button events" + self hasSubmorphs + ifTrue: [ + "Not if we are grabbing them" + mouseClickState ifNil: [ + "Want to drop on mouseUp, NOT mouseDown" + aMouseEvent isMouseUp ifTrue: [ + self dropMorphs: aMouseEvent ] + ] + ] ifFalse: [ + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ]]]]. + self mouseOverHandler processMouseOver: self lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:53' prior: 16851875! + startWindowEventDispatch: aWindowEvent + + owner dispatchEvent: aWindowEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'grabbing/dropping' stamp: 'jmv 1/5/2021 12:12:23' prior: 16852020! + dropMorph: aMorph event: aMouseEvent + "Drop the given morph which was carried by the hand" + | morphData dropEvent | + morphData := self grabMorphDataFor: aMorph. + dropEvent _ DropEvent new + setPosition: self morphPosition + contents: aMorph + hand: self + formerOwner: (morphData at: 1) + formerPosition: (morphData at: 2). + owner dispatchEvent: dropEvent. + dropEvent wasHandled ifFalse: [ aMorph rejectDropMorphEvent: dropEvent ]. + self forgetGrabMorphDataFor: aMorph. + self mouseOverHandler processMouseOver: aMouseEvent! ! +!MenuMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:13:16' prior: 50563292 overrides: 50563281! + handleFocusEvent: aMorphicEvent + "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." + + self dispatchEvent: aMorphicEvent. + + "Need to handle keyboard input if we have the focus." + aMorphicEvent isKeyboard ifTrue: [ ^ aMorphicEvent sendEventTo: self ]. + + "We need to handle button clicks outside and transitions to local popUps so throw away everything else" + (aMorphicEvent isMouseOver or: [aMorphicEvent isMouse not]) ifTrue: [ ^self ]. + "What remains are mouse buttons and moves" + aMorphicEvent isMove ifFalse: [ ^ aMorphicEvent sendEventTo: self ]. "handle clicks outside by regular means" + "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil:[(selectedItem activateSubmenu: aMorphicEvent) ifTrue: [^self]]. + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: aMorphicEvent) ifTrue: [^self]].! ! + +WindowEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: WindowEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchWith: aMorph localPosition: positionInAMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! + +MouseScrollEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MouseScrollEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! + +MouseButtonEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MouseButtonEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! + +DropFilesEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: DropFilesEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! + +DropEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: DropEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! + +MorphicEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MorphicEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! + +Morph removeSelector: #dispatchEvent:localPosition:! + +!methodRemoval: Morph #dispatchEvent:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +dispatchEvent: aMorphicEvent localPosition: localPosition + "This is the central entry for dispatching events in morphic. Given some event, find the right receiver and let him handle it. + localPosition is in our coordinates." + + ^ (self rejectsEventFully: aMorphicEvent) + ifTrue: [ #rejected ] + ifFalse: [ aMorphicEvent dispatchWith: self localPosition: localPosition ]! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4517] on 5 January 2021 at 1:15:41 pm'! +!TextEditor methodsFor: 'typing support' stamp: 'jmv 1/5/2021 13:14:39'! + processKeystrokeEvent: aKeyboardEvent + "Key struck on the keyboard. Find out which one and, if special, carry + out the associated special action. Otherwise, add the character to the + stream of characters." + + (self dispatchOn: aKeyboardEvent) ifTrue: [ + self storeSelectionInComposition. + ^self]. + + markBlock _ pointBlock. + self storeSelectionInComposition! ! +!InnerTextMorph methodsFor: 'event handling' stamp: 'jmv 1/5/2021 13:14:54'! + processKeystrokeEvent: evt + | action | + + (acceptOnCR and: [evt isReturnKey]) ifTrue: [^ self acceptContents]. + + self pauseBlinking. + + "Return - check for special action" + evt isReturnKey ifTrue: [ + action _ self crAction. + action ifNotNil: [ ^action value]]. + + "Esc - check for special action" + evt isEsc ifTrue: [ + action _ self escAction. + action ifNotNil: [ ^action value]]. + + self handleInteraction: [ editor processKeystrokeEvent: evt ]. + self scrollSelectionIntoView! ! +!InnerTextMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 13:14:49' prior: 50466042 overrides: 50449234! + keyStroke: aKeyboardEvent + + (self focusKeyboardFor: aKeyboardEvent) + ifTrue: [ ^ self ]. + + autoCompleter + ifNil: [ self processKeystrokeEvent: aKeyboardEvent ] + ifNotNil: [ + autoCompleter + autoCompletionAround: [ self processKeystrokeEvent: aKeyboardEvent ] + keyStroke: aKeyboardEvent ]. + + super keyStroke: aKeyboardEvent! ! + +InnerTextMorph removeSelector: #processKeyStroke:! + +!methodRemoval: InnerTextMorph #processKeyStroke: stamp: 'Install-4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +processKeyStroke: evt + | action | + + (acceptOnCR and: [evt isReturnKey]) ifTrue: [^ self acceptContents]. + + self pauseBlinking. + + "Return - check for special action" + evt isReturnKey ifTrue: [ + action _ self crAction. + action ifNotNil: [ ^action value]]. + + "Esc - check for special action" + evt isEsc ifTrue: [ + action _ self escAction. + action ifNotNil: [ ^action value]]. + + self handleInteraction: [ editor processKeyStroke: evt ]. + self scrollSelectionIntoView! + +TextEditor removeSelector: #processKeyStroke:! + +!methodRemoval: TextEditor #processKeyStroke: stamp: 'Install-4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st 1/7/2021 16:18:30'! +processKeyStroke: aKeyboardEvent + "Key struck on the keyboard. Find out which one and, if special, carry + out the associated special action. Otherwise, add the character to the + stream of characters." + + (self dispatchOn: aKeyboardEvent) ifTrue: [ + self storeSelectionInComposition. + ^self]. + + markBlock _ pointBlock. + self storeSelectionInComposition! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4518] on 5 January 2021 at 2:48:26 pm'! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 14:47:51'! + sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^ self wasHandled: true! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +[ + (Delay forSeconds: 1) wait. + SystemChangeNotifier uniqueInstance doSilently: [ + MorphicEvent removeSelector: #sentTo:localPosition:. + SmalltalkCompleter initialize] +] fork! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4519-AvoidWalkback-JuanVuletich-2021Jan05-14h47m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4519] on 6 January 2021 at 12:01:26 pm'! +!String methodsFor: 'converting' stamp: 'jmv 1/6/2021 11:51:13'! + findPositiveInteger + "Answer the Integer created by interpreting the receiver as the string representation of an integer. + Answer nil if no digits, else find the first digit and then all consecutive digits after that" + + | startPosition tail endPosition | + startPosition _ self findFirst: [:ch | ch isDigit]. + startPosition = 0 ifTrue: [^ nil]. + tail _ self copyFrom: startPosition to: self size. + endPosition _ tail findFirst: [:ch | ch isDigit not]. + endPosition = 0 ifTrue: [endPosition _ tail size + 1]. + ^ Number readFrom: (tail copyFrom: 1 to: endPosition - 1) readStream + +" +'1796exportFixes-tkMX' findPositiveInteger +'1848recentLogFile-sw' findPositiveInteger +'donald' findPositiveInteger +'abc234def567' findPositiveInteger +"! ! + +String removeSelector: #asInteger! + +!methodRemoval: String #asInteger stamp: 'Install-4520-Rename-String-asInteger-to-findPositiveInteger-JuanVuletich-2021Jan06-11h51m-jmv.001.cs.st 1/7/2021 16:18:30'! +asInteger + "Answer the Integer created by interpreting the receiver as the string representation of an integer. Answer nil if no digits, else find the first digit and then all consecutive digits after that" + + | startPosition tail endPosition | + startPosition _ self findFirst: [:ch | ch isDigit]. + startPosition = 0 ifTrue: [^ nil]. + tail _ self copyFrom: startPosition to: self size. + endPosition _ tail findFirst: [:ch | ch isDigit not]. + endPosition = 0 ifTrue: [endPosition _ tail size + 1]. + ^ Number readFrom: (tail copyFrom: 1 to: endPosition - 1) readStream + +" +'1796exportFixes-tkMX' asInteger +'1848recentLogFile-sw' asInteger +'donald' asInteger +'abc234def567' asInteger +"! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4520-Rename-String-asInteger-to-findPositiveInteger-JuanVuletich-2021Jan06-11h51m-jmv.001.cs.st----! + +----SNAPSHOT----(7 January 2021 16:18:45) Cuis5.0-4520-v3.image priorSource: 7366069! \ No newline at end of file diff --git a/Cuis5.0-4507-v3.image b/Cuis5.0-4520-v3.image similarity index 67% rename from Cuis5.0-4507-v3.image rename to Cuis5.0-4520-v3.image index 7b95686d..476d144a 100644 Binary files a/Cuis5.0-4507-v3.image and b/Cuis5.0-4520-v3.image differ diff --git a/Cuis5.0-4507.changes b/Cuis5.0-4520.changes similarity index 99% rename from Cuis5.0-4507.changes rename to Cuis5.0-4520.changes index a3649540..c4a7e0e1 100644 --- a/Cuis5.0-4507.changes +++ b/Cuis5.0-4520.changes @@ -311619,4 +311619,2105 @@ for $"" rather than blindly adding it to the comment being collected." ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4507-findSelectorFix-JuanVuletich-2020Dec30-14h38m-jmv.001.cs.st----! -----SNAPSHOT----(30 December 2020 14:47:08) Cuis5.0-4507.image priorSource: 12700536! \ No newline at end of file +----SNAPSHOT----(30 December 2020 14:47:08) Cuis5.0-4507.image priorSource: 12700536! + +----STARTUP---- (7 January 2021 16:16:43) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4507.image! + + +'From Cuis 5.0 [latest update: #4506] on 29 December 2020 at 7:19:51 pm'! +!MethodContext methodsFor: 'instruction decoding (closures)' stamp: 'HAW 12/29/2020 19:19:31'! + callPrimitive: primNumber + "Evaluate the primitive, either normal or inlined, and answer the new context resulting from that + (either the sender if a successful non-inlined primitive, or the current context, if not)." + "Copied from Squeak, Context>>#callPrimitive: + The message callInlinedPrimitive: is not implemented in Squeak also - Hernan" + + | maybePrimFailToken | + primNumber >= (1 << 15) ifTrue: "Inlined primitive, cannot fail" + [^self callInlinedPrimitive: primNumber]. + maybePrimFailToken := self doPrimitive: primNumber + method: method + receiver: receiver + args: self arguments. + "Normal primitive. Always at the beginning of methods." + (self isPrimFailToken: maybePrimFailToken) ifFalse: "On success return the result" + [^self methodReturnTop]. + "On failure, store the error code if appropriate and keep interpreting the method" + (method encoderClass isStoreAt: pc in: method) ifTrue: + [self at: stackp put: maybePrimFailToken last]. + ^self! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4508-callPrimitive-HernanWilkinson-2020Dec29-19h19m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4384] on 30 December 2020 at 7:32:37 pm'! +!ContextPart methodsFor: 'closure support' stamp: 'HAW 12/30/2020 19:31:45'! + contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! ! + +MethodContext removeSelector: #contextTag! + +!methodRemoval: MethodContext #contextTag stamp: 'Install-4509-contextTagMovedToSuper-HernanWilkinson-2020Dec30-19h30m-HAW.001.cs.st 1/7/2021 16:16:49'! +contextTag + "Context tags may be used for referring to contexts instead of contexts themselves as they can be copied and will continue to work in other processes (continuations). By default, we use the context itself to as its tag." + ^self! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4509-contextTagMovedToSuper-HernanWilkinson-2020Dec30-19h30m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4384] on 30 December 2020 at 7:34:30 pm'! +!TestCase methodsFor: 'assertions' stamp: 'HAW 12/30/2020 19:33:44' prior: 16927604! + assert: expected equals: actual + ^ self + assert: expected = actual + description: [ self comparingStringBetween: expected and: actual ] +! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4510-assertEqualsDescriptionsDelayedUntilNeccesary-HernanWilkinson-2020Dec30-19h32m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4494] on 1 January 2021 at 3:56:49 pm'! + +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings ' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +!classDefinition: #PluggableListMorph category: 'Morphic-Widgets' stamp: 'Install-4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st 1/7/2021 16:16:49'! +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! +!PluggableListMorph commentStamp: '' prior: 16888551! + ... + +When a PluggableListMorph is in focus, type in a letter (or several +letters quickly) to go to the next item that begins with that letter. +Special keys (up, down, home, etc.) are also supported. + +leftSibling and rightSibling have two uses. + [A] One can use left and right arrow keys to shift focus to a sibling + [B] When scrollSiblings is true, one can do "multiscrolling" -- vertical scroll siblings with self + +For [B] Sample usage see: CodePackageListWindow >>buildMorphicWindow! +!PluggableScrollPane methodsFor: 'access options' stamp: 'KenD 12/31/2020 13:05:54'! + alwaysHideVerticalScrollbar + + hideScrollBars _ #alwaysHideVertical. + self vHideScrollBar.! ! +!PluggableListMorph methodsFor: 'siblings' stamp: 'KenD 1/1/2021 13:10:42'! + scrollSiblings + "Do I scroll my siblings with myself?" + ^ scrollSiblings! ! +!PluggableListMorph methodsFor: 'siblings' stamp: 'KenD 1/1/2021 13:11:00'! + scrollSiblings: aBoolean + "Do I scroll my siblings with myself?" + scrollSiblings := aBoolean! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:57' overrides: 50581333! + scrollBy: delta + "Scroll self and any siblings" + super scrollBy: delta. + self scrollMySiblings! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:34:25'! + scrollMySiblings + "vertical scroll my siblings along with my self" + | yOffset | + yOffset := self scrollerOffset y. + scrollSiblings ifTrue: [ + self vScrollLeftSibling: yOffset; + vScrollRightSibling: yOffset + ]! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:49' prior: 50365040 overrides: 16889986! + scrollSelectionIntoView + "make sure that the current selection is visible" + | row r | + row _ self getCurrentSelectionIndex. + row = 0 + ifTrue: [ + "Value is 0, but we need to propagate it to model" + scrollBar internalScrollValue: scrollBar scrollValue ] + ifFalse: [ + self flag: #jmvVer2. + r _ self listMorph drawBoundsForRow: row. + r _ ((self listMorph externalize: r origin) extent: r extent). + self scrollToShow: r ]. + self scrollMySiblings +! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 13:14:29' overrides: 50630476! + scrollToShow: aRectangle + + super scrollToShow: aRectangle. + self scrollMySiblings ! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:41:31'! + vPrivateScrollTo: scrollValue + + self scrollerOffset: (self scrollerOffset x @ scrollValue)! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:43:22' overrides: 16890025! + vScrollBarValue: scrollValue + + super vScrollBarValue: scrollValue. + self scrollMySiblings! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:32:18'! + vScrollLeftSibling: yOffset + "vertical scroll my LEFT siblings along with my self" + self vPrivateScrollTo: yOffset. + scrollSiblings ifTrue: [ + leftSibling ifNotNil: [ :left | + left vScrollLeftSibling: yOffset ] + ]! ! +!PluggableListMorph methodsFor: 'scrolling' stamp: 'KenD 1/1/2021 15:32:25'! + vScrollRightSibling: yOffset + "vertical scroll my RIGHT siblings along with my self" + self vPrivateScrollTo: yOffset. + scrollSiblings ifTrue: [ + rightSibling ifNotNil: [ :left | + left vScrollRightSibling: yOffset ] + ]! ! +!PluggableScrollPane methodsFor: 'geometry' stamp: 'KenD 12/31/2020 13:09:16' prior: 50729707! + updateScrollBarsBounds + + | t | + hideScrollBars = #hide ifTrue: [^self]. + t _ self scrollBarClass scrollbarThickness. + (hideScrollBars = #hideVertical) + ifFalse: [ + scrollBar + morphPosition: extent x - t - borderWidth @ borderWidth + extent: t @ self vScrollBarHeight. + ]. + hScrollBar + morphPosition: borderWidth @ (extent y - t - borderWidth) + extent: self hScrollBarWidth@t! ! +!PluggableScrollPane methodsFor: 'scrolling' stamp: 'KenD 12/31/2020 13:18:18' prior: 50729752! + vIsScrollbarNeeded + "Return whether the vertical scrollbar is needed" + + "Don't show it if we were told not to." + hideScrollBars = #hide ifTrue: [ ^false ]. + + hideScrollBars = #alwaysHideVertical ifTrue: [ ^false ]. + + hideScrollBars = #alwaysShowVertical ifTrue: [ ^true ]. + + ^self vLeftoverScrollRange > 0! ! +!PluggableListMorph methodsFor: 'initialization' stamp: 'KenD 1/1/2021 13:11:40' prior: 50667718 overrides: 50729722! + initialize + super initialize. + scroller morphWidth: extent x. + scrollSiblings := false. "user must override"! ! +!CodePackageListWindow methodsFor: 'GUI building' stamp: 'KenD 1/1/2021 15:49:40' prior: 50722896! + buildMorphicWindow + " + CodePackageListWindow open: CodePackageList new + " + | dirtyFlags names fileNames dirtyFlagsPane namesPane fileNamesPane + upperRow description summary backColor labelBackground | + backColor := self textBackgroundColor. + labelBackground := Theme current background. + + dirtyFlags := PluggableListMorph + model: model + listGetter: #packageDirtyFlags + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + dirtyFlags color: backColor; + hideScrollBarsIndefinitely. + dirtyFlagsPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Unsaved?'); + addMorphUseAll: dirtyFlags. + + names := PluggableListMorph + model: model + listGetter: #packageNames + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + names color: backColor. + namesPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Package Name'); + addMorphUseAll: names. + + fileNames := PluggableListMorph + model: model + listGetter: #packageFullNames + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + fileNames color: backColor; + alwaysHideVerticalScrollbar. + fileNamesPane := LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' File Name'); + addMorphUseAll: fileNames. + + upperRow := LayoutMorph newRow. + upperRow + addMorph: dirtyFlagsPane proportionalWidth: 0.13; + addAdjusterAndMorph: namesPane proportionalWidth: 0.27; + addAdjusterAndMorph: fileNamesPane proportionalWidth: 0.6. + + description := (TextModelMorph + textProvider: model + textGetter: #description + textSetter: #description:) emptyTextDisplayMessage: 'Please enter a description for this package'. + + summary := (TextModelMorph + textProvider: model + textGetter: #summary) emptyTextDisplayMessage: 'Package summary (No package selected?)'. + + names leftSibling: dirtyFlags rightSibling: fileNames; scrollSiblings: true. + dirtyFlags rightSibling: names; scrollSiblings: true. + fileNames leftSibling: names; scrollSiblings: true. + + self layoutMorph + addMorph: upperRow proportionalHeight: 0.6; + addAdjusterAndMorph: self buildButtonPane fixedHeight: Theme current buttonPaneHeight; + addAdjusterAndMorph: summary fixedHeight: 60; + addAdjusterAndMorph: description proportionalHeight: 0.25; + addAdjusterAndMorph: self buildRequirementsPane proportionalHeight: 0.15. + self setLabel: 'Installed Packages'! ! +!CodePackageListWindow methodsFor: 'GUI building' stamp: 'KenD 12/31/2020 11:40:22' prior: 50695057! + buildRequirementsPane + + | requirements deleteReqButton "editReqButton" reqLayout buttonLayout updateReqButton | + requirements := PluggableListMorph + model: (PackageRequirementsList fromCodePackageList: model) + listGetter: #requirementsStrings + indexGetter: #selectionIndex + indexSetter: #selectionIndex:. + requirements color: Theme current textPane. + + deleteReqButton := PluggableButtonMorph + model: requirements model + action: #deleteSelectedRequirement + label: 'delete':: + setBalloonText: 'Remove selected Feature requirement'. + deleteReqButton color: self widgetsColor. + updateReqButton _ PluggableButtonMorph + model: requirements model + action: #updateSelectedRequirement + label: 'update':: + setBalloonText: 'Update requirement to current Feature revision'. + updateReqButton color: self widgetsColor. + + buttonLayout := LayoutMorph newRow. + buttonLayout + addMorph: deleteReqButton + layoutSpec: (LayoutSpec + proportionalWidth: 1.0 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + color: self widgetsColor quiteWhiter; + addMorph: updateReqButton + layoutSpec: (LayoutSpec + proportionalWidth: 1.0 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + color: self widgetsColor quiteWhiter. + + model when: #changed: send: #updateRequirementsFromPackageList to: requirements model. + self when: #changed: send: #updateRequirementsFromPackageList to: requirements model. + requirements model when: #changed: send: #verifyContents to: requirements. + self when: #changed: send: #verifyContents to: requirements. + + reqLayout := LayoutMorph newRow. + ^ reqLayout + doAdoptWidgetsColor; + addMorph: requirements + layoutSpec: (LayoutSpec + proportionalWidth: 0.8 + proportionalHeight: 1.0 + offAxisEdgeWeight: #leftOrTop); + addMorph: buttonLayout + layoutSpec: (LayoutSpec + proportionalWidth: 0.2 + proportionalHeight: 1.0 + offAxisEdgeWeight: #rightOrBottom); + color: `Color transparent`; + yourself + ! ! +!ChangeSorterWindow methodsFor: 'GUI building' stamp: 'KenD 1/1/2021 15:54:53' prior: 50722974! + buildMorphicWindow + "Add a set of change sorter views to the given top view offset by the given amount. To create a single change sorter, call this once with an offset of 0@0. To create a dual change sorter, call it twice with offsets of 0@0 and 0.5@0." + + | dirtyFlags changeSetList classList dirtyFlagsPane changeSetListPane classListPane + messageList upperPanes backColor labelBackground | + backColor _ self textBackgroundColor. + labelBackground _ Theme current background. + model myChangeSet ifNil: [ + self flag: #ojo. "Or whatever was last changed, or is top of list, or whatever" + model myChangeSet: ChangeSet changeSetForBaseSystem ]. + + dirtyFlags _ PluggableListMorph + model: model + listGetter: #changeSetDirtyFlags + indexGetter: nil + indexSetter: nil. + dirtyFlags color: backColor. + dirtyFlagsPane _ LayoutMorph newColumn + color: Theme current background; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: ' Unsaved?'); + addMorphUseAll: dirtyFlags. + + changeSetList _ (PluggableListMorphByItem + model: model + listGetter: #changeSetList + indexGetter: #currentCngSet + indexSetter: #showChangeSetNamed: + mainView: self + menuGetter: #changeSetMenu + keystrokeAction: #changeSetListKey:from:) + autoDeselect: false. + changeSetList color: backColor. + changeSetListPane _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Change Set name'); + addMorphUseAll: changeSetList. + + classList _ PluggableListMorphByItem + model: model + listGetter: #classList + indexGetter: #currentClassName + indexSetter: #currentClassName: + mainView: self + menuGetter: #classListMenu + keystrokeAction: #classListKey:from:. + classList color: backColor. + classListPane _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Classes'); + addMorphUseAll: classList. + + upperPanes _ LayoutMorph newRow. + upperPanes + addMorph: dirtyFlagsPane proportionalWidth: 0.13; + addAdjusterAndMorph: changeSetListPane proportionalWidth: 0.47; + addAdjusterAndMorph: classListPane proportionalWidth: 0.4. + + "Scroll Sibling Panes together." + changeSetList leftSibling: dirtyFlags; scrollSiblings: true. + dirtyFlags rightSibling: changeSetList; scrollSiblings: true. + + messageList _ PluggableListMorphByItem + model: model + listGetter: #messageList + indexGetter: #currentSelector + indexSetter: #currentSelector: + mainView: self + menuGetter: #messageMenu + keystrokeAction: #messageListKey:from:. + messageList color: backColor. + messageList _ LayoutMorph newColumn + color: labelBackground; + addMorph: (WidgetMorph new noBorder color: `Color transparent`) fixedHeight: 4; + addMorphKeepMorphHeight: (LabelMorph new contents: 'Methods'); + addMorphUseAll: messageList. + + + self layoutMorph + addMorph: upperPanes proportionalHeight: 0.25; + addAdjusterAndMorph: messageList proportionalHeight: 0.2; + addAdjusterAndMorph: self buildLowerPanes proportionalHeight: 0.55. + + self setLabel: model labelString! ! + +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +!classDefinition: #PluggableListMorph category: 'Morphic-Widgets' stamp: 'Install-4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st 1/7/2021 16:16:49'! +PluggableScrollPane subclass: #PluggableListMorph + instanceVariableNames: 'list getListSelector getIndexSelector setIndexSelector keystrokeActionSelector autoDeselect lastKeystrokeTime lastKeystrokes doubleClickSelector menuGetter mainView leftSibling rightSibling scrollSiblings' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Widgets'! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4511-MultiListScroll-KenDickey-2020Dec31-11h39m-KenD.002.cs.st----! + +'From Cuis 5.0 [latest update: #4511] on 5 January 2021 at 10:59:27 am'! +!HandMorph methodsFor: 'events-processing' stamp: 'KenD 1/4/2021 11:09:49' prior: 50549044! + startMouseDispatch: aMouseEvent + + aMouseEvent isMouseOver ifTrue: [ + ^self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ]]. + + "any mouse event but mouseOver" + lastMouseEvent _ aMouseEvent. + lastMouseEventTime _ Time localMillisecondClock. + + "Check for pending drag or double click operations." + mouseClickState ifNotNil: [ + (mouseClickState handleEvent: aMouseEvent from: self) ifTrue: [ + "Possibly dispatched #click: or something. Do not further process this event." + ^self mouseOverHandler processMouseOver: lastMouseEvent ]]. + + aMouseEvent isMove + ifTrue: [ + self morphPosition: aMouseEvent eventPosition. + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ] + ] ifFalse: [ + aMouseEvent isMouseScroll ifTrue: [ + owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition + ] ifFalse: [ + "Issue a synthetic move event if we're not at the position of the event" + aMouseEvent eventPosition = self morphPosition ifFalse: [ + "Issue a mouse move event to make the receiver appear at the given position" + self startMouseDispatch: (MouseMoveEvent new + setType: #mouseMove + position: aMouseEvent eventPosition + buttons: aMouseEvent buttons + hand: self + stamp: aMouseEvent timeStamp) ]. + "Drop submorphs on button events" + self hasSubmorphs + ifTrue: [ + "Not if we are grabbing them" + mouseClickState ifNil: [ + "Want to drop on mouseUp, NOT mouseDown" + aMouseEvent isMouseUp ifTrue: [ + self dropMorphs: aMouseEvent ] + ] + ] ifFalse: [ + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent localPosition: aMouseEvent eventPosition ]]]]. + self mouseOverHandler processMouseOver: self lastMouseEvent! ! +!HandMorph methodsFor: 'grabbing/dropping' stamp: 'KenD 1/3/2021 13:44:18' prior: 50733228! + grabMorph: aMorph moveUnderHand: moveUnderHand + "Grab the given morph (i.e., add it to this hand and remove it from its current owner). + If moveUnderHand is requested or it seems neccesary anyway, move the grabbed morph under the hand." + + | grabbed positionInHandCoordinates tx | + self releaseMouseFocus. "Break focus" + grabbed _ aMorph. + aMorph owner ifNotNil: [ :o | grabbed _ o aboutToGrab: aMorph ]. + grabbed ifNil: [ ^ self ]. + grabbed _ grabbed aboutToBeGrabbedBy: self. + grabbed ifNil: [ ^ self ]. + + moveUnderHand + ifTrue: [ + "We can possibly do better, especially for non WidgetMorphs" + positionInHandCoordinates _ -30 @ -10. + grabbed isInWorld ifTrue: [ + grabbed displayBounds ifNotNil: [ :r | + positionInHandCoordinates _ (r extent // 2) negated ]]. + self + grabMorph: grabbed + delta: positionInHandCoordinates. + ^self ]. + + positionInHandCoordinates _ (grabbed isInWorld ifTrue: [grabbed] ifFalse: [aMorph]) + morphPositionInWorld - self morphPositionInWorld. + + tx _ GeometryTransformation identity. + aMorph withAllOwnersDo: [ :o | + tx _ o location composedWith: tx ]. + self withAllOwnersReverseDo: [ :o | + tx _ o location inverseTransformation composedWith: tx ]. + + self + grabMorph: grabbed + delta: positionInHandCoordinates. + + grabbed location: tx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4512-HandMorph-fixes-KenDickey-2021Jan05-10h58m-KenD.001.cs.st----! + +'From Cuis 5.0 [latest update: #4512] on 5 January 2021 at 11:26:28 am'! +!Morph methodsFor: 'geometry testing' stamp: 'jmv 1/5/2021 11:20:58'! + containsGlobalPoint: worldPoint + + "If not visible, won't contain any point at all." + | canvas | + self visible ifFalse: [ ^false ]. + + canvas _ self world canvas. + canvas isNil ifTrue: [ ^false ]. + (canvas morph: self isAtPoint: worldPoint) ifTrue: [ ^ true ]. + ^ false! ! +!Morph methodsFor: 'geometry testing' stamp: 'jmv 1/5/2021 11:21:34' prior: 50712390! + fullContainsGlobalPoint: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape." + + "If not visible, won't contain any point at all." + | canvas | + self visible ifFalse: [ ^false ]. + + canvas _ self world canvas. + canvas isNil ifTrue: [ ^false ]. + (canvas morph: self isAtPoint: worldPoint) ifTrue: [ ^ true ]. + self submorphsDo: [ :m | + (m fullContainsGlobalPoint: worldPoint) ifTrue: [ ^ true ]]. + ^ false! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:11' prior: 16851032! + doRecolor: event with: aHandle + "The mouse went down in the 'recolor' halo handle. Allow the user to change the color of the innerTarget" + + event hand obtainHalo: self. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ "only do it if mouse still in handle on mouse up" + self delete. + target addHalo: event] + ifTrue: [ + target changeColor]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:14' prior: 16851082! + maybeCollapse: event with: aHandle + "Ask hand to collapse my target if mouse comes up in it." + + event hand obtainHalo: self. + self delete. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ + target addHalo: event ] + ifTrue: [ + target collapse ]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:19' prior: 16851094! + maybeDismiss: event with: aHandle + "Ask hand to dismiss my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ + self delete. + target addHalo: event] + ifTrue: [ + target resistsRemoval ifTrue: [ + (PopUpMenu + confirm: 'Really throw this away' + trueChoice: 'Yes' + falseChoice: 'Um, no, let me reconsider') ifFalse: [^ self]]. + + self delete. + target dismissViaHalo]! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 1/5/2021 11:22:25' prior: 50563687! + setDismissColor: event with: aHandle + "Called on mouseStillDown in the dismiss handle; set the color appropriately." + + | colorToUse | + event hand obtainHalo: self. + colorToUse _ (aHandle containsGlobalPoint: event eventPosition) + ifFalse: [ `Color red muchLighter` ] + ifTrue: [ `Color lightGray` ]. + aHandle color: colorToUse! ! +!LayoutAdjustingMorph methodsFor: 'stepping' stamp: 'jmv 1/5/2021 11:24:34' prior: 50710413 overrides: 50722820! + stepAt: millisecondSinceLast + "got the #mouseLeave: message" + | p | + hand ifNil: [ + Cursor currentCursor == self cursor ifTrue: [ Cursor defaultCursor activateCursor ]. + ^ self stopStepping ]. + "hasn't got the #mouseLeave: message (yet)" + p _ hand morphPosition. + hand lastMouseEvent mouseButton1Pressed + ifTrue: [ + self adjustOwnerAt: p. + (Preferences cheapWindowReframe or: [ millisecondSinceLast > 200]) ifTrue: [ + owner displayBounds newRectFrom: [ :f | + self adjustOwnerAt: Sensor mousePoint. + owner morphPosition extent: owner morphExtent ]]] + ifFalse: [ + self stopStepping. + "If the button was unpressed outside the morph (can happen if you try to go outside container), + we might not get the #mouseLeave: message" + (self containsGlobalPoint: p) ifFalse: [ + hand _ nil. + Cursor defaultCursor activateCursor ]].! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:24:48' prior: 50341035! + activateOwnerMenu: evt + "Activate our owner menu; e.g., pass control to it" + owner ifNil: [ ^false ]. "not applicable" + (owner containsGlobalPoint: evt eventPosition) + ifFalse: [ ^false ]. + owner activate: evt. + ^true! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:25:19' prior: 50583766! + activateSubmenu: event + "Activate our submenu; e.g., pass control to it" + + subMenu ifNil: [ ^false ]. "not applicable" + (subMenu containsGlobalPoint: event eventPosition) ifFalse: [^false]. + subMenu activate: event. + ^true! ! +!PluggableButtonMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:22:49' prior: 16888243 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + isPressed _ false. + mouseIsOver _ false. + (actWhen == #buttonUp and: [ + self containsGlobalPoint: aMouseButtonEvent eventPosition ]) + ifTrue: [ self performAction ]. + self redrawNeeded! ! +!AutoCompleterMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:24:01' prior: 50611830 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + (self containsGlobalPoint: aMouseButtonEvent eventPosition) + ifTrue: [ + ((self upButtonPosition extent: ScrollBar scrollbarThickness) containsPoint: localEventPosition) + ifTrue: [ ^self stillActive; goUp ]. + ((self downButtonPosition extent: ScrollBar scrollbarThickness) containsPoint: localEventPosition) + ifTrue: [ ^self stillActive; goDown ]. + self selected: (localEventPosition y // self itemHeight) + self firstVisible. + completer insertSelected ] + ifFalse: [ self delete. completer menuClosed ]! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 1/5/2021 11:23:35' prior: 50630567! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w containsGlobalPoint: self eventPosition) + ifTrue: [ w delete ] ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4513-avoid-morphContainsPoint-JuanVuletich-2021Jan05-11h12m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 11:35:12 am'! +!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 1/5/2021 11:33:43' prior: 50719495! + transferHalo: event from: formerHaloOwner + "Progressively transfer the halo to the next likely recipient" + + formerHaloOwner == self + ifFalse: [ ^self addHalo: event ]. + + event shiftPressed ifTrue: [ + "Pass it outwards" + owner ifNotNil: [ ^owner transferHalo: event from: formerHaloOwner ]. + "We're at the top level; just keep it on ourselves" + ^self ]. + + self submorphsDo: [ :m | + (m wantsHalo and: [ m fullContainsGlobalPoint: event eventPosition ]) + ifTrue: [ ^m transferHalo: event from: formerHaloOwner ]]. + "We're at the bottom most level; just keep halo on ourselves"! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4514-avoid-fullContainsPoint-JuanVuletich-2021Jan05-11h33m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 11:46:24 am'! +!MorphicEvent methodsFor: 'accessing' stamp: 'jmv 1/5/2021 11:42:09'! + eventPosition + self subclassResponsibility! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:44:31' prior: 50706173! + processMouseOver: aMouseEvent localPosition: localEventPosition + "System level event handling." + self hasMouseFocus ifTrue: [ + "Got this directly through #handleFocusEvent: so check explicitly" + ((self rejectsEvent: aMouseEvent) not and: [self fullContainsGlobalPoint: aMouseEvent eventPosition]) ifFalse: [ + ^self ]]. + aMouseEvent hand noticeMouseOver: self event: aMouseEvent. + "Open question: should any unhandled mouse move events be filtered out? (i.e. should mouseHover:localPosition: be called when a mouse button is pressed but the morph doesn't have mouse button handlers? Essentially, what are the limits of what is considered 'hovering'?" + (self handlesMouseHover and: [aMouseEvent wasHandled not]) ifTrue: [ + self + mouseHover: aMouseEvent + localPosition: localEventPosition ].! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:43:53' prior: 16866892 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + (stayUp or: [ self fullContainsGlobalPoint: aMouseButtonEvent eventPosition ]) + ifFalse: [ ^self deleteIfPopUp: aMouseButtonEvent ]. "click outside" + + "Grab the menu and drag it to some other place + This is reimplemented here because we handle the event, and if the following lines are commented, a menu can't be grabbed with the hand. This is not nice and shouldn't be needed" + self isSticky ifTrue: [ ^self ]. + aMouseButtonEvent hand grabMorph: self! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 11:44:12' prior: 16866911 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse up event. + Note: This might be sent from a modal shell." + (self fullContainsGlobalPoint: aMouseButtonEvent eventPosition) ifFalse:[ + "Mouse up outside. Release eventual focus and delete if pop up." + aMouseButtonEvent hand ifNotNil: [ :h | h releaseMouseFocus: self ]. + ^ self deleteIfPopUp: aMouseButtonEvent ]. + stayUp ifFalse: [ + "Still in pop-up transition; keep focus" + aMouseButtonEvent hand newMouseFocus: self ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:44:50' prior: 50706215! + dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sentTo: aMorph localPosition: positionInAMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:39:39' prior: 50706249 overrides: 50736222! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sentTo: aMorph localPosition: positionInAMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:40:08' prior: 50706282 overrides: 50736222! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sentTo: aMorph localPosition: positionInAMorph ]. + + ^#rejected! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 1/5/2021 11:39:47' prior: 50736105! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w containsGlobalPoint: position) + ifTrue: [ w delete ] ].! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:45:08' prior: 50706308 overrides: 50736222! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sentTo: aMorph localPosition: positionInAMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:45:22' prior: 50706408 overrides: 50736222! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self + sentTo: aMorph + localPosition: positionInAMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! + +Morph removeSelector: #fullContainsPoint:! + +!methodRemoval: Morph #fullContainsPoint: stamp: 'Install-4515-remove-fullContainsPoint-JuanVuletich-2021Jan05-11h35m-jmv.001.cs.st 1/7/2021 16:16:49'! +fullContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in some submorph, regardless of being also inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + ^self fullContainsGlobalPoint: (self externalizeToWorld: aLocalPoint).! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4515-remove-fullContainsPoint-JuanVuletich-2021Jan05-11h35m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4515] on 5 January 2021 at 12:53:31 pm'! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:09'! + processDropFiles: aDropFilesEvent + "Handle a dropping file." + + aDropFilesEvent wasHandled ifTrue: [ ^self ]. + + aDropFilesEvent wasHandled: true. + self dropFiles: aDropFilesEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:50:19'! + processDropMorph: aDropEvent + "Handle a dropping morph." + | aMorph | + + aDropEvent wasHandled ifTrue: [ ^self ]. "Do it just once, for one drop destination" + + aMorph _ aDropEvent contents. + aDropEvent wasHandled: true. + self acceptDroppingMorph: aMorph event: aDropEvent. + aMorph justDroppedInto: self event: aDropEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:52:40'! + processKeyDown: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyDown: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:52:57'! + processKeyUp: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyUp: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:54'! + processKeystroke: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyStroke: aKeyboardEvent! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:53:33'! + processUnknownEvent: aMorphicEvent + "An event of an unknown type was sent to the receiver. What shall we do?!!" + + Smalltalk beep. + aMorphicEvent printString displayAt: `0@0`. + aMorphicEvent wasHandled: true! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:03:21'! + processWindowEvent: aWindowEvent + "Handle an event concerning our host window" + + aWindowEvent wasHandled ifTrue: [^self]. "not interested" + (self wantsWindowEvent: aWindowEvent) ifFalse: [^self]. + aWindowEvent wasHandled: true. + self windowEvent: aWindowEvent. +! ! +!InnerTextMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 11:51:44' overrides: 50736556! + processKeystroke: aKeyboardEvent + "System level event handling." + + aKeyboardEvent wasHandled ifTrue:[^self]. + self handlesKeyboard ifFalse: [^ self]. + aKeyboardEvent wasHandled: true. + self keyStroke: aKeyboardEvent! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:53:47'! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^ aMorph processUnknownEvent: self! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:50:38' overrides: 50736597! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropMorph: self! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:51:15' overrides: 50736597! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropFiles: self! ! +!KeyboardEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 11:53:19' overrides: 50736597! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + type == #keystroke ifTrue: [ + self isFindClassShortcut + ifTrue: [ ^ BrowserWindow findClass]. + self isCloseWindowShortcut + ifTrue: [ ^ self closeCurrentWindowOf: aMorph ]. + ^ aMorph processKeystroke: self ]. + type == #keyDown ifTrue: [ + ^ aMorph processKeyDown: self ]. + type == #keyUp ifTrue: [ + ^ aMorph processKeyUp: self ]. + ^ super sendEventTo: aMorph.! ! +!MouseEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:02:08' overrides: 50736597! + sendEventTo: aMorph + "Dispatch the receiver into aMorph" + + type == #mouseOver ifTrue: [ + ^aMorph processMouseOver: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseEnter ifTrue: [ + ^ aMorph processMouseEnter: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseLeave ifTrue: [ + ^aMorph processMouseLeave: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^ super sendEventTo: aMorph! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:00:01' overrides: 50736632! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + type == #mouseDown ifTrue: [ + ^aMorph processMouseDown: self localPosition: (aMorph internalizeFromWorld: position) ]. + type == #mouseUp ifTrue: [ + ^aMorph processMouseUp: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^super sendEventTo: aMorph! ! +!MouseMoveEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:02:43' overrides: 50736632! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + type == #mouseMove ifTrue: [ + ^aMorph processMouseMove: self localPosition: (aMorph internalizeFromWorld: position) ]. + ^ super sendEventTo: aMorph! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:02' overrides: 50736632! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + ^ aMorph + processMouseScroll: self + localPosition: (aMorph internalizeFromWorld: position).! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:28' overrides: 50736597! + sendEventTo: aMorph + "Dispatch the receiver into anObject" + + ^ aMorph processWindowEvent: self! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:04:44' prior: 16874935! + handleFocusEvent: aMorphicEvent + "Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand." + + ^aMorphicEvent sendEventTo: self! ! +!MenuMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:04:29' prior: 50341088 overrides: 50736688! + handleFocusEvent: aMorphicEvent + "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." + | eventPositionInOurCoordinates | + eventPositionInOurCoordinates _ self internalizeFromWorld: aMorphicEvent eventPosition. + + self dispatchEvent: aMorphicEvent localPosition: eventPositionInOurCoordinates. + + "Need to handle keyboard input if we have the focus." + aMorphicEvent isKeyboard ifTrue: [ ^ aMorphicEvent sendEventTo: self ]. + + "We need to handle button clicks outside and transitions to local popUps so throw away everything else" + (aMorphicEvent isMouseOver or: [aMorphicEvent isMouse not]) ifTrue: [ ^self ]. + "What remains are mouse buttons and moves" + aMorphicEvent isMove ifFalse: [ ^ aMorphicEvent sendEventTo: self ]. "handle clicks outside by regular means" + "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil:[(selectedItem activateSubmenu: aMorphicEvent) ifTrue: [^self]]. + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: aMorphicEvent) ifTrue: [^self]].! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:04:55' prior: 50736222! + dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:03:56' prior: 50736256 overrides: 50736744! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:04:05' prior: 50736289 overrides: 50736744! + dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:05:04' prior: 50736322 overrides: 50736744! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:06:25' prior: 50736422 overrides: 50736744! + dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:06:35' prior: 16945210 overrides: 50736744! + dispatchWith: aMorph localPosition: positionInAMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! ! +!MouseOverHandler methodsFor: 'event handling' stamp: 'jmv 1/5/2021 12:06:07' prior: 16879290! + processMouseOver: aMouseEvent + "Re-establish the z-order for all morphs wrt the given event" + + | hand focus evt | + hand := aMouseEvent hand. + 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 startEventDispatch: aMouseEvent asMouseOver. + "Get out early if there's no change" + (leftMorphs isNil or: [ "Should never happen, but it could if you halt during layout." + (leftMorphs isEmpty and: [enteredMorphs position = 0])]) + ifTrue: [^leftMorphs := enteredMorphs := overMorphs := nil]. + focus := hand mouseFocus. + "Send #mouseLeave as appropriate" + evt := aMouseEvent 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]) + ifTrue: [ + evt sendEventTo: m ] + ifFalse: [overMorphs nextPut: m]]. + "Send #mouseEnter as appropriate" + evt := aMouseEvent asMouseEnter. + enteredMorphs ifNil: [ + "inform: was called in handleEvent:" + ^ leftMorphs := enteredMorphs := overMorphs := nil]. + enteredMorphs := enteredMorphs contents. + enteredMorphs reverseDo: [ :m | + (m == focus or: [m hasOwner: focus]) + ifTrue: [ + evt sendEventTo: m ]]. + "And remember the over list" + overMorphs ifNil: [ + "inform: was called in handleEvent:" + ^leftMorphs := enteredMorphs := overMorphs := nil]. + mouseOverMorphs := overMorphs contents. + leftMorphs := enteredMorphs := overMorphs := nil! ! + +WindowEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: WindowEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + ^ aMorph processWindowEvent: self localPosition: positionInAMorph! + +MouseScrollEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseScrollEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + ^ aMorph + processMouseScroll: self + localPosition: positionInAMorph.! + +MouseMoveEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseMoveEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + type == #mouseMove ifTrue: [ + ^aMorph processMouseMove: self localPosition: positionInAMorph ]. + ^ super sentTo: aMorph localPosition: positionInAMorph! + +MouseButtonEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseButtonEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + + type == #mouseDown ifTrue: [ + ^aMorph processMouseDown: self localPosition: positionInAMorph ]. + type == #mouseUp ifTrue: [ + ^aMorph processMouseUp: self localPosition: positionInAMorph ]. + ^super sentTo: aMorph localPosition: positionInAMorph! + +MouseEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MouseEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + type == #mouseOver ifTrue: [ + ^aMorph processMouseOver: self localPosition: positionInAMorph ]. + type == #mouseEnter ifTrue: [ + ^ aMorph processMouseEnter: self localPosition: positionInAMorph ]. + type == #mouseLeave ifTrue: [ + ^aMorph processMouseLeave: self localPosition: positionInAMorph ]. + ^ super sentTo: aMorph localPosition: positionInAMorph! + +KeyboardEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: KeyboardEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into anObject" + type == #keystroke ifTrue: [ + self isFindClassShortcut + ifTrue: [ ^ BrowserWindow findClass]. + self isCloseWindowShortcut + ifTrue: [ ^ self closeCurrentWindowOf: aMorph ]. + ^ aMorph + processKeystroke: self + localPosition: positionInAMorph ]. + type == #keyDown ifTrue: [ + ^ aMorph + processKeyDown: self + localPosition: positionInAMorph ]. + type == #keyUp ifTrue: [ + ^ aMorph + processKeyUp: self + localPosition: positionInAMorph ]. + ^ super + sentTo: aMorph + localPosition: positionInAMorph.! + +DropFilesEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: DropFilesEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropFiles: self localPosition: positionInAMorph! + +DropEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: DropEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^aMorph processDropMorph: self localPosition: positionInAMorph! + +MorphicEvent removeSelector: #sentTo:localPosition:! + +!methodRemoval: MorphicEvent #sentTo:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^ aMorph processUnknownEvent: self localPosition: positionInAMorph! + +InnerTextMorph removeSelector: #processKeystroke:localPosition:! + +!methodRemoval: InnerTextMorph #processKeystroke:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processKeystroke: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue:[^self]. + self handlesKeyboard ifFalse: [^ self]. + aKeyboardEvent wasHandled: true. + self keyStroke: aKeyboardEvent! + +Morph removeSelector: #processWindowEvent:localPosition:! + +!methodRemoval: Morph #processWindowEvent:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processWindowEvent: aWindowEvent localPosition: localEventPosition + "Handle an event concerning our host window" + + aWindowEvent wasHandled ifTrue: [^self]. "not interested" + (self wantsWindowEvent: aWindowEvent) ifFalse: [^self]. + aWindowEvent wasHandled: true. + self windowEvent: aWindowEvent. +! + +Morph removeSelector: #processKeyDown:localPosition:! + +!methodRemoval: Morph #processKeyDown:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processKeyDown: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyDown: aKeyboardEvent! + +Morph removeSelector: #processDropFiles:localPosition:! + +!methodRemoval: Morph #processDropFiles:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processDropFiles: aDropFilesEvent localPosition: localEventPosition + "Handle a dropping file." + + aDropFilesEvent wasHandled ifTrue: [ ^self ]. + + aDropFilesEvent wasHandled: true. + self dropFiles: aDropFilesEvent! + +Morph removeSelector: #processDropMorph:localPosition:! + +!methodRemoval: Morph #processDropMorph:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processDropMorph: aDropEvent localPosition: localEventPosition + "Handle a dropping morph." + | aMorph | + + aDropEvent wasHandled ifTrue: [ ^self ]. "Do it just once, for one drop destination" + + aMorph _ aDropEvent contents. + aDropEvent wasHandled: true. + self acceptDroppingMorph: aMorph event: aDropEvent. + aMorph justDroppedInto: self event: aDropEvent! + +Morph removeSelector: #processKeystroke:localPosition:! + +!methodRemoval: Morph #processKeystroke:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processKeystroke: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyStroke: aKeyboardEvent! + +Morph removeSelector: #processKeyUp:localPosition:! + +!methodRemoval: Morph #processKeyUp:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processKeyUp: aKeyboardEvent localPosition: localEventPosition + "System level event handling." + "localEventPosition?????" + + aKeyboardEvent wasHandled ifTrue: [^self]. + self handlesKeyboard ifFalse: [^self]. + aKeyboardEvent wasHandled: true. + ^self keyUp: aKeyboardEvent! + +Morph removeSelector: #processUnknownEvent:localPosition:! + +!methodRemoval: Morph #processUnknownEvent:localPosition: stamp: 'Install-4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st 1/7/2021 16:16:49'! +processUnknownEvent: aMorphicEvent localPosition: localEventPosition + "An event of an unknown type was sent to the receiver. What shall we do?!!" + + Smalltalk beep. + aMorphicEvent printString displayAt: `0@0`. + aMorphicEvent wasHandled: true! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4516-remove-sentTolocalPosition-JuanVuletich-2021Jan05-12h47m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4513] on 5 January 2021 at 12:15:13 pm'! +!Morph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:08:39'! + dispatchEvent: aMorphicEvent + "This is the central entry for dispatching events in morphic. Given some event, find the right receiver and let him handle it." + + ^ (self rejectsEventFully: aMorphicEvent) + ifTrue: [ #rejected ] + ifFalse: [ aMorphicEvent dispatchWith: self ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:09:46'! + dispatchWith: aMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:08:46' overrides: 50737354! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + | dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! ! +!DropFilesEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:09:18' overrides: 50737354! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + (eachChild dispatchEvent: self) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:10:27' overrides: 50737354! + dispatchWith: aMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! ! +!MouseScrollEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:10:57' overrides: 50737354! + dispatchWith: aMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + (eachChild dispatchEvent: self) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! ! +!WindowEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 12:11:04' overrides: 50737354! + dispatchWith: aMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:30' prior: 16851794! + startDropEventDispatch: aDropEvent + + owner dispatchEvent: aDropEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:36' prior: 50600028! + startDropFilesEventDispatch: aDropFilesEvent + + owner dispatchEvent: aDropFilesEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:13:52' prior: 50735818! + startMouseDispatch: aMouseEvent + + aMouseEvent isMouseOver ifTrue: [ + ^self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ]]. + + "any mouse event but mouseOver" + lastMouseEvent _ aMouseEvent. + lastMouseEventTime _ Time localMillisecondClock. + + "Check for pending drag or double click operations." + mouseClickState ifNotNil: [ + (mouseClickState handleEvent: aMouseEvent from: self) ifTrue: [ + "Possibly dispatched #click: or something. Do not further process this event." + ^self mouseOverHandler processMouseOver: lastMouseEvent ]]. + + aMouseEvent isMove + ifTrue: [ + self morphPosition: aMouseEvent eventPosition. + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ] + ] ifFalse: [ + aMouseEvent isMouseScroll ifTrue: [ + owner dispatchEvent: aMouseEvent + ] ifFalse: [ + "Issue a synthetic move event if we're not at the position of the event" + aMouseEvent eventPosition = self morphPosition ifFalse: [ + "Issue a mouse move event to make the receiver appear at the given position" + self startMouseDispatch: (MouseMoveEvent new + setType: #mouseMove + position: aMouseEvent eventPosition + buttons: aMouseEvent buttons + hand: self + stamp: aMouseEvent timeStamp) ]. + "Drop submorphs on button events" + self hasSubmorphs + ifTrue: [ + "Not if we are grabbing them" + mouseClickState ifNil: [ + "Want to drop on mouseUp, NOT mouseDown" + aMouseEvent isMouseUp ifTrue: [ + self dropMorphs: aMouseEvent ] + ] + ] ifFalse: [ + self mouseFocus + ifNotNil: [ mouseFocus handleFocusEvent: aMouseEvent ] + ifNil: [ owner dispatchEvent: aMouseEvent ]]]]. + self mouseOverHandler processMouseOver: self lastMouseEvent! ! +!HandMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:12:53' prior: 16851875! + startWindowEventDispatch: aWindowEvent + + owner dispatchEvent: aWindowEvent. + self mouseOverHandler processMouseOver: lastMouseEvent! ! +!HandMorph methodsFor: 'grabbing/dropping' stamp: 'jmv 1/5/2021 12:12:23' prior: 16852020! + dropMorph: aMorph event: aMouseEvent + "Drop the given morph which was carried by the hand" + | morphData dropEvent | + morphData := self grabMorphDataFor: aMorph. + dropEvent _ DropEvent new + setPosition: self morphPosition + contents: aMorph + hand: self + formerOwner: (morphData at: 1) + formerPosition: (morphData at: 2). + owner dispatchEvent: dropEvent. + dropEvent wasHandled ifFalse: [ aMorph rejectDropMorphEvent: dropEvent ]. + self forgetGrabMorphDataFor: aMorph. + self mouseOverHandler processMouseOver: aMouseEvent! ! +!MenuMorph methodsFor: 'events-processing' stamp: 'jmv 1/5/2021 12:13:16' prior: 50736699 overrides: 50736688! + handleFocusEvent: aMorphicEvent + "Handle focus events. Valid menu transitions are determined based on the menu currently holding the focus after the mouse went down on one of its children." + + self dispatchEvent: aMorphicEvent. + + "Need to handle keyboard input if we have the focus." + aMorphicEvent isKeyboard ifTrue: [ ^ aMorphicEvent sendEventTo: self ]. + + "We need to handle button clicks outside and transitions to local popUps so throw away everything else" + (aMorphicEvent isMouseOver or: [aMorphicEvent isMouse not]) ifTrue: [ ^self ]. + "What remains are mouse buttons and moves" + aMorphicEvent isMove ifFalse: [ ^ aMorphicEvent sendEventTo: self ]. "handle clicks outside by regular means" + "Now it's getting tricky. On #mouseMove we might transfer control to *either* the currently active submenu or the pop up owner, if any. Since the active sub menu is always displayed upfront check it first." + selectedItem ifNotNil:[(selectedItem activateSubmenu: aMorphicEvent) ifTrue: [^self]]. + "Note: The following does not traverse upwards but it's the best I can do for now" + popUpOwner ifNotNil:[(popUpOwner activateOwnerMenu: aMorphicEvent) ifTrue: [^self]].! ! + +WindowEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: WindowEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchWith: aMorph localPosition: positionInAMorph + "Host window events do not have a position and are only dispatched to the World" + + aMorph isWorldMorph ifFalse: [ ^#rejected ]. + self wasHandled ifTrue: [ ^self ]. + ^ self sendEventTo: aMorph! + +MouseScrollEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MouseScrollEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + "Try to get out quickly" + | aMorphHandlesIt handledByInner eventPositionInChild focus| + focus := self hand keyboardFocus. + "FIXME - this works in all tested cases but one: when the window directly under the mouse doesn't have keyboard focus (i.e. a Transcript window)" + ((aMorph fullContainsGlobalPoint: position) and: [(aMorph = focus) or: [focus notNil and: [aMorph notNil and: [focus hasOwner: aMorph]]]]) ifFalse: [ ^ #rejected ]. + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + (aMorph handlesMouseScroll: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild + dispatchEvent: self + localPosition: eventPositionInChild) == #rejected ifFalse: [ "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + (handledByInner or: [ + (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position]]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt ifTrue: [ ^ self sendEventTo: aMorph ]]. + handledByInner ifTrue: [ ^ self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected.! + +MouseButtonEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MouseButtonEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchWith: aMorph localPosition: positionInAMorph + "Find the appropriate receiver for the event and let it handle it. Default rules: + * The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event. + * When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is. + * When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed. + * If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event. + " + | aMorphHandlesIt grabAMorph handledByInner eventPositionInChild | + "Only for MouseDown" + self isMouseDown ifFalse: [ + ^super dispatchWith: aMorph localPosition: positionInAMorph ]. + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Install the prospective handler for the receiver" + aMorphHandlesIt _ false. + grabAMorph _ false. + self mouseButton3Pressed + ifTrue: [ + (eventHandler isNil or: [ eventHandler isWorldMorph or: [ + self shiftPressed or: [ aMorph is: #HaloMorph ]]]) + ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]] + ifFalse: [ + (aMorph handlesMouseDown: self) ifTrue: [ + eventHandler _ aMorph. + aMorphHandlesIt _ true ]. + "If button 1, and both aMorph and the owner allows grabbing with the hand (to initiate drag & drop), so be it." + self mouseButton1Pressed ifTrue: [ + aMorph owner ifNotNil: [ :o | + (o allowsSubmorphDrag and: [ aMorph isSticky not ]) ifTrue: [ + grabAMorph _ true ]]]]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) ifTrue: [ + "aMorph is in the top-most unlocked, visible morph in the chain." + aMorphHandlesIt + ifTrue: [ ^self sendEventTo: aMorph ] + ifFalse: [ + (grabAMorph and: [ handledByInner not ]) ifTrue: [ + self hand + waitForClicksOrDrag: aMorph event: self + dragSel: (Preferences clickGrabsMorphs ifFalse: [#dragEvent:localPosition:]) + clkSel: (Preferences clickGrabsMorphs ifTrue: [#dragEvent:localPosition:]). + "false ifTrue: [ self hand grabMorph: aMorph ]." + Preferences clickGrabsMorphs ifFalse: [aMorph activateWindow]. + self wasHandled: true. + ^self ]]]. + + handledByInner ifTrue: [ ^self ]. + "Mouse was not on aMorph nor any of its children" + ^ #rejected! + +DropFilesEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: DropFilesEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + + | eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ ^self ]]. + + (aMorph allowsFilesDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! + +DropEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: DropEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchWith: aMorph localPosition: positionInAMorph + "Drop is done on the innermost target that accepts it." + | eventPositionInChild dropped | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: position) + ifFalse: [ ^#rejected ]. + + "Go looking if any of our submorphs wants it" + aMorph submorphsDo: [ :eachChild | + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + ^self ]]. + + (aMorph allowsMorphDrop and: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: position] ]) + ifTrue: [ + "Do a symmetric check if both morphs like each other" + dropped _ self contents. + ((aMorph wantsDroppedMorph: dropped event: self) "I want her" + and: [dropped wantsToBeDroppedInto: aMorph]) "she wants me" + ifTrue: [ + ^ self sendEventTo: aMorph ]]. + ^#rejected! + +MorphicEvent removeSelector: #dispatchWith:localPosition:! + +!methodRemoval: MorphicEvent #dispatchWith:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchWith: aMorph localPosition: positionInAMorph + "Dispatch me. The event will be passed to the front-most visible submorph that contains the position wrt. to the event." + | handledByInner eventPositionInChild | + + "Try to get out quickly" + (aMorph fullContainsGlobalPoint: self eventPosition) + ifFalse: [ ^#rejected ]. + + "Now give submorphs a chance to handle the event" + handledByInner _ false. + aMorph submorphsDo: [ :eachChild | + handledByInner ifFalse: [ + eventPositionInChild _ eachChild internalize: positionInAMorph. + (eachChild dispatchEvent: self localPosition: eventPositionInChild) == #rejected ifFalse: [ + "Some child did contain the point so aMorph is part of the top-most chain." + handledByInner _ true ]]]. + + "Check for being inside the receiver" + (handledByInner or: [ (aMorph rejectsEvent: self) not and: [aMorph fullContainsGlobalPoint: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! + +Morph removeSelector: #dispatchEvent:localPosition:! + +!methodRemoval: Morph #dispatchEvent:localPosition: stamp: 'Install-4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +dispatchEvent: aMorphicEvent localPosition: localPosition + "This is the central entry for dispatching events in morphic. Given some event, find the right receiver and let him handle it. + localPosition is in our coordinates." + + ^ (self rejectsEventFully: aMorphicEvent) + ifTrue: [ #rejected ] + ifFalse: [ aMorphicEvent dispatchWith: self localPosition: localPosition ]! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4517-remove-dispatchWithlocalPosition-JuanVuletich-2021Jan05-12h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4517] on 5 January 2021 at 1:15:41 pm'! +!TextEditor methodsFor: 'typing support' stamp: 'jmv 1/5/2021 13:14:39'! + processKeystrokeEvent: aKeyboardEvent + "Key struck on the keyboard. Find out which one and, if special, carry + out the associated special action. Otherwise, add the character to the + stream of characters." + + (self dispatchOn: aKeyboardEvent) ifTrue: [ + self storeSelectionInComposition. + ^self]. + + markBlock _ pointBlock. + self storeSelectionInComposition! ! +!InnerTextMorph methodsFor: 'event handling' stamp: 'jmv 1/5/2021 13:14:54'! + processKeystrokeEvent: evt + | action | + + (acceptOnCR and: [evt isReturnKey]) ifTrue: [^ self acceptContents]. + + self pauseBlinking. + + "Return - check for special action" + evt isReturnKey ifTrue: [ + action _ self crAction. + action ifNotNil: [ ^action value]]. + + "Esc - check for special action" + evt isEsc ifTrue: [ + action _ self escAction. + action ifNotNil: [ ^action value]]. + + self handleInteraction: [ editor processKeystrokeEvent: evt ]. + self scrollSelectionIntoView! ! +!InnerTextMorph methodsFor: 'events' stamp: 'jmv 1/5/2021 13:14:49' prior: 50641246 overrides: 50624438! + keyStroke: aKeyboardEvent + + (self focusKeyboardFor: aKeyboardEvent) + ifTrue: [ ^ self ]. + + autoCompleter + ifNil: [ self processKeystrokeEvent: aKeyboardEvent ] + ifNotNil: [ + autoCompleter + autoCompletionAround: [ self processKeystrokeEvent: aKeyboardEvent ] + keyStroke: aKeyboardEvent ]. + + super keyStroke: aKeyboardEvent! ! + +InnerTextMorph removeSelector: #processKeyStroke:! + +!methodRemoval: InnerTextMorph #processKeyStroke: stamp: 'Install-4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +processKeyStroke: evt + | action | + + (acceptOnCR and: [evt isReturnKey]) ifTrue: [^ self acceptContents]. + + self pauseBlinking. + + "Return - check for special action" + evt isReturnKey ifTrue: [ + action _ self crAction. + action ifNotNil: [ ^action value]]. + + "Esc - check for special action" + evt isEsc ifTrue: [ + action _ self escAction. + action ifNotNil: [ ^action value]]. + + self handleInteraction: [ editor processKeyStroke: evt ]. + self scrollSelectionIntoView! + +TextEditor removeSelector: #processKeyStroke:! + +!methodRemoval: TextEditor #processKeyStroke: stamp: 'Install-4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st 1/7/2021 16:16:49'! +processKeyStroke: aKeyboardEvent + "Key struck on the keyboard. Find out which one and, if special, carry + out the associated special action. Otherwise, add the character to the + stream of characters." + + (self dispatchOn: aKeyboardEvent) ifTrue: [ + self storeSelectionInComposition. + ^self]. + + markBlock _ pointBlock. + self storeSelectionInComposition! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4518-AvoidConfusingSelector-JuanVuletich-2021Jan05-13h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4518] on 5 January 2021 at 2:48:26 pm'! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 1/5/2021 14:47:51'! + sentTo: aMorph localPosition: positionInAMorph + "Dispatch the receiver into aMorph" + + ^ self wasHandled: true! ! + +"Postscript: +Leave the line above, and replace the rest of this comment by a useful one. +Executable statements should follow this comment, and should +be separated by periods, with no exclamation points (!!). +Be sure to put any further comments in double-quotes, like this one." +[ + (Delay forSeconds: 1) wait. + SystemChangeNotifier uniqueInstance doSilently: [ + MorphicEvent removeSelector: #sentTo:localPosition:. + SmalltalkCompleter initialize] +] fork! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4519-AvoidWalkback-JuanVuletich-2021Jan05-14h47m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4519] on 6 January 2021 at 12:01:26 pm'! +!String methodsFor: 'converting' stamp: 'jmv 1/6/2021 11:51:13'! + findPositiveInteger + "Answer the Integer created by interpreting the receiver as the string representation of an integer. + Answer nil if no digits, else find the first digit and then all consecutive digits after that" + + | startPosition tail endPosition | + startPosition _ self findFirst: [:ch | ch isDigit]. + startPosition = 0 ifTrue: [^ nil]. + tail _ self copyFrom: startPosition to: self size. + endPosition _ tail findFirst: [:ch | ch isDigit not]. + endPosition = 0 ifTrue: [endPosition _ tail size + 1]. + ^ Number readFrom: (tail copyFrom: 1 to: endPosition - 1) readStream + +" +'1796exportFixes-tkMX' findPositiveInteger +'1848recentLogFile-sw' findPositiveInteger +'donald' findPositiveInteger +'abc234def567' findPositiveInteger +"! ! + +String removeSelector: #asInteger! + +!methodRemoval: String #asInteger stamp: 'Install-4520-Rename-String-asInteger-to-findPositiveInteger-JuanVuletich-2021Jan06-11h51m-jmv.001.cs.st 1/7/2021 16:16:49'! +asInteger + "Answer the Integer created by interpreting the receiver as the string representation of an integer. Answer nil if no digits, else find the first digit and then all consecutive digits after that" + + | startPosition tail endPosition | + startPosition _ self findFirst: [:ch | ch isDigit]. + startPosition = 0 ifTrue: [^ nil]. + tail _ self copyFrom: startPosition to: self size. + endPosition _ tail findFirst: [:ch | ch isDigit not]. + endPosition = 0 ifTrue: [endPosition _ tail size + 1]. + ^ Number readFrom: (tail copyFrom: 1 to: endPosition - 1) readStream + +" +'1796exportFixes-tkMX' asInteger +'1848recentLogFile-sw' asInteger +'donald' asInteger +'abc234def567' asInteger +"! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4520-Rename-String-asInteger-to-findPositiveInteger-JuanVuletich-2021Jan06-11h51m-jmv.001.cs.st----! + +----SNAPSHOT----(7 January 2021 16:17:06) Cuis5.0-4520.image priorSource: 12915093! \ No newline at end of file diff --git a/Cuis5.0-4507.image b/Cuis5.0-4520.image similarity index 64% rename from Cuis5.0-4507.image rename to Cuis5.0-4520.image index bee90186..c59a62a4 100644 Binary files a/Cuis5.0-4507.image and b/Cuis5.0-4520.image differ diff --git a/Documentation/GettingStarted-NoCommandLine.md b/Documentation/GettingStarted-NoCommandLine.md index ded9ad49..dbb3c0d2 100644 --- a/Documentation/GettingStarted-NoCommandLine.md +++ b/Documentation/GettingStarted-NoCommandLine.md @@ -8,7 +8,7 @@ What follows are instructions for setting up Cuis on Windows or Mac OS X without * extract the contents of the zip file right there ("extract here") * download [`squeak.cog.spur_win32x86_201901172323.zip`](https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/201901172323/squeak.cog.spur_win32x86_201901172323.zip), saving it to yourFolder\Cuis-Smalltalk-Dev-master\ (the folder that was just created while extracting the first zip file). * extract the contents of the zip file right there ("extract here") -* drop the Cuis5.0-4507-32.image over the Squeak.exe file. Alternatively, double click on the Squeak.exe file, and when prompted to select an image file, select Cuis5.0-4507-32.image. +* drop the Cuis5.0-4520-32.image over the Squeak.exe file. Alternatively, double click on the Squeak.exe file, and when prompted to select an image file, select Cuis5.0-4520-32.image. * If you get a message like "This publisher could not be verified. Are you sure you want to run this software?", then untag "Always ask before opening this file" (if present) and click [Run]. * If you get a message like "Windows protected your PC", then click on "More info", and click [Run anyway]. @@ -19,10 +19,10 @@ What follows are instructions for setting up Cuis on Windows or Mac OS X without * download [`squeak.cog.spur_macos64x64_201901172323.dmg`](https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/201901172323/squeak.cog.spur_macos64x64_201901172323.dmg), saving it to your folder * double click on the dmg file * Drag Squeak to your folder -* drop the Cuis5.0-4507.image over the Squeak.app file +* drop the Cuis5.0-4520.image over the Squeak.app file * If you get "Squeak is an app downloaded from the Internet. Are you sure you want to open it?", click on [Open] ## Troubleshooting ## -* If you can't find Cuis5.0-4507.image, then this document is outdated. Use the Cuis image with the latest update number available. +* If you can't find Cuis5.0-4520.image, then this document is outdated. Use the Cuis image with the latest update number available. * If you can't find the Squeak Cog Spur VM specified, then this document is outdated. Use the the Squeak Cog Spur VM for your platform with the latest Date and Time available from https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/latest or http://opensmalltalk.org/ * If you can't get Cuis to run on your system after trying the above instructions, send mail to the Cuis-Dev mail list. Please give enough detail of your system, what you tried, and any error messages you got. diff --git a/Documentation/GettingStarted.md b/Documentation/GettingStarted.md index 3e19168c..9d9019d1 100644 --- a/Documentation/GettingStarted.md +++ b/Documentation/GettingStarted.md @@ -43,7 +43,7 @@ mv ./sqcogspur64linuxht ./cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4507.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4520.image ``` If you get this error message (you won't get it if you run Cuis as root or sudo): ``` @@ -68,11 +68,11 @@ Drag Squeak.app to your folder ``` ### Starting Cuis Smalltalk ### -* drop the Cuis5.0-4507.image over the Squeak.app file +* drop the Cuis5.0-4520.image over the Squeak.app file * If you get "Squeak is an app downloaded from the Internet. Are you sure you want to open it?", click on [Open] * Alternatively, you might: ``` -./Squeak.app/Contents/MacOS/Squeak Cuis-Smalltalk-Dev-master/Cuis5.0-4507.image +./Squeak.app/Contents/MacOS/Squeak Cuis-Smalltalk-Dev-master/Cuis5.0-4520.image ``` ## For 64 bits Windows (Git Bash) ## @@ -89,7 +89,7 @@ unzip cogspur.zip -d cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/Squeak.exe Cuis-Smalltalk-Dev/Cuis5.0-4507.image +cogspur/Squeak.exe Cuis-Smalltalk-Dev/Cuis5.0-4520.image ``` ## For Raspberry Pi Raspian ## @@ -105,7 +105,7 @@ mv ./sqcogspurlinuxhtRPi ./cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4507-32.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4520-32.image ``` ## For Chromebooks ## @@ -136,14 +136,14 @@ mv ./sqstkspurlinuxhtRPi ./stkspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4507-32.image -stkspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4507-32.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4520-32.image +stkspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4520-32.image ``` ## Troubleshooting ## * If when starting the image you get error messages like "This interpreter (vers. 6505) cannot read image file (vers. 68021).", (68021 or some other reasonable number) it means you image and VM are mismatched. For example, one of them is Spur and the other is pre-Spur, or one of them is 32 bits and the other is 64 bits. * If when starting the image you get error messages like "This interpreter (vers. 6505) cannot read image file (vers. 1007290890).", (1007290890 or some other absurd number) it means your git installation is breaking the files. It is usually best to configure git not to do any conversion on files. -* If you can't find Cuis5.0-4507-32.image, then this document is outdated. Use the Cuis spur image with the latest update number available. +* If you can't find Cuis5.0-4520-32.image, then this document is outdated. Use the Cuis spur image with the latest update number available. * If you can't find the Squeak Cog Spur VM specified, then this document is outdated. Use the the Squeak Cog Spur VM for your platform with the latest Date and Time available from http://opensmalltalk.org/ * If you can't get Cuis to run on your system after trying the above instructions, send mail to the Cuis-Dev mail list. Please give enough detail of your system, what you tried, and any error messages you got. * To get the contents of this repository without using Git, you can do