diff --git a/Cuis5.0-4834-32.image b/Cuis5.0-4834-32.image deleted file mode 100644 index 73ac931f..00000000 Binary files a/Cuis5.0-4834-32.image and /dev/null differ diff --git a/Cuis5.0-4834.image b/Cuis5.0-4834.image deleted file mode 100644 index 44baeb6a..00000000 Binary files a/Cuis5.0-4834.image and /dev/null differ diff --git a/Cuis5.0-4834-32.changes b/Cuis5.0-4871-32.changes similarity index 98% rename from Cuis5.0-4834-32.changes rename to Cuis5.0-4871-32.changes index 55862924..bf8bc1a6 100644 --- a/Cuis5.0-4834-32.changes +++ b/Cuis5.0-4871-32.changes @@ -206857,4 +206857,3092 @@ Please remedy manually and then repeat your request.' ]. ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4834-Enlarge-GCParameters-JuanVuletich-2021Sep03-11h27m-jmv.001.cs.st----! -----QUIT----(3 September 2021 15:02:29) Cuis5.0-4834-32.image priorSource: 8697056! \ No newline at end of file +----QUIT----(3 September 2021 15:02:29) Cuis5.0-4834-32.image priorSource: 8697056! + +----STARTUP---- (21 September 2021 12:54:02) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4834-32.image! + + +'From Haver 5.0 [latest update: #4821] on 1 September 2021 at 5:39:26 pm'! +!Boolean methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:33:22'! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ self subclassResponsibility! ! +!False methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:33:51' overrides: 50604882! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ ''! ! +!True methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:34:02' overrides: 50604882! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ ''! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4835-asMenuItemTextPrefix-GeraldKlix-2021Sep01-17h30m-KLG.001.cs.st----! + +'From Haver 5.0 [latest update: #4821] on 1 September 2021 at 7:00:13 pm'! +!TaskbarMorph class methodsFor: 'as yet unclassified' stamp: 'KLG 9/1/2021 18:58:39' overrides: 16877245! + includeInNewMorphMenu + "Return true for all classes that can be instantiated from the menu + + More than one taskbar confuses the running wolrd!!" + + ^ false! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4836-NoAdditionalTaskbarMorphs-GeraldKlix-2021Sep01-17h39m-KLG.001.cs.st----! + +'From Cuis 5.0 [latest update: #4836] on 5 September 2021 at 1:59:07 pm'! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:54:43' prior: 16812346! + showingLineDiffsString + "Answer a string representing whether I'm showing regular diffs" + + ^ self showingLineDiffs asMenuItemTextPrefix, + 'lineDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:55:59' prior: 16812361! + showingPrettyLineDiffsString + "Answer a string representing whether I'm showing pretty diffs" + + ^ self showingPrettyLineDiffs asMenuItemTextPrefix, + 'linePrettyDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:56:14' prior: 16812377! + showingPrettyWordDiffsString + "Answer a string representing whether I'm showing pretty diffs" + + ^ self showingPrettyWordDiffs asMenuItemTextPrefix, + 'wordPrettyDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:56:25' prior: 16812393! + showingWordDiffsString + "Answer a string representing whether I'm showing regular diffs" + + ^ self showingWordDiffs asMenuItemTextPrefix, + 'wordDiffs'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:55:22' prior: 16812559! + prettyPrintString + "Answer whether the receiver is showing pretty-print" + + ^ self showingPrettyPrint asMenuItemTextPrefix, + 'prettyPrint'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:53:44' prior: 16812605! + showingByteCodesString + "Answer whether the receiver is showing bytecodes" + + ^ self showingByteCodes asMenuItemTextPrefix, + 'byteCodes'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:54:04' prior: 16812620! + showingDecompileString + "Answer a string characerizing whether decompilation is showing" + + ^ self showingDecompile asMenuItemTextPrefix, + 'decompile'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:54:20' prior: 16812636! + showingDocumentationString + "Answer a string characerizing whether documentation is showing" + + ^ self showingDocumentation asMenuItemTextPrefix, + 'documentation'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:55:44' prior: 16812651! + showingPlainSourceString + "Answer a string telling whether the receiver is showing plain source" + + ^ self showingPlainSource asMenuItemTextPrefix, + 'source'! ! +!Morph methodsFor: 'menus' stamp: 'jmv 9/5/2021 13:57:02' prior: 16876328! + stickinessString + "Answer the string to be shown in a menu to represent the + stickiness status" + + ^ self isSticky asMenuItemTextPrefix, + 'resist being picked up'! ! +!InnerTextMorph methodsFor: 'menu' stamp: 'jmv 9/5/2021 13:57:19' prior: 16855935! + wrapString + "Answer the string to put in a menu that will invite the user to + switch word wrap mode" + ^ wrapFlag asMenuItemTextPrefix, + 'text wrap to bounds'! ! +!FileListWindow methodsFor: 'menu building' stamp: 'jmv 9/5/2021 13:58:00' prior: 50602245! + volumeMenu + | aMenu initialDirectoriesMenu | + aMenu _ MenuMorph new defaultTarget: model. + aMenu + add: 'delete directory...' + action: #deleteDirectory + icon: #warningIcon :: setBalloonText: 'Delete the selected directory'. + model currentDirectorySelected + ifNil: [ aMenu add: 'initial directory' action: #yourself :: isEnabled: false ] + ifNotNil: [ :selectedWrapper | + aMenu + add: (Preferences isInitialFileListDirectory: selectedWrapper item) + asMenuItemTextPrefix, 'initial directory' + action: #toggleInitialDirectory :: + setBalloonText: 'The selected directory is an initial director for new file list windows' ]. + initialDirectoriesMenu _ MenuMorph new. + #( + (roots 'default roots' 'Use the usual root directories. Drives on Windows; "/" on Unix') + (image 'image directory' 'Use the directory with Smalltalk image') + (vm 'VM directory' 'Use the virtual machine directory') + (current 'current directory' 'Use the current directory; usually the directory the VM was started in') + ) + do: [ :entry | + initialDirectoriesMenu + add: entry second + target: Preferences + action: #initialFileListDirectories: + argument: entry first :: + setBalloonText: entry third ]. + aMenu add: 'default initial directories' subMenu: initialDirectoriesMenu. + ^ aMenu! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4837-MakeGoodUseOf4835-JuanVuletich-2021Sep05-13h52m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4837] on 5 September 2021 at 7:51:29 pm'! +!PluggableScrollPane methodsFor: 'geometry' stamp: 'jmv 9/5/2021 18:38:10' overrides: 50552865! + fontPreferenceChanged + + super fontPreferenceChanged. + scrollBar recreateSubmorphs. + hScrollBar recreateSubmorphs. + self setScrollDeltas.! ! + +ScrollBar removeSelector: #fontPreferenceChanged! + +!methodRemoval: ScrollBar #fontPreferenceChanged stamp: 'Install-4838-GUIelementsSizeChangeFix-JuanVuletich-2021Sep05-19h50m-jmv.001.cs.st 9/21/2021 12:54:08'! +fontPreferenceChanged + "Rescale" + + self recreateSubmorphs! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4838-GUIelementsSizeChangeFix-JuanVuletich-2021Sep05-19h50m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4837] on 5 September 2021 at 7:52:31 pm'! +!Preferences class methodsFor: 'fonts' stamp: 'jmv 9/5/2021 19:52:05' prior: 50568016! + setDefaultFont: aFontName + "Change the font on the whole system without changing point sizes." + FontFamily defaultFamilyName: aFontName. + Preferences + setDefaultFont: FontFamily defaultFamilyName + spec: { + {#setListFontTo:. Preferences standardListFont pointSize.}. + {#setMenuFontTo:. Preferences standardMenuFont pointSize.}. + {#setWindowTitleFontTo:. Preferences windowTitleFont pointSize.}. + {#setCodeFontTo:. Preferences standardCodeFont pointSize.}. + {#setButtonFontTo:. Preferences standardButtonFont pointSize.}. + }. + MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ]. + UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! ! +!Preferences class methodsFor: 'fonts' stamp: 'jmv 9/5/2021 19:51:58' prior: 50602840! + setDefaultFont: fontFamilyName spec: defaultFontsSpec + + | font | + defaultFontsSpec do: [ :triplet | + font _ FontFamily familyName: fontFamilyName pointSize: triplet second. + font ifNil: [ font _ FontFamily defaultFamilyAndPointSize ]. + triplet size > 2 ifTrue: [ + font _ font emphasized: triplet third ]. + self + perform: triplet first + with: font ]. + MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ]. + UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4839-GUISizePreferenceChanged-JuanVuletich-2021Sep05-19h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4839] on 6 September 2021 at 10:24:41 am'! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/6/2021 10:21:10' prior: 50596319! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + stepX _ FontFamily defaultPointSize * 4 //10 * 10. + stepY _ FontFamily defaultPointSize * 2 //10 * 10. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: 2 color: c. + aCanvas line: 0@y0 to: 0@y1 width: 2 color: c. + + (x0 truncateTo: stepX) to: (x1 - stepX truncateTo: stepX) by: stepX do: [ :x | + aCanvas line: x @ -5 to: x @ 5 width: 2 color: c. + aCanvas drawString: x printString atCenterXBaselineY: x @ -10 font: nil color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - 15 @ 0 font: nil color: c. + + (y0 truncateTo: stepY) to: (y1 - stepY truncateTo: stepY) by: stepY do: [ :y | + aCanvas line: -5 @ y to: 5 @ y width: 2 color: c. + aCanvas drawString: y printString, ' ' atWaistRight: -5 @ y font: nil color: c ]. + aCanvas drawString: 'y' atWaistRight: -5 @ (y1 - 20) font: nil color: c. + + aCanvas geometryTransformation: prevTx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4840-drawCoordinateSystem-tweak-JuanVuletich-2021Sep05-20h14m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4839] on 6 September 2021 at 11:07:34 am'! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 11:07:11' prior: 50604024! + displayWorldSafely + "Update this world's display and keep track of errors during draw methods." + + [self displayWorld] on: Error, Halt do: [ :ex | + "Handle a drawing error" + canvas currentMorphDrawingFails. + "Creating a new canvas here could be dangerous, as code signaling the exception will be resumed." + self resetCanvas. + "Install the old error handler, so we can re-raise the error" + ex receiver error: ex description. + ]! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4841-Morphic-ErrorHandling-fix-JuanVuletich-2021Sep06-11h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4841] on 6 September 2021 at 12:08:56 pm'! +!MorphicCanvas methodsFor: 'morphic' stamp: 'jmv 9/6/2021 12:08:14' prior: 50559607! + fullDraw: aMorph + "Draw the full Morphic structure on us" + + "We are already set with a proper transformation from aMorph owner's coordinates to those of our target form." + + self flag: #jmvVer3. + aMorph visible ifFalse: [^ self]. + self into: aMorph. + + currentMorph layoutSubmorphsIfNeeded. + + currentMorph isKnownFailing ifTrue: [ + self canvasToUse drawCurrentAsError. + self outOfMorph. + ^ self]. + + (currentMorph isOwnedByHand and: [ + Preferences cheapWindowReframe and: [currentMorph is: #SystemWindow]]) ifTrue: [ + self drawCurrentAsOutline. + self outOfMorph. + ^ self]. + + "Draw current Morph and submorphs" + self canvasToUse drawCurrentAndSubmorphs. + + self outOfMorph! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4842-cheapWindowReframe-onlyForWindows-JuanVuletich-2021Sep06-12h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4841] on 6 September 2021 at 12:47:09 pm'! +!CodePackage methodsFor: 'naming' stamp: 'jmv 9/6/2021 12:17:27'! + packageDirectory + + ^self packageDirectoryName asDirectoryEntry! ! + +CodePackage removeSelector: #pagkageDirectory! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4843-packageDirectory-JuanVuletich-2021Sep06-12h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4843] on 6 September 2021 at 3:12:10 pm'! +!HandMorph methodsFor: 'drawing' stamp: 'jmv 9/6/2021 15:06:24'! + isDrawnBySoftware + "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden." + "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor from the display." + "Note. We draw the hand as a regular morph (using #drawOn:), disabling the hardware cursor, when we carry submorphs. The reason is to lock the mouse pointer and the carried morph together. Otherwhise the carried morph would lag behind the mouse pointer. + This method answers whether the regular #drawOn: drawing mechanism is used for us. + + Check senders. Hand drawing is handled explicitly by the world, because the Hand is not a submorph of the world!!" + | blankCursor | + (prevFullBounds notNil or: [ + submorphs anySatisfy: [ :ea | + ea visible ]]) ifTrue: [ + "using the software cursor; hide the hardware one" + blankCursor _ Cursor cursorAt: #blankCursor. + Cursor currentCursor == blankCursor ifFalse: [ blankCursor activateCursor ]. + ^ true ]. + ^ false.! ! +!WorldMorph methodsFor: 'hands' stamp: 'jmv 9/6/2021 15:06:31' prior: 50570236! + selectHandsToDrawForDamage: damageList + "Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle." + + | result | + result _ OrderedCollection new. + hands do: [:hand | + hand isDrawnBySoftware ifTrue: [ + hand isRedrawNeeded + ifTrue: [result add: hand] + ifFalse: [ + hand displayFullBounds ifNotNil: [ :handBounds | + (damageList anySatisfy: [ :r | r intersects: handBounds]) ifTrue: [ + result add: hand]]]]]. + ^ result! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 15:06:36' prior: 50570256! + checkIfUpdateNeeded + + self isSubmorphRedrawNeeded ifTrue: [ ^true ]. + damageRecorder updateIsNeeded ifTrue: [^true]. + hands do: [:h | (h isRedrawNeeded | h isSubmorphRedrawNeeded and: [h isDrawnBySoftware]) ifTrue: [^true]]. + ^false "display is already up-to-date" +! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 15:10:14' prior: 50564980! + doOneCycle + "Do one cycle of the interaction loop. This method is called repeatedly when the world is running. + + Make for low cpu usage if the ui is inactive, but quick response when ui is in use. + However, after some inactivity, there will be a larger delay before the ui gets responsive again." + + | wait waitUntil | + waitDelay ifNil: [ waitDelay _ Delay forMilliseconds: 50 ]. + (lastCycleHadAnyEvent or: [ deferredUIMessages isEmpty not ]) + ifTrue: [ + pause _ 20. "This value will only be used later, when there are no more events to serve or deferred UI messages to process." + wait _ 0. "Don't wait this time"] + ifFalse: [ + "wait between 20 and 200 milliseconds" + (hands anySatisfy: [ :h | h waitingForMoreClicks ]) + ifTrue: [ pause _ 20 ] + ifFalse: [ pause < 200 ifTrue: [ pause _ pause * 21//20 ] ]. + waitUntil _ lastCycleTime + pause. + "Earlier if steps" + stepList isEmpty not ifTrue: [ + waitUntil _ waitUntil min: stepList first scheduledTime ]. + "Earlier if alarms" + alarms ifNotNil: [ + alarms isEmpty not ifTrue: [ + waitUntil _ waitUntil min: alarms first scheduledTime ]]. + wait _ waitUntil - Time localMillisecondClock max: 0 ]. + Preferences serverMode + ifTrue: [ wait _ wait max: 50 ]. "Always wait at least a bit on servers, even if this makes the UI slow." + wait = 0 + ifTrue: [ Processor yield ] + ifFalse: [ + waitDelay beingWaitedOn + ifFalse: [ waitDelay setDelay: wait; wait ] + ifTrue: [ + "If we are called from a different process than that of the main UI, we might be called in the main + interCyclePause. In such case, use a new Delay to avoid 'This Delay has already been scheduled' errors" + (Delay forMilliseconds: wait) wait ]]. + + "Record start time of this cycle, and do cycle" + lastCycleTime _ Time localMillisecondClock. + lastCycleHadAnyEvent _ self doOneCycleNow.! ! + +HandMorph removeSelector: #needsToBeDrawn! + +!methodRemoval: HandMorph #needsToBeDrawn stamp: 'Install-4844-DelayInMenuOpenBug-Fix-JuanVuletich-2021Sep06-15h09m-jmv.001.cs.st 9/21/2021 12:54:08'! +needsToBeDrawn + "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden." + "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor from the display." + "Note. We draw the hand as a regular morph (using #drawOn:), disabling the hardware cursor, when we carry submorphs. The reason is to lock the mouse pointer and the carried morph together. Otherwhise the carried morph would lag behind the mouse pointer. + This method answers whether the regular #drawOn: drawing mechanism is used for us. + + Check senders. Hand drawing is handled explicitly by the world, because the Hand is not a submorph of the world!!" + | blankCursor | + (prevFullBounds notNil or: [ + submorphs anySatisfy: [ :ea | + ea visible ]]) ifTrue: [ + "using the software cursor; hide the hardware one" + blankCursor _ Cursor cursorAt: #blankCursor. + Cursor currentCursor == blankCursor ifFalse: [ blankCursor activateCursor ]. + ^ true ]. + ^ false.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4844-DelayInMenuOpenBug-Fix-JuanVuletich-2021Sep06-15h09m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:36:59 pm'! +!Morph methodsFor: 'initialization' stamp: 'jmv 9/6/2021 15:21:29' prior: 16875917! + intoWorld: aWorld + "The receiver has just appeared in a new world. Note: + * aWorld can be nil (due to optimizations in other places) + * owner is already set + * owner's submorphs may not include receiver yet. + Important: Keep this method fast - it is run whenever morphs are added." + + aWorld ifNil: [ ^self ]. + self needsRedraw: true. + self wantsSteps ifTrue: [ self startStepping ]. + self submorphsDo: [ :m | m intoWorld: aWorld ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4845-AlwaysRefreshNewMorphs-JuanVuletich-2021Sep06-15h36m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:37:39 pm'! +!WorldMorph methodsFor: 'events' stamp: 'jmv 9/6/2021 15:20:19' prior: 50552190 overrides: 16874466! + click: aMouseButtonEvent localPosition: localEventPosition + + ^self mouseButton2Activity.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4846-DontWaitToOpenWorldMenu-JuanVuletich-2021Sep06-15h36m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:38:16 pm'! +!HandMorph methodsFor: 'double click support' stamp: 'jmv 9/6/2021 15:30:21'! + waitForClicksOrDragOrSimulatedMouseButton2: aMorph event: evt clkSel: clkSel + + "Wait until the difference between click, or drag gesture is known, then inform the given morph what transpired." + + mouseClickState _ + MouseClickState new + client: aMorph + drag: nil + click: clkSel + clickAndHalf: nil + dblClick: nil + dblClickAndHalf: nil + tripleClick: nil + event: evt + sendMouseButton2Activity: Preferences tapAndHoldEmulatesButton2. + + "It seems the Mac VM may occasionally lose button up events triggering bogus activations. + Hence Preferences tapAndHoldEmulatesButton2"! ! +!MouseClickState methodsFor: 'private' stamp: 'jmv 9/6/2021 15:33:13'! + notWaitingForMultipleClicks + + ^ clickAndHalfSelector isNil and: [ + dblClickSelector isNil and: [ + dblClickAndHalfSelector isNil and: [ + tripleClickSelector isNil ]]]! ! +!PasteUpMorph methodsFor: 'events' stamp: 'jmv 9/6/2021 15:30:26' prior: 50550883 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + + super mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition. + + aMouseButtonEvent hand + waitForClicksOrDragOrSimulatedMouseButton2: self + event: aMouseButtonEvent + clkSel: #click:localPosition:.! ! +!MouseClickState methodsFor: 'actions' stamp: 'jmv 9/6/2021 15:33:53' prior: 50574240! + handleEvent: aMouseEvent from: aHand + "Process the given mouse event to detect a click, double-click, or drag. + Return true if the event should be processed by the sender, false if it shouldn't. + NOTE: This method heavily relies on getting *all* mouse button events." + + | timedOut distance | + timedOut _ (aMouseEvent timeStamp - lastClickDown timeStamp) > self class doubleClickTimeout. + timedOut ifTrue: [ aHand dontWaitForMoreClicks ]. + distance _ (aMouseEvent eventPosition - lastClickDown eventPosition) r. + "Real action dispatch might be done after the triggering event, for example, because of waiting for timeout. + So, count the button downs and ups(clicks), to be processed, maybe later, maybe in a mouseMove..." + aMouseEvent isMouseDown ifTrue: [ + lastClickDown _ aMouseEvent. + buttonDownCount _ buttonDownCount + 1 ]. + aMouseEvent isMouseUp ifTrue: [ + buttonUpCount _ buttonUpCount + 1 ]. + + "Drag, or tap & hold" + (buttonDownCount = 1 and: [ buttonUpCount = 0]) ifTrue: [ + (self notWaitingForMultipleClicks or: [ distance > 0 ]) ifTrue: [ + "If we have already moved, then it won't be a double or triple click... why wait?" + aHand dontWaitForMoreClicks. + dragSelector + ifNotNil: [ self didDrag ] + ifNil: [ self didClick ]. + ^ false ]. + timedOut ifTrue: [ + aHand dontWaitForMoreClicks. + "Simulate button 2 via tap & hold. Useful for opening menus on pen computers." + sendMouseButton2Activity ifTrue: [ + clickClient mouseButton2Activity ]. + ^ false ]]. + + "If we're over triple click, or timed out, or mouse moved, don't allow more clicks." + (buttonDownCount = 4 or: [ timedOut or: [ distance > 0 ]]) ifTrue: [ + aHand dontWaitForMoreClicks. + ^ false ]. + + "Simple click." + (buttonDownCount = 1 and: [ buttonUpCount = 1 ]) ifTrue: [ + self didClick ]. + + "Click & hold" + (buttonDownCount = 2 and: [ buttonUpCount = 1]) ifTrue: [ + self didClickAndHalf ]. + + "Double click." + (buttonDownCount = 2 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClick ]. + + "Double click & hold." + (buttonDownCount = 3 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClickAndHalf ]. + + "Triple click" + (buttonDownCount = 3 and: [ buttonUpCount = 3]) ifTrue: [ + self didTripleClick ]. + + "This means: if a mouseDown, then don't further process this event (so we can turn it into a double or triple click on next buttonUp)" + ^ aMouseEvent isMouseDown! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4847-MouseClickState-tweaks-JuanVuletich-2021Sep06-15h37m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4847] on 6 September 2021 at 7:55:36 pm'! +!MouseClickState methodsFor: 'actions' stamp: 'jmv 6/17/2021 13:01:32' prior: 50605552! + handleEvent: aMouseEvent from: aHand + "Process the given mouse event to detect a click, double-click, or drag. + Return true if the event should be processed by the sender, false if it shouldn't. + NOTE: This method heavily relies on getting *all* mouse button events." + + | timedOut distance | + timedOut _ (aMouseEvent timeStamp - lastClickDown timeStamp) > self class doubleClickTimeout. + timedOut ifTrue: [ aHand dontWaitForMoreClicks ]. + distance _ (aMouseEvent eventPosition - lastClickDown eventPosition) r. + "Real action dispatch might be done after the triggering event, for example, because of waiting for timeout. + So, count the button downs and ups(clicks), to be processed, maybe later, maybe in a mouseMove..." + aMouseEvent isMouseDown ifTrue: [ + lastClickDown _ aMouseEvent. + buttonDownCount _ buttonDownCount + 1 ]. + aMouseEvent isMouseUp ifTrue: [ + buttonUpCount _ buttonUpCount + 1 ]. + + "Drag, or tap & hold" + (buttonDownCount = 1 and: [ buttonUpCount = 0]) ifTrue: [ + distance > 0 ifTrue: [ + aHand dontWaitForMoreClicks. + dragSelector + ifNotNil: [ self didDrag ] + "If we have already moved, then it won't be a double or triple click... why wait?" + ifNil: [ self didClick ]. + ^ false ]. + timedOut ifTrue: [ + aHand dontWaitForMoreClicks. + "Simulate button 2 via tap & hold. Useful for opening menus on pen computers." + sendMouseButton2Activity ifTrue: [ + clickClient mouseButton2Activity ]. + ^ false ]]. + + "If we're over triple click, or timed out, or mouse moved, don't allow more clicks." + (buttonDownCount = 4 or: [ timedOut or: [ distance > 0 ]]) ifTrue: [ + aHand dontWaitForMoreClicks. + ^ false ]. + + "Simple click." + (buttonDownCount = 1 and: [ buttonUpCount = 1 ]) ifTrue: [ + self didClick ]. + + "Click & hold" + (buttonDownCount = 2 and: [ buttonUpCount = 1]) ifTrue: [ + self didClickAndHalf ]. + + "Double click." + (buttonDownCount = 2 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClick ]. + + "Double click & hold." + (buttonDownCount = 3 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClickAndHalf ]. + + "Triple click" + (buttonDownCount = 3 and: [ buttonUpCount = 3]) ifTrue: [ + self didTripleClick ]. + + "This means: if a mouseDown, then don't further process this event (so we can turn it into a double or triple click on next buttonUp)" + ^ aMouseEvent isMouseDown! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4848-fixBugIn4847-JuanVuletich-2021Sep06-19h55m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4848] on 7 September 2021 at 11:05:59 am'! +!BitBltCanvas methodsFor: 'initialization' stamp: 'jmv 9/7/2021 09:41:09' overrides: 50604015! + resetCanvas + "To be called in case of possible inconsistency due to an exception during drawing. + See #displayWorldSafely" + + super resetCanvas. + boundsFinderCanvas resetCanvas.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4849-resetCanvas-fix-JuanVuletich-2021Sep07-11h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4849] on 7 September 2021 at 11:17:08 am'! +!Number methodsFor: 'truncation and round off' stamp: 'jmv 9/7/2021 10:54:01'! + round4perMagnitudeOrder + "Round receiver to 1 or two significant digits. + Answer is 1, 2, 2.5, 5, 10, 20, 25, 50, 100, 200, 250, 500, 1000, etc. + better name?" + + | excess firstDigitPosition | + firstDigitPosition _ self log floor. + excess _ self log - firstDigitPosition. + excess < 2 log ifTrue: [ ^10 raisedTo: firstDigitPosition ]. + excess < 2.5 log ifTrue: [ ^(10 raisedTo: firstDigitPosition) * 2 ]. + excess < 5 log ifTrue: [ ^(10 raisedTo: firstDigitPosition-1) * 25 ]. + ^(10 raisedTo: firstDigitPosition) * 5! ! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2021 11:13:25' prior: 50605141! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 10) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1-(stepX*0.2) by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atCenterXBaselineY: x @ (tickLength*2) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1-(stepY*0.5) by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaistRight: tickLength negated @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! +!WidgetMorph methodsFor: 'halos and balloon help' stamp: 'jmv 9/7/2021 09:26:23' prior: 50601327 overrides: 50601321! + haloShowsCoordinateSystem + "We are usually not concerned with this level of detail for Widgets, as they prefer using automatic Layout." + + ^self requiresVectorCanvas! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4850-drawCoordinateSystem-enhancements-JuanVuletich-2021Sep07-11h16m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4849] on 7 September 2021 at 11:21:43 am'! +!WindowEdgeAdjustingMorph methodsFor: 'adjusting' stamp: 'jmv 9/7/2021 11:21:14' prior: 50603909 overrides: 50591384! + adjustOwnerAt: aGlobalPoint millisecondSinceLast: millisecondSinceLast + + self basicAdjustOwnerAt: aGlobalPoint. + + "If UI is becoming slow or is optimized for slow systems, resize without + showing window contents, but only edges. But don't do it for rotated Windows!!" + (owner isOrAnyOwnerIsRotated not and: [ + Preferences cheapWindowReframe or: [millisecondSinceLast > 200]]) ifTrue: [ + owner displayBounds newRectFrom: [ :f | + self basicAdjustOwnerAt: Sensor mousePoint. + owner morphPosition extent: owner morphExtentInWorld ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4851-cheapWindowReframe-lessAgressive-JuanVuletich-2021Sep07-11h17m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4851] on 7 September 2021 at 12:04:13 pm'! +!CodeWindow methodsFor: 'updating' stamp: 'jmv 9/7/2021 12:02:33' prior: 50602515! + updateListsAndCode + "All code windows receive this message on any code change in the system. + Process it only once, for the benefit of installing large packages!!" + + (self hasProperty: #updateListsAndCode) ifFalse: [ + self setProperty: #updateListsAndCode toValue: true. + self whenUIinSafeState: [ + self removeProperty: #updateListsAndCode. + owner ifNotNil: [ self updateListsAndCodeNow ]]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4852-CodeWindow-updateListsAndCode-afterClose-fix-JuanVuletich-2021Sep07-12h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4809] on 5 September 2021 at 10:49:47 pm'! + +Smalltalk removeClassNamed: #ExtractMethodApplier! + +!classRemoval: #ExtractMethodApplier stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Smalltalk removeClassNamed: #ExtractMethod! + +!classRemoval: #ExtractMethod stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +MessageSet subclass: #ExtractMethodMessageSet + instanceVariableNames: 'finder selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodMessageSet category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +MessageSet subclass: #ExtractMethodMessageSet + instanceVariableNames: 'finder selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +MessageSetWindow subclass: #ExtractMethodReplacementsWindow + instanceVariableNames: 'applier finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacementsWindow category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +MessageSetWindow subclass: #ExtractMethodReplacementsWindow + instanceVariableNames: 'applier finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Object subclass: #ExtractMethodReplacementsFinder + instanceVariableNames: 'intervalToExtract sourceMethod replacements newMessage sourceCodeToExtract sizeToExtract' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacementsFinder category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +Object subclass: #ExtractMethodReplacementsFinder + instanceVariableNames: 'intervalToExtract sourceMethod replacements newMessage sourceCodeToExtract sizeToExtract' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'extractMethodNewMethod collectionOfReplacements' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethod category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'extractMethodNewMethod collectionOfReplacements' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethod commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +Refactoring subclass: #ExtractMethodNewMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodNewMethod category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +Refactoring subclass: #ExtractMethodNewMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodNewMethod commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +Refactoring subclass: #ExtractMethodReplacement + instanceVariableNames: 'intervalToExtract newMessage methodToExtractFrom callingExpression' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacement category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +Refactoring subclass: #ExtractMethodReplacement + instanceVariableNames: 'intervalToExtract newMessage methodToExtractFrom callingExpression' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodReplacement commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider sourceCodeToExtract newMethodRefactoring finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodApplier category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider sourceCodeToExtract newMethodRefactoring finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodMessageSet methodsFor: 'initialization' stamp: 'HAW 9/5/2021 07:15:36' overrides: 50407636! + initialize + + selectedIndex := 0. + super initialize ! ! +!ExtractMethodMessageSet methodsFor: 'initialization' stamp: 'HAW 9/5/2021 00:12:23'! + initializeFinder: aFinder + + finder := aFinder.! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 07:15:16' overrides: 16792396! + messageListIndex + + ^selectedIndex ! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 07:14:51' overrides: 50390577! + messageListIndex: anIndex + + selectedIndex := anIndex. + ^super messageListIndex: anIndex ! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 21:52:26' overrides: 50442972! + removeMessageFromBrowserKeepingLabel + + | newIndex | + + selectedMessage ifNil: [ ^nil ]. + messageList removeIndex: selectedIndex. + finder removeReplacementAt: selectedIndex. + self changed: #messageList. + + newIndex := selectedIndex > messageList size + ifTrue: [ selectedIndex - 1 ] + ifFalse: [ selectedIndex ]. + self messageListIndex: newIndex.! ! +!ExtractMethodMessageSet methodsFor: 'source code ranges' stamp: 'HAW 9/5/2021 21:46:48' overrides: 50452610! + messageSendsRangesOf: aSelector + + | replacement | + + replacement := finder replacementsAt: self messageListIndex ifAbsent: [ ^#() ]. + + ^Array with: replacement intervalToExtract + ! ! +!ExtractMethodMessageSet class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 00:11:22'! + finder: aFinder + + ^(self messageList: aFinder methodsToReplace) initializeFinder: aFinder! ! +!MethodNode methodsFor: 'source ranges' stamp: 'HAW 8/26/2021 15:57:14'! + definitionStartPosition + + "It does not includes temp definition because the extract can include temps - Hernan" + ^self selectorLastPosition + 1! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:28'! + closeAfter: aBlock + + aBlock value. + self whenUIinSafeState: [ self delete ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:16'! + extractAllInClass + + self closeAfter: [ applier valueWithMethodsInClass ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:43'! + extractInMethodOnly + + self closeAfter: [ applier valueWithSourceMethod ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:52'! + extractSelectionOnly + + self closeAfter: [ applier valueWithOriginalSelection ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:42:00'! + refactor + + self closeAfter: [ applier valueWithAllReplacements ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 8/25/2021 22:07:31'! +remove + + model removeMessageFromBrowserKeepingLabel! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31'! + addButton: button to: row color: buttonColor + + button color: buttonColor. + row addMorph: button proportionalWidth: 10! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 9/5/2021 20:02:21'! + addButtonsTo: row color: buttonColor + + self + addButton: self createRemoveButton to: row color: buttonColor; + addButton: self createRefactorButton to: row color: buttonColor; + addButton: self createExtractSelectionOnlyButton to: row color: buttonColor; + addButton: self createExtractInMethodOnlyButton to: row color: buttonColor; + addButton: self createExtractAllInClassButton to: row color: buttonColor; + addButton: self createCancelButton to: row color: buttonColor. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31' overrides: 50518714! + buildLowerPanes + + | codeAndButtons | + + codeAndButtons _ LayoutMorph newColumn. + codeAndButtons + addMorph: self buttonsRow fixedHeight: self defaultButtonPaneHeight; + addAdjusterMorph; + addMorph: self buildMorphicCodePane proportionalHeight: 1.0. + + ^codeAndButtons ! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31'! + buttonsRow + + | buttonColor row | + + buttonColor := self buttonColor. + row := LayoutMorph newRow. + row doAdoptWidgetsColor. + row color: buttonColor. + + self addButtonsTo: row color: buttonColor. + + ^row + + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 8/25/2021 22:07:31'! + createCancelButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #delete + label: 'Cancel'. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:55:47'! + createExtractAllInClassButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractAllInClass + label: 'In Class'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:55:57'! + createExtractInMethodOnlyButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractInMethodOnly + label: 'In Method'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:43:25'! + createExtractSelectionOnlyButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractSelectionOnly + label: 'Selection Only'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:56:07'! + createRefactorButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #refactor + label: 'Refactor'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 20:07:00'! + createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'initialization' stamp: 'HAW 9/4/2021 23:30:56'! + initializeFrom: anExtractMethodApplier with: aFinder + + applier := anExtractMethodApplier. + finder := aFinder ! ! +!ExtractMethodReplacementsWindow class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 20:31:15'! + openFrom: anExtractMethodApplier with: aFinder + + | window messageSet | + + messageSet := ExtractMethodMessageSet finder: aFinder. + "I have to set a autoSelectString even if I do not use it because if not the + autoSelect event is not triggered - Hernan" + messageSet autoSelectString: aFinder sourceCodeToExtract. + + window := self open: messageSet label: 'Select replacements'. + window initializeFrom: anExtractMethodApplier with: aFinder. + + ^window + +! ! +!ExtractMethodReplacementsFinder methodsFor: 'initialization' stamp: 'HAW 9/2/2021 17:31:19'! + initializeOfCodeIn: anIntervalToExtract at: aMethod to: aNewMessage + + intervalToExtract := anIntervalToExtract. + sourceMethod := aMethod. + newMessage := aNewMessage ! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/5/2021 22:05:15'! + addReplacementAt: foundIntervalToExtract in: aMethod + + "If ther is an error creating the refactoring, then the found text is not extractable and + therefore should not be replaced - Hernan" + [ replacements add: (self createReplacementAt: foundIntervalToExtract in: aMethod) ] + on: RefactoringError + do: [ :anError | ].! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:03:06'! + createReplacementAt: foundIntervalToExtract in: aMethod + + ^ExtractMethodReplacement + fromInterval: foundIntervalToExtract asSourceCodeInterval + of: aMethod + to: newMessage! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:01:06'! + findReplacementsAt: aClass + + aClass methodsDo: [ :aMethod | self findReplacementsIn: aMethod asMethodReference ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:04:49'! + findReplacementsIn: aMethod + + | sourceCode foundIntervalToExtract sourceCodeToExtractStart | + + sourceCode := aMethod sourceCode. + sourceCodeToExtractStart := 1. + + [ sourceCodeToExtractStart := sourceCode indexOfSubCollection: sourceCodeToExtract startingAt: sourceCodeToExtractStart. + sourceCodeToExtractStart ~= 0 ] whileTrue: [ + foundIntervalToExtract := sourceCodeToExtractStart to: sourceCodeToExtractStart + sizeToExtract. + self addReplacementAt: foundIntervalToExtract in: aMethod. + sourceCodeToExtractStart := foundIntervalToExtract last + 1 ] + + ! ! +!ExtractMethodReplacementsFinder methodsFor: 'testing' stamp: 'HAW 9/4/2021 23:25:35'! + hasOneReplacement + + ^replacements size = 1! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:18:47'! + inClassReplacements + + ^replacements select: [ :aReplacement | aReplacement isAt: sourceMethod methodClass ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 00:12:03'! + methodsToReplace + + ^replacements collect: [ :aReplacement | aReplacement methodToExtractFrom ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:14:49'! + originalSelectionReplacement + + ^ExtractMethodReplacement fromInterval: intervalToExtract of: sourceMethod to: newMessage ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 21:51:40'! + removeReplacementAt: anIndex + + ^replacements removeAt: anIndex ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/2/2021 17:41:27'! + replacements + + ^replacements ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 07:24:58'! + replacementsAt: anIndex ifAbsent: ifAbsentBlock + + ^replacements at: anIndex ifAbsent: ifAbsentBlock ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:17:31'! + sourceMethodReplacements + + ^replacements select: [:aReplacement | aReplacement isOf: sourceMethod ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'evaluating' stamp: 'HAW 9/4/2021 21:00:59' overrides: 16881508! + value + + sourceCodeToExtract := sourceMethod sourceCode copyFrom: intervalToExtract first to: intervalToExtract last. + sizeToExtract := intervalToExtract size - 1. + replacements := OrderedCollection new. + + sourceMethod methodClass withAllSubclassesDo: [ :aClass | self findReplacementsAt: aClass] + ! ! +!ExtractMethodReplacementsFinder methodsFor: 'source code' stamp: 'HAW 9/5/2021 00:14:54'! + sourceCodeToExtract + + ^sourceCodeToExtract! ! +!ExtractMethodReplacementsFinder class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 17:31:33'! + ofCodeIn: anIntervalToExtract at: aMethod to: aNewMessage + + ^self new initializeOfCodeIn: anIntervalToExtract at: aMethod to: aNewMessage ! ! +!ExtractMethod methodsFor: 'initialization' stamp: 'HAW 9/5/2021 22:46:43'! + initializeNewDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements + + extractMethodNewMethod := anExtractMethodNewMethod. + collectionOfReplacements := aCollectionOfReplacements.! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:48'! + applyMethodReplacements: aMethodReplacements + + | adjustment sortedReplacements | + + adjustment := 0. + "This is not really necesary because the groupBy: keeps the order, but I do it just in case that is changed - Hernan" + sortedReplacements := aMethodReplacements sorted: [ :leftReplacement :rightReplacement | leftReplacement isBefore: rightReplacement ]. + sortedReplacements do: [ :aReplacement | + aReplacement applyAdjusting: adjustment. + adjustment := adjustment + aReplacement adjustmentForNextReplacement ]! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:51'! + applyReplacements + + | replacementsByMethod | + + replacementsByMethod := collectionOfReplacements groupBy: [ :aReplacement | aReplacement methodToExtractFrom ]. + replacementsByMethod valuesDo: [ :aMethodReplacements | self applyMethodReplacements: aMethodReplacements ]. + ! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:54'! + createNewMethod + + extractMethodNewMethod apply. +! ! +!ExtractMethod methodsFor: 'applying' stamp: 'HAW 9/5/2021 22:46:38' overrides: 50438490! + apply + + self + createNewMethod; + applyReplacements ! ! +!ExtractMethod class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:46:15'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage categorizedAs: aCategory + + ^self + newDefinition: (ExtractMethodNewMethod + fromInterval: anIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + categorizedAs: aCategory ) + replacements: (Array with: (ExtractMethodReplacement + fromInterval: anIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage)) + +! ! +!ExtractMethod class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:46:32'! + newDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements + + ^self new initializeNewDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements ! ! +!ExtractMethodNewMethod methodsFor: 'applying' stamp: 'HAW 9/4/2021 15:55:33' overrides: 50438490! + apply + + self sourceClass + compile: self newMethodSourceCode + classified: categoryOfNewSelector! ! +!ExtractMethodNewMethod methodsFor: 'initialization' stamp: 'HAW 9/2/2021 18:09:20'! + initializeExtractedSourceCode + + extractedSourceCode := existingMethod sourceCode + copyFrom: intervalToExtract first + to: intervalToExtract last! ! +!ExtractMethodNewMethod methodsFor: 'initialization' stamp: 'HAW 9/2/2021 18:09:20'! + initializeFrom: anIntervalToExtract of: aMethodToExtractCodeFrom to: aNewMessage in: aCategory + + intervalToExtract := anIntervalToExtract. + existingMethod := aMethodToExtractCodeFrom. + newMessage := aNewMessage. + categoryOfNewSelector := aCategory. + self initializeExtractedSourceCode.! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + newMessageString + + ^ newMessage fullName! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + newMethodSourceCode + + ^ String streamContents: [ :stream | + stream + nextPutAll: self newMessageString; + nextPutAll: self startingMethodIdentation; + nextPutAll: self returnCharacterIfNeeded; + nextPutAll: extractedSourceCode ]! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + returnCharacterIfNeeded + + | extractedMethodNode | + + extractedMethodNode := Parser parse: extractedSourceCode class: self sourceClass noPattern: true. + + ^ (extractedMethodNode numberOfStatements > 1 or: [ extractedMethodNode hasTemporaryVariables ]) + ifTrue: [ '' ] ifFalse: [ '^ ' ]! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + sourceClass + + ^ existingMethod methodClass! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + startingMethodIdentation + + ^ String lfString , String lfString , String tab! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + noSelectionErrorMessage + + ^ 'Please select some code for extraction'! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + outOfBoundsSelectionErrorMessage + + ^ 'The requested source code selection interval is out of bounds'! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + wrongNumberOfArgumentsGivenErrorMessage + + ^ 'The number of arguments in the given selector is not correct'! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalExtractMethodWithWrongNumberOfArgumentsError + + self refactoringError: self wrongNumberOfArgumentsGivenErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalNoSelectedCodeError + + self refactoringError: self noSelectionErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalOutOfBoundsIntervalError + + self refactoringError: self outOfBoundsSelectionErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 18:09:20'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage categorizedAs: aCategory + + | trimmedIntervalToExtract | + + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: aMethodToExtractCodeFrom sourceCode. + self + assert: newMessage selector canBeDefinedIn: aMethodToExtractCodeFrom methodClass; + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: trimmedIntervalToExtract; + assert: newMessage hasValidParametersForExtracting: anIntervalToExtract from: aMethodToExtractCodeFrom methodNode. + + ^ self new + initializeFrom: trimmedIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + in: aCategory! ! +!ExtractMethodNewMethod class methodsFor: 'pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract + + self + assertIntervalToExtractIsNotEmpty: anIntervalToExtract; + assert: anIntervalToExtract isWithinBoundsOf: aMethodToExtractCodeFrom sourceCode; + assert: aMethodToExtractCodeFrom containsValidCodeToBeExtractedAt: anIntervalToExtract! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: aSelector canBeDefinedIn: aClass + + NewSelectorPrecondition valueFor: aSelector on: aClass! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: aMethodToRefactor containsValidCodeToBeExtractedAt: anIntervalToExtract + + SourceCodeOfMethodToBeExtractedPrecondition valueFor: anIntervalToExtract of: aMethodToRefactor! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: newMessage hasValidParametersForExtracting: anIntervalToExtract from: aMethodNodeToRefactor + + | parseNodesToParameterize | + parseNodesToParameterize := ExtractMethodParametersDetector + valueFor: aMethodNodeToRefactor + at: anIntervalToExtract. + newMessage arguments size = parseNodesToParameterize size + ifFalse: [ self signalExtractMethodWithWrongNumberOfArgumentsError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: anIntervalToExtract isWithinBoundsOf: sourceCode + + (self is: anIntervalToExtract withinBoundsOf: sourceCode) + ifFalse: [ self signalOutOfBoundsIntervalError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assertIntervalToExtractIsNotEmpty: anIntervalToExtract + + (self isNotEmpty: anIntervalToExtract) + ifFalse: [ self signalNoSelectedCodeError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + is: anIntervalToExtract withinBoundsOf: aSourceCode + + ^ anIntervalToExtract first >= 1 and: [ anIntervalToExtract last <= aSourceCode size ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + isNotEmpty: anInterval + + ^ anInterval first <= anInterval last! ! +!ExtractMethodReplacement methodsFor: 'applying' stamp: 'HAW 9/2/2021 17:38:51' overrides: 50438490! + apply + + self sourceClass + compile: self updatedSourceCodeOfExistingMethod + classified: methodToExtractFrom category! ! +!ExtractMethodReplacement methodsFor: 'applying' stamp: 'HAW 9/4/2021 20:59:16'! + applyAdjusting: anAdjustment + + intervalToExtract := (intervalToExtract + anAdjustment) asSourceCodeInterval. + self apply ! ! +!ExtractMethodReplacement methodsFor: 'initialization' stamp: 'HAW 9/4/2021 16:53:14'! + initializeFrom: anIntervalToExtract of: aMethodToExtractCodeFrom to: aNewMessage + + intervalToExtract := anIntervalToExtract. + methodToExtractFrom := aMethodToExtractCodeFrom. + newMessage := aNewMessage. + self initializeCallingExpression ! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/4/2021 16:31:47'! + initializeCallingExpression + + callingExpression := 'self ', self newMessageString. + self shouldBeEnclosedWithParens ifTrue: [ callingExpression := '(' , callingExpression , ')' ] + ! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:06:21'! + newMessageString + + ^ newMessage fullName! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:38:51'! + shouldBeEnclosedWithParens + + | initialNode finalNode parseNodesInCommon methodNode initialNodeAncestors finalNodeAncestors insideMessageNodeExpressions | + + methodNode _ methodToExtractFrom methodNode. + initialNodeAncestors _ methodNode parseNodesPathAt: intervalToExtract first ifAbsent: [ ^ false]. + finalNodeAncestors _ methodNode parseNodesPathAt: intervalToExtract last ifAbsent: [ ^ false ]. + parseNodesInCommon _ initialNodeAncestors intersection: finalNodeAncestors. + + initialNode _ (parseNodesInCommon at: 1 ifAbsent: [ ^ false ]) key. + finalNode _ (parseNodesInCommon at: 2 ifAbsent: [ ^ false ]) key. + insideMessageNodeExpressions _ initialNode isMessageNode and: [ finalNode isMessageNode ]. + + ^ insideMessageNodeExpressions + and: [ initialNode precedence < newMessage selector precedence ] + and: [ initialNode precedence <= finalNode precedence ]! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:38:51'! +sourceClass + + ^ methodToExtractFrom methodClass! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/4/2021 16:37:55'! + updatedSourceCodeOfExistingMethod + + ^ methodToExtractFrom sourceCode + copyReplaceFrom: intervalToExtract first + to: intervalToExtract last + with: callingExpression! ! +!ExtractMethodReplacement methodsFor: 'accessing' stamp: 'HAW 9/2/2021 17:36:44'! + intervalToExtract + + ^intervalToExtract! ! +!ExtractMethodReplacement methodsFor: 'accessing' stamp: 'HAW 9/2/2021 17:38:51'! + methodToExtractFrom + + ^methodToExtractFrom ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 20:28:45'! +isAt: aClass + + ^methodToExtractFrom methodClass = aClass ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 17:02:06'! + isBefore: anExtractMethodReplacement + + ^anExtractMethodReplacement startsAfter: intervalToExtract first! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/2/2021 18:06:56'! + isOf: aMethod + + ^methodToExtractFrom = aMethod ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 17:02:34'! + startsAfter: aPosition + + ^intervalToExtract first > aPosition ! ! +!ExtractMethodReplacement methodsFor: 'adjustment' stamp: 'HAW 9/4/2021 16:50:17'! + adjustmentForNextReplacement + + ^callingExpression size - intervalToExtract size! ! +!ExtractMethodReplacement class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 17:26:03'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage + + | trimmedIntervalToExtract | + + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: aMethodToExtractCodeFrom sourceCode. + self assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: trimmedIntervalToExtract. + + ^ self new + initializeFrom: trimmedIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + ! ! +!ExtractMethodReplacement class methodsFor: 'pre-conditions' stamp: 'HAW 9/5/2021 22:07:25'! + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract + + ExtractMethodNewMethod assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract +! ! +!RefactoringApplier methodsFor: 'refactoring - creation' stamp: 'HAW 8/26/2021 16:06:07'! + createAndSetRefactoringHandlingRefactoringExceptions: aCreatorBlock + + self valueHandlingRefactoringExceptions: [ refactoring := aCreatorBlock value] + ! ! +!ExtractMethodApplier methodsFor: 'initialization' stamp: 'HAW 9/5/2021 22:47:39'! + initializeOn: aCodeProvider for: anIntervalToExtract of: aMethodToExtractCodeFrom + + codeProvider := aCodeProvider. + intervalToExtract := anIntervalToExtract. + methodToExtractCodeFrom := MethodReference method: aMethodToExtractCodeFrom. + newMessageArguments := Dictionary new! ! +!ExtractMethodApplier methodsFor: 'refactoring - changes' stamp: 'HAW 9/5/2021 22:47:43' overrides: 50441450! + showChanges + + codeProvider currentMethodRefactored! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:49' overrides: 50441327! + createRefactoring + + ^ self shouldNotImplement! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:53'! + createRefactoringForMethodsInClass + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder inClassReplacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:57'! + createRefactoringForOriginalSelection + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: { finder originalSelectionReplacement }! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:02'! + createRefactoringForSourceMethod + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder sourceMethodReplacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:06'! + createRefactoringWithAllReplacements + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder replacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:10'! + refactoringClass + + ^ ExtractMethod! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:14'! + createExtractMethodNewMethodFor: newMessage + + ^ newMethodRefactoring := ExtractMethodNewMethod + fromInterval: intervalToExtract + of: methodToExtractCodeFrom + to: newMessage + categorizedAs: methodToExtractCodeFrom category! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:17'! + findReplacementsWith: newMessage + + finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: methodToExtractCodeFrom to: newMessage. + finder value! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:20'! + requestNewMessage + + | parseNodesToParameterize initialAnswer userAnswer | + + parseNodesToParameterize := self parseNodesToParameterize. + initialAnswer := self buildInitialSelectorAnswer: parseNodesToParameterize. + userAnswer := self request: 'New method name:' initialAnswer: initialAnswer. + + parseNodesToParameterize + ifEmpty: [ self saveUnarySelector: userAnswer ] + ifNotEmpty: [ self saveBinaryOrKeywordSelector: userAnswer withArguments: parseNodesToParameterize ]. + + ^self buildNewMessage. + ! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:24' overrides: 50441345! + requestRefactoringParameters + + | newMessage | + + newMessage := self requestNewMessage. + self createExtractMethodNewMethodFor: newMessage. + self findReplacementsWith: newMessage. + + finder hasOneReplacement + ifTrue: [ self valueWithAllReplacements ] + ifFalse: [ ExtractMethodReplacementsWindow openFrom: self with: finder ] + ! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:29'! + buildNewMessage + + ^ Message + selector: newSelector + arguments: self newMessageArgumentNames! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:32'! + newMessageArgumentNames + + ^ newMessageArguments values collect: [ :parseNode | parseNode name ]! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:36'! + saveUnarySelector: userAnswer + + ^ newSelector := userAnswer asSymbol! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:40' overrides: 50441454! + value + + requestExitBlock := [ ^self ]. + + self requestRefactoringParametersHandlingRefactoringExceptions +! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:45'! + valueCreatingWith: aRefactoringCreationBlock + + self + createAndSetRefactoringHandlingRefactoringExceptions: aRefactoringCreationBlock; + applyRefactoring; + showChanges + + ! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:48'! + valueWithAllReplacements + + self valueCreatingWith: [ self createRefactoringWithAllReplacements ] + ! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:51'! + valueWithMethodsInClass + + self valueCreatingWith: [ self createRefactoringForMethodsInClass ]! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:54'! + valueWithOriginalSelection + + self valueCreatingWith: [ self createRefactoringForOriginalSelection ]! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:58'! + valueWithSourceMethod + + self valueCreatingWith: [ self createRefactoringForSourceMethod ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:03'! + buildInitialSelectorAnswer: parseNodesToParameterize + "builds a selector with the shape of #m1 if unary, or #m1: something m2: else if it has args" + + ^ parseNodesToParameterize + ifEmpty: [ self formatAsKeyword: 'm1' ] + ifNotEmpty: [ parseNodesToParameterize + inject: '' + into: [ :partialSelector :parseNode | + | currentKeyword | + currentKeyword _ 'm' , (parseNodesToParameterize indexOf: parseNode) asString , ': '. + partialSelector + , (self formatAsKeyword: currentKeyword) + , (self formatAsMethodArgument: parseNode name) + , String newLineString ] ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:06'! +formatAsKeyword: aKeyword + + ^ Text + string: aKeyword + attributes: (SHTextStylerST80 attributesFor: #patternKeyword)! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:10'! + formatAsMethodArgument: aMethodArgumentName + + ^ Text + string: aMethodArgumentName + attributes: (SHTextStylerST80 attributesFor: #methodArg)! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:13'! + parseNodesToParameterize + + ^ ExtractMethodParametersDetector + valueFor: methodToExtractCodeFrom methodNode + at: intervalToExtract! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:16'! + saveBinaryOrKeywordSelector: userAnswer withArguments: parseNodesToParameterize + + self saveMessageArgumentsForEach: parseNodesToParameterize using: userAnswer. + newSelector := ('' join: (self selectorTokensOf: userAnswer)) asSymbol.! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:20'! + saveMessageArgumentsForEach: parseNodesToParameterize using: userAnswer + + | newSelectorKeywords | + newSelectorKeywords _ self selectorTokensOf: userAnswer. + self validateRequiredParameters: parseNodesToParameterize haveACorrespondingKeywordIn: newSelectorKeywords. + parseNodesToParameterize withIndexDo: [ :parseNode :index | + newMessageArguments at: (newSelectorKeywords at: index) put: parseNode ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:23'! + selectorTokensOf: userAnswer + "this selects the pieces of strings before each $:" + + ^ (userAnswer findTokens: ':') allButLast + collect: [ :tok | (tok findTokens: Character separators) last , ':' ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:26'! + sourceCodeToExtract + + ^sourceCodeToExtract! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:29'! + validateRequiredParameters: parseNodesToParameterize haveACorrespondingKeywordIn: newSelectorKeywords + + newSelectorKeywords size = parseNodesToParameterize size + ifFalse: [ ExtractMethodNewMethod signalExtractMethodWithWrongNumberOfArgumentsError ]! ! +!ExtractMethodApplier class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:47:32'! + on: aCodeProvider for: anIntervalToExtract of: aMethodToRefactor + + | trimmedIntervalToExtract sourceCode | + + sourceCode := aMethodToRefactor sourceCode. + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: sourceCode.. + + self assertCanApplyRefactoringOn: aMethodToRefactor at: trimmedIntervalToExtract. + + ^ self new initializeOn: aCodeProvider for: trimmedIntervalToExtract of: aMethodToRefactor! ! +!ExtractMethodApplier class methodsFor: 'pre-conditions' stamp: 'HAW 9/5/2021 22:47:27'! + assertCanApplyRefactoringOn: aMethodToRefactor at: anIntervalToExtract + + ExtractMethodNewMethod + assertCanApplyRefactoringOn: aMethodToRefactor + at: anIntervalToExtract! ! +!SmalltalkEditor methodsFor: 'extract method' stamp: 'HAW 9/5/2021 20:36:00' prior: 50517563! + extractMethod + + self performCodeExtractionRefactoringWith: ExtractMethodApplier! ! +!ChangeSelectorWizardStepWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 20:07:07' prior: 50438289! + createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! +!AddInstanceVariable methodsFor: 'initialization' stamp: 'HAW 8/28/2021 17:44:36' prior: 50438540! + initializeNamed: aNewVariable to: aClassToRefactor + + newVariable := aNewVariable. + classToRefactor := aClassToRefactor ! ! +!RefactoringApplier methodsFor: 'refactoring - creation' stamp: 'HAW 8/26/2021 16:04:27' prior: 50441332! + createRefactoringHandlingRefactoringExceptions + + self createAndSetRefactoringHandlingRefactoringExceptions: [ self createRefactoring ] + ! ! +!SourceCodeIntervalPrecondition methodsFor: 'pre-conditions' stamp: 'HAW 8/26/2021 15:57:31' prior: 50529604! + assertSourceCodeIsNotPartOfMethodSignature + + self intervalToExtractIncludesPartOfMethodSignature + ifTrue: [ self signalExtractingPartOfMethodSignatureError ]! ! +!SourceCodeIntervalPrecondition methodsFor: 'private' stamp: 'HAW 8/26/2021 15:56:33' prior: 50529658! + methodDefinitionStartPosition + + ^methodNode definitionStartPosition! ! +!MethodReference methodsFor: 'decompiling' stamp: 'HAW 9/5/2021 23:06:10'! + methodNode + + ^self compiledMethod methodNode! ! +!CompiledMethod methodsFor: 'converting' stamp: 'HAW 9/5/2021 23:06:10'! + asMethodReference + + ^MethodReference method: self! ! + +SourceCodeIntervalPrecondition removeSelector: #firstParseNodeOfMethodDefinition! + +!methodRemoval: SourceCodeIntervalPrecondition #firstParseNodeOfMethodDefinition stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +firstParseNodeOfMethodDefinition + + ^ methodNode hasTemporaryVariables + ifTrue: [ methodNode temporariesDeclaration ] + ifFalse: [ methodNode block statements first + ifNotNil: [ :statement | statement ] + ifNil: [ methodNode ] ]! + +ChangeSelectorWizardStepWindow removeSelector: #isMessageSelected! + +!methodRemoval: ChangeSelectorWizardStepWindow #isMessageSelected stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:09'! +isMessageSelected + + ^model isNil ifTrue: [ false ] ifFalse: [ model selection notNil ]! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4853] on 7 September 2021 at 12:53:40 pm'! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2021 12:52:43' prior: 50605756! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 9) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1 by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atCenterXBaselineY: x @ (tickLength*2) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1 by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaist: tickLength @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4854-drawCoordinates-tweak-JuanVuletich-2021Sep07-12h50m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4854] on 9 September 2021 at 2:05:28 pm'! +!BitBltBoundsFinderCanvas methodsFor: 'morphic' stamp: 'jmv 9/9/2021 14:05:20' prior: 50595329! + updateBoundsIn: aWorldMorph addDamageTo: aDamageRecorder + + aWorldMorph haloMorphsDo: [ :halo | + (halo target isRedrawNeeded or: [halo target isSubmorphRedrawNeeded]) ifTrue: [ + "Invalidation of halos requires this specific sequence:" + halo redrawNeeded. "invalidate old halo bounds" + self fullAddRedrawRect: halo target to: aDamageRecorder. "recompute & invalidate target bounds" + self fullAddRedrawRect: halo to: aDamageRecorder ]]. "recompute & invalidate halo bounds" + "bogus iteration on halos and targets below is harmless: + Both now marked as neither #isRedrawNeeded nor #isSubmorphRedrawNeeded." + + aWorldMorph submorphsDo: [ :morph | + self fullAddRedrawRect: morph to: aDamageRecorder ]. + self updateHandsDisplayBounds: aWorldMorph.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4855-BoundsFinder-fix-JuanVuletich-2021Sep09-14h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4855] on 10 September 2021 at 4:10:30 pm'! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:02:58'! + turnMouseButton2Into3 + "Answer true if modifier keys are such that button 2 should be considered as button 3. + ctrl - click right -> center click + " + + self controlKeyPressed ifTrue: [ ^ true ]. + ^ false! ! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:08:01' prior: 50467593! + mouseButton2Pressed + "Answer true if the mouseButton2 is being pressed. + Reported by the VM for right mouse button or option+click on the Mac, ctrl-click on Windows, or ctrl-click or alt-click on Linux. + It is also emulated here with ctrl-click on any platform." + + (self turnMouseButton1Into2 and: [ buttons anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + self turnMouseButton2Into3 ifTrue: [ ^ false ]. + ^ buttons anyMask: InputSensor mouseButton2! ! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:06:43' prior: 50467609! + mouseButton3Pressed + "Answer true if the mouseButton3 is being pressed. + Reported by the VM for center (wheel) mouse button or cmd+click on the Mac or win/meta+click on Windows and Linux. + It is also emulated here with on any platform with: + shift - ctrl - click + ctrl - rightClick" + + (self turnMouseButton1Into3 and: [ buttons anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + (self turnMouseButton2Into3 and: [ buttons anyMask: InputSensor mouseButton2 ]) + ifTrue: [ ^ true ]. + ^ buttons anyMask: InputSensor mouseButton3! ! +!MouseButtonEvent methodsFor: 'accessing' stamp: 'jmv 9/10/2021 16:09:10' prior: 50467646! + mouseButton2Changed + "Answer true if the mouseButton2 has changed. + Reported by the VM for right mouse button or option+click on the Mac. + It is also emulated here with ctrl-click on any platform. + The check for button change (instead of button press) is specially useful on buttonUp events." + + (self turnMouseButton1Into2 and: [ whichButton anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + self turnMouseButton2Into3 ifTrue: [ ^ false ]. + ^ whichButton anyMask: InputSensor mouseButton2! ! +!MouseButtonEvent methodsFor: 'accessing' stamp: 'jmv 9/10/2021 16:07:19' prior: 50467663! + mouseButton3Changed + "Answer true if the mouseButton3 has changed. + Reported by the VM for center (wheel) mouse button or cmd+click on the Mac or meta+click on Linux. + It is also emulated here with shift-ctrl-click or ctrl-rightClick on any platform. + The check for button change (instead of button press) is specially useful on buttonUp events." + + (self turnMouseButton1Into3 and: [ whichButton anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + (self turnMouseButton2Into3 and: [ whichButton anyMask: InputSensor mouseButton2 ]) + ifTrue: [ ^ true ]. + ^ whichButton anyMask: InputSensor mouseButton3! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4856-ctrl-rightClick-emulatesCenterClick-JuanVuletich-2021Sep10-16h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4856] on 13 September 2021 at 3:51:30 pm'! +!ScrollBar methodsFor: 'events' stamp: 'jmv 9/13/2021 15:51:20' prior: 16904535 overrides: 16874668! + mouseStillDown + + nextPageDirection notNil ifTrue: [ + self scrollByPage ]! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4857-AvoidWalkbackOnLost-mouseDown-JuanVuletich-2021Sep13-15h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4856] on 13 September 2021 at 4:08:19 pm'! +!WorldMorph methodsFor: 'canvas' stamp: 'jmv 9/13/2021 16:07:58' prior: 50603064! + setMainCanvas + "Deallocate before allocating could mean less memory stress." + + self clearCanvas. + self setCanvas: Display getMainCanvas. + self restoreDisplay.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/13/2021 16:03:02' prior: 50604399! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + self clearCanvas. + DisplayScreen startUp. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4858-MainWindowResizeCleanup-JuanVuletich-2021Sep13-15h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4858] on 14 September 2021 at 3:57:49 pm'! +!WidgetMorph methodsFor: 'drawing' stamp: 'jmv 9/13/2021 17:26:04' overrides: 50578084! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + auxCanvas _ MorphicCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! +!Morph methodsFor: 'drawing' stamp: 'jmv 9/13/2021 17:26:23' prior: 50578084! + imageForm: extentOrNil depth: depth + + self subclassResponsibility! ! + +MovableMorph removeSelector: #privateLocation:! + +!methodRemoval: MovableMorph #privateLocation: stamp: 'Install-4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st 9/21/2021 12:54:09'! +privateLocation: aGeometryTransformation + location _ aGeometryTransformation.! + +Morph removeSelector: #privateLocation:! + +!methodRemoval: Morph #privateLocation: stamp: 'Install-4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st 9/21/2021 12:54:09'! +privateLocation: aGeometryTransformation! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4859] on 14 September 2021 at 4:21:17 pm'! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 9/14/2021 16:20:04' prior: 16835206! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:. + + If for whatever reason, actual OS or hardware Display is smaller than us, don't go outside its bounds. + This can sometimes happen, at least on MacOS, when frantically resizing the main OS Cuis window, + while Morphic is busy drawing many heavy morphs: it could be observed than apparently in #displayWorld, + after we were updated in #checkForNewScreenSize, MacOS window could be made smaller than aRectangle, + and a hard crash due to an invalid memory access happened in this primitive." + + | platformDisplayExtent | + platformDisplayExtent _ DisplayScreen actualScreenSize. + self primShowRectLeft: (aRectangle left max: 0) + right: (aRectangle right min: platformDisplayExtent x) + top: (aRectangle top max: 0) + bottom: (aRectangle bottom min: platformDisplayExtent y). +! ! +!WorldMorph methodsFor: 'drawing' stamp: 'jmv 9/14/2021 16:20:41' prior: 50551876! + displayWorld + "Update this world's display." + + | deferredUpdateVMMode worldDamageRects handsToDraw allDamage | + self checkIfUpdateNeeded ifFalse: [ ^ self ]. "display is already up-to-date" + "I (jmv) removed the call to 'deferUpdates: false' below. No more need to call this every time." + deferredUpdateVMMode _ self tryDeferredUpdatingAndSetCanvas. + + "repair world's damage on canvas" + worldDamageRects _ canvas drawWorld: self repair: damageRecorder. + + "Check which hands need to be drawn (they are not the hardware mouse pointer)" + handsToDraw _ self selectHandsToDrawForDamage: worldDamageRects. + allDamage _ Array streamContents: [ :strm | + strm nextPutAll: worldDamageRects. + handsToDraw do: [ :h | + h savePatchFrom: canvas appendDamageTo: strm ]]. + + "Draw hands (usually carying morphs) onto world canvas" + canvas newClipRect: nil. + handsToDraw reverseDo: [ :h | canvas fullDrawHand: h ]. + + "quickly copy altered rects of canvas to Display:" + deferredUpdateVMMode ifFalse: [ + "Drawing was done to off-Display canvas. Copy content to Display" + canvas showAt: self viewBox origin invalidRects: allDamage ]. + + "Display deferUpdates: false." + "Display forceDisplayUpdate" + DisplayScreen isDisplayExtentOk ifTrue: [ + Display forceDamageToScreen: allDamage ]. + + "Restore world canvas under hands and their carried morphs" + handsToDraw do: [ :h | h restoreSavedPatchOn: canvas ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4860-fixUnlikelyCrashOnMainWindowResize-JuanVuletich-2021Sep14-16h15m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4860] on 15 September 2021 at 9:48:57 am'! +!GeometryTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:16:54'! + invertingYAxis: mustInvertYAxis + "Answer an instance (either the receiver or a new one) with the prescribed behavior on the Y axis: + - If mustInvertYAxis, the Y axis in inner and outer space point in opposite directions. + - If mustInvertYAxis is false, the Y axis in inner and outer space point in the same direction (either up or down). + Senders should always use the returned object, but not assume it is a new one: + it could also be the receiver itself." + + self doesMirror = mustInvertYAxis ifFalse: [ + ^self withCurrentYAxisInverted ]. + ^self! ! +!GeometryTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:15:52'! + withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one: + it could also be the receiver itself." + + self subclassResponsibility! ! +!AffineTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:15:58' overrides: 50607686! + withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one (like for MorphicTranslation): + it could also be the receiver itself, like when the receiver is already a AffineTransformation." + + self a12: self a12 negated. + self a22: self a22 negated. + ^self! ! +!MorphicTranslation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:16:01' overrides: 50607686! +withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one (like here): + it could also be the receiver itself, like when the receiver is already a AffineTransformation." + + ^(AffineTransformation withTranslation: self translation) withCurrentYAxisInverted! ! +!MovableMorph methodsFor: 'geometry testing' stamp: 'jmv 9/14/2021 18:21:50'! + yAxisPointsUp + "By default, most morphs assume the usual convention in 2d computer graphics: + - x points to the right (i.e. increasing x values move from left to right) + - y points down (i.e. increasing y values move from top to bottom) + Subclasses wanting to follow the standard math convention, making increasing y values move upwards + should redefine this method to answer true." + + ^false! ! +!MovableMorph methodsFor: 'private' stamp: 'jmv 9/14/2021 18:24:55'! + fixYAxisDirection + "Ensure the direction of the Y axis used by our location for coordinate transformations matches our #yAxisPointsUp." + + | ownersYAxisPointsUp | + ownersYAxisPointsUp _ owner ifNil: [false] ifNotNil: [owner yAxisPointsUp]. + location _ location invertingYAxis: (self yAxisPointsUp = ownersYAxisPointsUp) not! ! +!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 9/14/2021 18:58:27'! + drawString: s atWaistCenter: pt font: fontOrNil color: aColor + "Answer position to place next glyph + Answer nil if nothing was done" + + | font dy | + font _ self fontToUse: fontOrNil. + dy _ currentTransformation doesMirror + ifFalse: [ font ascent * 0.4 ] + ifTrue: [ font ascent * -0.4 ]. + ^self + drawString: s + from: 1 to: s size + atBaseline: pt + ((font widthOfString: s) negated / 2 @ dy) + font: font color: aColor! ! +!GeometryTransformation methodsFor: 'testing' stamp: 'jmv 9/13/2021 17:01:20' prior: 50560741! + doesMirror + "Return true if the receiver mirrors points around some rect. + Usually this is interpreted as (and used for) inverting the direction of the Y axis between the inner and the outer coordinates systems." + + ^false! ! +!AffineTransformation methodsFor: 'testing' stamp: 'jmv 9/13/2021 17:01:13' prior: 50560747 overrides: 50607785! + doesMirror + "Return true if the receiver mirrors points around some rect. + Usually this is interpreted as (and used for) inverting the direction of the Y axis between the inner and the outer coordinates systems." + + | f | + f _ self a11 * self a22. + ^ f = 0.0 + ifTrue: [ self a12 * self a21 > 0.0] + ifFalse: [ f < 0.0 ]! ! +!MovableMorph methodsFor: 'accessing' stamp: 'jmv 9/14/2021 18:27:26' prior: 50576101 overrides: 50559666! + location: aGeometryTransformation + location _ aGeometryTransformation. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self fixYAxisDirection. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'geometry' stamp: 'jmv 9/15/2021 09:45:04' prior: 50554261! + rotateBy: radians + "Change the rotation of this morph. Argument is an angle (possibly negative), to be added to current rotation." + + | r | + r _ self yAxisPointsUp ifTrue: [ radians negated ] ifFalse: [ radians ]. + location _ location rotatedBy: r. + self fixYAxisDirection. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'geometry' stamp: 'jmv 9/15/2021 09:44:18' prior: 50554280 overrides: 50554557! + rotation: radians scale: scale + "Change the rotation and scale of this morph. Arguments are an angle and a scale." + + | r | + r _ self yAxisPointsUp ifTrue: [ radians negated ] ifFalse: [ radians ]. + location _ location withRotation: r scale: scale. + self fixYAxisDirection. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'private' stamp: 'jmv 9/14/2021 18:26:53' prior: 50554394 overrides: 50590088! + privateOwner: aMorph + "Private!! Should only be used by methods that maintain the ower/submorph invariant." + + | oldGlobalPosition prevOwner | + + self flag: #jmvVer2. + "Is this the best behavior???" + prevOwner _ owner. + prevOwner + ifNotNil: [ + "Had an owner. Maintain my global position..." + oldGlobalPosition _ self morphPositionInWorld ]. + owner _ aMorph. + owner + ifNil: [ + "Won't have any owner. Keep local position, as it will be maintained in my new owner later" + ] + ifNotNil: [ + prevOwner + ifNil: [ + "Didn't have any owner. Assume my local position is to be maintained in my new owner" + ] + ifNotNil: [ + "Had an owner. Maintain my global position..." + location _ location withTranslation: (owner internalizeFromWorld: oldGlobalPosition). + self flag: #jmvVer2. + "extent _ owner internalizeDistanceFromWorld: oldGlobalExtent" "or something like this!!" + ]]. + self fixYAxisDirection.! ! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/14/2021 18:59:01' prior: 50607278! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 9) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1 by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atWaistCenter: x @ (tickLength*4) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1 by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaist: tickLength @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/15/2021 09:46:28' prior: 50576109! + doRot: evt with: rotHandle + "Update the rotation of my target if it is rotatable." + + | radians prevLocation deltaRadians | + evt hand obtainHalo: self. + radians _ (evt eventPosition - target referencePosition) theta + angleOffset. + radians _ radians detentBy: 0.05 atMultiplesOf: Float pi / 4 snap: false. + rotHandle color: (radians = 0.0 + ifTrue: [`Color lightBlue`] + ifFalse: [`Color blue`]). + rotHandle submorphsDo: [ :m | + m color: rotHandle color makeForegroundColor]. + prevLocation _ target location. + deltaRadians _ radians-prevLocation radians. + target yAxisPointsUp ifTrue: [ deltaRadians _ deltaRadians negated ]. + target location: (prevLocation composedWith: ( + AffineTransformation withRadians: deltaRadians around: target rotationCenter)). + rotHandle morphPositionInWorld: evt eventPosition - (rotHandle morphExtent // 2). + self redrawNeeded.! ! +!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 9/14/2021 19:00:41' prior: 50565954! + drawString: aString from: firstIndex to: lastIndex atWaist: aPoint font: font color: aColor + "Answer position to place next glyph + Answer nil if nothing was done" + + | dy | + dy _ currentTransformation doesMirror + ifFalse: [ font ascent * 0.4 ] + ifTrue: [ font ascent * -0.4 ]. + ^self drawString: aString from: firstIndex to: lastIndex + atBaseline: aPoint + (0 @ dy) + font: font color: aColor! ! + +MorphicTranslation removeSelector: #withYAxisNegated! + +!methodRemoval: MorphicTranslation #withYAxisNegated stamp: 'Install-4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st 9/21/2021 12:54:09'! +withYAxisNegated + "Swap inneer point Y sign. + Make y increment upwards. + This makes the any matrix transform from standard mathematical coordinates + to standard display coordinates (in addition to the transform it was already doing) + + Answer the modified object. In this implementation this requires the creation of a new, more general instance. + Senders should always use the returned object, but not assume it is a new one: it could also be the receiver itself, + as if the receiver is already a AffineTransformation." + + ^(AffineTransformation withTranslation: self translation) withYAxisNegated! + +AffineTransformation removeSelector: #withYAxisNegated! + +!methodRemoval: AffineTransformation #withYAxisNegated stamp: 'Install-4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st 9/21/2021 12:54:09'! +withYAxisNegated + "Swap inneer point Y sign. + Make y increment upwards. + This makes the any matrix transform from standard mathematical coordinates + to standard display coordinates (in addition to the transform it was already doing) + + Answer the modified object. In this implementation it is self, but some classes of transformations, + more restricted ones (like MorphicTranslation) could require the creation of a new, more general instance. + Senders should always use the returned object, but not assume it is a new one: it could also be the receiver itself." + + self a12: self a12 negated. + self a22: self a22 negated. + ^self! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4861] on 15 September 2021 at 9:07:29 am'! +!WidgetMorph methodsFor: 'drawing' stamp: 'jmv 9/15/2021 08:48:04' prior: 50607529 overrides: 50607548! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + "To avoid slower Smalltalk VG engine just because of window decorations" + auxCanvas _ BitBltCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4862-imageForm-use-BitBltCanvas-JuanVuletich-2021Sep15-09h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4862] on 16 September 2021 at 11:30:30 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/16/2021 11:22:16'! + setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk garbageCollect ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 9/16/2021 10:58:07' prior: 50607577! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:. + + If for whatever reason, actual OS or hardware Display is smaller than us, don't go outside its bounds. + This can sometimes happen, at least on MacOS, when frantically resizing the main OS Cuis window, + while Morphic is busy drawing many heavy morphs: it could be observed than apparently in #displayWorld, + after we were updated in #checkForNewScreenSize, MacOS window could be made smaller than aRectangle, + and a hard crash due to an invalid memory access happened in this primitive. + + Protecting against our bounds being smaller than aRectangle is done in the primitive. No need to do it here." + + | platformDisplayExtent | + platformDisplayExtent _ DisplayScreen actualScreenSize. + self primShowRectLeft: (aRectangle left max: 0) + right: (aRectangle right min: platformDisplayExtent x) + top: (aRectangle top max: 0) + bottom: (aRectangle bottom min: platformDisplayExtent y). +! ! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/16/2021 11:22:01' prior: 50571531 overrides: 50335344! + startUp + " + DisplayScreen startUp. + Display forceToScreen. + " + self setupDisplay: false.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/16/2021 11:25:32' prior: 50607509! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + "Minimize the risk of going out of memory: + - First clear existing canvas, to free the memory it uses. + - Then, setup the display, with a GarbageCollection prior to allocating new display memory. + - Then set up new canvas." + self clearCanvas. + DisplayScreen setupDisplay: true. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4863-GarbabeCollectDuringDisplayResize-JuanVuletich-2021Sep16-11h28m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:28:36 pm'! +!LargeNegativeInteger methodsFor: 'printing' stamp: 'jmv 9/16/2021 14:27:54' overrides: 16862727! + printOn: aStream base: b nDigits: n + "See comment at LargePositiveInteger." + + self shouldNotImplement.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4864-printOnbasenDigits-notAppropriateFor-LargeNegativeInteger-JuanVuletich-2021Sep16-14h27m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:33:13 pm'! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:32:50'! + millisecondsToRun + "Answer the number of milliseconds taken to execute this block." + + ^ Time millisecondsToRun: self +! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4865-millisecondsToRun-JuanVuletich-2021Sep16-14h28m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:36:00 pm'! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:34:45'! + millisecondsToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(Smalltalk vmParameterAt: 8) + + (Smalltalk vmParameterAt: 10) + + self millisecondsToRun - + (Smalltalk vmParameterAt: 8) - + (Smalltalk vmParameterAt: 10) +! ! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:34:26' prior: 16787872! + durationToRun + "Answer the duration taken to execute this block." + + ^ Duration milliSeconds: self millisecondsToRun.! ! +!TestCase methodsFor: 'assertions' stamp: 'jmv 9/16/2021 14:35:21' prior: 50458978! + should: aClosure notTakeMoreThan: aLimit + + | millisecondsLimit | + + millisecondsLimit := aLimit totalMilliseconds. + self assert: aClosure millisecondsToRun <= millisecondsLimit + description: [ 'Took more than ', millisecondsLimit printString, ' milliseconds' ].! ! + +BlockClosure removeSelector: #timeToRunWithoutGC! + +!methodRemoval: BlockClosure #timeToRunWithoutGC stamp: 'Install-4866-prefer-millisecondsToRun-over-timeToRun-JuanVuletich-2021Sep16-14h33m-jmv.001.cs.st 9/21/2021 12:54:09'! +timeToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(Smalltalk vmParameterAt: 8) + + (Smalltalk vmParameterAt: 10) + + self timeToRun - + (Smalltalk vmParameterAt: 8) - + (Smalltalk vmParameterAt: 10) +! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4866-prefer-millisecondsToRun-over-timeToRun-JuanVuletich-2021Sep16-14h33m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4866] on 17 September 2021 at 10:22:21 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/17/2021 10:21:57' prior: 50608085! + setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk primitiveGarbageCollect. ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4867-just-primitiveGarbageCollect-onDisplaySetup-JuanVuletich-2021Sep17-10h21m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4866] on 17 September 2021 at 10:58:32 am'! +!PasteUpMorph methodsFor: 'misc' stamp: 'jmv 9/17/2021 10:58:19' prior: 50572278! + buildMagnifiedBackgroundImage + | image | + backgroundImageData + ifNil: [ backgroundImage _ nil ] + ifNotNil: [ + [ + backgroundImage _ nil. + Smalltalk primitiveGarbageCollect. + image _ Form fromBinaryStream: backgroundImageData readStream. + backgroundImage _ image magnifyTo: extent. + backgroundImage _ backgroundImage orderedDither32To16 asColorFormOfDepth: 8. + image _ nil. + Smalltalk primitiveGarbageCollect. + backgroundImage bits pin. + ] on: Error do: [backgroundImage := nil]. "Can happen if JPEG plugin not built" + self redrawNeeded + ]! ! + +"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." +self runningWorld color: (Color fromHexString: '#214A8C') lighter.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4868-disableDesktopBackground-JuanVuletich-2021Sep17-10h39m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4868] on 20 September 2021 at 3:34:52 pm'! +!Morph methodsFor: 'change reporting' stamp: 'jmv 9/20/2021 12:32:14' prior: 50567572! + invalidateDisplayRect: damageRect for: aMorph + " + If we clip submorphs, then we clip damageRect. + + aMorph is the morph that changed and therefore should be redrawn. In some cases, damage reporting is done by no longer occupying some area, and requesting whatever appropriate morph to be drawn there. In such cases, aMorph should be nil. See senders." + + | clippedRect b | + self visible ifFalse: [ ^self]. + + clippedRect _ damageRect. + aMorph == self ifFalse: [ + self clipsSubmorphsReally ifTrue: [ + b _ self displayBounds. + b ifNil: [ ^self ]. + clippedRect _ damageRect intersect: b ]]. + owner ifNotNil: [ + owner invalidateDisplayRect: clippedRect for: aMorph ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4869-Transcript-artifactsInVG-fix-JuanVuletich-2021Sep20-15h34m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4869] on 21 September 2021 at 9:53:48 am'! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:32'! +fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^true ]. + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^true ]]. + ^ false.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:50:59'! + isCloserThan: maxDistance toPixel: worldPoint + "Answer true if our closest point to aPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + Uses precise testing of the morph contour if available: + Morphs not in the WidgetMorph hierarchy should answer #true to wantsContour. + Note: Considers only the external border. Any inner pixel is considered 'inside' regardless of us being transparent there. + Note: Cheaper than #coversAnyPixelCloserThan:to: . Doesn't use #bitMask. Doesn't require maintenance." + + | center contourTop contourBottom | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - worldPoint y) abs < (privateDisplayBounds height // 2 + maxDistance) ifFalse: [ + ^false ]. + (center x - worldPoint x) abs < (privateDisplayBounds width // 2 + maxDistance) ifFalse: [ + ^false ]. + "Precise check with contour, if available" + (self valueOfProperty: #contour) ifNotNil: [ :contour | | y0 y1 x0 x1 | + contourTop _ self valueOfProperty: #contourY0. + contourBottom _ self valueOfProperty: #contourY1. + "Contour rows to consider are those within requested distance." + y0 _ worldPoint y - maxDistance max: contourTop. + y1 _ worldPoint y + maxDistance min: contourBottom. + y0 to: y1 do: [ :y | + x0 _ (contour at: (y - contourTop) * 2 + 1) - maxDistance. + x1 _ (contour at: (y - contourTop) * 2 + 2) + maxDistance. + "If a vertical line of 2*aNumber height centered on aPoint is inside the contour, quick exit" + (worldPoint x between: x0 and: x1) ifTrue: [ ^true ]. + "Check if aPoint is close enough to contour" + (x0@y - worldPoint) r < maxDistance ifTrue: [ ^true ]. + (x1@y - worldPoint) r < maxDistance ifTrue: [ ^true ]]. + "Not inside, not close enough to contour" + ^ false ]. + "If contour is not available, and aPoint is close enough to displayBounds, answer true, as it is the best we can know." + ^ true! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:33:07'! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + Some implementations (KernelMorph and WidgetMorph) may also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for VectorGraphics based morphs (i.e. morphs that answer true to #requiresVectorCanvas). + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self ownsPixel: worldPoint.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:12:00'! + ownsPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + Requires VectorGraphics. + Only valid for morphs that answer true to #requiresVectorCanvas" + + self topmostWorld ifNotNil: [ :w | + w canvas ifNotNil: [ :canvas | + ^ (canvas morphIdAt: worldPoint) = self morphId ]]. + ^ false.! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:25:55'! + coversLocalPoint: aLocalPoint + "Answer true as long as aLocalPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it." + + "If not visible, won't cover any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:36:45'! + coversPixel: worldPoint + "Answer true as long as worldPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it. + This implementation is cheap, we are a rectangular shape." + + ^ self coversLocalPoint: + (self internalizeFromWorld: worldPoint)! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:36' overrides: 50608350! + fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]. + self submorphsMightProtrude ifTrue: [ + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]]]. + ^ false.! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:35:38' overrides: 50608428! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + This implementation also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for morphs with a cheap #coversPixel:. + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self visible and: [self coversPixel: worldPoint].! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:26:19'! + coversLocalPoint: aLocalPoint + "Answer true as long as aLocalPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it." + + "If not visible, won't cover any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:36:52'! + coversPixel: worldPoint + "Answer true as long as worldPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it. + This implementation is cheap, we are a rectangular shape." + + ^ self coversLocalPoint: + (self internalizeFromWorld: worldPoint)! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:41' overrides: 50608350! + fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]. + self submorphsMightProtrude ifTrue: [ + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]]]. + ^ false.! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:35:48' overrides: 50608428! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + This implementation also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for morphs with a cheap #coversPixel:. + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self visible and: [self coversPixel: worldPoint].! ! +!WindowEdgeAdjustingMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:30:16' overrides: 50608531! + coversLocalPoint: aLocalPoint + "We don't completely cover our bounds. Account for that." + + | sensitiveBorder | + ( self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [ ^false ]. + sensitiveBorder _ owner borderWidth. + selector caseOf: { + [ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]]. + [ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]]. + } + otherwise: [ + "all the morph is sensitive for horizontal and vertical (i.e. non corner) instances." + ^true ]! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 9/20/2021 12:13:48' prior: 50562667! + 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 fullOwnsOrCoversPixel: 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 ].! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:53:20' prior: 50593328! + contourIntersects: aContourArray top: aContourTop bottom: aContourBottom + "Check if contours intersect. + If contour is not available, use displayBounds. + Not to be called directly. Pefer a higher level service. See senders." + + | contour contourTop contourBottom x0Own x1Own x0Arg x1Arg | + contour _ self valueOfProperty: #contour. + contourTop _ (self valueOfProperty: #contourY0) ifNil: [aContourTop]. + contourBottom _ (self valueOfProperty: #contourY1) ifNil: [aContourBottom]. + + (contourTop max: aContourTop) to: (contourBottom min: aContourBottom) do: [ :y | + x0Own _ contour ifNil: [privateDisplayBounds left] ifNotNil: [ contour at: (y - contourTop) * 2 + 1 ]. + x1Own _ contour ifNil: [privateDisplayBounds right-1] ifNotNil: [ contour at: (y - contourTop) * 2 + 2 ]. + x0Arg _ aContourArray at: (y - aContourTop) * 2 + 1. + x1Arg _ aContourArray at: (y - aContourTop) * 2 + 2. + (x0Own <= x1Arg and: [ x0Arg <= x1Own ]) + ifTrue: [ ^true ]]. + + ^false! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:51:06'! + coversAnyPixelCloserThan: maxDistance to: worldPoint + "Answer true if our closest point to worldPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + See #bitMask. + Remember to do + self removeProperty: #bitMask. + when appropriate!! (i.e. when we change in such a way to make the bitMask invalid). + + Note: Requires VectorGraphics. Meant to be used only when needed. + Note: Prefer #isCloserThan:toPixel:, that doesn't use #bitMask, and doesn't require maintenance." + + | center maxDistanceSquared | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - worldPoint y) abs < (privateDisplayBounds height // 2 + maxDistance) ifFalse: [ + ^false ]. + (center x - worldPoint x) abs < (privateDisplayBounds width // 2 + maxDistance) ifFalse: [ + ^false ]. + "Precise check with bitMask" + (self coversPixel: worldPoint) ifTrue: [ ^true ]. + maxDistanceSquared _ maxDistance squared. + maxDistance negated to: maxDistance do: [ :dy | + maxDistance negated to: maxDistance do: [ :dx | + dx squared + dy squared <= maxDistanceSquared ifTrue: [ + (self coversPixel: worldPoint + (dx@dy)) ifTrue: [ ^true ]]]]. + ^false.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:38:06'! + coversPixel: worldPoint + "Answer true if pixel worldPoint is covered by us, even if we are not visible a it because of some + other morph above us also covers it. + See #bitMask. + Remember to do + self removeProperty: #bitMask. + when appropriate!! (i.e. when we change in such a way to make the bitMask invalid). + + Note: Subclasses such as KernelMorph and WidgetMorph redefine this method with an optimized + implementation that doesn't require computing and invalidating the #bitMask. Senders in the base image + and framework actually only use this optimized implementation. That's why general morphs don't care about + invalidting #bitMask. + + Note: If your morph #requiresVectorCanvas, and depends on this general implementation, remember to + `removeProperty: #bitMask` whenever it becomes invalid due to changes in your morphs. You may consider + using #ownsPixel: if appropriate, that doesn't require any maintenance and is cheaper (in cpu and memory). + + Note: This implementation requires VectorGraphics." + + self visible ifTrue: [ + ^(self bitMask pixelValueAt: worldPoint - self displayFullBounds topLeft) = 1 ]. + ^ false! ! +!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 9/20/2021 12:13:54' prior: 50567110! + transferHalo: event from: formerHaloOwner + "Progressively transfer the halo to the next likely recipient" + + formerHaloOwner == self + ifFalse: [ + self addHalo: event. + ^self ]. + + event shiftPressed ifTrue: [ + "Pass it outwards" + owner ifNotNil: [ + owner transferHalo: event from: formerHaloOwner. + ^self ]. + "We're at the top level; just keep it on ourselves" + ^self ]. + + self submorphsDo: [ :m | + (m wantsHalo and: [ m fullOwnsOrCoversPixel: event eventPosition ]) + ifTrue: [ + m transferHalo: event from: formerHaloOwner. + ^self ]]. + "We're at the bottom most level; just keep halo on ourselves"! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/20/2021 11:32:25' prior: 50562477! + 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 coversPixel: 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 9/20/2021 11:32:30' prior: 50567233! + maybeCollapse: event with: aHandle + "Ask hand to collapse my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle coversPixel: event eventPosition) + ifTrue: [ + target collapse ]. + self delete.! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/20/2021 11:32:34' prior: 50562502! + maybeDismiss: event with: aHandle + "Ask hand to dismiss my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle coversPixel: 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 9/20/2021 11:32:38' prior: 50562520! + setDismissColor: event with: aHandle + "Called on mouseStillDown in the dismiss handle; set the color appropriately." + + | colorToUse | + event hand obtainHalo: self. + colorToUse _ (aHandle coversPixel: event eventPosition) + ifFalse: [ `Color red muchLighter` ] + ifTrue: [ `Color lightGray` ]. + aHandle color: colorToUse! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:44' prior: 50562564! + activateOwnerMenu: evt + "Activate our owner menu; e.g., pass control to it" + owner ifNil: [ ^false ]. "not applicable" + (owner coversPixel: evt eventPosition) + ifFalse: [ ^false ]. + owner activate: evt. + ^true! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:47' prior: 50565627! + activateSubmenu: event + "Activate our submenu; e.g., pass control to it" + + subMenu ifNil: [ ^false ]. "not applicable" + subMenu isInWorld ifFalse: [ ^false ]. + (subMenu coversPixel: event eventPosition) ifFalse: [^false]. + subMenu activate: event. + ^true! ! +!PluggableButtonMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:53' prior: 50562585 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + isPressed _ false. + mouseIsOver _ false. + (actWhen == #buttonUp and: [ + self coversPixel: aMouseButtonEvent eventPosition ]) + ifTrue: [ self performAction ]. + self redrawNeeded! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:36:05' prior: 50574679 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + (stayUp or: [ self coversPixel: aMouseButtonEvent eventPosition ]) + ifFalse: [ + self deleteIfPopUp: aMouseButtonEvent. + self activeHand + newKeyboardFocus: prevKbdFocus; + newMouseFocus: prevMouseFocus. + ^ self ]. "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 9/20/2021 11:36:32' prior: 50574703 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse up event. + Note: This might be sent from a modal shell." + (self coversPixel: aMouseButtonEvent eventPosition) ifFalse:[ + "Mouse up outside. Release eventual focus and delete if pop up." + aMouseButtonEvent hand ifNotNil: [ :h | h releaseMouseFocus: self ]. + self deleteIfPopUp: aMouseButtonEvent. + self activeHand + newKeyboardFocus: prevKbdFocus; + newMouseFocus: prevMouseFocus. + ^ self]. + stayUp ifFalse: [ + "Still in pop-up transition; keep focus" + aMouseButtonEvent hand newMouseFocus: self ].! ! +!AutoCompleterMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:58' prior: 50562597 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + (self coversPixel: 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 ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:09' prior: 50563868! + 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 fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:16' prior: 50563896 overrides: 50608949! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + | dropped | + + "Try to get out quickly" + (aMorph fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: 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 9/20/2021 12:14:23' prior: 50563923 overrides: 50608949! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + + "Try to get out quickly" + (aMorph fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 9/20/2021 11:33:02' prior: 50562828! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w coversPixel: position) + ifTrue: [ w delete ] ].! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:44' prior: 50563942 overrides: 50608949! + 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 fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: 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 9/20/2021 12:14:35' prior: 50598417 overrides: 50608949! + 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 | + "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 fullOwnsOrCoversPixel: position :: 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 fullOwnsOrCoversPixel: 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.! ! + +BitBltCanvas removeSelector: #morph:isAtPoint:! + +!methodRemoval: BitBltCanvas #morph:isAtPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +morph: aMorph isAtPoint: aPoint + + aMorph basicDisplayBounds ifNotNil: [ :r | + (r containsPoint: aPoint) ifFalse: [ + ^false ]]. + "Give morphs with a non-rectangular shape (corner WindowEdgeAdjustingMorphs) + a chance to have a say." + ^ aMorph morphContainsPoint: + (aMorph internalizeFromWorld: aPoint)! + +WindowEdgeAdjustingMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: WindowEdgeAdjustingMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +morphContainsPoint: aLocalPoint + | sensitiveBorder | + ( self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [ ^false ]. + sensitiveBorder _ owner borderWidth. + selector caseOf: { + [ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]]. + [ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]]. + } + otherwise: [ + "all the morph is sensitive for horizontal and vertical (i.e. non corner) instances." + ^true ]! + +WidgetMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: WidgetMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +morphContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in a submorph in front of us, as long as it is inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! + +HaloMorph removeSelector: #containsGlobalPoint:! + +!methodRemoval: HaloMorph #containsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +containsGlobalPoint: worldPoint + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + ^self morphLocalBounds containsPoint: + (self internalizeFromWorld: worldPoint) ]]. + ^ false! + +KernelMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: KernelMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +morphContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in a submorph in front of us, as long as it is inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! + +Morph removeSelector: #containsGlobalPoint:! + +!methodRemoval: Morph #containsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +containsGlobalPoint: worldPoint + "Answer true if pixel worldPoint is covered by us, and we are visible a it. + No other morph above us also covers it." + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + w canvas ifNotNil: [ :canvas | + ^ canvas morph: self isAtPoint: worldPoint ]]]. + ^ false! + +Morph removeSelector: #isCloserThan:to:! + +Morph removeSelector: #fullContainsGlobalPoint:! + +!methodRemoval: Morph #fullContainsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +fullContainsGlobalPoint: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape." + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + (self containsGlobalPoint: worldPoint) ifTrue: [ ^ true ]. + self submorphsDo: [ :m | + (m fullContainsGlobalPoint: worldPoint) ifTrue: [ ^ true ]]]]. + ^ false! + +Morph removeSelector: #isCloserThan:toPoint:! + +!methodRemoval: Morph #isCloserThan:toPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:09'! +isCloserThan: aNumber toPoint: aPoint + "Answer true if our closest point to aPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + Uses precise testing of the morph contour if available. See #knowsContour." + + | center contourTop contourBottom | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - aPoint y) abs < (privateDisplayBounds height // 2 + aNumber) ifFalse: [ + ^false ]. + (center x - aPoint x) abs < (privateDisplayBounds width // 2 + aNumber) ifFalse: [ + ^false ]. + "Precise check with contour, if available" + (self valueOfProperty: #contour) ifNotNil: [ :contour | | y0 y1 x0 x1 | + contourTop _ self valueOfProperty: #contourY0. + contourBottom _ self valueOfProperty: #contourY1. + "Contour rows to consider are those within requested distance." + y0 _ aPoint y - aNumber max: contourTop. + y1 _ aPoint y + aNumber min: contourBottom. + y0 to: y1 do: [ :y | + x0 _ (contour at: (y - contourTop) * 2 + 1) - aNumber. + x1 _ (contour at: (y - contourTop) * 2 + 2) + aNumber. + "If a vertical line of 2*aNumber height centered on aPoint is inside the contour, quick exit" + (aPoint x between: x0 and: x1) ifTrue: [ ^true ]. + "Check if aPoint is close enough to contour" + (x0@y - aPoint) r < aNumber ifTrue: [ ^true ]. + (x1@y - aPoint) r < aNumber ifTrue: [ ^true ]]. + "Not inside, not close enough to contour" + ^ false ]. + "If contour is not available, and aPoint is close enough to displayBounds, answer true, as it is the best we can know." + ^ true! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st----! + +'From Cuis 5.0 [latest update: #4870] on 21 September 2021 at 10:47:45 am'! +!KernelMorph methodsFor: 'drawing' stamp: 'jmv 9/21/2021 10:47:14' overrides: 50607548! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + auxCanvas _ BitBltCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4871-imageFormdepth-KernelMorph-JuanVuletich-2021Sep21-10h46m-jmv.001.cs.st----! + +----QUIT----(21 September 2021 12:54:16) Cuis5.0-4871-32.image priorSource: 8743091! \ No newline at end of file diff --git a/Cuis5.0-4871-32.image b/Cuis5.0-4871-32.image new file mode 100644 index 00000000..07ac66c3 Binary files /dev/null and b/Cuis5.0-4871-32.image differ diff --git a/Cuis5.0-4834-v3.changes b/Cuis5.0-4871-v3.changes similarity index 98% rename from Cuis5.0-4834-v3.changes rename to Cuis5.0-4871-v3.changes index cd929ee9..d36c3de7 100644 --- a/Cuis5.0-4834-v3.changes +++ b/Cuis5.0-4871-v3.changes @@ -206915,4 +206915,3092 @@ Please remedy manually and then repeat your request.' ]. ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4834-Enlarge-GCParameters-JuanVuletich-2021Sep03-11h27m-jmv.001.cs.st----! -----QUIT----(3 September 2021 15:02:55) Cuis5.0-4834-v3.image priorSource: 8699584! \ No newline at end of file +----QUIT----(3 September 2021 15:02:55) Cuis5.0-4834-v3.image priorSource: 8699584! + +----STARTUP---- (21 September 2021 12:54:32) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4834-v3.image! + + +'From Haver 5.0 [latest update: #4821] on 1 September 2021 at 5:39:26 pm'! +!Boolean methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:33:22'! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ self subclassResponsibility! ! +!False methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:33:51' overrides: 50604961! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ ''! ! +!True methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:34:02' overrides: 50604961! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ ''! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4835-asMenuItemTextPrefix-GeraldKlix-2021Sep01-17h30m-KLG.001.cs.st----! + +'From Haver 5.0 [latest update: #4821] on 1 September 2021 at 7:00:13 pm'! +!TaskbarMorph class methodsFor: 'as yet unclassified' stamp: 'KLG 9/1/2021 18:58:39' overrides: 16877245! + includeInNewMorphMenu + "Return true for all classes that can be instantiated from the menu + + More than one taskbar confuses the running wolrd!!" + + ^ false! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4836-NoAdditionalTaskbarMorphs-GeraldKlix-2021Sep01-17h39m-KLG.001.cs.st----! + +'From Cuis 5.0 [latest update: #4836] on 5 September 2021 at 1:59:07 pm'! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:54:43' prior: 16812346! + showingLineDiffsString + "Answer a string representing whether I'm showing regular diffs" + + ^ self showingLineDiffs asMenuItemTextPrefix, + 'lineDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:55:59' prior: 16812361! + showingPrettyLineDiffsString + "Answer a string representing whether I'm showing pretty diffs" + + ^ self showingPrettyLineDiffs asMenuItemTextPrefix, + 'linePrettyDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:56:14' prior: 16812377! + showingPrettyWordDiffsString + "Answer a string representing whether I'm showing pretty diffs" + + ^ self showingPrettyWordDiffs asMenuItemTextPrefix, + 'wordPrettyDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:56:25' prior: 16812393! + showingWordDiffsString + "Answer a string representing whether I'm showing regular diffs" + + ^ self showingWordDiffs asMenuItemTextPrefix, + 'wordDiffs'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:55:22' prior: 16812559! + prettyPrintString + "Answer whether the receiver is showing pretty-print" + + ^ self showingPrettyPrint asMenuItemTextPrefix, + 'prettyPrint'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:53:44' prior: 16812605! + showingByteCodesString + "Answer whether the receiver is showing bytecodes" + + ^ self showingByteCodes asMenuItemTextPrefix, + 'byteCodes'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:54:04' prior: 16812620! + showingDecompileString + "Answer a string characerizing whether decompilation is showing" + + ^ self showingDecompile asMenuItemTextPrefix, + 'decompile'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:54:20' prior: 16812636! + showingDocumentationString + "Answer a string characerizing whether documentation is showing" + + ^ self showingDocumentation asMenuItemTextPrefix, + 'documentation'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:55:44' prior: 16812651! + showingPlainSourceString + "Answer a string telling whether the receiver is showing plain source" + + ^ self showingPlainSource asMenuItemTextPrefix, + 'source'! ! +!Morph methodsFor: 'menus' stamp: 'jmv 9/5/2021 13:57:02' prior: 16876328! + stickinessString + "Answer the string to be shown in a menu to represent the + stickiness status" + + ^ self isSticky asMenuItemTextPrefix, + 'resist being picked up'! ! +!InnerTextMorph methodsFor: 'menu' stamp: 'jmv 9/5/2021 13:57:19' prior: 16855935! + wrapString + "Answer the string to put in a menu that will invite the user to + switch word wrap mode" + ^ wrapFlag asMenuItemTextPrefix, + 'text wrap to bounds'! ! +!FileListWindow methodsFor: 'menu building' stamp: 'jmv 9/5/2021 13:58:00' prior: 50602324! + volumeMenu + | aMenu initialDirectoriesMenu | + aMenu _ MenuMorph new defaultTarget: model. + aMenu + add: 'delete directory...' + action: #deleteDirectory + icon: #warningIcon :: setBalloonText: 'Delete the selected directory'. + model currentDirectorySelected + ifNil: [ aMenu add: 'initial directory' action: #yourself :: isEnabled: false ] + ifNotNil: [ :selectedWrapper | + aMenu + add: (Preferences isInitialFileListDirectory: selectedWrapper item) + asMenuItemTextPrefix, 'initial directory' + action: #toggleInitialDirectory :: + setBalloonText: 'The selected directory is an initial director for new file list windows' ]. + initialDirectoriesMenu _ MenuMorph new. + #( + (roots 'default roots' 'Use the usual root directories. Drives on Windows; "/" on Unix') + (image 'image directory' 'Use the directory with Smalltalk image') + (vm 'VM directory' 'Use the virtual machine directory') + (current 'current directory' 'Use the current directory; usually the directory the VM was started in') + ) + do: [ :entry | + initialDirectoriesMenu + add: entry second + target: Preferences + action: #initialFileListDirectories: + argument: entry first :: + setBalloonText: entry third ]. + aMenu add: 'default initial directories' subMenu: initialDirectoriesMenu. + ^ aMenu! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4837-MakeGoodUseOf4835-JuanVuletich-2021Sep05-13h52m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4837] on 5 September 2021 at 7:51:29 pm'! +!PluggableScrollPane methodsFor: 'geometry' stamp: 'jmv 9/5/2021 18:38:10' overrides: 50552944! + fontPreferenceChanged + + super fontPreferenceChanged. + scrollBar recreateSubmorphs. + hScrollBar recreateSubmorphs. + self setScrollDeltas.! ! + +ScrollBar removeSelector: #fontPreferenceChanged! + +!methodRemoval: ScrollBar #fontPreferenceChanged stamp: 'Install-4838-GUIelementsSizeChangeFix-JuanVuletich-2021Sep05-19h50m-jmv.001.cs.st 9/21/2021 12:54:38'! +fontPreferenceChanged + "Rescale" + + self recreateSubmorphs! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4838-GUIelementsSizeChangeFix-JuanVuletich-2021Sep05-19h50m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4837] on 5 September 2021 at 7:52:31 pm'! +!Preferences class methodsFor: 'fonts' stamp: 'jmv 9/5/2021 19:52:05' prior: 50568095! + setDefaultFont: aFontName + "Change the font on the whole system without changing point sizes." + FontFamily defaultFamilyName: aFontName. + Preferences + setDefaultFont: FontFamily defaultFamilyName + spec: { + {#setListFontTo:. Preferences standardListFont pointSize.}. + {#setMenuFontTo:. Preferences standardMenuFont pointSize.}. + {#setWindowTitleFontTo:. Preferences windowTitleFont pointSize.}. + {#setCodeFontTo:. Preferences standardCodeFont pointSize.}. + {#setButtonFontTo:. Preferences standardButtonFont pointSize.}. + }. + MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ]. + UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! ! +!Preferences class methodsFor: 'fonts' stamp: 'jmv 9/5/2021 19:51:58' prior: 50602919! + setDefaultFont: fontFamilyName spec: defaultFontsSpec + + | font | + defaultFontsSpec do: [ :triplet | + font _ FontFamily familyName: fontFamilyName pointSize: triplet second. + font ifNil: [ font _ FontFamily defaultFamilyAndPointSize ]. + triplet size > 2 ifTrue: [ + font _ font emphasized: triplet third ]. + self + perform: triplet first + with: font ]. + MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ]. + UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4839-GUISizePreferenceChanged-JuanVuletich-2021Sep05-19h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4839] on 6 September 2021 at 10:24:41 am'! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/6/2021 10:21:10' prior: 50596398! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + stepX _ FontFamily defaultPointSize * 4 //10 * 10. + stepY _ FontFamily defaultPointSize * 2 //10 * 10. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: 2 color: c. + aCanvas line: 0@y0 to: 0@y1 width: 2 color: c. + + (x0 truncateTo: stepX) to: (x1 - stepX truncateTo: stepX) by: stepX do: [ :x | + aCanvas line: x @ -5 to: x @ 5 width: 2 color: c. + aCanvas drawString: x printString atCenterXBaselineY: x @ -10 font: nil color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - 15 @ 0 font: nil color: c. + + (y0 truncateTo: stepY) to: (y1 - stepY truncateTo: stepY) by: stepY do: [ :y | + aCanvas line: -5 @ y to: 5 @ y width: 2 color: c. + aCanvas drawString: y printString, ' ' atWaistRight: -5 @ y font: nil color: c ]. + aCanvas drawString: 'y' atWaistRight: -5 @ (y1 - 20) font: nil color: c. + + aCanvas geometryTransformation: prevTx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4840-drawCoordinateSystem-tweak-JuanVuletich-2021Sep05-20h14m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4839] on 6 September 2021 at 11:07:34 am'! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 11:07:11' prior: 50604103! + displayWorldSafely + "Update this world's display and keep track of errors during draw methods." + + [self displayWorld] on: Error, Halt do: [ :ex | + "Handle a drawing error" + canvas currentMorphDrawingFails. + "Creating a new canvas here could be dangerous, as code signaling the exception will be resumed." + self resetCanvas. + "Install the old error handler, so we can re-raise the error" + ex receiver error: ex description. + ]! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4841-Morphic-ErrorHandling-fix-JuanVuletich-2021Sep06-11h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4841] on 6 September 2021 at 12:08:56 pm'! +!MorphicCanvas methodsFor: 'morphic' stamp: 'jmv 9/6/2021 12:08:14' prior: 50559686! + fullDraw: aMorph + "Draw the full Morphic structure on us" + + "We are already set with a proper transformation from aMorph owner's coordinates to those of our target form." + + self flag: #jmvVer3. + aMorph visible ifFalse: [^ self]. + self into: aMorph. + + currentMorph layoutSubmorphsIfNeeded. + + currentMorph isKnownFailing ifTrue: [ + self canvasToUse drawCurrentAsError. + self outOfMorph. + ^ self]. + + (currentMorph isOwnedByHand and: [ + Preferences cheapWindowReframe and: [currentMorph is: #SystemWindow]]) ifTrue: [ + self drawCurrentAsOutline. + self outOfMorph. + ^ self]. + + "Draw current Morph and submorphs" + self canvasToUse drawCurrentAndSubmorphs. + + self outOfMorph! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4842-cheapWindowReframe-onlyForWindows-JuanVuletich-2021Sep06-12h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4841] on 6 September 2021 at 12:47:09 pm'! +!CodePackage methodsFor: 'naming' stamp: 'jmv 9/6/2021 12:17:27'! + packageDirectory + + ^self packageDirectoryName asDirectoryEntry! ! + +CodePackage removeSelector: #pagkageDirectory! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4843-packageDirectory-JuanVuletich-2021Sep06-12h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4843] on 6 September 2021 at 3:12:10 pm'! +!HandMorph methodsFor: 'drawing' stamp: 'jmv 9/6/2021 15:06:24'! + isDrawnBySoftware + "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden." + "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor from the display." + "Note. We draw the hand as a regular morph (using #drawOn:), disabling the hardware cursor, when we carry submorphs. The reason is to lock the mouse pointer and the carried morph together. Otherwhise the carried morph would lag behind the mouse pointer. + This method answers whether the regular #drawOn: drawing mechanism is used for us. + + Check senders. Hand drawing is handled explicitly by the world, because the Hand is not a submorph of the world!!" + | blankCursor | + (prevFullBounds notNil or: [ + submorphs anySatisfy: [ :ea | + ea visible ]]) ifTrue: [ + "using the software cursor; hide the hardware one" + blankCursor _ Cursor cursorAt: #blankCursor. + Cursor currentCursor == blankCursor ifFalse: [ blankCursor activateCursor ]. + ^ true ]. + ^ false.! ! +!WorldMorph methodsFor: 'hands' stamp: 'jmv 9/6/2021 15:06:31' prior: 50570315! + selectHandsToDrawForDamage: damageList + "Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle." + + | result | + result _ OrderedCollection new. + hands do: [:hand | + hand isDrawnBySoftware ifTrue: [ + hand isRedrawNeeded + ifTrue: [result add: hand] + ifFalse: [ + hand displayFullBounds ifNotNil: [ :handBounds | + (damageList anySatisfy: [ :r | r intersects: handBounds]) ifTrue: [ + result add: hand]]]]]. + ^ result! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 15:06:36' prior: 50570335! + checkIfUpdateNeeded + + self isSubmorphRedrawNeeded ifTrue: [ ^true ]. + damageRecorder updateIsNeeded ifTrue: [^true]. + hands do: [:h | (h isRedrawNeeded | h isSubmorphRedrawNeeded and: [h isDrawnBySoftware]) ifTrue: [^true]]. + ^false "display is already up-to-date" +! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 15:10:14' prior: 50565059! + doOneCycle + "Do one cycle of the interaction loop. This method is called repeatedly when the world is running. + + Make for low cpu usage if the ui is inactive, but quick response when ui is in use. + However, after some inactivity, there will be a larger delay before the ui gets responsive again." + + | wait waitUntil | + waitDelay ifNil: [ waitDelay _ Delay forMilliseconds: 50 ]. + (lastCycleHadAnyEvent or: [ deferredUIMessages isEmpty not ]) + ifTrue: [ + pause _ 20. "This value will only be used later, when there are no more events to serve or deferred UI messages to process." + wait _ 0. "Don't wait this time"] + ifFalse: [ + "wait between 20 and 200 milliseconds" + (hands anySatisfy: [ :h | h waitingForMoreClicks ]) + ifTrue: [ pause _ 20 ] + ifFalse: [ pause < 200 ifTrue: [ pause _ pause * 21//20 ] ]. + waitUntil _ lastCycleTime + pause. + "Earlier if steps" + stepList isEmpty not ifTrue: [ + waitUntil _ waitUntil min: stepList first scheduledTime ]. + "Earlier if alarms" + alarms ifNotNil: [ + alarms isEmpty not ifTrue: [ + waitUntil _ waitUntil min: alarms first scheduledTime ]]. + wait _ waitUntil - Time localMillisecondClock max: 0 ]. + Preferences serverMode + ifTrue: [ wait _ wait max: 50 ]. "Always wait at least a bit on servers, even if this makes the UI slow." + wait = 0 + ifTrue: [ Processor yield ] + ifFalse: [ + waitDelay beingWaitedOn + ifFalse: [ waitDelay setDelay: wait; wait ] + ifTrue: [ + "If we are called from a different process than that of the main UI, we might be called in the main + interCyclePause. In such case, use a new Delay to avoid 'This Delay has already been scheduled' errors" + (Delay forMilliseconds: wait) wait ]]. + + "Record start time of this cycle, and do cycle" + lastCycleTime _ Time localMillisecondClock. + lastCycleHadAnyEvent _ self doOneCycleNow.! ! + +HandMorph removeSelector: #needsToBeDrawn! + +!methodRemoval: HandMorph #needsToBeDrawn stamp: 'Install-4844-DelayInMenuOpenBug-Fix-JuanVuletich-2021Sep06-15h09m-jmv.001.cs.st 9/21/2021 12:54:38'! +needsToBeDrawn + "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden." + "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor from the display." + "Note. We draw the hand as a regular morph (using #drawOn:), disabling the hardware cursor, when we carry submorphs. The reason is to lock the mouse pointer and the carried morph together. Otherwhise the carried morph would lag behind the mouse pointer. + This method answers whether the regular #drawOn: drawing mechanism is used for us. + + Check senders. Hand drawing is handled explicitly by the world, because the Hand is not a submorph of the world!!" + | blankCursor | + (prevFullBounds notNil or: [ + submorphs anySatisfy: [ :ea | + ea visible ]]) ifTrue: [ + "using the software cursor; hide the hardware one" + blankCursor _ Cursor cursorAt: #blankCursor. + Cursor currentCursor == blankCursor ifFalse: [ blankCursor activateCursor ]. + ^ true ]. + ^ false.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4844-DelayInMenuOpenBug-Fix-JuanVuletich-2021Sep06-15h09m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:36:59 pm'! +!Morph methodsFor: 'initialization' stamp: 'jmv 9/6/2021 15:21:29' prior: 16875917! + intoWorld: aWorld + "The receiver has just appeared in a new world. Note: + * aWorld can be nil (due to optimizations in other places) + * owner is already set + * owner's submorphs may not include receiver yet. + Important: Keep this method fast - it is run whenever morphs are added." + + aWorld ifNil: [ ^self ]. + self needsRedraw: true. + self wantsSteps ifTrue: [ self startStepping ]. + self submorphsDo: [ :m | m intoWorld: aWorld ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4845-AlwaysRefreshNewMorphs-JuanVuletich-2021Sep06-15h36m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:37:39 pm'! +!WorldMorph methodsFor: 'events' stamp: 'jmv 9/6/2021 15:20:19' prior: 50552192 overrides: 16874466! + click: aMouseButtonEvent localPosition: localEventPosition + + ^self mouseButton2Activity.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4846-DontWaitToOpenWorldMenu-JuanVuletich-2021Sep06-15h36m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:38:16 pm'! +!HandMorph methodsFor: 'double click support' stamp: 'jmv 9/6/2021 15:30:21'! + waitForClicksOrDragOrSimulatedMouseButton2: aMorph event: evt clkSel: clkSel + + "Wait until the difference between click, or drag gesture is known, then inform the given morph what transpired." + + mouseClickState _ + MouseClickState new + client: aMorph + drag: nil + click: clkSel + clickAndHalf: nil + dblClick: nil + dblClickAndHalf: nil + tripleClick: nil + event: evt + sendMouseButton2Activity: Preferences tapAndHoldEmulatesButton2. + + "It seems the Mac VM may occasionally lose button up events triggering bogus activations. + Hence Preferences tapAndHoldEmulatesButton2"! ! +!MouseClickState methodsFor: 'private' stamp: 'jmv 9/6/2021 15:33:13'! + notWaitingForMultipleClicks + + ^ clickAndHalfSelector isNil and: [ + dblClickSelector isNil and: [ + dblClickAndHalfSelector isNil and: [ + tripleClickSelector isNil ]]]! ! +!PasteUpMorph methodsFor: 'events' stamp: 'jmv 9/6/2021 15:30:26' prior: 50550885 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + + super mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition. + + aMouseButtonEvent hand + waitForClicksOrDragOrSimulatedMouseButton2: self + event: aMouseButtonEvent + clkSel: #click:localPosition:.! ! +!MouseClickState methodsFor: 'actions' stamp: 'jmv 9/6/2021 15:33:53' prior: 50574319! + handleEvent: aMouseEvent from: aHand + "Process the given mouse event to detect a click, double-click, or drag. + Return true if the event should be processed by the sender, false if it shouldn't. + NOTE: This method heavily relies on getting *all* mouse button events." + + | timedOut distance | + timedOut _ (aMouseEvent timeStamp - lastClickDown timeStamp) > self class doubleClickTimeout. + timedOut ifTrue: [ aHand dontWaitForMoreClicks ]. + distance _ (aMouseEvent eventPosition - lastClickDown eventPosition) r. + "Real action dispatch might be done after the triggering event, for example, because of waiting for timeout. + So, count the button downs and ups(clicks), to be processed, maybe later, maybe in a mouseMove..." + aMouseEvent isMouseDown ifTrue: [ + lastClickDown _ aMouseEvent. + buttonDownCount _ buttonDownCount + 1 ]. + aMouseEvent isMouseUp ifTrue: [ + buttonUpCount _ buttonUpCount + 1 ]. + + "Drag, or tap & hold" + (buttonDownCount = 1 and: [ buttonUpCount = 0]) ifTrue: [ + (self notWaitingForMultipleClicks or: [ distance > 0 ]) ifTrue: [ + "If we have already moved, then it won't be a double or triple click... why wait?" + aHand dontWaitForMoreClicks. + dragSelector + ifNotNil: [ self didDrag ] + ifNil: [ self didClick ]. + ^ false ]. + timedOut ifTrue: [ + aHand dontWaitForMoreClicks. + "Simulate button 2 via tap & hold. Useful for opening menus on pen computers." + sendMouseButton2Activity ifTrue: [ + clickClient mouseButton2Activity ]. + ^ false ]]. + + "If we're over triple click, or timed out, or mouse moved, don't allow more clicks." + (buttonDownCount = 4 or: [ timedOut or: [ distance > 0 ]]) ifTrue: [ + aHand dontWaitForMoreClicks. + ^ false ]. + + "Simple click." + (buttonDownCount = 1 and: [ buttonUpCount = 1 ]) ifTrue: [ + self didClick ]. + + "Click & hold" + (buttonDownCount = 2 and: [ buttonUpCount = 1]) ifTrue: [ + self didClickAndHalf ]. + + "Double click." + (buttonDownCount = 2 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClick ]. + + "Double click & hold." + (buttonDownCount = 3 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClickAndHalf ]. + + "Triple click" + (buttonDownCount = 3 and: [ buttonUpCount = 3]) ifTrue: [ + self didTripleClick ]. + + "This means: if a mouseDown, then don't further process this event (so we can turn it into a double or triple click on next buttonUp)" + ^ aMouseEvent isMouseDown! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4847-MouseClickState-tweaks-JuanVuletich-2021Sep06-15h37m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4847] on 6 September 2021 at 7:55:36 pm'! +!MouseClickState methodsFor: 'actions' stamp: 'jmv 6/17/2021 13:01:32' prior: 50605631! + handleEvent: aMouseEvent from: aHand + "Process the given mouse event to detect a click, double-click, or drag. + Return true if the event should be processed by the sender, false if it shouldn't. + NOTE: This method heavily relies on getting *all* mouse button events." + + | timedOut distance | + timedOut _ (aMouseEvent timeStamp - lastClickDown timeStamp) > self class doubleClickTimeout. + timedOut ifTrue: [ aHand dontWaitForMoreClicks ]. + distance _ (aMouseEvent eventPosition - lastClickDown eventPosition) r. + "Real action dispatch might be done after the triggering event, for example, because of waiting for timeout. + So, count the button downs and ups(clicks), to be processed, maybe later, maybe in a mouseMove..." + aMouseEvent isMouseDown ifTrue: [ + lastClickDown _ aMouseEvent. + buttonDownCount _ buttonDownCount + 1 ]. + aMouseEvent isMouseUp ifTrue: [ + buttonUpCount _ buttonUpCount + 1 ]. + + "Drag, or tap & hold" + (buttonDownCount = 1 and: [ buttonUpCount = 0]) ifTrue: [ + distance > 0 ifTrue: [ + aHand dontWaitForMoreClicks. + dragSelector + ifNotNil: [ self didDrag ] + "If we have already moved, then it won't be a double or triple click... why wait?" + ifNil: [ self didClick ]. + ^ false ]. + timedOut ifTrue: [ + aHand dontWaitForMoreClicks. + "Simulate button 2 via tap & hold. Useful for opening menus on pen computers." + sendMouseButton2Activity ifTrue: [ + clickClient mouseButton2Activity ]. + ^ false ]]. + + "If we're over triple click, or timed out, or mouse moved, don't allow more clicks." + (buttonDownCount = 4 or: [ timedOut or: [ distance > 0 ]]) ifTrue: [ + aHand dontWaitForMoreClicks. + ^ false ]. + + "Simple click." + (buttonDownCount = 1 and: [ buttonUpCount = 1 ]) ifTrue: [ + self didClick ]. + + "Click & hold" + (buttonDownCount = 2 and: [ buttonUpCount = 1]) ifTrue: [ + self didClickAndHalf ]. + + "Double click." + (buttonDownCount = 2 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClick ]. + + "Double click & hold." + (buttonDownCount = 3 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClickAndHalf ]. + + "Triple click" + (buttonDownCount = 3 and: [ buttonUpCount = 3]) ifTrue: [ + self didTripleClick ]. + + "This means: if a mouseDown, then don't further process this event (so we can turn it into a double or triple click on next buttonUp)" + ^ aMouseEvent isMouseDown! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4848-fixBugIn4847-JuanVuletich-2021Sep06-19h55m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4848] on 7 September 2021 at 11:05:59 am'! +!BitBltCanvas methodsFor: 'initialization' stamp: 'jmv 9/7/2021 09:41:09' overrides: 50604094! + resetCanvas + "To be called in case of possible inconsistency due to an exception during drawing. + See #displayWorldSafely" + + super resetCanvas. + boundsFinderCanvas resetCanvas.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4849-resetCanvas-fix-JuanVuletich-2021Sep07-11h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4849] on 7 September 2021 at 11:17:08 am'! +!Number methodsFor: 'truncation and round off' stamp: 'jmv 9/7/2021 10:54:01'! + round4perMagnitudeOrder + "Round receiver to 1 or two significant digits. + Answer is 1, 2, 2.5, 5, 10, 20, 25, 50, 100, 200, 250, 500, 1000, etc. + better name?" + + | excess firstDigitPosition | + firstDigitPosition _ self log floor. + excess _ self log - firstDigitPosition. + excess < 2 log ifTrue: [ ^10 raisedTo: firstDigitPosition ]. + excess < 2.5 log ifTrue: [ ^(10 raisedTo: firstDigitPosition) * 2 ]. + excess < 5 log ifTrue: [ ^(10 raisedTo: firstDigitPosition-1) * 25 ]. + ^(10 raisedTo: firstDigitPosition) * 5! ! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2021 11:13:25' prior: 50605220! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 10) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1-(stepX*0.2) by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atCenterXBaselineY: x @ (tickLength*2) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1-(stepY*0.5) by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaistRight: tickLength negated @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! +!WidgetMorph methodsFor: 'halos and balloon help' stamp: 'jmv 9/7/2021 09:26:23' prior: 50601406 overrides: 50601400! + haloShowsCoordinateSystem + "We are usually not concerned with this level of detail for Widgets, as they prefer using automatic Layout." + + ^self requiresVectorCanvas! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4850-drawCoordinateSystem-enhancements-JuanVuletich-2021Sep07-11h16m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4849] on 7 September 2021 at 11:21:43 am'! +!WindowEdgeAdjustingMorph methodsFor: 'adjusting' stamp: 'jmv 9/7/2021 11:21:14' prior: 50603988 overrides: 50591463! + adjustOwnerAt: aGlobalPoint millisecondSinceLast: millisecondSinceLast + + self basicAdjustOwnerAt: aGlobalPoint. + + "If UI is becoming slow or is optimized for slow systems, resize without + showing window contents, but only edges. But don't do it for rotated Windows!!" + (owner isOrAnyOwnerIsRotated not and: [ + Preferences cheapWindowReframe or: [millisecondSinceLast > 200]]) ifTrue: [ + owner displayBounds newRectFrom: [ :f | + self basicAdjustOwnerAt: Sensor mousePoint. + owner morphPosition extent: owner morphExtentInWorld ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4851-cheapWindowReframe-lessAgressive-JuanVuletich-2021Sep07-11h17m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4851] on 7 September 2021 at 12:04:13 pm'! +!CodeWindow methodsFor: 'updating' stamp: 'jmv 9/7/2021 12:02:33' prior: 50602594! + updateListsAndCode + "All code windows receive this message on any code change in the system. + Process it only once, for the benefit of installing large packages!!" + + (self hasProperty: #updateListsAndCode) ifFalse: [ + self setProperty: #updateListsAndCode toValue: true. + self whenUIinSafeState: [ + self removeProperty: #updateListsAndCode. + owner ifNotNil: [ self updateListsAndCodeNow ]]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4852-CodeWindow-updateListsAndCode-afterClose-fix-JuanVuletich-2021Sep07-12h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4809] on 5 September 2021 at 10:49:47 pm'! + +Smalltalk removeClassNamed: #ExtractMethodApplier! + +!classRemoval: #ExtractMethodApplier stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Smalltalk removeClassNamed: #ExtractMethod! + +!classRemoval: #ExtractMethod stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +MessageSet subclass: #ExtractMethodMessageSet + instanceVariableNames: 'finder selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodMessageSet category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +MessageSet subclass: #ExtractMethodMessageSet + instanceVariableNames: 'finder selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +MessageSetWindow subclass: #ExtractMethodReplacementsWindow + instanceVariableNames: 'applier finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacementsWindow category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +MessageSetWindow subclass: #ExtractMethodReplacementsWindow + instanceVariableNames: 'applier finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Object subclass: #ExtractMethodReplacementsFinder + instanceVariableNames: 'intervalToExtract sourceMethod replacements newMessage sourceCodeToExtract sizeToExtract' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacementsFinder category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +Object subclass: #ExtractMethodReplacementsFinder + instanceVariableNames: 'intervalToExtract sourceMethod replacements newMessage sourceCodeToExtract sizeToExtract' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'extractMethodNewMethod collectionOfReplacements' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethod category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'extractMethodNewMethod collectionOfReplacements' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethod commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +Refactoring subclass: #ExtractMethodNewMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodNewMethod category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +Refactoring subclass: #ExtractMethodNewMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodNewMethod commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +Refactoring subclass: #ExtractMethodReplacement + instanceVariableNames: 'intervalToExtract newMessage methodToExtractFrom callingExpression' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacement category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +Refactoring subclass: #ExtractMethodReplacement + instanceVariableNames: 'intervalToExtract newMessage methodToExtractFrom callingExpression' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodReplacement commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider sourceCodeToExtract newMethodRefactoring finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodApplier category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider sourceCodeToExtract newMethodRefactoring finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodMessageSet methodsFor: 'initialization' stamp: 'HAW 9/5/2021 07:15:36' overrides: 50407630! + initialize + + selectedIndex := 0. + super initialize ! ! +!ExtractMethodMessageSet methodsFor: 'initialization' stamp: 'HAW 9/5/2021 00:12:23'! + initializeFinder: aFinder + + finder := aFinder.! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 07:15:16' overrides: 16792396! + messageListIndex + + ^selectedIndex ! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 07:14:51' overrides: 50390571! + messageListIndex: anIndex + + selectedIndex := anIndex. + ^super messageListIndex: anIndex ! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 21:52:26' overrides: 50442967! + removeMessageFromBrowserKeepingLabel + + | newIndex | + + selectedMessage ifNil: [ ^nil ]. + messageList removeIndex: selectedIndex. + finder removeReplacementAt: selectedIndex. + self changed: #messageList. + + newIndex := selectedIndex > messageList size + ifTrue: [ selectedIndex - 1 ] + ifFalse: [ selectedIndex ]. + self messageListIndex: newIndex.! ! +!ExtractMethodMessageSet methodsFor: 'source code ranges' stamp: 'HAW 9/5/2021 21:46:48' overrides: 50452605! + messageSendsRangesOf: aSelector + + | replacement | + + replacement := finder replacementsAt: self messageListIndex ifAbsent: [ ^#() ]. + + ^Array with: replacement intervalToExtract + ! ! +!ExtractMethodMessageSet class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 00:11:22'! + finder: aFinder + + ^(self messageList: aFinder methodsToReplace) initializeFinder: aFinder! ! +!MethodNode methodsFor: 'source ranges' stamp: 'HAW 8/26/2021 15:57:14'! + definitionStartPosition + + "It does not includes temp definition because the extract can include temps - Hernan" + ^self selectorLastPosition + 1! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:28'! + closeAfter: aBlock + + aBlock value. + self whenUIinSafeState: [ self delete ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:16'! + extractAllInClass + + self closeAfter: [ applier valueWithMethodsInClass ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:43'! + extractInMethodOnly + + self closeAfter: [ applier valueWithSourceMethod ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:52'! + extractSelectionOnly + + self closeAfter: [ applier valueWithOriginalSelection ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:42:00'! + refactor + + self closeAfter: [ applier valueWithAllReplacements ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 8/25/2021 22:07:31'! +remove + + model removeMessageFromBrowserKeepingLabel! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31'! + addButton: button to: row color: buttonColor + + button color: buttonColor. + row addMorph: button proportionalWidth: 10! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 9/5/2021 20:02:21'! + addButtonsTo: row color: buttonColor + + self + addButton: self createRemoveButton to: row color: buttonColor; + addButton: self createRefactorButton to: row color: buttonColor; + addButton: self createExtractSelectionOnlyButton to: row color: buttonColor; + addButton: self createExtractInMethodOnlyButton to: row color: buttonColor; + addButton: self createExtractAllInClassButton to: row color: buttonColor; + addButton: self createCancelButton to: row color: buttonColor. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31' overrides: 50518716! + buildLowerPanes + + | codeAndButtons | + + codeAndButtons _ LayoutMorph newColumn. + codeAndButtons + addMorph: self buttonsRow fixedHeight: self defaultButtonPaneHeight; + addAdjusterMorph; + addMorph: self buildMorphicCodePane proportionalHeight: 1.0. + + ^codeAndButtons ! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31'! + buttonsRow + + | buttonColor row | + + buttonColor := self buttonColor. + row := LayoutMorph newRow. + row doAdoptWidgetsColor. + row color: buttonColor. + + self addButtonsTo: row color: buttonColor. + + ^row + + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 8/25/2021 22:07:31'! + createCancelButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #delete + label: 'Cancel'. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:55:47'! + createExtractAllInClassButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractAllInClass + label: 'In Class'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:55:57'! + createExtractInMethodOnlyButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractInMethodOnly + label: 'In Method'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:43:25'! + createExtractSelectionOnlyButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractSelectionOnly + label: 'Selection Only'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:56:07'! + createRefactorButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #refactor + label: 'Refactor'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 20:07:00'! + createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'initialization' stamp: 'HAW 9/4/2021 23:30:56'! + initializeFrom: anExtractMethodApplier with: aFinder + + applier := anExtractMethodApplier. + finder := aFinder ! ! +!ExtractMethodReplacementsWindow class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 20:31:15'! + openFrom: anExtractMethodApplier with: aFinder + + | window messageSet | + + messageSet := ExtractMethodMessageSet finder: aFinder. + "I have to set a autoSelectString even if I do not use it because if not the + autoSelect event is not triggered - Hernan" + messageSet autoSelectString: aFinder sourceCodeToExtract. + + window := self open: messageSet label: 'Select replacements'. + window initializeFrom: anExtractMethodApplier with: aFinder. + + ^window + +! ! +!ExtractMethodReplacementsFinder methodsFor: 'initialization' stamp: 'HAW 9/2/2021 17:31:19'! + initializeOfCodeIn: anIntervalToExtract at: aMethod to: aNewMessage + + intervalToExtract := anIntervalToExtract. + sourceMethod := aMethod. + newMessage := aNewMessage ! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/5/2021 22:05:15'! + addReplacementAt: foundIntervalToExtract in: aMethod + + "If ther is an error creating the refactoring, then the found text is not extractable and + therefore should not be replaced - Hernan" + [ replacements add: (self createReplacementAt: foundIntervalToExtract in: aMethod) ] + on: RefactoringError + do: [ :anError | ].! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:03:06'! + createReplacementAt: foundIntervalToExtract in: aMethod + + ^ExtractMethodReplacement + fromInterval: foundIntervalToExtract asSourceCodeInterval + of: aMethod + to: newMessage! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:01:06'! + findReplacementsAt: aClass + + aClass methodsDo: [ :aMethod | self findReplacementsIn: aMethod asMethodReference ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:04:49'! + findReplacementsIn: aMethod + + | sourceCode foundIntervalToExtract sourceCodeToExtractStart | + + sourceCode := aMethod sourceCode. + sourceCodeToExtractStart := 1. + + [ sourceCodeToExtractStart := sourceCode indexOfSubCollection: sourceCodeToExtract startingAt: sourceCodeToExtractStart. + sourceCodeToExtractStart ~= 0 ] whileTrue: [ + foundIntervalToExtract := sourceCodeToExtractStart to: sourceCodeToExtractStart + sizeToExtract. + self addReplacementAt: foundIntervalToExtract in: aMethod. + sourceCodeToExtractStart := foundIntervalToExtract last + 1 ] + + ! ! +!ExtractMethodReplacementsFinder methodsFor: 'testing' stamp: 'HAW 9/4/2021 23:25:35'! + hasOneReplacement + + ^replacements size = 1! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:18:47'! + inClassReplacements + + ^replacements select: [ :aReplacement | aReplacement isAt: sourceMethod methodClass ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 00:12:03'! + methodsToReplace + + ^replacements collect: [ :aReplacement | aReplacement methodToExtractFrom ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:14:49'! + originalSelectionReplacement + + ^ExtractMethodReplacement fromInterval: intervalToExtract of: sourceMethod to: newMessage ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 21:51:40'! + removeReplacementAt: anIndex + + ^replacements removeAt: anIndex ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/2/2021 17:41:27'! + replacements + + ^replacements ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 07:24:58'! + replacementsAt: anIndex ifAbsent: ifAbsentBlock + + ^replacements at: anIndex ifAbsent: ifAbsentBlock ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:17:31'! + sourceMethodReplacements + + ^replacements select: [:aReplacement | aReplacement isOf: sourceMethod ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'evaluating' stamp: 'HAW 9/4/2021 21:00:59' overrides: 16881508! + value + + sourceCodeToExtract := sourceMethod sourceCode copyFrom: intervalToExtract first to: intervalToExtract last. + sizeToExtract := intervalToExtract size - 1. + replacements := OrderedCollection new. + + sourceMethod methodClass withAllSubclassesDo: [ :aClass | self findReplacementsAt: aClass] + ! ! +!ExtractMethodReplacementsFinder methodsFor: 'source code' stamp: 'HAW 9/5/2021 00:14:54'! + sourceCodeToExtract + + ^sourceCodeToExtract! ! +!ExtractMethodReplacementsFinder class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 17:31:33'! + ofCodeIn: anIntervalToExtract at: aMethod to: aNewMessage + + ^self new initializeOfCodeIn: anIntervalToExtract at: aMethod to: aNewMessage ! ! +!ExtractMethod methodsFor: 'initialization' stamp: 'HAW 9/5/2021 22:46:43'! + initializeNewDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements + + extractMethodNewMethod := anExtractMethodNewMethod. + collectionOfReplacements := aCollectionOfReplacements.! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:48'! + applyMethodReplacements: aMethodReplacements + + | adjustment sortedReplacements | + + adjustment := 0. + "This is not really necesary because the groupBy: keeps the order, but I do it just in case that is changed - Hernan" + sortedReplacements := aMethodReplacements sorted: [ :leftReplacement :rightReplacement | leftReplacement isBefore: rightReplacement ]. + sortedReplacements do: [ :aReplacement | + aReplacement applyAdjusting: adjustment. + adjustment := adjustment + aReplacement adjustmentForNextReplacement ]! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:51'! + applyReplacements + + | replacementsByMethod | + + replacementsByMethod := collectionOfReplacements groupBy: [ :aReplacement | aReplacement methodToExtractFrom ]. + replacementsByMethod valuesDo: [ :aMethodReplacements | self applyMethodReplacements: aMethodReplacements ]. + ! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:54'! + createNewMethod + + extractMethodNewMethod apply. +! ! +!ExtractMethod methodsFor: 'applying' stamp: 'HAW 9/5/2021 22:46:38' overrides: 50438485! + apply + + self + createNewMethod; + applyReplacements ! ! +!ExtractMethod class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:46:15'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage categorizedAs: aCategory + + ^self + newDefinition: (ExtractMethodNewMethod + fromInterval: anIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + categorizedAs: aCategory ) + replacements: (Array with: (ExtractMethodReplacement + fromInterval: anIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage)) + +! ! +!ExtractMethod class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:46:32'! + newDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements + + ^self new initializeNewDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements ! ! +!ExtractMethodNewMethod methodsFor: 'applying' stamp: 'HAW 9/4/2021 15:55:33' overrides: 50438485! + apply + + self sourceClass + compile: self newMethodSourceCode + classified: categoryOfNewSelector! ! +!ExtractMethodNewMethod methodsFor: 'initialization' stamp: 'HAW 9/2/2021 18:09:20'! + initializeExtractedSourceCode + + extractedSourceCode := existingMethod sourceCode + copyFrom: intervalToExtract first + to: intervalToExtract last! ! +!ExtractMethodNewMethod methodsFor: 'initialization' stamp: 'HAW 9/2/2021 18:09:20'! + initializeFrom: anIntervalToExtract of: aMethodToExtractCodeFrom to: aNewMessage in: aCategory + + intervalToExtract := anIntervalToExtract. + existingMethod := aMethodToExtractCodeFrom. + newMessage := aNewMessage. + categoryOfNewSelector := aCategory. + self initializeExtractedSourceCode.! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + newMessageString + + ^ newMessage fullName! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + newMethodSourceCode + + ^ String streamContents: [ :stream | + stream + nextPutAll: self newMessageString; + nextPutAll: self startingMethodIdentation; + nextPutAll: self returnCharacterIfNeeded; + nextPutAll: extractedSourceCode ]! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + returnCharacterIfNeeded + + | extractedMethodNode | + + extractedMethodNode := Parser parse: extractedSourceCode class: self sourceClass noPattern: true. + + ^ (extractedMethodNode numberOfStatements > 1 or: [ extractedMethodNode hasTemporaryVariables ]) + ifTrue: [ '' ] ifFalse: [ '^ ' ]! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + sourceClass + + ^ existingMethod methodClass! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + startingMethodIdentation + + ^ String lfString , String lfString , String tab! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + noSelectionErrorMessage + + ^ 'Please select some code for extraction'! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + outOfBoundsSelectionErrorMessage + + ^ 'The requested source code selection interval is out of bounds'! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + wrongNumberOfArgumentsGivenErrorMessage + + ^ 'The number of arguments in the given selector is not correct'! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalExtractMethodWithWrongNumberOfArgumentsError + + self refactoringError: self wrongNumberOfArgumentsGivenErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalNoSelectedCodeError + + self refactoringError: self noSelectionErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalOutOfBoundsIntervalError + + self refactoringError: self outOfBoundsSelectionErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 18:09:20'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage categorizedAs: aCategory + + | trimmedIntervalToExtract | + + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: aMethodToExtractCodeFrom sourceCode. + self + assert: newMessage selector canBeDefinedIn: aMethodToExtractCodeFrom methodClass; + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: trimmedIntervalToExtract; + assert: newMessage hasValidParametersForExtracting: anIntervalToExtract from: aMethodToExtractCodeFrom methodNode. + + ^ self new + initializeFrom: trimmedIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + in: aCategory! ! +!ExtractMethodNewMethod class methodsFor: 'pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract + + self + assertIntervalToExtractIsNotEmpty: anIntervalToExtract; + assert: anIntervalToExtract isWithinBoundsOf: aMethodToExtractCodeFrom sourceCode; + assert: aMethodToExtractCodeFrom containsValidCodeToBeExtractedAt: anIntervalToExtract! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: aSelector canBeDefinedIn: aClass + + NewSelectorPrecondition valueFor: aSelector on: aClass! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: aMethodToRefactor containsValidCodeToBeExtractedAt: anIntervalToExtract + + SourceCodeOfMethodToBeExtractedPrecondition valueFor: anIntervalToExtract of: aMethodToRefactor! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: newMessage hasValidParametersForExtracting: anIntervalToExtract from: aMethodNodeToRefactor + + | parseNodesToParameterize | + parseNodesToParameterize := ExtractMethodParametersDetector + valueFor: aMethodNodeToRefactor + at: anIntervalToExtract. + newMessage arguments size = parseNodesToParameterize size + ifFalse: [ self signalExtractMethodWithWrongNumberOfArgumentsError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: anIntervalToExtract isWithinBoundsOf: sourceCode + + (self is: anIntervalToExtract withinBoundsOf: sourceCode) + ifFalse: [ self signalOutOfBoundsIntervalError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assertIntervalToExtractIsNotEmpty: anIntervalToExtract + + (self isNotEmpty: anIntervalToExtract) + ifFalse: [ self signalNoSelectedCodeError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + is: anIntervalToExtract withinBoundsOf: aSourceCode + + ^ anIntervalToExtract first >= 1 and: [ anIntervalToExtract last <= aSourceCode size ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + isNotEmpty: anInterval + + ^ anInterval first <= anInterval last! ! +!ExtractMethodReplacement methodsFor: 'applying' stamp: 'HAW 9/2/2021 17:38:51' overrides: 50438485! + apply + + self sourceClass + compile: self updatedSourceCodeOfExistingMethod + classified: methodToExtractFrom category! ! +!ExtractMethodReplacement methodsFor: 'applying' stamp: 'HAW 9/4/2021 20:59:16'! + applyAdjusting: anAdjustment + + intervalToExtract := (intervalToExtract + anAdjustment) asSourceCodeInterval. + self apply ! ! +!ExtractMethodReplacement methodsFor: 'initialization' stamp: 'HAW 9/4/2021 16:53:14'! + initializeFrom: anIntervalToExtract of: aMethodToExtractCodeFrom to: aNewMessage + + intervalToExtract := anIntervalToExtract. + methodToExtractFrom := aMethodToExtractCodeFrom. + newMessage := aNewMessage. + self initializeCallingExpression ! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/4/2021 16:31:47'! + initializeCallingExpression + + callingExpression := 'self ', self newMessageString. + self shouldBeEnclosedWithParens ifTrue: [ callingExpression := '(' , callingExpression , ')' ] + ! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:06:21'! + newMessageString + + ^ newMessage fullName! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:38:51'! + shouldBeEnclosedWithParens + + | initialNode finalNode parseNodesInCommon methodNode initialNodeAncestors finalNodeAncestors insideMessageNodeExpressions | + + methodNode _ methodToExtractFrom methodNode. + initialNodeAncestors _ methodNode parseNodesPathAt: intervalToExtract first ifAbsent: [ ^ false]. + finalNodeAncestors _ methodNode parseNodesPathAt: intervalToExtract last ifAbsent: [ ^ false ]. + parseNodesInCommon _ initialNodeAncestors intersection: finalNodeAncestors. + + initialNode _ (parseNodesInCommon at: 1 ifAbsent: [ ^ false ]) key. + finalNode _ (parseNodesInCommon at: 2 ifAbsent: [ ^ false ]) key. + insideMessageNodeExpressions _ initialNode isMessageNode and: [ finalNode isMessageNode ]. + + ^ insideMessageNodeExpressions + and: [ initialNode precedence < newMessage selector precedence ] + and: [ initialNode precedence <= finalNode precedence ]! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:38:51'! +sourceClass + + ^ methodToExtractFrom methodClass! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/4/2021 16:37:55'! + updatedSourceCodeOfExistingMethod + + ^ methodToExtractFrom sourceCode + copyReplaceFrom: intervalToExtract first + to: intervalToExtract last + with: callingExpression! ! +!ExtractMethodReplacement methodsFor: 'accessing' stamp: 'HAW 9/2/2021 17:36:44'! + intervalToExtract + + ^intervalToExtract! ! +!ExtractMethodReplacement methodsFor: 'accessing' stamp: 'HAW 9/2/2021 17:38:51'! + methodToExtractFrom + + ^methodToExtractFrom ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 20:28:45'! +isAt: aClass + + ^methodToExtractFrom methodClass = aClass ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 17:02:06'! + isBefore: anExtractMethodReplacement + + ^anExtractMethodReplacement startsAfter: intervalToExtract first! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/2/2021 18:06:56'! + isOf: aMethod + + ^methodToExtractFrom = aMethod ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 17:02:34'! + startsAfter: aPosition + + ^intervalToExtract first > aPosition ! ! +!ExtractMethodReplacement methodsFor: 'adjustment' stamp: 'HAW 9/4/2021 16:50:17'! + adjustmentForNextReplacement + + ^callingExpression size - intervalToExtract size! ! +!ExtractMethodReplacement class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 17:26:03'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage + + | trimmedIntervalToExtract | + + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: aMethodToExtractCodeFrom sourceCode. + self assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: trimmedIntervalToExtract. + + ^ self new + initializeFrom: trimmedIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + ! ! +!ExtractMethodReplacement class methodsFor: 'pre-conditions' stamp: 'HAW 9/5/2021 22:07:25'! + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract + + ExtractMethodNewMethod assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract +! ! +!RefactoringApplier methodsFor: 'refactoring - creation' stamp: 'HAW 8/26/2021 16:06:07'! + createAndSetRefactoringHandlingRefactoringExceptions: aCreatorBlock + + self valueHandlingRefactoringExceptions: [ refactoring := aCreatorBlock value] + ! ! +!ExtractMethodApplier methodsFor: 'initialization' stamp: 'HAW 9/5/2021 22:47:39'! + initializeOn: aCodeProvider for: anIntervalToExtract of: aMethodToExtractCodeFrom + + codeProvider := aCodeProvider. + intervalToExtract := anIntervalToExtract. + methodToExtractCodeFrom := MethodReference method: aMethodToExtractCodeFrom. + newMessageArguments := Dictionary new! ! +!ExtractMethodApplier methodsFor: 'refactoring - changes' stamp: 'HAW 9/5/2021 22:47:43' overrides: 50441445! + showChanges + + codeProvider currentMethodRefactored! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:49' overrides: 50441322! + createRefactoring + + ^ self shouldNotImplement! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:53'! + createRefactoringForMethodsInClass + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder inClassReplacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:57'! + createRefactoringForOriginalSelection + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: { finder originalSelectionReplacement }! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:02'! + createRefactoringForSourceMethod + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder sourceMethodReplacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:06'! + createRefactoringWithAllReplacements + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder replacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:10'! + refactoringClass + + ^ ExtractMethod! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:14'! + createExtractMethodNewMethodFor: newMessage + + ^ newMethodRefactoring := ExtractMethodNewMethod + fromInterval: intervalToExtract + of: methodToExtractCodeFrom + to: newMessage + categorizedAs: methodToExtractCodeFrom category! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:17'! + findReplacementsWith: newMessage + + finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: methodToExtractCodeFrom to: newMessage. + finder value! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:20'! + requestNewMessage + + | parseNodesToParameterize initialAnswer userAnswer | + + parseNodesToParameterize := self parseNodesToParameterize. + initialAnswer := self buildInitialSelectorAnswer: parseNodesToParameterize. + userAnswer := self request: 'New method name:' initialAnswer: initialAnswer. + + parseNodesToParameterize + ifEmpty: [ self saveUnarySelector: userAnswer ] + ifNotEmpty: [ self saveBinaryOrKeywordSelector: userAnswer withArguments: parseNodesToParameterize ]. + + ^self buildNewMessage. + ! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:24' overrides: 50441340! + requestRefactoringParameters + + | newMessage | + + newMessage := self requestNewMessage. + self createExtractMethodNewMethodFor: newMessage. + self findReplacementsWith: newMessage. + + finder hasOneReplacement + ifTrue: [ self valueWithAllReplacements ] + ifFalse: [ ExtractMethodReplacementsWindow openFrom: self with: finder ] + ! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:29'! + buildNewMessage + + ^ Message + selector: newSelector + arguments: self newMessageArgumentNames! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:32'! + newMessageArgumentNames + + ^ newMessageArguments values collect: [ :parseNode | parseNode name ]! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:36'! + saveUnarySelector: userAnswer + + ^ newSelector := userAnswer asSymbol! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:40' overrides: 50441449! + value + + requestExitBlock := [ ^self ]. + + self requestRefactoringParametersHandlingRefactoringExceptions +! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:45'! + valueCreatingWith: aRefactoringCreationBlock + + self + createAndSetRefactoringHandlingRefactoringExceptions: aRefactoringCreationBlock; + applyRefactoring; + showChanges + + ! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:48'! + valueWithAllReplacements + + self valueCreatingWith: [ self createRefactoringWithAllReplacements ] + ! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:51'! + valueWithMethodsInClass + + self valueCreatingWith: [ self createRefactoringForMethodsInClass ]! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:54'! + valueWithOriginalSelection + + self valueCreatingWith: [ self createRefactoringForOriginalSelection ]! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:58'! + valueWithSourceMethod + + self valueCreatingWith: [ self createRefactoringForSourceMethod ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:03'! + buildInitialSelectorAnswer: parseNodesToParameterize + "builds a selector with the shape of #m1 if unary, or #m1: something m2: else if it has args" + + ^ parseNodesToParameterize + ifEmpty: [ self formatAsKeyword: 'm1' ] + ifNotEmpty: [ parseNodesToParameterize + inject: '' + into: [ :partialSelector :parseNode | + | currentKeyword | + currentKeyword _ 'm' , (parseNodesToParameterize indexOf: parseNode) asString , ': '. + partialSelector + , (self formatAsKeyword: currentKeyword) + , (self formatAsMethodArgument: parseNode name) + , String newLineString ] ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:06'! +formatAsKeyword: aKeyword + + ^ Text + string: aKeyword + attributes: (SHTextStylerST80 attributesFor: #patternKeyword)! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:10'! + formatAsMethodArgument: aMethodArgumentName + + ^ Text + string: aMethodArgumentName + attributes: (SHTextStylerST80 attributesFor: #methodArg)! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:13'! + parseNodesToParameterize + + ^ ExtractMethodParametersDetector + valueFor: methodToExtractCodeFrom methodNode + at: intervalToExtract! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:16'! + saveBinaryOrKeywordSelector: userAnswer withArguments: parseNodesToParameterize + + self saveMessageArgumentsForEach: parseNodesToParameterize using: userAnswer. + newSelector := ('' join: (self selectorTokensOf: userAnswer)) asSymbol.! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:20'! + saveMessageArgumentsForEach: parseNodesToParameterize using: userAnswer + + | newSelectorKeywords | + newSelectorKeywords _ self selectorTokensOf: userAnswer. + self validateRequiredParameters: parseNodesToParameterize haveACorrespondingKeywordIn: newSelectorKeywords. + parseNodesToParameterize withIndexDo: [ :parseNode :index | + newMessageArguments at: (newSelectorKeywords at: index) put: parseNode ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:23'! + selectorTokensOf: userAnswer + "this selects the pieces of strings before each $:" + + ^ (userAnswer findTokens: ':') allButLast + collect: [ :tok | (tok findTokens: Character separators) last , ':' ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:26'! + sourceCodeToExtract + + ^sourceCodeToExtract! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:29'! + validateRequiredParameters: parseNodesToParameterize haveACorrespondingKeywordIn: newSelectorKeywords + + newSelectorKeywords size = parseNodesToParameterize size + ifFalse: [ ExtractMethodNewMethod signalExtractMethodWithWrongNumberOfArgumentsError ]! ! +!ExtractMethodApplier class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:47:32'! + on: aCodeProvider for: anIntervalToExtract of: aMethodToRefactor + + | trimmedIntervalToExtract sourceCode | + + sourceCode := aMethodToRefactor sourceCode. + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: sourceCode.. + + self assertCanApplyRefactoringOn: aMethodToRefactor at: trimmedIntervalToExtract. + + ^ self new initializeOn: aCodeProvider for: trimmedIntervalToExtract of: aMethodToRefactor! ! +!ExtractMethodApplier class methodsFor: 'pre-conditions' stamp: 'HAW 9/5/2021 22:47:27'! + assertCanApplyRefactoringOn: aMethodToRefactor at: anIntervalToExtract + + ExtractMethodNewMethod + assertCanApplyRefactoringOn: aMethodToRefactor + at: anIntervalToExtract! ! +!SmalltalkEditor methodsFor: 'extract method' stamp: 'HAW 9/5/2021 20:36:00' prior: 50517565! + extractMethod + + self performCodeExtractionRefactoringWith: ExtractMethodApplier! ! +!ChangeSelectorWizardStepWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 20:07:07' prior: 50438284! + createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! +!AddInstanceVariable methodsFor: 'initialization' stamp: 'HAW 8/28/2021 17:44:36' prior: 50438535! + initializeNamed: aNewVariable to: aClassToRefactor + + newVariable := aNewVariable. + classToRefactor := aClassToRefactor ! ! +!RefactoringApplier methodsFor: 'refactoring - creation' stamp: 'HAW 8/26/2021 16:04:27' prior: 50441327! + createRefactoringHandlingRefactoringExceptions + + self createAndSetRefactoringHandlingRefactoringExceptions: [ self createRefactoring ] + ! ! +!SourceCodeIntervalPrecondition methodsFor: 'pre-conditions' stamp: 'HAW 8/26/2021 15:57:31' prior: 50529606! + assertSourceCodeIsNotPartOfMethodSignature + + self intervalToExtractIncludesPartOfMethodSignature + ifTrue: [ self signalExtractingPartOfMethodSignatureError ]! ! +!SourceCodeIntervalPrecondition methodsFor: 'private' stamp: 'HAW 8/26/2021 15:56:33' prior: 50529660! + methodDefinitionStartPosition + + ^methodNode definitionStartPosition! ! +!MethodReference methodsFor: 'decompiling' stamp: 'HAW 9/5/2021 23:06:10'! + methodNode + + ^self compiledMethod methodNode! ! +!CompiledMethod methodsFor: 'converting' stamp: 'HAW 9/5/2021 23:06:10'! + asMethodReference + + ^MethodReference method: self! ! + +SourceCodeIntervalPrecondition removeSelector: #firstParseNodeOfMethodDefinition! + +!methodRemoval: SourceCodeIntervalPrecondition #firstParseNodeOfMethodDefinition stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +firstParseNodeOfMethodDefinition + + ^ methodNode hasTemporaryVariables + ifTrue: [ methodNode temporariesDeclaration ] + ifFalse: [ methodNode block statements first + ifNotNil: [ :statement | statement ] + ifNil: [ methodNode ] ]! + +ChangeSelectorWizardStepWindow removeSelector: #isMessageSelected! + +!methodRemoval: ChangeSelectorWizardStepWindow #isMessageSelected stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:54:38'! +isMessageSelected + + ^model isNil ifTrue: [ false ] ifFalse: [ model selection notNil ]! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4853] on 7 September 2021 at 12:53:40 pm'! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2021 12:52:43' prior: 50605835! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 9) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1 by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atCenterXBaselineY: x @ (tickLength*2) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1 by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaist: tickLength @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4854-drawCoordinates-tweak-JuanVuletich-2021Sep07-12h50m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4854] on 9 September 2021 at 2:05:28 pm'! +!BitBltBoundsFinderCanvas methodsFor: 'morphic' stamp: 'jmv 9/9/2021 14:05:20' prior: 50595408! + updateBoundsIn: aWorldMorph addDamageTo: aDamageRecorder + + aWorldMorph haloMorphsDo: [ :halo | + (halo target isRedrawNeeded or: [halo target isSubmorphRedrawNeeded]) ifTrue: [ + "Invalidation of halos requires this specific sequence:" + halo redrawNeeded. "invalidate old halo bounds" + self fullAddRedrawRect: halo target to: aDamageRecorder. "recompute & invalidate target bounds" + self fullAddRedrawRect: halo to: aDamageRecorder ]]. "recompute & invalidate halo bounds" + "bogus iteration on halos and targets below is harmless: + Both now marked as neither #isRedrawNeeded nor #isSubmorphRedrawNeeded." + + aWorldMorph submorphsDo: [ :morph | + self fullAddRedrawRect: morph to: aDamageRecorder ]. + self updateHandsDisplayBounds: aWorldMorph.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4855-BoundsFinder-fix-JuanVuletich-2021Sep09-14h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4855] on 10 September 2021 at 4:10:30 pm'! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:02:58'! + turnMouseButton2Into3 + "Answer true if modifier keys are such that button 2 should be considered as button 3. + ctrl - click right -> center click + " + + self controlKeyPressed ifTrue: [ ^ true ]. + ^ false! ! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:08:01' prior: 50467588! + mouseButton2Pressed + "Answer true if the mouseButton2 is being pressed. + Reported by the VM for right mouse button or option+click on the Mac, ctrl-click on Windows, or ctrl-click or alt-click on Linux. + It is also emulated here with ctrl-click on any platform." + + (self turnMouseButton1Into2 and: [ buttons anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + self turnMouseButton2Into3 ifTrue: [ ^ false ]. + ^ buttons anyMask: InputSensor mouseButton2! ! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:06:43' prior: 50467604! + mouseButton3Pressed + "Answer true if the mouseButton3 is being pressed. + Reported by the VM for center (wheel) mouse button or cmd+click on the Mac or win/meta+click on Windows and Linux. + It is also emulated here with on any platform with: + shift - ctrl - click + ctrl - rightClick" + + (self turnMouseButton1Into3 and: [ buttons anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + (self turnMouseButton2Into3 and: [ buttons anyMask: InputSensor mouseButton2 ]) + ifTrue: [ ^ true ]. + ^ buttons anyMask: InputSensor mouseButton3! ! +!MouseButtonEvent methodsFor: 'accessing' stamp: 'jmv 9/10/2021 16:09:10' prior: 50467641! + mouseButton2Changed + "Answer true if the mouseButton2 has changed. + Reported by the VM for right mouse button or option+click on the Mac. + It is also emulated here with ctrl-click on any platform. + The check for button change (instead of button press) is specially useful on buttonUp events." + + (self turnMouseButton1Into2 and: [ whichButton anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + self turnMouseButton2Into3 ifTrue: [ ^ false ]. + ^ whichButton anyMask: InputSensor mouseButton2! ! +!MouseButtonEvent methodsFor: 'accessing' stamp: 'jmv 9/10/2021 16:07:19' prior: 50467658! + mouseButton3Changed + "Answer true if the mouseButton3 has changed. + Reported by the VM for center (wheel) mouse button or cmd+click on the Mac or meta+click on Linux. + It is also emulated here with shift-ctrl-click or ctrl-rightClick on any platform. + The check for button change (instead of button press) is specially useful on buttonUp events." + + (self turnMouseButton1Into3 and: [ whichButton anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + (self turnMouseButton2Into3 and: [ whichButton anyMask: InputSensor mouseButton2 ]) + ifTrue: [ ^ true ]. + ^ whichButton anyMask: InputSensor mouseButton3! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4856-ctrl-rightClick-emulatesCenterClick-JuanVuletich-2021Sep10-16h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4856] on 13 September 2021 at 3:51:30 pm'! +!ScrollBar methodsFor: 'events' stamp: 'jmv 9/13/2021 15:51:20' prior: 16904535 overrides: 16874668! + mouseStillDown + + nextPageDirection notNil ifTrue: [ + self scrollByPage ]! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4857-AvoidWalkbackOnLost-mouseDown-JuanVuletich-2021Sep13-15h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4856] on 13 September 2021 at 4:08:19 pm'! +!WorldMorph methodsFor: 'canvas' stamp: 'jmv 9/13/2021 16:07:58' prior: 50603143! + setMainCanvas + "Deallocate before allocating could mean less memory stress." + + self clearCanvas. + self setCanvas: Display getMainCanvas. + self restoreDisplay.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/13/2021 16:03:02' prior: 50604478! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + self clearCanvas. + DisplayScreen startUp. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4858-MainWindowResizeCleanup-JuanVuletich-2021Sep13-15h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4858] on 14 September 2021 at 3:57:49 pm'! +!WidgetMorph methodsFor: 'drawing' stamp: 'jmv 9/13/2021 17:26:04' overrides: 50578163! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + auxCanvas _ MorphicCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! +!Morph methodsFor: 'drawing' stamp: 'jmv 9/13/2021 17:26:23' prior: 50578163! + imageForm: extentOrNil depth: depth + + self subclassResponsibility! ! + +MovableMorph removeSelector: #privateLocation:! + +!methodRemoval: MovableMorph #privateLocation: stamp: 'Install-4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st 9/21/2021 12:54:38'! +privateLocation: aGeometryTransformation + location _ aGeometryTransformation.! + +Morph removeSelector: #privateLocation:! + +!methodRemoval: Morph #privateLocation: stamp: 'Install-4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st 9/21/2021 12:54:38'! +privateLocation: aGeometryTransformation! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4859] on 14 September 2021 at 4:21:17 pm'! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 9/14/2021 16:20:04' prior: 16835206! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:. + + If for whatever reason, actual OS or hardware Display is smaller than us, don't go outside its bounds. + This can sometimes happen, at least on MacOS, when frantically resizing the main OS Cuis window, + while Morphic is busy drawing many heavy morphs: it could be observed than apparently in #displayWorld, + after we were updated in #checkForNewScreenSize, MacOS window could be made smaller than aRectangle, + and a hard crash due to an invalid memory access happened in this primitive." + + | platformDisplayExtent | + platformDisplayExtent _ DisplayScreen actualScreenSize. + self primShowRectLeft: (aRectangle left max: 0) + right: (aRectangle right min: platformDisplayExtent x) + top: (aRectangle top max: 0) + bottom: (aRectangle bottom min: platformDisplayExtent y). +! ! +!WorldMorph methodsFor: 'drawing' stamp: 'jmv 9/14/2021 16:20:41' prior: 50551878! + displayWorld + "Update this world's display." + + | deferredUpdateVMMode worldDamageRects handsToDraw allDamage | + self checkIfUpdateNeeded ifFalse: [ ^ self ]. "display is already up-to-date" + "I (jmv) removed the call to 'deferUpdates: false' below. No more need to call this every time." + deferredUpdateVMMode _ self tryDeferredUpdatingAndSetCanvas. + + "repair world's damage on canvas" + worldDamageRects _ canvas drawWorld: self repair: damageRecorder. + + "Check which hands need to be drawn (they are not the hardware mouse pointer)" + handsToDraw _ self selectHandsToDrawForDamage: worldDamageRects. + allDamage _ Array streamContents: [ :strm | + strm nextPutAll: worldDamageRects. + handsToDraw do: [ :h | + h savePatchFrom: canvas appendDamageTo: strm ]]. + + "Draw hands (usually carying morphs) onto world canvas" + canvas newClipRect: nil. + handsToDraw reverseDo: [ :h | canvas fullDrawHand: h ]. + + "quickly copy altered rects of canvas to Display:" + deferredUpdateVMMode ifFalse: [ + "Drawing was done to off-Display canvas. Copy content to Display" + canvas showAt: self viewBox origin invalidRects: allDamage ]. + + "Display deferUpdates: false." + "Display forceDisplayUpdate" + DisplayScreen isDisplayExtentOk ifTrue: [ + Display forceDamageToScreen: allDamage ]. + + "Restore world canvas under hands and their carried morphs" + handsToDraw do: [ :h | h restoreSavedPatchOn: canvas ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4860-fixUnlikelyCrashOnMainWindowResize-JuanVuletich-2021Sep14-16h15m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4860] on 15 September 2021 at 9:48:57 am'! +!GeometryTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:16:54'! + invertingYAxis: mustInvertYAxis + "Answer an instance (either the receiver or a new one) with the prescribed behavior on the Y axis: + - If mustInvertYAxis, the Y axis in inner and outer space point in opposite directions. + - If mustInvertYAxis is false, the Y axis in inner and outer space point in the same direction (either up or down). + Senders should always use the returned object, but not assume it is a new one: + it could also be the receiver itself." + + self doesMirror = mustInvertYAxis ifFalse: [ + ^self withCurrentYAxisInverted ]. + ^self! ! +!GeometryTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:15:52'! + withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one: + it could also be the receiver itself." + + self subclassResponsibility! ! +!AffineTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:15:58' overrides: 50607765! + withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one (like for MorphicTranslation): + it could also be the receiver itself, like when the receiver is already a AffineTransformation." + + self a12: self a12 negated. + self a22: self a22 negated. + ^self! ! +!MorphicTranslation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:16:01' overrides: 50607765! +withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one (like here): + it could also be the receiver itself, like when the receiver is already a AffineTransformation." + + ^(AffineTransformation withTranslation: self translation) withCurrentYAxisInverted! ! +!MovableMorph methodsFor: 'geometry testing' stamp: 'jmv 9/14/2021 18:21:50'! + yAxisPointsUp + "By default, most morphs assume the usual convention in 2d computer graphics: + - x points to the right (i.e. increasing x values move from left to right) + - y points down (i.e. increasing y values move from top to bottom) + Subclasses wanting to follow the standard math convention, making increasing y values move upwards + should redefine this method to answer true." + + ^false! ! +!MovableMorph methodsFor: 'private' stamp: 'jmv 9/14/2021 18:24:55'! + fixYAxisDirection + "Ensure the direction of the Y axis used by our location for coordinate transformations matches our #yAxisPointsUp." + + | ownersYAxisPointsUp | + ownersYAxisPointsUp _ owner ifNil: [false] ifNotNil: [owner yAxisPointsUp]. + location _ location invertingYAxis: (self yAxisPointsUp = ownersYAxisPointsUp) not! ! +!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 9/14/2021 18:58:27'! + drawString: s atWaistCenter: pt font: fontOrNil color: aColor + "Answer position to place next glyph + Answer nil if nothing was done" + + | font dy | + font _ self fontToUse: fontOrNil. + dy _ currentTransformation doesMirror + ifFalse: [ font ascent * 0.4 ] + ifTrue: [ font ascent * -0.4 ]. + ^self + drawString: s + from: 1 to: s size + atBaseline: pt + ((font widthOfString: s) negated / 2 @ dy) + font: font color: aColor! ! +!GeometryTransformation methodsFor: 'testing' stamp: 'jmv 9/13/2021 17:01:20' prior: 50560820! + doesMirror + "Return true if the receiver mirrors points around some rect. + Usually this is interpreted as (and used for) inverting the direction of the Y axis between the inner and the outer coordinates systems." + + ^false! ! +!AffineTransformation methodsFor: 'testing' stamp: 'jmv 9/13/2021 17:01:13' prior: 50560826 overrides: 50607864! + doesMirror + "Return true if the receiver mirrors points around some rect. + Usually this is interpreted as (and used for) inverting the direction of the Y axis between the inner and the outer coordinates systems." + + | f | + f _ self a11 * self a22. + ^ f = 0.0 + ifTrue: [ self a12 * self a21 > 0.0] + ifFalse: [ f < 0.0 ]! ! +!MovableMorph methodsFor: 'accessing' stamp: 'jmv 9/14/2021 18:27:26' prior: 50576180 overrides: 50559745! + location: aGeometryTransformation + location _ aGeometryTransformation. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self fixYAxisDirection. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'geometry' stamp: 'jmv 9/15/2021 09:45:04' prior: 50554340! + rotateBy: radians + "Change the rotation of this morph. Argument is an angle (possibly negative), to be added to current rotation." + + | r | + r _ self yAxisPointsUp ifTrue: [ radians negated ] ifFalse: [ radians ]. + location _ location rotatedBy: r. + self fixYAxisDirection. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'geometry' stamp: 'jmv 9/15/2021 09:44:18' prior: 50554359 overrides: 50554636! + rotation: radians scale: scale + "Change the rotation and scale of this morph. Arguments are an angle and a scale." + + | r | + r _ self yAxisPointsUp ifTrue: [ radians negated ] ifFalse: [ radians ]. + location _ location withRotation: r scale: scale. + self fixYAxisDirection. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'private' stamp: 'jmv 9/14/2021 18:26:53' prior: 50554473 overrides: 50590167! + privateOwner: aMorph + "Private!! Should only be used by methods that maintain the ower/submorph invariant." + + | oldGlobalPosition prevOwner | + + self flag: #jmvVer2. + "Is this the best behavior???" + prevOwner _ owner. + prevOwner + ifNotNil: [ + "Had an owner. Maintain my global position..." + oldGlobalPosition _ self morphPositionInWorld ]. + owner _ aMorph. + owner + ifNil: [ + "Won't have any owner. Keep local position, as it will be maintained in my new owner later" + ] + ifNotNil: [ + prevOwner + ifNil: [ + "Didn't have any owner. Assume my local position is to be maintained in my new owner" + ] + ifNotNil: [ + "Had an owner. Maintain my global position..." + location _ location withTranslation: (owner internalizeFromWorld: oldGlobalPosition). + self flag: #jmvVer2. + "extent _ owner internalizeDistanceFromWorld: oldGlobalExtent" "or something like this!!" + ]]. + self fixYAxisDirection.! ! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/14/2021 18:59:01' prior: 50607357! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 9) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1 by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atWaistCenter: x @ (tickLength*4) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1 by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaist: tickLength @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/15/2021 09:46:28' prior: 50576188! + doRot: evt with: rotHandle + "Update the rotation of my target if it is rotatable." + + | radians prevLocation deltaRadians | + evt hand obtainHalo: self. + radians _ (evt eventPosition - target referencePosition) theta + angleOffset. + radians _ radians detentBy: 0.05 atMultiplesOf: Float pi / 4 snap: false. + rotHandle color: (radians = 0.0 + ifTrue: [`Color lightBlue`] + ifFalse: [`Color blue`]). + rotHandle submorphsDo: [ :m | + m color: rotHandle color makeForegroundColor]. + prevLocation _ target location. + deltaRadians _ radians-prevLocation radians. + target yAxisPointsUp ifTrue: [ deltaRadians _ deltaRadians negated ]. + target location: (prevLocation composedWith: ( + AffineTransformation withRadians: deltaRadians around: target rotationCenter)). + rotHandle morphPositionInWorld: evt eventPosition - (rotHandle morphExtent // 2). + self redrawNeeded.! ! +!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 9/14/2021 19:00:41' prior: 50566033! + drawString: aString from: firstIndex to: lastIndex atWaist: aPoint font: font color: aColor + "Answer position to place next glyph + Answer nil if nothing was done" + + | dy | + dy _ currentTransformation doesMirror + ifFalse: [ font ascent * 0.4 ] + ifTrue: [ font ascent * -0.4 ]. + ^self drawString: aString from: firstIndex to: lastIndex + atBaseline: aPoint + (0 @ dy) + font: font color: aColor! ! + +MorphicTranslation removeSelector: #withYAxisNegated! + +!methodRemoval: MorphicTranslation #withYAxisNegated stamp: 'Install-4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st 9/21/2021 12:54:39'! +withYAxisNegated + "Swap inneer point Y sign. + Make y increment upwards. + This makes the any matrix transform from standard mathematical coordinates + to standard display coordinates (in addition to the transform it was already doing) + + Answer the modified object. In this implementation this requires the creation of a new, more general instance. + Senders should always use the returned object, but not assume it is a new one: it could also be the receiver itself, + as if the receiver is already a AffineTransformation." + + ^(AffineTransformation withTranslation: self translation) withYAxisNegated! + +AffineTransformation removeSelector: #withYAxisNegated! + +!methodRemoval: AffineTransformation #withYAxisNegated stamp: 'Install-4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st 9/21/2021 12:54:39'! +withYAxisNegated + "Swap inneer point Y sign. + Make y increment upwards. + This makes the any matrix transform from standard mathematical coordinates + to standard display coordinates (in addition to the transform it was already doing) + + Answer the modified object. In this implementation it is self, but some classes of transformations, + more restricted ones (like MorphicTranslation) could require the creation of a new, more general instance. + Senders should always use the returned object, but not assume it is a new one: it could also be the receiver itself." + + self a12: self a12 negated. + self a22: self a22 negated. + ^self! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4861] on 15 September 2021 at 9:07:29 am'! +!WidgetMorph methodsFor: 'drawing' stamp: 'jmv 9/15/2021 08:48:04' prior: 50607608 overrides: 50607627! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + "To avoid slower Smalltalk VG engine just because of window decorations" + auxCanvas _ BitBltCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4862-imageForm-use-BitBltCanvas-JuanVuletich-2021Sep15-09h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4862] on 16 September 2021 at 11:30:30 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/16/2021 11:22:16'! + setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk garbageCollect ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 9/16/2021 10:58:07' prior: 50607656! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:. + + If for whatever reason, actual OS or hardware Display is smaller than us, don't go outside its bounds. + This can sometimes happen, at least on MacOS, when frantically resizing the main OS Cuis window, + while Morphic is busy drawing many heavy morphs: it could be observed than apparently in #displayWorld, + after we were updated in #checkForNewScreenSize, MacOS window could be made smaller than aRectangle, + and a hard crash due to an invalid memory access happened in this primitive. + + Protecting against our bounds being smaller than aRectangle is done in the primitive. No need to do it here." + + | platformDisplayExtent | + platformDisplayExtent _ DisplayScreen actualScreenSize. + self primShowRectLeft: (aRectangle left max: 0) + right: (aRectangle right min: platformDisplayExtent x) + top: (aRectangle top max: 0) + bottom: (aRectangle bottom min: platformDisplayExtent y). +! ! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/16/2021 11:22:01' prior: 50571610 overrides: 50335342! + startUp + " + DisplayScreen startUp. + Display forceToScreen. + " + self setupDisplay: false.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/16/2021 11:25:32' prior: 50607588! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + "Minimize the risk of going out of memory: + - First clear existing canvas, to free the memory it uses. + - Then, setup the display, with a GarbageCollection prior to allocating new display memory. + - Then set up new canvas." + self clearCanvas. + DisplayScreen setupDisplay: true. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4863-GarbabeCollectDuringDisplayResize-JuanVuletich-2021Sep16-11h28m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:28:36 pm'! +!LargeNegativeInteger methodsFor: 'printing' stamp: 'jmv 9/16/2021 14:27:54' overrides: 16862727! + printOn: aStream base: b nDigits: n + "See comment at LargePositiveInteger." + + self shouldNotImplement.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4864-printOnbasenDigits-notAppropriateFor-LargeNegativeInteger-JuanVuletich-2021Sep16-14h27m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:33:13 pm'! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:32:50'! + millisecondsToRun + "Answer the number of milliseconds taken to execute this block." + + ^ Time millisecondsToRun: self +! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4865-millisecondsToRun-JuanVuletich-2021Sep16-14h28m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:36:00 pm'! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:34:45'! + millisecondsToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(Smalltalk vmParameterAt: 8) + + (Smalltalk vmParameterAt: 10) + + self millisecondsToRun - + (Smalltalk vmParameterAt: 8) - + (Smalltalk vmParameterAt: 10) +! ! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:34:26' prior: 16787872! + durationToRun + "Answer the duration taken to execute this block." + + ^ Duration milliSeconds: self millisecondsToRun.! ! +!TestCase methodsFor: 'assertions' stamp: 'jmv 9/16/2021 14:35:21' prior: 50458973! + should: aClosure notTakeMoreThan: aLimit + + | millisecondsLimit | + + millisecondsLimit := aLimit totalMilliseconds. + self assert: aClosure millisecondsToRun <= millisecondsLimit + description: [ 'Took more than ', millisecondsLimit printString, ' milliseconds' ].! ! + +BlockClosure removeSelector: #timeToRunWithoutGC! + +!methodRemoval: BlockClosure #timeToRunWithoutGC stamp: 'Install-4866-prefer-millisecondsToRun-over-timeToRun-JuanVuletich-2021Sep16-14h33m-jmv.001.cs.st 9/21/2021 12:54:39'! +timeToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(Smalltalk vmParameterAt: 8) + + (Smalltalk vmParameterAt: 10) + + self timeToRun - + (Smalltalk vmParameterAt: 8) - + (Smalltalk vmParameterAt: 10) +! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4866-prefer-millisecondsToRun-over-timeToRun-JuanVuletich-2021Sep16-14h33m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4866] on 17 September 2021 at 10:22:21 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/17/2021 10:21:57' prior: 50608164! + setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk primitiveGarbageCollect. ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4867-just-primitiveGarbageCollect-onDisplaySetup-JuanVuletich-2021Sep17-10h21m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4866] on 17 September 2021 at 10:58:32 am'! +!PasteUpMorph methodsFor: 'misc' stamp: 'jmv 9/17/2021 10:58:19' prior: 50572357! + buildMagnifiedBackgroundImage + | image | + backgroundImageData + ifNil: [ backgroundImage _ nil ] + ifNotNil: [ + [ + backgroundImage _ nil. + Smalltalk primitiveGarbageCollect. + image _ Form fromBinaryStream: backgroundImageData readStream. + backgroundImage _ image magnifyTo: extent. + backgroundImage _ backgroundImage orderedDither32To16 asColorFormOfDepth: 8. + image _ nil. + Smalltalk primitiveGarbageCollect. + backgroundImage bits pin. + ] on: Error do: [backgroundImage := nil]. "Can happen if JPEG plugin not built" + self redrawNeeded + ]! ! + +"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." +self runningWorld color: (Color fromHexString: '#214A8C') lighter.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4868-disableDesktopBackground-JuanVuletich-2021Sep17-10h39m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4868] on 20 September 2021 at 3:34:52 pm'! +!Morph methodsFor: 'change reporting' stamp: 'jmv 9/20/2021 12:32:14' prior: 50567651! + invalidateDisplayRect: damageRect for: aMorph + " + If we clip submorphs, then we clip damageRect. + + aMorph is the morph that changed and therefore should be redrawn. In some cases, damage reporting is done by no longer occupying some area, and requesting whatever appropriate morph to be drawn there. In such cases, aMorph should be nil. See senders." + + | clippedRect b | + self visible ifFalse: [ ^self]. + + clippedRect _ damageRect. + aMorph == self ifFalse: [ + self clipsSubmorphsReally ifTrue: [ + b _ self displayBounds. + b ifNil: [ ^self ]. + clippedRect _ damageRect intersect: b ]]. + owner ifNotNil: [ + owner invalidateDisplayRect: clippedRect for: aMorph ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4869-Transcript-artifactsInVG-fix-JuanVuletich-2021Sep20-15h34m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4869] on 21 September 2021 at 9:53:48 am'! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:32'! +fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^true ]. + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^true ]]. + ^ false.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:50:59'! + isCloserThan: maxDistance toPixel: worldPoint + "Answer true if our closest point to aPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + Uses precise testing of the morph contour if available: + Morphs not in the WidgetMorph hierarchy should answer #true to wantsContour. + Note: Considers only the external border. Any inner pixel is considered 'inside' regardless of us being transparent there. + Note: Cheaper than #coversAnyPixelCloserThan:to: . Doesn't use #bitMask. Doesn't require maintenance." + + | center contourTop contourBottom | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - worldPoint y) abs < (privateDisplayBounds height // 2 + maxDistance) ifFalse: [ + ^false ]. + (center x - worldPoint x) abs < (privateDisplayBounds width // 2 + maxDistance) ifFalse: [ + ^false ]. + "Precise check with contour, if available" + (self valueOfProperty: #contour) ifNotNil: [ :contour | | y0 y1 x0 x1 | + contourTop _ self valueOfProperty: #contourY0. + contourBottom _ self valueOfProperty: #contourY1. + "Contour rows to consider are those within requested distance." + y0 _ worldPoint y - maxDistance max: contourTop. + y1 _ worldPoint y + maxDistance min: contourBottom. + y0 to: y1 do: [ :y | + x0 _ (contour at: (y - contourTop) * 2 + 1) - maxDistance. + x1 _ (contour at: (y - contourTop) * 2 + 2) + maxDistance. + "If a vertical line of 2*aNumber height centered on aPoint is inside the contour, quick exit" + (worldPoint x between: x0 and: x1) ifTrue: [ ^true ]. + "Check if aPoint is close enough to contour" + (x0@y - worldPoint) r < maxDistance ifTrue: [ ^true ]. + (x1@y - worldPoint) r < maxDistance ifTrue: [ ^true ]]. + "Not inside, not close enough to contour" + ^ false ]. + "If contour is not available, and aPoint is close enough to displayBounds, answer true, as it is the best we can know." + ^ true! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:33:07'! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + Some implementations (KernelMorph and WidgetMorph) may also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for VectorGraphics based morphs (i.e. morphs that answer true to #requiresVectorCanvas). + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self ownsPixel: worldPoint.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:12:00'! + ownsPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + Requires VectorGraphics. + Only valid for morphs that answer true to #requiresVectorCanvas" + + self topmostWorld ifNotNil: [ :w | + w canvas ifNotNil: [ :canvas | + ^ (canvas morphIdAt: worldPoint) = self morphId ]]. + ^ false.! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:25:55'! + coversLocalPoint: aLocalPoint + "Answer true as long as aLocalPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it." + + "If not visible, won't cover any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:36:45'! + coversPixel: worldPoint + "Answer true as long as worldPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it. + This implementation is cheap, we are a rectangular shape." + + ^ self coversLocalPoint: + (self internalizeFromWorld: worldPoint)! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:36' overrides: 50608429! + fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]. + self submorphsMightProtrude ifTrue: [ + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]]]. + ^ false.! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:35:38' overrides: 50608507! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + This implementation also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for morphs with a cheap #coversPixel:. + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self visible and: [self coversPixel: worldPoint].! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:26:19'! + coversLocalPoint: aLocalPoint + "Answer true as long as aLocalPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it." + + "If not visible, won't cover any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:36:52'! + coversPixel: worldPoint + "Answer true as long as worldPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it. + This implementation is cheap, we are a rectangular shape." + + ^ self coversLocalPoint: + (self internalizeFromWorld: worldPoint)! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:41' overrides: 50608429! + fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]. + self submorphsMightProtrude ifTrue: [ + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]]]. + ^ false.! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:35:48' overrides: 50608507! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + This implementation also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for morphs with a cheap #coversPixel:. + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self visible and: [self coversPixel: worldPoint].! ! +!WindowEdgeAdjustingMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:30:16' overrides: 50608610! + coversLocalPoint: aLocalPoint + "We don't completely cover our bounds. Account for that." + + | sensitiveBorder | + ( self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [ ^false ]. + sensitiveBorder _ owner borderWidth. + selector caseOf: { + [ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]]. + [ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]]. + } + otherwise: [ + "all the morph is sensitive for horizontal and vertical (i.e. non corner) instances." + ^true ]! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 9/20/2021 12:13:48' prior: 50562746! + 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 fullOwnsOrCoversPixel: 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 ].! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:53:20' prior: 50593407! + contourIntersects: aContourArray top: aContourTop bottom: aContourBottom + "Check if contours intersect. + If contour is not available, use displayBounds. + Not to be called directly. Pefer a higher level service. See senders." + + | contour contourTop contourBottom x0Own x1Own x0Arg x1Arg | + contour _ self valueOfProperty: #contour. + contourTop _ (self valueOfProperty: #contourY0) ifNil: [aContourTop]. + contourBottom _ (self valueOfProperty: #contourY1) ifNil: [aContourBottom]. + + (contourTop max: aContourTop) to: (contourBottom min: aContourBottom) do: [ :y | + x0Own _ contour ifNil: [privateDisplayBounds left] ifNotNil: [ contour at: (y - contourTop) * 2 + 1 ]. + x1Own _ contour ifNil: [privateDisplayBounds right-1] ifNotNil: [ contour at: (y - contourTop) * 2 + 2 ]. + x0Arg _ aContourArray at: (y - aContourTop) * 2 + 1. + x1Arg _ aContourArray at: (y - aContourTop) * 2 + 2. + (x0Own <= x1Arg and: [ x0Arg <= x1Own ]) + ifTrue: [ ^true ]]. + + ^false! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:51:06'! + coversAnyPixelCloserThan: maxDistance to: worldPoint + "Answer true if our closest point to worldPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + See #bitMask. + Remember to do + self removeProperty: #bitMask. + when appropriate!! (i.e. when we change in such a way to make the bitMask invalid). + + Note: Requires VectorGraphics. Meant to be used only when needed. + Note: Prefer #isCloserThan:toPixel:, that doesn't use #bitMask, and doesn't require maintenance." + + | center maxDistanceSquared | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - worldPoint y) abs < (privateDisplayBounds height // 2 + maxDistance) ifFalse: [ + ^false ]. + (center x - worldPoint x) abs < (privateDisplayBounds width // 2 + maxDistance) ifFalse: [ + ^false ]. + "Precise check with bitMask" + (self coversPixel: worldPoint) ifTrue: [ ^true ]. + maxDistanceSquared _ maxDistance squared. + maxDistance negated to: maxDistance do: [ :dy | + maxDistance negated to: maxDistance do: [ :dx | + dx squared + dy squared <= maxDistanceSquared ifTrue: [ + (self coversPixel: worldPoint + (dx@dy)) ifTrue: [ ^true ]]]]. + ^false.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:38:06'! + coversPixel: worldPoint + "Answer true if pixel worldPoint is covered by us, even if we are not visible a it because of some + other morph above us also covers it. + See #bitMask. + Remember to do + self removeProperty: #bitMask. + when appropriate!! (i.e. when we change in such a way to make the bitMask invalid). + + Note: Subclasses such as KernelMorph and WidgetMorph redefine this method with an optimized + implementation that doesn't require computing and invalidating the #bitMask. Senders in the base image + and framework actually only use this optimized implementation. That's why general morphs don't care about + invalidting #bitMask. + + Note: If your morph #requiresVectorCanvas, and depends on this general implementation, remember to + `removeProperty: #bitMask` whenever it becomes invalid due to changes in your morphs. You may consider + using #ownsPixel: if appropriate, that doesn't require any maintenance and is cheaper (in cpu and memory). + + Note: This implementation requires VectorGraphics." + + self visible ifTrue: [ + ^(self bitMask pixelValueAt: worldPoint - self displayFullBounds topLeft) = 1 ]. + ^ false! ! +!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 9/20/2021 12:13:54' prior: 50567189! + transferHalo: event from: formerHaloOwner + "Progressively transfer the halo to the next likely recipient" + + formerHaloOwner == self + ifFalse: [ + self addHalo: event. + ^self ]. + + event shiftPressed ifTrue: [ + "Pass it outwards" + owner ifNotNil: [ + owner transferHalo: event from: formerHaloOwner. + ^self ]. + "We're at the top level; just keep it on ourselves" + ^self ]. + + self submorphsDo: [ :m | + (m wantsHalo and: [ m fullOwnsOrCoversPixel: event eventPosition ]) + ifTrue: [ + m transferHalo: event from: formerHaloOwner. + ^self ]]. + "We're at the bottom most level; just keep halo on ourselves"! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/20/2021 11:32:25' prior: 50562556! + 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 coversPixel: 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 9/20/2021 11:32:30' prior: 50567312! + maybeCollapse: event with: aHandle + "Ask hand to collapse my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle coversPixel: event eventPosition) + ifTrue: [ + target collapse ]. + self delete.! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/20/2021 11:32:34' prior: 50562581! + maybeDismiss: event with: aHandle + "Ask hand to dismiss my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle coversPixel: 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 9/20/2021 11:32:38' prior: 50562599! + setDismissColor: event with: aHandle + "Called on mouseStillDown in the dismiss handle; set the color appropriately." + + | colorToUse | + event hand obtainHalo: self. + colorToUse _ (aHandle coversPixel: event eventPosition) + ifFalse: [ `Color red muchLighter` ] + ifTrue: [ `Color lightGray` ]. + aHandle color: colorToUse! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:44' prior: 50562643! + activateOwnerMenu: evt + "Activate our owner menu; e.g., pass control to it" + owner ifNil: [ ^false ]. "not applicable" + (owner coversPixel: evt eventPosition) + ifFalse: [ ^false ]. + owner activate: evt. + ^true! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:47' prior: 50565706! + activateSubmenu: event + "Activate our submenu; e.g., pass control to it" + + subMenu ifNil: [ ^false ]. "not applicable" + subMenu isInWorld ifFalse: [ ^false ]. + (subMenu coversPixel: event eventPosition) ifFalse: [^false]. + subMenu activate: event. + ^true! ! +!PluggableButtonMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:53' prior: 50562664 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + isPressed _ false. + mouseIsOver _ false. + (actWhen == #buttonUp and: [ + self coversPixel: aMouseButtonEvent eventPosition ]) + ifTrue: [ self performAction ]. + self redrawNeeded! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:36:05' prior: 50574758 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + (stayUp or: [ self coversPixel: aMouseButtonEvent eventPosition ]) + ifFalse: [ + self deleteIfPopUp: aMouseButtonEvent. + self activeHand + newKeyboardFocus: prevKbdFocus; + newMouseFocus: prevMouseFocus. + ^ self ]. "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 9/20/2021 11:36:32' prior: 50574782 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse up event. + Note: This might be sent from a modal shell." + (self coversPixel: aMouseButtonEvent eventPosition) ifFalse:[ + "Mouse up outside. Release eventual focus and delete if pop up." + aMouseButtonEvent hand ifNotNil: [ :h | h releaseMouseFocus: self ]. + self deleteIfPopUp: aMouseButtonEvent. + self activeHand + newKeyboardFocus: prevKbdFocus; + newMouseFocus: prevMouseFocus. + ^ self]. + stayUp ifFalse: [ + "Still in pop-up transition; keep focus" + aMouseButtonEvent hand newMouseFocus: self ].! ! +!AutoCompleterMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:58' prior: 50562676 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + (self coversPixel: 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 ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:09' prior: 50563947! + 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 fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:16' prior: 50563975 overrides: 50609028! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + | dropped | + + "Try to get out quickly" + (aMorph fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: 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 9/20/2021 12:14:23' prior: 50564002 overrides: 50609028! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + + "Try to get out quickly" + (aMorph fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 9/20/2021 11:33:02' prior: 50562907! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w coversPixel: position) + ifTrue: [ w delete ] ].! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:44' prior: 50564021 overrides: 50609028! + 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 fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: 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 9/20/2021 12:14:35' prior: 50598496 overrides: 50609028! + 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 | + "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 fullOwnsOrCoversPixel: position :: 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 fullOwnsOrCoversPixel: 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.! ! + +BitBltCanvas removeSelector: #morph:isAtPoint:! + +!methodRemoval: BitBltCanvas #morph:isAtPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +morph: aMorph isAtPoint: aPoint + + aMorph basicDisplayBounds ifNotNil: [ :r | + (r containsPoint: aPoint) ifFalse: [ + ^false ]]. + "Give morphs with a non-rectangular shape (corner WindowEdgeAdjustingMorphs) + a chance to have a say." + ^ aMorph morphContainsPoint: + (aMorph internalizeFromWorld: aPoint)! + +WindowEdgeAdjustingMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: WindowEdgeAdjustingMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +morphContainsPoint: aLocalPoint + | sensitiveBorder | + ( self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [ ^false ]. + sensitiveBorder _ owner borderWidth. + selector caseOf: { + [ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]]. + [ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]]. + } + otherwise: [ + "all the morph is sensitive for horizontal and vertical (i.e. non corner) instances." + ^true ]! + +WidgetMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: WidgetMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +morphContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in a submorph in front of us, as long as it is inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! + +HaloMorph removeSelector: #containsGlobalPoint:! + +!methodRemoval: HaloMorph #containsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +containsGlobalPoint: worldPoint + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + ^self morphLocalBounds containsPoint: + (self internalizeFromWorld: worldPoint) ]]. + ^ false! + +KernelMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: KernelMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +morphContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in a submorph in front of us, as long as it is inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! + +Morph removeSelector: #containsGlobalPoint:! + +!methodRemoval: Morph #containsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +containsGlobalPoint: worldPoint + "Answer true if pixel worldPoint is covered by us, and we are visible a it. + No other morph above us also covers it." + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + w canvas ifNotNil: [ :canvas | + ^ canvas morph: self isAtPoint: worldPoint ]]]. + ^ false! + +Morph removeSelector: #isCloserThan:to:! + +Morph removeSelector: #fullContainsGlobalPoint:! + +!methodRemoval: Morph #fullContainsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +fullContainsGlobalPoint: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape." + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + (self containsGlobalPoint: worldPoint) ifTrue: [ ^ true ]. + self submorphsDo: [ :m | + (m fullContainsGlobalPoint: worldPoint) ifTrue: [ ^ true ]]]]. + ^ false! + +Morph removeSelector: #isCloserThan:toPoint:! + +!methodRemoval: Morph #isCloserThan:toPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:54:39'! +isCloserThan: aNumber toPoint: aPoint + "Answer true if our closest point to aPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + Uses precise testing of the morph contour if available. See #knowsContour." + + | center contourTop contourBottom | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - aPoint y) abs < (privateDisplayBounds height // 2 + aNumber) ifFalse: [ + ^false ]. + (center x - aPoint x) abs < (privateDisplayBounds width // 2 + aNumber) ifFalse: [ + ^false ]. + "Precise check with contour, if available" + (self valueOfProperty: #contour) ifNotNil: [ :contour | | y0 y1 x0 x1 | + contourTop _ self valueOfProperty: #contourY0. + contourBottom _ self valueOfProperty: #contourY1. + "Contour rows to consider are those within requested distance." + y0 _ aPoint y - aNumber max: contourTop. + y1 _ aPoint y + aNumber min: contourBottom. + y0 to: y1 do: [ :y | + x0 _ (contour at: (y - contourTop) * 2 + 1) - aNumber. + x1 _ (contour at: (y - contourTop) * 2 + 2) + aNumber. + "If a vertical line of 2*aNumber height centered on aPoint is inside the contour, quick exit" + (aPoint x between: x0 and: x1) ifTrue: [ ^true ]. + "Check if aPoint is close enough to contour" + (x0@y - aPoint) r < aNumber ifTrue: [ ^true ]. + (x1@y - aPoint) r < aNumber ifTrue: [ ^true ]]. + "Not inside, not close enough to contour" + ^ false ]. + "If contour is not available, and aPoint is close enough to displayBounds, answer true, as it is the best we can know." + ^ true! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st----! + +'From Cuis 5.0 [latest update: #4870] on 21 September 2021 at 10:47:45 am'! +!KernelMorph methodsFor: 'drawing' stamp: 'jmv 9/21/2021 10:47:14' overrides: 50607627! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + auxCanvas _ BitBltCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4871-imageFormdepth-KernelMorph-JuanVuletich-2021Sep21-10h46m-jmv.001.cs.st----! + +----QUIT----(21 September 2021 12:54:43) Cuis5.0-4871-v3.image priorSource: 8745619! \ No newline at end of file diff --git a/Cuis5.0-4834-v3.image b/Cuis5.0-4871-v3.image similarity index 66% rename from Cuis5.0-4834-v3.image rename to Cuis5.0-4871-v3.image index 6f70dfde..a024dcea 100644 Binary files a/Cuis5.0-4834-v3.image and b/Cuis5.0-4871-v3.image differ diff --git a/Cuis5.0-4834.changes b/Cuis5.0-4871.changes similarity index 98% rename from Cuis5.0-4834.changes rename to Cuis5.0-4871.changes index 097a1615..3f080e75 100644 --- a/Cuis5.0-4834.changes +++ b/Cuis5.0-4871.changes @@ -343740,4 +343740,3092 @@ Please remedy manually and then repeat your request.' ]. ----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4834-Enlarge-GCParameters-JuanVuletich-2021Sep03-11h27m-jmv.001.cs.st----! -----QUIT----(3 September 2021 15:02:05) Cuis5.0-4834.image priorSource: 14248608! \ No newline at end of file +----QUIT----(3 September 2021 15:02:05) Cuis5.0-4834.image priorSource: 14248608! + +----STARTUP---- (21 September 2021 12:53:25) as C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\Cuis5.0-4834.image! + + +'From Haver 5.0 [latest update: #4821] on 1 September 2021 at 5:39:26 pm'! +!Boolean methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:33:22'! +asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ self subclassResponsibility! ! +!False methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:33:51' overrides: 50778367! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ ''! ! +!True methodsFor: 'user interface support' stamp: 'KLG 9/1/2021 17:34:02' overrides: 50778367! + asMenuItemTextPrefix + "Answer '' or '' to prefix a menu item text with a check box. " + + ^ ''! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4835-asMenuItemTextPrefix-GeraldKlix-2021Sep01-17h30m-KLG.001.cs.st----! + +'From Haver 5.0 [latest update: #4821] on 1 September 2021 at 7:00:13 pm'! +!TaskbarMorph class methodsFor: 'as yet unclassified' stamp: 'KLG 9/1/2021 18:58:39' overrides: 16877245! + includeInNewMorphMenu + "Return true for all classes that can be instantiated from the menu + + More than one taskbar confuses the running wolrd!!" + + ^ false! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4836-NoAdditionalTaskbarMorphs-GeraldKlix-2021Sep01-17h39m-KLG.001.cs.st----! + +'From Cuis 5.0 [latest update: #4836] on 5 September 2021 at 1:59:07 pm'! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:54:43' prior: 16812346! + showingLineDiffsString + "Answer a string representing whether I'm showing regular diffs" + + ^ self showingLineDiffs asMenuItemTextPrefix, + 'lineDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:55:59' prior: 16812361! + showingPrettyLineDiffsString + "Answer a string representing whether I'm showing pretty diffs" + + ^ self showingPrettyLineDiffs asMenuItemTextPrefix, + 'linePrettyDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:56:14' prior: 16812377! + showingPrettyWordDiffsString + "Answer a string representing whether I'm showing pretty diffs" + + ^ self showingPrettyWordDiffs asMenuItemTextPrefix, + 'wordPrettyDiffs'! ! +!CodeProvider methodsFor: 'diffs' stamp: 'jmv 9/5/2021 13:56:25' prior: 16812393! + showingWordDiffsString + "Answer a string representing whether I'm showing regular diffs" + + ^ self showingWordDiffs asMenuItemTextPrefix, + 'wordDiffs'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:55:22' prior: 16812559! + prettyPrintString + "Answer whether the receiver is showing pretty-print" + + ^ self showingPrettyPrint asMenuItemTextPrefix, + 'prettyPrint'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:53:44' prior: 16812605! + showingByteCodesString + "Answer whether the receiver is showing bytecodes" + + ^ self showingByteCodes asMenuItemTextPrefix, + 'byteCodes'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:54:04' prior: 16812620! + showingDecompileString + "Answer a string characerizing whether decompilation is showing" + + ^ self showingDecompile asMenuItemTextPrefix, + 'decompile'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:54:20' prior: 16812636! + showingDocumentationString + "Answer a string characerizing whether documentation is showing" + + ^ self showingDocumentation asMenuItemTextPrefix, + 'documentation'! ! +!CodeProvider methodsFor: 'what to show' stamp: 'jmv 9/5/2021 13:55:44' prior: 16812651! + showingPlainSourceString + "Answer a string telling whether the receiver is showing plain source" + + ^ self showingPlainSource asMenuItemTextPrefix, + 'source'! ! +!Morph methodsFor: 'menus' stamp: 'jmv 9/5/2021 13:57:02' prior: 16876328! + stickinessString + "Answer the string to be shown in a menu to represent the + stickiness status" + + ^ self isSticky asMenuItemTextPrefix, + 'resist being picked up'! ! +!InnerTextMorph methodsFor: 'menu' stamp: 'jmv 9/5/2021 13:57:19' prior: 16855935! + wrapString + "Answer the string to put in a menu that will invite the user to + switch word wrap mode" + ^ wrapFlag asMenuItemTextPrefix, + 'text wrap to bounds'! ! +!FileListWindow methodsFor: 'menu building' stamp: 'jmv 9/5/2021 13:58:00' prior: 50775730! + volumeMenu + | aMenu initialDirectoriesMenu | + aMenu _ MenuMorph new defaultTarget: model. + aMenu + add: 'delete directory...' + action: #deleteDirectory + icon: #warningIcon :: setBalloonText: 'Delete the selected directory'. + model currentDirectorySelected + ifNil: [ aMenu add: 'initial directory' action: #yourself :: isEnabled: false ] + ifNotNil: [ :selectedWrapper | + aMenu + add: (Preferences isInitialFileListDirectory: selectedWrapper item) + asMenuItemTextPrefix, 'initial directory' + action: #toggleInitialDirectory :: + setBalloonText: 'The selected directory is an initial director for new file list windows' ]. + initialDirectoriesMenu _ MenuMorph new. + #( + (roots 'default roots' 'Use the usual root directories. Drives on Windows; "/" on Unix') + (image 'image directory' 'Use the directory with Smalltalk image') + (vm 'VM directory' 'Use the virtual machine directory') + (current 'current directory' 'Use the current directory; usually the directory the VM was started in') + ) + do: [ :entry | + initialDirectoriesMenu + add: entry second + target: Preferences + action: #initialFileListDirectories: + argument: entry first :: + setBalloonText: entry third ]. + aMenu add: 'default initial directories' subMenu: initialDirectoriesMenu. + ^ aMenu! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4837-MakeGoodUseOf4835-JuanVuletich-2021Sep05-13h52m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4837] on 5 September 2021 at 7:51:29 pm'! +!PluggableScrollPane methodsFor: 'geometry' stamp: 'jmv 9/5/2021 18:38:10' overrides: 50726351! + fontPreferenceChanged + + super fontPreferenceChanged. + scrollBar recreateSubmorphs. + hScrollBar recreateSubmorphs. + self setScrollDeltas.! ! + +ScrollBar removeSelector: #fontPreferenceChanged! + +!methodRemoval: ScrollBar #fontPreferenceChanged stamp: 'Install-4838-GUIelementsSizeChangeFix-JuanVuletich-2021Sep05-19h50m-jmv.001.cs.st 9/21/2021 12:53:31'! +fontPreferenceChanged + "Rescale" + + self recreateSubmorphs! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4838-GUIelementsSizeChangeFix-JuanVuletich-2021Sep05-19h50m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4837] on 5 September 2021 at 7:52:31 pm'! +!Preferences class methodsFor: 'fonts' stamp: 'jmv 9/5/2021 19:52:05' prior: 50741502! + setDefaultFont: aFontName + "Change the font on the whole system without changing point sizes." + FontFamily defaultFamilyName: aFontName. + Preferences + setDefaultFont: FontFamily defaultFamilyName + spec: { + {#setListFontTo:. Preferences standardListFont pointSize.}. + {#setMenuFontTo:. Preferences standardMenuFont pointSize.}. + {#setWindowTitleFontTo:. Preferences windowTitleFont pointSize.}. + {#setCodeFontTo:. Preferences standardCodeFont pointSize.}. + {#setButtonFontTo:. Preferences standardButtonFont pointSize.}. + }. + MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ]. + UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! ! +!Preferences class methodsFor: 'fonts' stamp: 'jmv 9/5/2021 19:51:58' prior: 50776326! + setDefaultFont: fontFamilyName spec: defaultFontsSpec + + | font | + defaultFontsSpec do: [ :triplet | + font _ FontFamily familyName: fontFamilyName pointSize: triplet second. + font ifNil: [ font _ FontFamily defaultFamilyAndPointSize ]. + triplet size > 2 ifTrue: [ + font _ font emphasized: triplet third ]. + self + perform: triplet first + with: font ]. + MorphicCanvas allSubclassesDo: [ :c| c guiSizePreferenceChanged ]. + UISupervisor ui ifNotNil: [ :w | w fontPreferenceChanged ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4839-GUISizePreferenceChanged-JuanVuletich-2021Sep05-19h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4839] on 6 September 2021 at 10:24:41 am'! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/6/2021 10:21:10' prior: 50769804! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + stepX _ FontFamily defaultPointSize * 4 //10 * 10. + stepY _ FontFamily defaultPointSize * 2 //10 * 10. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: 2 color: c. + aCanvas line: 0@y0 to: 0@y1 width: 2 color: c. + + (x0 truncateTo: stepX) to: (x1 - stepX truncateTo: stepX) by: stepX do: [ :x | + aCanvas line: x @ -5 to: x @ 5 width: 2 color: c. + aCanvas drawString: x printString atCenterXBaselineY: x @ -10 font: nil color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - 15 @ 0 font: nil color: c. + + (y0 truncateTo: stepY) to: (y1 - stepY truncateTo: stepY) by: stepY do: [ :y | + aCanvas line: -5 @ y to: 5 @ y width: 2 color: c. + aCanvas drawString: y printString, ' ' atWaistRight: -5 @ y font: nil color: c ]. + aCanvas drawString: 'y' atWaistRight: -5 @ (y1 - 20) font: nil color: c. + + aCanvas geometryTransformation: prevTx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4840-drawCoordinateSystem-tweak-JuanVuletich-2021Sep05-20h14m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4839] on 6 September 2021 at 11:07:34 am'! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 11:07:11' prior: 50777510! + displayWorldSafely + "Update this world's display and keep track of errors during draw methods." + + [self displayWorld] on: Error, Halt do: [ :ex | + "Handle a drawing error" + canvas currentMorphDrawingFails. + "Creating a new canvas here could be dangerous, as code signaling the exception will be resumed." + self resetCanvas. + "Install the old error handler, so we can re-raise the error" + ex receiver error: ex description. + ]! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4841-Morphic-ErrorHandling-fix-JuanVuletich-2021Sep06-11h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4841] on 6 September 2021 at 12:08:56 pm'! +!MorphicCanvas methodsFor: 'morphic' stamp: 'jmv 9/6/2021 12:08:14' prior: 50733093! + fullDraw: aMorph + "Draw the full Morphic structure on us" + + "We are already set with a proper transformation from aMorph owner's coordinates to those of our target form." + + self flag: #jmvVer3. + aMorph visible ifFalse: [^ self]. + self into: aMorph. + + currentMorph layoutSubmorphsIfNeeded. + + currentMorph isKnownFailing ifTrue: [ + self canvasToUse drawCurrentAsError. + self outOfMorph. + ^ self]. + + (currentMorph isOwnedByHand and: [ + Preferences cheapWindowReframe and: [currentMorph is: #SystemWindow]]) ifTrue: [ + self drawCurrentAsOutline. + self outOfMorph. + ^ self]. + + "Draw current Morph and submorphs" + self canvasToUse drawCurrentAndSubmorphs. + + self outOfMorph! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4842-cheapWindowReframe-onlyForWindows-JuanVuletich-2021Sep06-12h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4841] on 6 September 2021 at 12:47:09 pm'! +!CodePackage methodsFor: 'naming' stamp: 'jmv 9/6/2021 12:17:27'! + packageDirectory + + ^self packageDirectoryName asDirectoryEntry! ! + +CodePackage removeSelector: #pagkageDirectory! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4843-packageDirectory-JuanVuletich-2021Sep06-12h08m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4843] on 6 September 2021 at 3:12:10 pm'! +!HandMorph methodsFor: 'drawing' stamp: 'jmv 9/6/2021 15:06:24'! + isDrawnBySoftware + "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden." + "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor from the display." + "Note. We draw the hand as a regular morph (using #drawOn:), disabling the hardware cursor, when we carry submorphs. The reason is to lock the mouse pointer and the carried morph together. Otherwhise the carried morph would lag behind the mouse pointer. + This method answers whether the regular #drawOn: drawing mechanism is used for us. + + Check senders. Hand drawing is handled explicitly by the world, because the Hand is not a submorph of the world!!" + | blankCursor | + (prevFullBounds notNil or: [ + submorphs anySatisfy: [ :ea | + ea visible ]]) ifTrue: [ + "using the software cursor; hide the hardware one" + blankCursor _ Cursor cursorAt: #blankCursor. + Cursor currentCursor == blankCursor ifFalse: [ blankCursor activateCursor ]. + ^ true ]. + ^ false.! ! +!WorldMorph methodsFor: 'hands' stamp: 'jmv 9/6/2021 15:06:31' prior: 50743721! + selectHandsToDrawForDamage: damageList + "Select the set of hands that must be redrawn because either (a) the hand itself has changed or (b) the hand intersects some damage rectangle." + + | result | + result _ OrderedCollection new. + hands do: [:hand | + hand isDrawnBySoftware ifTrue: [ + hand isRedrawNeeded + ifTrue: [result add: hand] + ifFalse: [ + hand displayFullBounds ifNotNil: [ :handBounds | + (damageList anySatisfy: [ :r | r intersects: handBounds]) ifTrue: [ + result add: hand]]]]]. + ^ result! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 15:06:36' prior: 50743741! + checkIfUpdateNeeded + + self isSubmorphRedrawNeeded ifTrue: [ ^true ]. + damageRecorder updateIsNeeded ifTrue: [^true]. + hands do: [:h | (h isRedrawNeeded | h isSubmorphRedrawNeeded and: [h isDrawnBySoftware]) ifTrue: [^true]]. + ^false "display is already up-to-date" +! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/6/2021 15:10:14' prior: 50738466! + doOneCycle + "Do one cycle of the interaction loop. This method is called repeatedly when the world is running. + + Make for low cpu usage if the ui is inactive, but quick response when ui is in use. + However, after some inactivity, there will be a larger delay before the ui gets responsive again." + + | wait waitUntil | + waitDelay ifNil: [ waitDelay _ Delay forMilliseconds: 50 ]. + (lastCycleHadAnyEvent or: [ deferredUIMessages isEmpty not ]) + ifTrue: [ + pause _ 20. "This value will only be used later, when there are no more events to serve or deferred UI messages to process." + wait _ 0. "Don't wait this time"] + ifFalse: [ + "wait between 20 and 200 milliseconds" + (hands anySatisfy: [ :h | h waitingForMoreClicks ]) + ifTrue: [ pause _ 20 ] + ifFalse: [ pause < 200 ifTrue: [ pause _ pause * 21//20 ] ]. + waitUntil _ lastCycleTime + pause. + "Earlier if steps" + stepList isEmpty not ifTrue: [ + waitUntil _ waitUntil min: stepList first scheduledTime ]. + "Earlier if alarms" + alarms ifNotNil: [ + alarms isEmpty not ifTrue: [ + waitUntil _ waitUntil min: alarms first scheduledTime ]]. + wait _ waitUntil - Time localMillisecondClock max: 0 ]. + Preferences serverMode + ifTrue: [ wait _ wait max: 50 ]. "Always wait at least a bit on servers, even if this makes the UI slow." + wait = 0 + ifTrue: [ Processor yield ] + ifFalse: [ + waitDelay beingWaitedOn + ifFalse: [ waitDelay setDelay: wait; wait ] + ifTrue: [ + "If we are called from a different process than that of the main UI, we might be called in the main + interCyclePause. In such case, use a new Delay to avoid 'This Delay has already been scheduled' errors" + (Delay forMilliseconds: wait) wait ]]. + + "Record start time of this cycle, and do cycle" + lastCycleTime _ Time localMillisecondClock. + lastCycleHadAnyEvent _ self doOneCycleNow.! ! + +HandMorph removeSelector: #needsToBeDrawn! + +!methodRemoval: HandMorph #needsToBeDrawn stamp: 'Install-4844-DelayInMenuOpenBug-Fix-JuanVuletich-2021Sep06-15h09m-jmv.001.cs.st 9/21/2021 12:53:32'! +needsToBeDrawn + "Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden." + "Details: Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor from the display." + "Note. We draw the hand as a regular morph (using #drawOn:), disabling the hardware cursor, when we carry submorphs. The reason is to lock the mouse pointer and the carried morph together. Otherwhise the carried morph would lag behind the mouse pointer. + This method answers whether the regular #drawOn: drawing mechanism is used for us. + + Check senders. Hand drawing is handled explicitly by the world, because the Hand is not a submorph of the world!!" + | blankCursor | + (prevFullBounds notNil or: [ + submorphs anySatisfy: [ :ea | + ea visible ]]) ifTrue: [ + "using the software cursor; hide the hardware one" + blankCursor _ Cursor cursorAt: #blankCursor. + Cursor currentCursor == blankCursor ifFalse: [ blankCursor activateCursor ]. + ^ true ]. + ^ false.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4844-DelayInMenuOpenBug-Fix-JuanVuletich-2021Sep06-15h09m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:36:59 pm'! +!Morph methodsFor: 'initialization' stamp: 'jmv 9/6/2021 15:21:29' prior: 16875917! + intoWorld: aWorld + "The receiver has just appeared in a new world. Note: + * aWorld can be nil (due to optimizations in other places) + * owner is already set + * owner's submorphs may not include receiver yet. + Important: Keep this method fast - it is run whenever morphs are added." + + aWorld ifNil: [ ^self ]. + self needsRedraw: true. + self wantsSteps ifTrue: [ self startStepping ]. + self submorphsDo: [ :m | m intoWorld: aWorld ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4845-AlwaysRefreshNewMorphs-JuanVuletich-2021Sep06-15h36m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:37:39 pm'! +!WorldMorph methodsFor: 'events' stamp: 'jmv 9/6/2021 15:20:19' prior: 50725571 overrides: 16874466! + click: aMouseButtonEvent localPosition: localEventPosition + + ^self mouseButton2Activity.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4846-DontWaitToOpenWorldMenu-JuanVuletich-2021Sep06-15h36m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4844] on 6 September 2021 at 3:38:16 pm'! +!HandMorph methodsFor: 'double click support' stamp: 'jmv 9/6/2021 15:30:21'! + waitForClicksOrDragOrSimulatedMouseButton2: aMorph event: evt clkSel: clkSel + + "Wait until the difference between click, or drag gesture is known, then inform the given morph what transpired." + + mouseClickState _ + MouseClickState new + client: aMorph + drag: nil + click: clkSel + clickAndHalf: nil + dblClick: nil + dblClickAndHalf: nil + tripleClick: nil + event: evt + sendMouseButton2Activity: Preferences tapAndHoldEmulatesButton2. + + "It seems the Mac VM may occasionally lose button up events triggering bogus activations. + Hence Preferences tapAndHoldEmulatesButton2"! ! +!MouseClickState methodsFor: 'private' stamp: 'jmv 9/6/2021 15:33:13'! + notWaitingForMultipleClicks + + ^ clickAndHalfSelector isNil and: [ + dblClickSelector isNil and: [ + dblClickAndHalfSelector isNil and: [ + tripleClickSelector isNil ]]]! ! +!PasteUpMorph methodsFor: 'events' stamp: 'jmv 9/6/2021 15:30:26' prior: 50724321 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + + super mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition. + + aMouseButtonEvent hand + waitForClicksOrDragOrSimulatedMouseButton2: self + event: aMouseButtonEvent + clkSel: #click:localPosition:.! ! +!MouseClickState methodsFor: 'actions' stamp: 'jmv 9/6/2021 15:33:53' prior: 50747725! + handleEvent: aMouseEvent from: aHand + "Process the given mouse event to detect a click, double-click, or drag. + Return true if the event should be processed by the sender, false if it shouldn't. + NOTE: This method heavily relies on getting *all* mouse button events." + + | timedOut distance | + timedOut _ (aMouseEvent timeStamp - lastClickDown timeStamp) > self class doubleClickTimeout. + timedOut ifTrue: [ aHand dontWaitForMoreClicks ]. + distance _ (aMouseEvent eventPosition - lastClickDown eventPosition) r. + "Real action dispatch might be done after the triggering event, for example, because of waiting for timeout. + So, count the button downs and ups(clicks), to be processed, maybe later, maybe in a mouseMove..." + aMouseEvent isMouseDown ifTrue: [ + lastClickDown _ aMouseEvent. + buttonDownCount _ buttonDownCount + 1 ]. + aMouseEvent isMouseUp ifTrue: [ + buttonUpCount _ buttonUpCount + 1 ]. + + "Drag, or tap & hold" + (buttonDownCount = 1 and: [ buttonUpCount = 0]) ifTrue: [ + (self notWaitingForMultipleClicks or: [ distance > 0 ]) ifTrue: [ + "If we have already moved, then it won't be a double or triple click... why wait?" + aHand dontWaitForMoreClicks. + dragSelector + ifNotNil: [ self didDrag ] + ifNil: [ self didClick ]. + ^ false ]. + timedOut ifTrue: [ + aHand dontWaitForMoreClicks. + "Simulate button 2 via tap & hold. Useful for opening menus on pen computers." + sendMouseButton2Activity ifTrue: [ + clickClient mouseButton2Activity ]. + ^ false ]]. + + "If we're over triple click, or timed out, or mouse moved, don't allow more clicks." + (buttonDownCount = 4 or: [ timedOut or: [ distance > 0 ]]) ifTrue: [ + aHand dontWaitForMoreClicks. + ^ false ]. + + "Simple click." + (buttonDownCount = 1 and: [ buttonUpCount = 1 ]) ifTrue: [ + self didClick ]. + + "Click & hold" + (buttonDownCount = 2 and: [ buttonUpCount = 1]) ifTrue: [ + self didClickAndHalf ]. + + "Double click." + (buttonDownCount = 2 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClick ]. + + "Double click & hold." + (buttonDownCount = 3 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClickAndHalf ]. + + "Triple click" + (buttonDownCount = 3 and: [ buttonUpCount = 3]) ifTrue: [ + self didTripleClick ]. + + "This means: if a mouseDown, then don't further process this event (so we can turn it into a double or triple click on next buttonUp)" + ^ aMouseEvent isMouseDown! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4847-MouseClickState-tweaks-JuanVuletich-2021Sep06-15h37m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4847] on 6 September 2021 at 7:55:36 pm'! +!MouseClickState methodsFor: 'actions' stamp: 'jmv 6/17/2021 13:01:32' prior: 50779037! + handleEvent: aMouseEvent from: aHand + "Process the given mouse event to detect a click, double-click, or drag. + Return true if the event should be processed by the sender, false if it shouldn't. + NOTE: This method heavily relies on getting *all* mouse button events." + + | timedOut distance | + timedOut _ (aMouseEvent timeStamp - lastClickDown timeStamp) > self class doubleClickTimeout. + timedOut ifTrue: [ aHand dontWaitForMoreClicks ]. + distance _ (aMouseEvent eventPosition - lastClickDown eventPosition) r. + "Real action dispatch might be done after the triggering event, for example, because of waiting for timeout. + So, count the button downs and ups(clicks), to be processed, maybe later, maybe in a mouseMove..." + aMouseEvent isMouseDown ifTrue: [ + lastClickDown _ aMouseEvent. + buttonDownCount _ buttonDownCount + 1 ]. + aMouseEvent isMouseUp ifTrue: [ + buttonUpCount _ buttonUpCount + 1 ]. + + "Drag, or tap & hold" + (buttonDownCount = 1 and: [ buttonUpCount = 0]) ifTrue: [ + distance > 0 ifTrue: [ + aHand dontWaitForMoreClicks. + dragSelector + ifNotNil: [ self didDrag ] + "If we have already moved, then it won't be a double or triple click... why wait?" + ifNil: [ self didClick ]. + ^ false ]. + timedOut ifTrue: [ + aHand dontWaitForMoreClicks. + "Simulate button 2 via tap & hold. Useful for opening menus on pen computers." + sendMouseButton2Activity ifTrue: [ + clickClient mouseButton2Activity ]. + ^ false ]]. + + "If we're over triple click, or timed out, or mouse moved, don't allow more clicks." + (buttonDownCount = 4 or: [ timedOut or: [ distance > 0 ]]) ifTrue: [ + aHand dontWaitForMoreClicks. + ^ false ]. + + "Simple click." + (buttonDownCount = 1 and: [ buttonUpCount = 1 ]) ifTrue: [ + self didClick ]. + + "Click & hold" + (buttonDownCount = 2 and: [ buttonUpCount = 1]) ifTrue: [ + self didClickAndHalf ]. + + "Double click." + (buttonDownCount = 2 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClick ]. + + "Double click & hold." + (buttonDownCount = 3 and: [ buttonUpCount = 2]) ifTrue: [ + self didDoubleClickAndHalf ]. + + "Triple click" + (buttonDownCount = 3 and: [ buttonUpCount = 3]) ifTrue: [ + self didTripleClick ]. + + "This means: if a mouseDown, then don't further process this event (so we can turn it into a double or triple click on next buttonUp)" + ^ aMouseEvent isMouseDown! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4848-fixBugIn4847-JuanVuletich-2021Sep06-19h55m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4848] on 7 September 2021 at 11:05:59 am'! +!BitBltCanvas methodsFor: 'initialization' stamp: 'jmv 9/7/2021 09:41:09' overrides: 50777501! + resetCanvas + "To be called in case of possible inconsistency due to an exception during drawing. + See #displayWorldSafely" + + super resetCanvas. + boundsFinderCanvas resetCanvas.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4849-resetCanvas-fix-JuanVuletich-2021Sep07-11h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4849] on 7 September 2021 at 11:17:08 am'! +!Number methodsFor: 'truncation and round off' stamp: 'jmv 9/7/2021 10:54:01'! + round4perMagnitudeOrder + "Round receiver to 1 or two significant digits. + Answer is 1, 2, 2.5, 5, 10, 20, 25, 50, 100, 200, 250, 500, 1000, etc. + better name?" + + | excess firstDigitPosition | + firstDigitPosition _ self log floor. + excess _ self log - firstDigitPosition. + excess < 2 log ifTrue: [ ^10 raisedTo: firstDigitPosition ]. + excess < 2.5 log ifTrue: [ ^(10 raisedTo: firstDigitPosition) * 2 ]. + excess < 5 log ifTrue: [ ^(10 raisedTo: firstDigitPosition-1) * 25 ]. + ^(10 raisedTo: firstDigitPosition) * 5! ! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2021 11:13:25' prior: 50778626! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 10) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1-(stepX*0.2) by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atCenterXBaselineY: x @ (tickLength*2) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1-(stepY*0.5) by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaistRight: tickLength negated @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! +!WidgetMorph methodsFor: 'halos and balloon help' stamp: 'jmv 9/7/2021 09:26:23' prior: 50774812 overrides: 50774806! + haloShowsCoordinateSystem + "We are usually not concerned with this level of detail for Widgets, as they prefer using automatic Layout." + + ^self requiresVectorCanvas! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4850-drawCoordinateSystem-enhancements-JuanVuletich-2021Sep07-11h16m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4849] on 7 September 2021 at 11:21:43 am'! +!WindowEdgeAdjustingMorph methodsFor: 'adjusting' stamp: 'jmv 9/7/2021 11:21:14' prior: 50777395 overrides: 50764869! + adjustOwnerAt: aGlobalPoint millisecondSinceLast: millisecondSinceLast + + self basicAdjustOwnerAt: aGlobalPoint. + + "If UI is becoming slow or is optimized for slow systems, resize without + showing window contents, but only edges. But don't do it for rotated Windows!!" + (owner isOrAnyOwnerIsRotated not and: [ + Preferences cheapWindowReframe or: [millisecondSinceLast > 200]]) ifTrue: [ + owner displayBounds newRectFrom: [ :f | + self basicAdjustOwnerAt: Sensor mousePoint. + owner morphPosition extent: owner morphExtentInWorld ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4851-cheapWindowReframe-lessAgressive-JuanVuletich-2021Sep07-11h17m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4851] on 7 September 2021 at 12:04:13 pm'! +!CodeWindow methodsFor: 'updating' stamp: 'jmv 9/7/2021 12:02:33' prior: 50776001! + updateListsAndCode + "All code windows receive this message on any code change in the system. + Process it only once, for the benefit of installing large packages!!" + + (self hasProperty: #updateListsAndCode) ifFalse: [ + self setProperty: #updateListsAndCode toValue: true. + self whenUIinSafeState: [ + self removeProperty: #updateListsAndCode. + owner ifNotNil: [ self updateListsAndCodeNow ]]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4852-CodeWindow-updateListsAndCode-afterClose-fix-JuanVuletich-2021Sep07-12h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4809] on 5 September 2021 at 10:49:47 pm'! + +Smalltalk removeClassNamed: #ExtractMethodApplier! + +!classRemoval: #ExtractMethodApplier stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:32'! +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Smalltalk removeClassNamed: #ExtractMethod! + +!classRemoval: #ExtractMethod stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:32'! +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +MessageSet subclass: #ExtractMethodMessageSet + instanceVariableNames: 'finder selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodMessageSet category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +MessageSet subclass: #ExtractMethodMessageSet + instanceVariableNames: 'finder selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +MessageSetWindow subclass: #ExtractMethodReplacementsWindow + instanceVariableNames: 'applier finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacementsWindow category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +MessageSetWindow subclass: #ExtractMethodReplacementsWindow + instanceVariableNames: 'applier finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Object subclass: #ExtractMethodReplacementsFinder + instanceVariableNames: 'intervalToExtract sourceMethod replacements newMessage sourceCodeToExtract sizeToExtract' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacementsFinder category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +Object subclass: #ExtractMethodReplacementsFinder + instanceVariableNames: 'intervalToExtract sourceMethod replacements newMessage sourceCodeToExtract sizeToExtract' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'extractMethodNewMethod collectionOfReplacements' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethod category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +Refactoring subclass: #ExtractMethod + instanceVariableNames: 'extractMethodNewMethod collectionOfReplacements' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethod commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +Refactoring subclass: #ExtractMethodNewMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodNewMethod category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +Refactoring subclass: #ExtractMethodNewMethod + instanceVariableNames: 'intervalToExtract categoryOfNewSelector newMessage extractedSourceCode existingMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodNewMethod commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +Refactoring subclass: #ExtractMethodReplacement + instanceVariableNames: 'intervalToExtract newMessage methodToExtractFrom callingExpression' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodReplacement category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +Refactoring subclass: #ExtractMethodReplacement + instanceVariableNames: 'intervalToExtract newMessage methodToExtractFrom callingExpression' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodReplacement commentStamp: '' prior: 0! + I am a refactoring that extracts a selected piece of code to a separate method. The input is the following: + +* interval of code to extract (from index - to index) +* the CompiledMethod where this change applies +* the new method selector + argument names (instance of Message) +* the category name for the new method + +Many conditions have to be satisfied for this refactoring to be made, I delegate into SourceCodeOfMethodToBeExtractedPrecondition and NewSelectorPrecondition most of these checks. Refer to those classes' comments for more information.! + +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider sourceCodeToExtract newMethodRefactoring finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!classDefinition: #ExtractMethodApplier category: #'Tools-Refactoring' stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +RefactoringApplier subclass: #ExtractMethodApplier + instanceVariableNames: 'intervalToExtract methodToExtractCodeFrom newSelector newMessageArguments codeProvider sourceCodeToExtract newMethodRefactoring finder' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!ExtractMethodMessageSet methodsFor: 'initialization' stamp: 'HAW 9/5/2021 07:15:36' overrides: 50582838! + initialize + + selectedIndex := 0. + super initialize ! ! +!ExtractMethodMessageSet methodsFor: 'initialization' stamp: 'HAW 9/5/2021 00:12:23'! + initializeFinder: aFinder + + finder := aFinder.! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 07:15:16' overrides: 16792396! + messageListIndex + + ^selectedIndex ! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 07:14:51' overrides: 50565779! + messageListIndex: anIndex + + selectedIndex := anIndex. + ^super messageListIndex: anIndex ! ! +!ExtractMethodMessageSet methodsFor: 'message list' stamp: 'HAW 9/5/2021 21:52:26' overrides: 50618172! + removeMessageFromBrowserKeepingLabel + + | newIndex | + + selectedMessage ifNil: [ ^nil ]. + messageList removeIndex: selectedIndex. + finder removeReplacementAt: selectedIndex. + self changed: #messageList. + + newIndex := selectedIndex > messageList size + ifTrue: [ selectedIndex - 1 ] + ifFalse: [ selectedIndex ]. + self messageListIndex: newIndex.! ! +!ExtractMethodMessageSet methodsFor: 'source code ranges' stamp: 'HAW 9/5/2021 21:46:48' overrides: 50627809! + messageSendsRangesOf: aSelector + + | replacement | + + replacement := finder replacementsAt: self messageListIndex ifAbsent: [ ^#() ]. + + ^Array with: replacement intervalToExtract + ! ! +!ExtractMethodMessageSet class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 00:11:22'! + finder: aFinder + + ^(self messageList: aFinder methodsToReplace) initializeFinder: aFinder! ! +!MethodNode methodsFor: 'source ranges' stamp: 'HAW 8/26/2021 15:57:14'! + definitionStartPosition + + "It does not includes temp definition because the extract can include temps - Hernan" + ^self selectorLastPosition + 1! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:28'! + closeAfter: aBlock + + aBlock value. + self whenUIinSafeState: [ self delete ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:16'! + extractAllInClass + + self closeAfter: [ applier valueWithMethodsInClass ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:43'! + extractInMethodOnly + + self closeAfter: [ applier valueWithSourceMethod ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:41:52'! + extractSelectionOnly + + self closeAfter: [ applier valueWithOriginalSelection ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 9/5/2021 20:42:00'! + refactor + + self closeAfter: [ applier valueWithAllReplacements ]. + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'actions' stamp: 'HAW 8/25/2021 22:07:31'! +remove + + model removeMessageFromBrowserKeepingLabel! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31'! + addButton: button to: row color: buttonColor + + button color: buttonColor. + row addMorph: button proportionalWidth: 10! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 9/5/2021 20:02:21'! + addButtonsTo: row color: buttonColor + + self + addButton: self createRemoveButton to: row color: buttonColor; + addButton: self createRefactorButton to: row color: buttonColor; + addButton: self createExtractSelectionOnlyButton to: row color: buttonColor; + addButton: self createExtractInMethodOnlyButton to: row color: buttonColor; + addButton: self createExtractAllInClassButton to: row color: buttonColor; + addButton: self createCancelButton to: row color: buttonColor. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31' overrides: 50693912! + buildLowerPanes + + | codeAndButtons | + + codeAndButtons _ LayoutMorph newColumn. + codeAndButtons + addMorph: self buttonsRow fixedHeight: self defaultButtonPaneHeight; + addAdjusterMorph; + addMorph: self buildMorphicCodePane proportionalHeight: 1.0. + + ^codeAndButtons ! ! +!ExtractMethodReplacementsWindow methodsFor: 'GUI building' stamp: 'HAW 8/25/2021 22:07:31'! + buttonsRow + + | buttonColor row | + + buttonColor := self buttonColor. + row := LayoutMorph newRow. + row doAdoptWidgetsColor. + row color: buttonColor. + + self addButtonsTo: row color: buttonColor. + + ^row + + ! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 8/25/2021 22:07:31'! + createCancelButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #delete + label: 'Cancel'. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:55:47'! + createExtractAllInClassButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractAllInClass + label: 'In Class'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:55:57'! + createExtractInMethodOnlyButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractInMethodOnly + label: 'In Method'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:43:25'! + createExtractSelectionOnlyButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #extractSelectionOnly + label: 'Selection Only'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 19:56:07'! + createRefactorButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #refactor + label: 'Refactor'! ! +!ExtractMethodReplacementsWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 20:07:00'! + createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! +!ExtractMethodReplacementsWindow methodsFor: 'initialization' stamp: 'HAW 9/4/2021 23:30:56'! + initializeFrom: anExtractMethodApplier with: aFinder + + applier := anExtractMethodApplier. + finder := aFinder ! ! +!ExtractMethodReplacementsWindow class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 20:31:15'! + openFrom: anExtractMethodApplier with: aFinder + + | window messageSet | + + messageSet := ExtractMethodMessageSet finder: aFinder. + "I have to set a autoSelectString even if I do not use it because if not the + autoSelect event is not triggered - Hernan" + messageSet autoSelectString: aFinder sourceCodeToExtract. + + window := self open: messageSet label: 'Select replacements'. + window initializeFrom: anExtractMethodApplier with: aFinder. + + ^window + +! ! +!ExtractMethodReplacementsFinder methodsFor: 'initialization' stamp: 'HAW 9/2/2021 17:31:19'! + initializeOfCodeIn: anIntervalToExtract at: aMethod to: aNewMessage + + intervalToExtract := anIntervalToExtract. + sourceMethod := aMethod. + newMessage := aNewMessage ! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/5/2021 22:05:15'! + addReplacementAt: foundIntervalToExtract in: aMethod + + "If ther is an error creating the refactoring, then the found text is not extractable and + therefore should not be replaced - Hernan" + [ replacements add: (self createReplacementAt: foundIntervalToExtract in: aMethod) ] + on: RefactoringError + do: [ :anError | ].! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:03:06'! + createReplacementAt: foundIntervalToExtract in: aMethod + + ^ExtractMethodReplacement + fromInterval: foundIntervalToExtract asSourceCodeInterval + of: aMethod + to: newMessage! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:01:06'! + findReplacementsAt: aClass + + aClass methodsDo: [ :aMethod | self findReplacementsIn: aMethod asMethodReference ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'private-replacement finding' stamp: 'HAW 9/4/2021 21:04:49'! + findReplacementsIn: aMethod + + | sourceCode foundIntervalToExtract sourceCodeToExtractStart | + + sourceCode := aMethod sourceCode. + sourceCodeToExtractStart := 1. + + [ sourceCodeToExtractStart := sourceCode indexOfSubCollection: sourceCodeToExtract startingAt: sourceCodeToExtractStart. + sourceCodeToExtractStart ~= 0 ] whileTrue: [ + foundIntervalToExtract := sourceCodeToExtractStart to: sourceCodeToExtractStart + sizeToExtract. + self addReplacementAt: foundIntervalToExtract in: aMethod. + sourceCodeToExtractStart := foundIntervalToExtract last + 1 ] + + ! ! +!ExtractMethodReplacementsFinder methodsFor: 'testing' stamp: 'HAW 9/4/2021 23:25:35'! + hasOneReplacement + + ^replacements size = 1! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:18:47'! + inClassReplacements + + ^replacements select: [ :aReplacement | aReplacement isAt: sourceMethod methodClass ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 00:12:03'! + methodsToReplace + + ^replacements collect: [ :aReplacement | aReplacement methodToExtractFrom ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:14:49'! + originalSelectionReplacement + + ^ExtractMethodReplacement fromInterval: intervalToExtract of: sourceMethod to: newMessage ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 21:51:40'! + removeReplacementAt: anIndex + + ^replacements removeAt: anIndex ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/2/2021 17:41:27'! + replacements + + ^replacements ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 07:24:58'! + replacementsAt: anIndex ifAbsent: ifAbsentBlock + + ^replacements at: anIndex ifAbsent: ifAbsentBlock ! ! +!ExtractMethodReplacementsFinder methodsFor: 'replacements' stamp: 'HAW 9/5/2021 20:17:31'! + sourceMethodReplacements + + ^replacements select: [:aReplacement | aReplacement isOf: sourceMethod ]! ! +!ExtractMethodReplacementsFinder methodsFor: 'evaluating' stamp: 'HAW 9/4/2021 21:00:59' overrides: 16881508! + value + + sourceCodeToExtract := sourceMethod sourceCode copyFrom: intervalToExtract first to: intervalToExtract last. + sizeToExtract := intervalToExtract size - 1. + replacements := OrderedCollection new. + + sourceMethod methodClass withAllSubclassesDo: [ :aClass | self findReplacementsAt: aClass] + ! ! +!ExtractMethodReplacementsFinder methodsFor: 'source code' stamp: 'HAW 9/5/2021 00:14:54'! + sourceCodeToExtract + + ^sourceCodeToExtract! ! +!ExtractMethodReplacementsFinder class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 17:31:33'! + ofCodeIn: anIntervalToExtract at: aMethod to: aNewMessage + + ^self new initializeOfCodeIn: anIntervalToExtract at: aMethod to: aNewMessage ! ! +!ExtractMethod methodsFor: 'initialization' stamp: 'HAW 9/5/2021 22:46:43'! + initializeNewDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements + + extractMethodNewMethod := anExtractMethodNewMethod. + collectionOfReplacements := aCollectionOfReplacements.! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:48'! + applyMethodReplacements: aMethodReplacements + + | adjustment sortedReplacements | + + adjustment := 0. + "This is not really necesary because the groupBy: keeps the order, but I do it just in case that is changed - Hernan" + sortedReplacements := aMethodReplacements sorted: [ :leftReplacement :rightReplacement | leftReplacement isBefore: rightReplacement ]. + sortedReplacements do: [ :aReplacement | + aReplacement applyAdjusting: adjustment. + adjustment := adjustment + aReplacement adjustmentForNextReplacement ]! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:51'! + applyReplacements + + | replacementsByMethod | + + replacementsByMethod := collectionOfReplacements groupBy: [ :aReplacement | aReplacement methodToExtractFrom ]. + replacementsByMethod valuesDo: [ :aMethodReplacements | self applyMethodReplacements: aMethodReplacements ]. + ! ! +!ExtractMethod methodsFor: 'private - applying' stamp: 'HAW 9/5/2021 22:46:54'! + createNewMethod + + extractMethodNewMethod apply. +! ! +!ExtractMethod methodsFor: 'applying' stamp: 'HAW 9/5/2021 22:46:38' overrides: 50613690! + apply + + self + createNewMethod; + applyReplacements ! ! +!ExtractMethod class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:46:15'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage categorizedAs: aCategory + + ^self + newDefinition: (ExtractMethodNewMethod + fromInterval: anIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + categorizedAs: aCategory ) + replacements: (Array with: (ExtractMethodReplacement + fromInterval: anIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage)) + +! ! +!ExtractMethod class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:46:32'! + newDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements + + ^self new initializeNewDefinition: anExtractMethodNewMethod replacements: aCollectionOfReplacements ! ! +!ExtractMethodNewMethod methodsFor: 'applying' stamp: 'HAW 9/4/2021 15:55:33' overrides: 50613690! + apply + + self sourceClass + compile: self newMethodSourceCode + classified: categoryOfNewSelector! ! +!ExtractMethodNewMethod methodsFor: 'initialization' stamp: 'HAW 9/2/2021 18:09:20'! + initializeExtractedSourceCode + + extractedSourceCode := existingMethod sourceCode + copyFrom: intervalToExtract first + to: intervalToExtract last! ! +!ExtractMethodNewMethod methodsFor: 'initialization' stamp: 'HAW 9/2/2021 18:09:20'! + initializeFrom: anIntervalToExtract of: aMethodToExtractCodeFrom to: aNewMessage in: aCategory + + intervalToExtract := anIntervalToExtract. + existingMethod := aMethodToExtractCodeFrom. + newMessage := aNewMessage. + categoryOfNewSelector := aCategory. + self initializeExtractedSourceCode.! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + newMessageString + + ^ newMessage fullName! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + newMethodSourceCode + + ^ String streamContents: [ :stream | + stream + nextPutAll: self newMessageString; + nextPutAll: self startingMethodIdentation; + nextPutAll: self returnCharacterIfNeeded; + nextPutAll: extractedSourceCode ]! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + returnCharacterIfNeeded + + | extractedMethodNode | + + extractedMethodNode := Parser parse: extractedSourceCode class: self sourceClass noPattern: true. + + ^ (extractedMethodNode numberOfStatements > 1 or: [ extractedMethodNode hasTemporaryVariables ]) + ifTrue: [ '' ] ifFalse: [ '^ ' ]! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + sourceClass + + ^ existingMethod methodClass! ! +!ExtractMethodNewMethod methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 18:09:20'! + startingMethodIdentation + + ^ String lfString , String lfString , String tab! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + noSelectionErrorMessage + + ^ 'Please select some code for extraction'! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + outOfBoundsSelectionErrorMessage + + ^ 'The requested source code selection interval is out of bounds'! ! +!ExtractMethodNewMethod class methodsFor: 'error messages' stamp: 'HAW 9/2/2021 18:09:20'! + wrongNumberOfArgumentsGivenErrorMessage + + ^ 'The number of arguments in the given selector is not correct'! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalExtractMethodWithWrongNumberOfArgumentsError + + self refactoringError: self wrongNumberOfArgumentsGivenErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalNoSelectedCodeError + + self refactoringError: self noSelectionErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'exceptions' stamp: 'HAW 9/2/2021 18:09:20'! + signalOutOfBoundsIntervalError + + self refactoringError: self outOfBoundsSelectionErrorMessage! ! +!ExtractMethodNewMethod class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 18:09:20'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage categorizedAs: aCategory + + | trimmedIntervalToExtract | + + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: aMethodToExtractCodeFrom sourceCode. + self + assert: newMessage selector canBeDefinedIn: aMethodToExtractCodeFrom methodClass; + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: trimmedIntervalToExtract; + assert: newMessage hasValidParametersForExtracting: anIntervalToExtract from: aMethodToExtractCodeFrom methodNode. + + ^ self new + initializeFrom: trimmedIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + in: aCategory! ! +!ExtractMethodNewMethod class methodsFor: 'pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract + + self + assertIntervalToExtractIsNotEmpty: anIntervalToExtract; + assert: anIntervalToExtract isWithinBoundsOf: aMethodToExtractCodeFrom sourceCode; + assert: aMethodToExtractCodeFrom containsValidCodeToBeExtractedAt: anIntervalToExtract! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: aSelector canBeDefinedIn: aClass + + NewSelectorPrecondition valueFor: aSelector on: aClass! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: aMethodToRefactor containsValidCodeToBeExtractedAt: anIntervalToExtract + + SourceCodeOfMethodToBeExtractedPrecondition valueFor: anIntervalToExtract of: aMethodToRefactor! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: newMessage hasValidParametersForExtracting: anIntervalToExtract from: aMethodNodeToRefactor + + | parseNodesToParameterize | + parseNodesToParameterize := ExtractMethodParametersDetector + valueFor: aMethodNodeToRefactor + at: anIntervalToExtract. + newMessage arguments size = parseNodesToParameterize size + ifFalse: [ self signalExtractMethodWithWrongNumberOfArgumentsError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assert: anIntervalToExtract isWithinBoundsOf: sourceCode + + (self is: anIntervalToExtract withinBoundsOf: sourceCode) + ifFalse: [ self signalOutOfBoundsIntervalError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + assertIntervalToExtractIsNotEmpty: anIntervalToExtract + + (self isNotEmpty: anIntervalToExtract) + ifFalse: [ self signalNoSelectedCodeError ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + is: anIntervalToExtract withinBoundsOf: aSourceCode + + ^ anIntervalToExtract first >= 1 and: [ anIntervalToExtract last <= aSourceCode size ]! ! +!ExtractMethodNewMethod class methodsFor: 'private - pre-conditions' stamp: 'HAW 9/2/2021 18:09:20'! + isNotEmpty: anInterval + + ^ anInterval first <= anInterval last! ! +!ExtractMethodReplacement methodsFor: 'applying' stamp: 'HAW 9/2/2021 17:38:51' overrides: 50613690! + apply + + self sourceClass + compile: self updatedSourceCodeOfExistingMethod + classified: methodToExtractFrom category! ! +!ExtractMethodReplacement methodsFor: 'applying' stamp: 'HAW 9/4/2021 20:59:16'! + applyAdjusting: anAdjustment + + intervalToExtract := (intervalToExtract + anAdjustment) asSourceCodeInterval. + self apply ! ! +!ExtractMethodReplacement methodsFor: 'initialization' stamp: 'HAW 9/4/2021 16:53:14'! + initializeFrom: anIntervalToExtract of: aMethodToExtractCodeFrom to: aNewMessage + + intervalToExtract := anIntervalToExtract. + methodToExtractFrom := aMethodToExtractCodeFrom. + newMessage := aNewMessage. + self initializeCallingExpression ! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/4/2021 16:31:47'! + initializeCallingExpression + + callingExpression := 'self ', self newMessageString. + self shouldBeEnclosedWithParens ifTrue: [ callingExpression := '(' , callingExpression , ')' ] + ! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:06:21'! + newMessageString + + ^ newMessage fullName! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:38:51'! + shouldBeEnclosedWithParens + + | initialNode finalNode parseNodesInCommon methodNode initialNodeAncestors finalNodeAncestors insideMessageNodeExpressions | + + methodNode _ methodToExtractFrom methodNode. + initialNodeAncestors _ methodNode parseNodesPathAt: intervalToExtract first ifAbsent: [ ^ false]. + finalNodeAncestors _ methodNode parseNodesPathAt: intervalToExtract last ifAbsent: [ ^ false ]. + parseNodesInCommon _ initialNodeAncestors intersection: finalNodeAncestors. + + initialNode _ (parseNodesInCommon at: 1 ifAbsent: [ ^ false ]) key. + finalNode _ (parseNodesInCommon at: 2 ifAbsent: [ ^ false ]) key. + insideMessageNodeExpressions _ initialNode isMessageNode and: [ finalNode isMessageNode ]. + + ^ insideMessageNodeExpressions + and: [ initialNode precedence < newMessage selector precedence ] + and: [ initialNode precedence <= finalNode precedence ]! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/2/2021 17:38:51'! +sourceClass + + ^ methodToExtractFrom methodClass! ! +!ExtractMethodReplacement methodsFor: 'private - source code' stamp: 'HAW 9/4/2021 16:37:55'! + updatedSourceCodeOfExistingMethod + + ^ methodToExtractFrom sourceCode + copyReplaceFrom: intervalToExtract first + to: intervalToExtract last + with: callingExpression! ! +!ExtractMethodReplacement methodsFor: 'accessing' stamp: 'HAW 9/2/2021 17:36:44'! + intervalToExtract + + ^intervalToExtract! ! +!ExtractMethodReplacement methodsFor: 'accessing' stamp: 'HAW 9/2/2021 17:38:51'! + methodToExtractFrom + + ^methodToExtractFrom ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 20:28:45'! +isAt: aClass + + ^methodToExtractFrom methodClass = aClass ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 17:02:06'! + isBefore: anExtractMethodReplacement + + ^anExtractMethodReplacement startsAfter: intervalToExtract first! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/2/2021 18:06:56'! + isOf: aMethod + + ^methodToExtractFrom = aMethod ! ! +!ExtractMethodReplacement methodsFor: 'testing' stamp: 'HAW 9/4/2021 17:02:34'! + startsAfter: aPosition + + ^intervalToExtract first > aPosition ! ! +!ExtractMethodReplacement methodsFor: 'adjustment' stamp: 'HAW 9/4/2021 16:50:17'! + adjustmentForNextReplacement + + ^callingExpression size - intervalToExtract size! ! +!ExtractMethodReplacement class methodsFor: 'instance creation' stamp: 'HAW 9/2/2021 17:26:03'! + fromInterval: anIntervalToExtract of: aMethodToExtractCodeFrom to: newMessage + + | trimmedIntervalToExtract | + + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: aMethodToExtractCodeFrom sourceCode. + self assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: trimmedIntervalToExtract. + + ^ self new + initializeFrom: trimmedIntervalToExtract + of: aMethodToExtractCodeFrom + to: newMessage + ! ! +!ExtractMethodReplacement class methodsFor: 'pre-conditions' stamp: 'HAW 9/5/2021 22:07:25'! + assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract + + ExtractMethodNewMethod assertCanApplyRefactoringOn: aMethodToExtractCodeFrom at: anIntervalToExtract +! ! +!RefactoringApplier methodsFor: 'refactoring - creation' stamp: 'HAW 8/26/2021 16:06:07'! + createAndSetRefactoringHandlingRefactoringExceptions: aCreatorBlock + + self valueHandlingRefactoringExceptions: [ refactoring := aCreatorBlock value] + ! ! +!ExtractMethodApplier methodsFor: 'initialization' stamp: 'HAW 9/5/2021 22:47:39'! + initializeOn: aCodeProvider for: anIntervalToExtract of: aMethodToExtractCodeFrom + + codeProvider := aCodeProvider. + intervalToExtract := anIntervalToExtract. + methodToExtractCodeFrom := MethodReference method: aMethodToExtractCodeFrom. + newMessageArguments := Dictionary new! ! +!ExtractMethodApplier methodsFor: 'refactoring - changes' stamp: 'HAW 9/5/2021 22:47:43' overrides: 50616650! + showChanges + + codeProvider currentMethodRefactored! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:49' overrides: 50616527! + createRefactoring + + ^ self shouldNotImplement! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:53'! + createRefactoringForMethodsInClass + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder inClassReplacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:47:57'! + createRefactoringForOriginalSelection + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: { finder originalSelectionReplacement }! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:02'! + createRefactoringForSourceMethod + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder sourceMethodReplacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:06'! + createRefactoringWithAllReplacements + + ^ self refactoringClass newDefinition: newMethodRefactoring replacements: finder replacements ! ! +!ExtractMethodApplier methodsFor: 'refactoring - creation' stamp: 'HAW 9/5/2021 22:48:10'! + refactoringClass + + ^ ExtractMethod! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:14'! + createExtractMethodNewMethodFor: newMessage + + ^ newMethodRefactoring := ExtractMethodNewMethod + fromInterval: intervalToExtract + of: methodToExtractCodeFrom + to: newMessage + categorizedAs: methodToExtractCodeFrom category! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:17'! + findReplacementsWith: newMessage + + finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: methodToExtractCodeFrom to: newMessage. + finder value! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:20'! + requestNewMessage + + | parseNodesToParameterize initialAnswer userAnswer | + + parseNodesToParameterize := self parseNodesToParameterize. + initialAnswer := self buildInitialSelectorAnswer: parseNodesToParameterize. + userAnswer := self request: 'New method name:' initialAnswer: initialAnswer. + + parseNodesToParameterize + ifEmpty: [ self saveUnarySelector: userAnswer ] + ifNotEmpty: [ self saveBinaryOrKeywordSelector: userAnswer withArguments: parseNodesToParameterize ]. + + ^self buildNewMessage. + ! ! +!ExtractMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 9/5/2021 22:48:24' overrides: 50616545! + requestRefactoringParameters + + | newMessage | + + newMessage := self requestNewMessage. + self createExtractMethodNewMethodFor: newMessage. + self findReplacementsWith: newMessage. + + finder hasOneReplacement + ifTrue: [ self valueWithAllReplacements ] + ifFalse: [ ExtractMethodReplacementsWindow openFrom: self with: finder ] + ! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:29'! + buildNewMessage + + ^ Message + selector: newSelector + arguments: self newMessageArgumentNames! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:32'! + newMessageArgumentNames + + ^ newMessageArguments values collect: [ :parseNode | parseNode name ]! ! +!ExtractMethodApplier methodsFor: 'private - new message' stamp: 'HAW 9/5/2021 22:48:36'! + saveUnarySelector: userAnswer + + ^ newSelector := userAnswer asSymbol! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:40' overrides: 50616654! + value + + requestExitBlock := [ ^self ]. + + self requestRefactoringParametersHandlingRefactoringExceptions +! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:45'! + valueCreatingWith: aRefactoringCreationBlock + + self + createAndSetRefactoringHandlingRefactoringExceptions: aRefactoringCreationBlock; + applyRefactoring; + showChanges + + ! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:48'! + valueWithAllReplacements + + self valueCreatingWith: [ self createRefactoringWithAllReplacements ] + ! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:51'! + valueWithMethodsInClass + + self valueCreatingWith: [ self createRefactoringForMethodsInClass ]! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:54'! + valueWithOriginalSelection + + self valueCreatingWith: [ self createRefactoringForOriginalSelection ]! ! +!ExtractMethodApplier methodsFor: 'value' stamp: 'HAW 9/5/2021 22:48:58'! + valueWithSourceMethod + + self valueCreatingWith: [ self createRefactoringForSourceMethod ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:03'! + buildInitialSelectorAnswer: parseNodesToParameterize + "builds a selector with the shape of #m1 if unary, or #m1: something m2: else if it has args" + + ^ parseNodesToParameterize + ifEmpty: [ self formatAsKeyword: 'm1' ] + ifNotEmpty: [ parseNodesToParameterize + inject: '' + into: [ :partialSelector :parseNode | + | currentKeyword | + currentKeyword _ 'm' , (parseNodesToParameterize indexOf: parseNode) asString , ': '. + partialSelector + , (self formatAsKeyword: currentKeyword) + , (self formatAsMethodArgument: parseNode name) + , String newLineString ] ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:06'! +formatAsKeyword: aKeyword + + ^ Text + string: aKeyword + attributes: (SHTextStylerST80 attributesFor: #patternKeyword)! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:10'! + formatAsMethodArgument: aMethodArgumentName + + ^ Text + string: aMethodArgumentName + attributes: (SHTextStylerST80 attributesFor: #methodArg)! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:13'! + parseNodesToParameterize + + ^ ExtractMethodParametersDetector + valueFor: methodToExtractCodeFrom methodNode + at: intervalToExtract! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:16'! + saveBinaryOrKeywordSelector: userAnswer withArguments: parseNodesToParameterize + + self saveMessageArgumentsForEach: parseNodesToParameterize using: userAnswer. + newSelector := ('' join: (self selectorTokensOf: userAnswer)) asSymbol.! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:20'! + saveMessageArgumentsForEach: parseNodesToParameterize using: userAnswer + + | newSelectorKeywords | + newSelectorKeywords _ self selectorTokensOf: userAnswer. + self validateRequiredParameters: parseNodesToParameterize haveACorrespondingKeywordIn: newSelectorKeywords. + parseNodesToParameterize withIndexDo: [ :parseNode :index | + newMessageArguments at: (newSelectorKeywords at: index) put: parseNode ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:23'! + selectorTokensOf: userAnswer + "this selects the pieces of strings before each $:" + + ^ (userAnswer findTokens: ':') allButLast + collect: [ :tok | (tok findTokens: Character separators) last , ':' ]! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:26'! + sourceCodeToExtract + + ^sourceCodeToExtract! ! +!ExtractMethodApplier methodsFor: 'private - parameterizing' stamp: 'HAW 9/5/2021 22:49:29'! + validateRequiredParameters: parseNodesToParameterize haveACorrespondingKeywordIn: newSelectorKeywords + + newSelectorKeywords size = parseNodesToParameterize size + ifFalse: [ ExtractMethodNewMethod signalExtractMethodWithWrongNumberOfArgumentsError ]! ! +!ExtractMethodApplier class methodsFor: 'instance creation' stamp: 'HAW 9/5/2021 22:47:32'! + on: aCodeProvider for: anIntervalToExtract of: aMethodToRefactor + + | trimmedIntervalToExtract sourceCode | + + sourceCode := aMethodToRefactor sourceCode. + trimmedIntervalToExtract := anIntervalToExtract trimToMatchExpressionOn: sourceCode.. + + self assertCanApplyRefactoringOn: aMethodToRefactor at: trimmedIntervalToExtract. + + ^ self new initializeOn: aCodeProvider for: trimmedIntervalToExtract of: aMethodToRefactor! ! +!ExtractMethodApplier class methodsFor: 'pre-conditions' stamp: 'HAW 9/5/2021 22:47:27'! + assertCanApplyRefactoringOn: aMethodToRefactor at: anIntervalToExtract + + ExtractMethodNewMethod + assertCanApplyRefactoringOn: aMethodToRefactor + at: anIntervalToExtract! ! +!SmalltalkEditor methodsFor: 'extract method' stamp: 'HAW 9/5/2021 20:36:00' prior: 50692761! + extractMethod + + self performCodeExtractionRefactoringWith: ExtractMethodApplier! ! +!ChangeSelectorWizardStepWindow methodsFor: 'button creation' stamp: 'HAW 9/5/2021 20:07:07' prior: 50613489! + createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! +!AddInstanceVariable methodsFor: 'initialization' stamp: 'HAW 8/28/2021 17:44:36' prior: 50613740! + initializeNamed: aNewVariable to: aClassToRefactor + + newVariable := aNewVariable. + classToRefactor := aClassToRefactor ! ! +!RefactoringApplier methodsFor: 'refactoring - creation' stamp: 'HAW 8/26/2021 16:04:27' prior: 50616532! + createRefactoringHandlingRefactoringExceptions + + self createAndSetRefactoringHandlingRefactoringExceptions: [ self createRefactoring ] + ! ! +!SourceCodeIntervalPrecondition methodsFor: 'pre-conditions' stamp: 'HAW 8/26/2021 15:57:31' prior: 50704802! + assertSourceCodeIsNotPartOfMethodSignature + + self intervalToExtractIncludesPartOfMethodSignature + ifTrue: [ self signalExtractingPartOfMethodSignatureError ]! ! +!SourceCodeIntervalPrecondition methodsFor: 'private' stamp: 'HAW 8/26/2021 15:56:33' prior: 50704856! + methodDefinitionStartPosition + + ^methodNode definitionStartPosition! ! +!MethodReference methodsFor: 'decompiling' stamp: 'HAW 9/5/2021 23:06:10'! + methodNode + + ^self compiledMethod methodNode! ! +!CompiledMethod methodsFor: 'converting' stamp: 'HAW 9/5/2021 23:06:10'! + asMethodReference + + ^MethodReference method: self! ! + +SourceCodeIntervalPrecondition removeSelector: #firstParseNodeOfMethodDefinition! + +!methodRemoval: SourceCodeIntervalPrecondition #firstParseNodeOfMethodDefinition stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +firstParseNodeOfMethodDefinition + + ^ methodNode hasTemporaryVariables + ifTrue: [ methodNode temporariesDeclaration ] + ifFalse: [ methodNode block statements first + ifNotNil: [ :statement | statement ] + ifNil: [ methodNode ] ]! + +ChangeSelectorWizardStepWindow removeSelector: #isMessageSelected! + +!methodRemoval: ChangeSelectorWizardStepWindow #isMessageSelected stamp: 'Install-4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st 9/21/2021 12:53:33'! +isMessageSelected + + ^model isNil ifTrue: [ false ] ifFalse: [ model selection notNil ]! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4853-ExtractMethodEnhancement-HernanWilkinson-2021Aug25-15h32m-HAW.001.cs.st----! + +'From Cuis 5.0 [latest update: #4853] on 7 September 2021 at 12:53:40 pm'! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/7/2021 12:52:43' prior: 50779241! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 9) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1 by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atCenterXBaselineY: x @ (tickLength*2) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1 by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaist: tickLength @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4854-drawCoordinates-tweak-JuanVuletich-2021Sep07-12h50m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4854] on 9 September 2021 at 2:05:28 pm'! +!BitBltBoundsFinderCanvas methodsFor: 'morphic' stamp: 'jmv 9/9/2021 14:05:20' prior: 50768814! + updateBoundsIn: aWorldMorph addDamageTo: aDamageRecorder + + aWorldMorph haloMorphsDo: [ :halo | + (halo target isRedrawNeeded or: [halo target isSubmorphRedrawNeeded]) ifTrue: [ + "Invalidation of halos requires this specific sequence:" + halo redrawNeeded. "invalidate old halo bounds" + self fullAddRedrawRect: halo target to: aDamageRecorder. "recompute & invalidate target bounds" + self fullAddRedrawRect: halo to: aDamageRecorder ]]. "recompute & invalidate halo bounds" + "bogus iteration on halos and targets below is harmless: + Both now marked as neither #isRedrawNeeded nor #isSubmorphRedrawNeeded." + + aWorldMorph submorphsDo: [ :morph | + self fullAddRedrawRect: morph to: aDamageRecorder ]. + self updateHandsDisplayBounds: aWorldMorph.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4855-BoundsFinder-fix-JuanVuletich-2021Sep09-14h05m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4855] on 10 September 2021 at 4:10:30 pm'! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:02:58'! + turnMouseButton2Into3 + "Answer true if modifier keys are such that button 2 should be considered as button 3. + ctrl - click right -> center click + " + + self controlKeyPressed ifTrue: [ ^ true ]. + ^ false! ! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:08:01' prior: 50642791! + mouseButton2Pressed + "Answer true if the mouseButton2 is being pressed. + Reported by the VM for right mouse button or option+click on the Mac, ctrl-click on Windows, or ctrl-click or alt-click on Linux. + It is also emulated here with ctrl-click on any platform." + + (self turnMouseButton1Into2 and: [ buttons anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + self turnMouseButton2Into3 ifTrue: [ ^ false ]. + ^ buttons anyMask: InputSensor mouseButton2! ! +!MouseEvent methodsFor: 'button state' stamp: 'jmv 9/10/2021 16:06:43' prior: 50642807! + mouseButton3Pressed + "Answer true if the mouseButton3 is being pressed. + Reported by the VM for center (wheel) mouse button or cmd+click on the Mac or win/meta+click on Windows and Linux. + It is also emulated here with on any platform with: + shift - ctrl - click + ctrl - rightClick" + + (self turnMouseButton1Into3 and: [ buttons anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + (self turnMouseButton2Into3 and: [ buttons anyMask: InputSensor mouseButton2 ]) + ifTrue: [ ^ true ]. + ^ buttons anyMask: InputSensor mouseButton3! ! +!MouseButtonEvent methodsFor: 'accessing' stamp: 'jmv 9/10/2021 16:09:10' prior: 50642844! + mouseButton2Changed + "Answer true if the mouseButton2 has changed. + Reported by the VM for right mouse button or option+click on the Mac. + It is also emulated here with ctrl-click on any platform. + The check for button change (instead of button press) is specially useful on buttonUp events." + + (self turnMouseButton1Into2 and: [ whichButton anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + self turnMouseButton2Into3 ifTrue: [ ^ false ]. + ^ whichButton anyMask: InputSensor mouseButton2! ! +!MouseButtonEvent methodsFor: 'accessing' stamp: 'jmv 9/10/2021 16:07:19' prior: 50642861! + mouseButton3Changed + "Answer true if the mouseButton3 has changed. + Reported by the VM for center (wheel) mouse button or cmd+click on the Mac or meta+click on Linux. + It is also emulated here with shift-ctrl-click or ctrl-rightClick on any platform. + The check for button change (instead of button press) is specially useful on buttonUp events." + + (self turnMouseButton1Into3 and: [ whichButton anyMask: InputSensor mouseButton1 ]) + ifTrue: [ ^ true ]. + (self turnMouseButton2Into3 and: [ whichButton anyMask: InputSensor mouseButton2 ]) + ifTrue: [ ^ true ]. + ^ whichButton anyMask: InputSensor mouseButton3! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4856-ctrl-rightClick-emulatesCenterClick-JuanVuletich-2021Sep10-16h02m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4856] on 13 September 2021 at 3:51:30 pm'! +!ScrollBar methodsFor: 'events' stamp: 'jmv 9/13/2021 15:51:20' prior: 16904535 overrides: 16874668! + mouseStillDown + + nextPageDirection notNil ifTrue: [ + self scrollByPage ]! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4857-AvoidWalkbackOnLost-mouseDown-JuanVuletich-2021Sep13-15h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4856] on 13 September 2021 at 4:08:19 pm'! +!WorldMorph methodsFor: 'canvas' stamp: 'jmv 9/13/2021 16:07:58' prior: 50776550! + setMainCanvas + "Deallocate before allocating could mean less memory stress." + + self clearCanvas. + self setCanvas: Display getMainCanvas. + self restoreDisplay.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/13/2021 16:03:02' prior: 50777885! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + self clearCanvas. + DisplayScreen startUp. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4858-MainWindowResizeCleanup-JuanVuletich-2021Sep13-15h51m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4858] on 14 September 2021 at 3:57:49 pm'! +!WidgetMorph methodsFor: 'drawing' stamp: 'jmv 9/13/2021 17:26:04' overrides: 50751569! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + auxCanvas _ MorphicCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! +!Morph methodsFor: 'drawing' stamp: 'jmv 9/13/2021 17:26:23' prior: 50751569! + imageForm: extentOrNil depth: depth + + self subclassResponsibility! ! + +MovableMorph removeSelector: #privateLocation:! + +!methodRemoval: MovableMorph #privateLocation: stamp: 'Install-4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st 9/21/2021 12:53:33'! +privateLocation: aGeometryTransformation + location _ aGeometryTransformation.! + +Morph removeSelector: #privateLocation:! + +!methodRemoval: Morph #privateLocation: stamp: 'Install-4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st 9/21/2021 12:53:33'! +privateLocation: aGeometryTransformation! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4859-imageFormdepth-refactor-JuanVuletich-2021Sep14-15h55m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4859] on 14 September 2021 at 4:21:17 pm'! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 9/14/2021 16:20:04' prior: 16835206! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:. + + If for whatever reason, actual OS or hardware Display is smaller than us, don't go outside its bounds. + This can sometimes happen, at least on MacOS, when frantically resizing the main OS Cuis window, + while Morphic is busy drawing many heavy morphs: it could be observed than apparently in #displayWorld, + after we were updated in #checkForNewScreenSize, MacOS window could be made smaller than aRectangle, + and a hard crash due to an invalid memory access happened in this primitive." + + | platformDisplayExtent | + platformDisplayExtent _ DisplayScreen actualScreenSize. + self primShowRectLeft: (aRectangle left max: 0) + right: (aRectangle right min: platformDisplayExtent x) + top: (aRectangle top max: 0) + bottom: (aRectangle bottom min: platformDisplayExtent y). +! ! +!WorldMorph methodsFor: 'drawing' stamp: 'jmv 9/14/2021 16:20:41' prior: 50725273! + displayWorld + "Update this world's display." + + | deferredUpdateVMMode worldDamageRects handsToDraw allDamage | + self checkIfUpdateNeeded ifFalse: [ ^ self ]. "display is already up-to-date" + "I (jmv) removed the call to 'deferUpdates: false' below. No more need to call this every time." + deferredUpdateVMMode _ self tryDeferredUpdatingAndSetCanvas. + + "repair world's damage on canvas" + worldDamageRects _ canvas drawWorld: self repair: damageRecorder. + + "Check which hands need to be drawn (they are not the hardware mouse pointer)" + handsToDraw _ self selectHandsToDrawForDamage: worldDamageRects. + allDamage _ Array streamContents: [ :strm | + strm nextPutAll: worldDamageRects. + handsToDraw do: [ :h | + h savePatchFrom: canvas appendDamageTo: strm ]]. + + "Draw hands (usually carying morphs) onto world canvas" + canvas newClipRect: nil. + handsToDraw reverseDo: [ :h | canvas fullDrawHand: h ]. + + "quickly copy altered rects of canvas to Display:" + deferredUpdateVMMode ifFalse: [ + "Drawing was done to off-Display canvas. Copy content to Display" + canvas showAt: self viewBox origin invalidRects: allDamage ]. + + "Display deferUpdates: false." + "Display forceDisplayUpdate" + DisplayScreen isDisplayExtentOk ifTrue: [ + Display forceDamageToScreen: allDamage ]. + + "Restore world canvas under hands and their carried morphs" + handsToDraw do: [ :h | h restoreSavedPatchOn: canvas ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4860-fixUnlikelyCrashOnMainWindowResize-JuanVuletich-2021Sep14-16h15m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4860] on 15 September 2021 at 9:48:57 am'! +!GeometryTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:16:54'! + invertingYAxis: mustInvertYAxis + "Answer an instance (either the receiver or a new one) with the prescribed behavior on the Y axis: + - If mustInvertYAxis, the Y axis in inner and outer space point in opposite directions. + - If mustInvertYAxis is false, the Y axis in inner and outer space point in the same direction (either up or down). + Senders should always use the returned object, but not assume it is a new one: + it could also be the receiver itself." + + self doesMirror = mustInvertYAxis ifFalse: [ + ^self withCurrentYAxisInverted ]. + ^self! ! +!GeometryTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:15:52'! + withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one: + it could also be the receiver itself." + + self subclassResponsibility! ! +!AffineTransformation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:15:58' overrides: 50781171! + withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one (like for MorphicTranslation): + it could also be the receiver itself, like when the receiver is already a AffineTransformation." + + self a12: self a12 negated. + self a22: self a22 negated. + ^self! ! +!MorphicTranslation methodsFor: 'modifying' stamp: 'jmv 9/14/2021 18:16:01' overrides: 50781171! +withCurrentYAxisInverted + "Answer an instance (either the receiver or a new one) that flips the current direction of the Y axis. + This means that whatever we answer when externalizing x@y, it will answer when externalizing x @ -y. + Senders should always use the returned object, but not assume it is a new one (like here): + it could also be the receiver itself, like when the receiver is already a AffineTransformation." + + ^(AffineTransformation withTranslation: self translation) withCurrentYAxisInverted! ! +!MovableMorph methodsFor: 'geometry testing' stamp: 'jmv 9/14/2021 18:21:50'! + yAxisPointsUp + "By default, most morphs assume the usual convention in 2d computer graphics: + - x points to the right (i.e. increasing x values move from left to right) + - y points down (i.e. increasing y values move from top to bottom) + Subclasses wanting to follow the standard math convention, making increasing y values move upwards + should redefine this method to answer true." + + ^false! ! +!MovableMorph methodsFor: 'private' stamp: 'jmv 9/14/2021 18:24:55'! + fixYAxisDirection + "Ensure the direction of the Y axis used by our location for coordinate transformations matches our #yAxisPointsUp." + + | ownersYAxisPointsUp | + ownersYAxisPointsUp _ owner ifNil: [false] ifNotNil: [owner yAxisPointsUp]. + location _ location invertingYAxis: (self yAxisPointsUp = ownersYAxisPointsUp) not! ! +!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 9/14/2021 18:58:27'! + drawString: s atWaistCenter: pt font: fontOrNil color: aColor + "Answer position to place next glyph + Answer nil if nothing was done" + + | font dy | + font _ self fontToUse: fontOrNil. + dy _ currentTransformation doesMirror + ifFalse: [ font ascent * 0.4 ] + ifTrue: [ font ascent * -0.4 ]. + ^self + drawString: s + from: 1 to: s size + atBaseline: pt + ((font widthOfString: s) negated / 2 @ dy) + font: font color: aColor! ! +!GeometryTransformation methodsFor: 'testing' stamp: 'jmv 9/13/2021 17:01:20' prior: 50734227! + doesMirror + "Return true if the receiver mirrors points around some rect. + Usually this is interpreted as (and used for) inverting the direction of the Y axis between the inner and the outer coordinates systems." + + ^false! ! +!AffineTransformation methodsFor: 'testing' stamp: 'jmv 9/13/2021 17:01:13' prior: 50734233 overrides: 50781270! + doesMirror + "Return true if the receiver mirrors points around some rect. + Usually this is interpreted as (and used for) inverting the direction of the Y axis between the inner and the outer coordinates systems." + + | f | + f _ self a11 * self a22. + ^ f = 0.0 + ifTrue: [ self a12 * self a21 > 0.0] + ifFalse: [ f < 0.0 ]! ! +!MovableMorph methodsFor: 'accessing' stamp: 'jmv 9/14/2021 18:27:26' prior: 50749586 overrides: 50733152! + location: aGeometryTransformation + location _ aGeometryTransformation. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self fixYAxisDirection. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'geometry' stamp: 'jmv 9/15/2021 09:45:04' prior: 50727747! + rotateBy: radians + "Change the rotation of this morph. Argument is an angle (possibly negative), to be added to current rotation." + + | r | + r _ self yAxisPointsUp ifTrue: [ radians negated ] ifFalse: [ radians ]. + location _ location rotatedBy: r. + self fixYAxisDirection. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'geometry' stamp: 'jmv 9/15/2021 09:44:18' prior: 50727766 overrides: 50728043! + rotation: radians scale: scale + "Change the rotation and scale of this morph. Arguments are an angle and a scale." + + | r | + r _ self yAxisPointsUp ifTrue: [ radians negated ] ifFalse: [ radians ]. + location _ location withRotation: r scale: scale. + self fixYAxisDirection. + owner ifNotNil: [ owner someSubmorphPositionOrExtentChanged ]. + self redrawNeeded.! ! +!MovableMorph methodsFor: 'private' stamp: 'jmv 9/14/2021 18:26:53' prior: 50727880 overrides: 50763573! + privateOwner: aMorph + "Private!! Should only be used by methods that maintain the ower/submorph invariant." + + | oldGlobalPosition prevOwner | + + self flag: #jmvVer2. + "Is this the best behavior???" + prevOwner _ owner. + prevOwner + ifNotNil: [ + "Had an owner. Maintain my global position..." + oldGlobalPosition _ self morphPositionInWorld ]. + owner _ aMorph. + owner + ifNil: [ + "Won't have any owner. Keep local position, as it will be maintained in my new owner later" + ] + ifNotNil: [ + prevOwner + ifNil: [ + "Didn't have any owner. Assume my local position is to be maintained in my new owner" + ] + ifNotNil: [ + "Had an owner. Maintain my global position..." + location _ location withTranslation: (owner internalizeFromWorld: oldGlobalPosition). + self flag: #jmvVer2. + "extent _ owner internalizeDistanceFromWorld: oldGlobalExtent" "or something like this!!" + ]]. + self fixYAxisDirection.! ! +!HaloMorph methodsFor: 'drawing' stamp: 'jmv 9/14/2021 18:59:01' prior: 50780763! + drawCoordinateSystemOn: aCanvas + + | x0 x1 y0 y1 c stepX stepY haloTargetTx prevTx font strokeWidth tickLength stepXDecimals stepYDecimals | + haloTargetTx _ MorphicTranslation identity. + target allOwnersReverseDo: [ :o | haloTargetTx _ haloTargetTx composedWith: o location ]. + haloTargetTx _ haloTargetTx composedWith: target location. + + target knowsOwnLocalBounds + ifTrue: [ | r | + r _ target morphLocalBounds. + x0 _ r left. + x1 _ r right. + y0 _ r top. + y1 _ r bottom ] + ifFalse: [ + x0 _ x1 _ y0 _ y1 _ 0. + target displayFullBounds corners collect: [ :pt | | p | + p _ haloTargetTx inverseTransform: pt. + x0 _ x0 min: p x. + x1 _ x1 max: p x. + y0 _ y0 min: p y. + y1 _ y1 max: p y.]]. + + font _ FontFamily defaultFamilyPointSize: FontFamily defaultPointSize * 1.5 / haloTargetTx scale. + stepX _ (font pointSize * 9) round4perMagnitudeOrder asFloat. + stepXDecimals _ stepX log rounded negated + 1. + stepY _ (font pointSize * 5) round4perMagnitudeOrder asFloat. + stepYDecimals _ stepY log rounded negated + 1. + strokeWidth _ 3/ haloTargetTx scale. + tickLength _ 5 / haloTargetTx scale. + + prevTx _ aCanvas currentTransformation. + aCanvas geometryTransformation: haloTargetTx. + + c _ `Color black alpha: 0.4`. + aCanvas line: x0@0 to: x1@0 width: strokeWidth color: c. + aCanvas line: 0@y0 to: 0@y1 width: strokeWidth color: c. + + (x0 truncateTo: stepX) to: x1 by: stepX do: [ :x | + aCanvas line: x @ tickLength negated to: x @ tickLength width: strokeWidth color: c. + aCanvas drawString: (x printStringFractionDigits: stepXDecimals) atWaistCenter: x @ (tickLength*4) negated font: font color: c ]. + aCanvas drawString: 'x' atCenterX: x1 - (tickLength*3) @ 0 font: font color: c. + + (y0 truncateTo: stepY) to: y1 by: stepY do: [ :y | + aCanvas line: tickLength negated @ y to: tickLength @ y width: strokeWidth color: c. + aCanvas drawString: (y printStringFractionDigits: stepYDecimals), ' ' atWaistRight: tickLength negated @ y font: font color: c ]. + aCanvas drawString: 'y' atWaist: tickLength @ (y1 - (tickLength*4)) font: font color: c. + + aCanvas geometryTransformation: prevTx.! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/15/2021 09:46:28' prior: 50749594! + doRot: evt with: rotHandle + "Update the rotation of my target if it is rotatable." + + | radians prevLocation deltaRadians | + evt hand obtainHalo: self. + radians _ (evt eventPosition - target referencePosition) theta + angleOffset. + radians _ radians detentBy: 0.05 atMultiplesOf: Float pi / 4 snap: false. + rotHandle color: (radians = 0.0 + ifTrue: [`Color lightBlue`] + ifFalse: [`Color blue`]). + rotHandle submorphsDo: [ :m | + m color: rotHandle color makeForegroundColor]. + prevLocation _ target location. + deltaRadians _ radians-prevLocation radians. + target yAxisPointsUp ifTrue: [ deltaRadians _ deltaRadians negated ]. + target location: (prevLocation composedWith: ( + AffineTransformation withRadians: deltaRadians around: target rotationCenter)). + rotHandle morphPositionInWorld: evt eventPosition - (rotHandle morphExtent // 2). + self redrawNeeded.! ! +!MorphicCanvas methodsFor: 'drawing-text' stamp: 'jmv 9/14/2021 19:00:41' prior: 50739440! + drawString: aString from: firstIndex to: lastIndex atWaist: aPoint font: font color: aColor + "Answer position to place next glyph + Answer nil if nothing was done" + + | dy | + dy _ currentTransformation doesMirror + ifFalse: [ font ascent * 0.4 ] + ifTrue: [ font ascent * -0.4 ]. + ^self drawString: aString from: firstIndex to: lastIndex + atBaseline: aPoint + (0 @ dy) + font: font color: aColor! ! + +MorphicTranslation removeSelector: #withYAxisNegated! + +!methodRemoval: MorphicTranslation #withYAxisNegated stamp: 'Install-4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st 9/21/2021 12:53:33'! +withYAxisNegated + "Swap inneer point Y sign. + Make y increment upwards. + This makes the any matrix transform from standard mathematical coordinates + to standard display coordinates (in addition to the transform it was already doing) + + Answer the modified object. In this implementation this requires the creation of a new, more general instance. + Senders should always use the returned object, but not assume it is a new one: it could also be the receiver itself, + as if the receiver is already a AffineTransformation." + + ^(AffineTransformation withTranslation: self translation) withYAxisNegated! + +AffineTransformation removeSelector: #withYAxisNegated! + +!methodRemoval: AffineTransformation #withYAxisNegated stamp: 'Install-4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st 9/21/2021 12:53:33'! +withYAxisNegated + "Swap inneer point Y sign. + Make y increment upwards. + This makes the any matrix transform from standard mathematical coordinates + to standard display coordinates (in addition to the transform it was already doing) + + Answer the modified object. In this implementation it is self, but some classes of transformations, + more restricted ones (like MorphicTranslation) could require the creation of a new, more general instance. + Senders should always use the returned object, but not assume it is a new one: it could also be the receiver itself." + + self a12: self a12 negated. + self a22: self a22 negated. + ^self! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4861-YaxisUpwardsSupport-JuanVuletich-2021Sep15-09h37m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4861] on 15 September 2021 at 9:07:29 am'! +!WidgetMorph methodsFor: 'drawing' stamp: 'jmv 9/15/2021 08:48:04' prior: 50781014 overrides: 50781033! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + "To avoid slower Smalltalk VG engine just because of window decorations" + auxCanvas _ BitBltCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4862-imageForm-use-BitBltCanvas-JuanVuletich-2021Sep15-09h07m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4862] on 16 September 2021 at 11:30:30 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/16/2021 11:22:16'! + setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk garbageCollect ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! +!DisplayScreen methodsFor: 'other' stamp: 'jmv 9/16/2021 10:58:07' prior: 50781062! + forceToScreen: aRectangle + "Force the given rectangular section of the Display to be copied to the screen. The primitive call does nothing if the primitive is not implemented. Used when the deferUpdates flag in the virtual machine is on; see #deferUpdates:. + + If for whatever reason, actual OS or hardware Display is smaller than us, don't go outside its bounds. + This can sometimes happen, at least on MacOS, when frantically resizing the main OS Cuis window, + while Morphic is busy drawing many heavy morphs: it could be observed than apparently in #displayWorld, + after we were updated in #checkForNewScreenSize, MacOS window could be made smaller than aRectangle, + and a hard crash due to an invalid memory access happened in this primitive. + + Protecting against our bounds being smaller than aRectangle is done in the primitive. No need to do it here." + + | platformDisplayExtent | + platformDisplayExtent _ DisplayScreen actualScreenSize. + self primShowRectLeft: (aRectangle left max: 0) + right: (aRectangle right min: platformDisplayExtent x) + top: (aRectangle top max: 0) + bottom: (aRectangle bottom min: platformDisplayExtent y). +! ! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/16/2021 11:22:01' prior: 50745016 overrides: 50335353! + startUp + " + DisplayScreen startUp. + Display forceToScreen. + " + self setupDisplay: false.! ! +!WorldMorph methodsFor: 'update cycle' stamp: 'jmv 9/16/2021 11:25:32' prior: 50780994! + checkForNewScreenSize + "Check whether the screen size has changed and if so take appropriate actions" + + DisplayScreen isDisplayExtentOk ifFalse: [ + "Minimize the risk of going out of memory: + - First clear existing canvas, to free the memory it uses. + - Then, setup the display, with a GarbageCollection prior to allocating new display memory. + - Then set up new canvas." + self clearCanvas. + DisplayScreen setupDisplay: true. + self setMainCanvas. + self whenUIinSafeState: [ Cursor defaultCursor activateCursor ]].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4863-GarbabeCollectDuringDisplayResize-JuanVuletich-2021Sep16-11h28m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:28:36 pm'! +!LargeNegativeInteger methodsFor: 'printing' stamp: 'jmv 9/16/2021 14:27:54' overrides: 16862727! + printOn: aStream base: b nDigits: n + "See comment at LargePositiveInteger." + + self shouldNotImplement.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4864-printOnbasenDigits-notAppropriateFor-LargeNegativeInteger-JuanVuletich-2021Sep16-14h27m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:33:13 pm'! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:32:50'! + millisecondsToRun + "Answer the number of milliseconds taken to execute this block." + + ^ Time millisecondsToRun: self +! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4865-millisecondsToRun-JuanVuletich-2021Sep16-14h28m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4863] on 16 September 2021 at 2:36:00 pm'! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:34:45'! + millisecondsToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(Smalltalk vmParameterAt: 8) + + (Smalltalk vmParameterAt: 10) + + self millisecondsToRun - + (Smalltalk vmParameterAt: 8) - + (Smalltalk vmParameterAt: 10) +! ! +!BlockClosure methodsFor: 'evaluating' stamp: 'jmv 9/16/2021 14:34:26' prior: 16787872! + durationToRun + "Answer the duration taken to execute this block." + + ^ Duration milliSeconds: self millisecondsToRun.! ! +!TestCase methodsFor: 'assertions' stamp: 'jmv 9/16/2021 14:35:21' prior: 50634177! + should: aClosure notTakeMoreThan: aLimit + + | millisecondsLimit | + + millisecondsLimit := aLimit totalMilliseconds. + self assert: aClosure millisecondsToRun <= millisecondsLimit + description: [ 'Took more than ', millisecondsLimit printString, ' milliseconds' ].! ! + +BlockClosure removeSelector: #timeToRunWithoutGC! + +!methodRemoval: BlockClosure #timeToRunWithoutGC stamp: 'Install-4866-prefer-millisecondsToRun-over-timeToRun-JuanVuletich-2021Sep16-14h33m-jmv.001.cs.st 9/21/2021 12:53:34'! +timeToRunWithoutGC + "Answer the number of milliseconds taken to execute this block without GC time." + + ^(Smalltalk vmParameterAt: 8) + + (Smalltalk vmParameterAt: 10) + + self timeToRun - + (Smalltalk vmParameterAt: 8) - + (Smalltalk vmParameterAt: 10) +! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4866-prefer-millisecondsToRun-over-timeToRun-JuanVuletich-2021Sep16-14h33m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4866] on 17 September 2021 at 10:22:21 am'! +!DisplayScreen class methodsFor: 'snapshots' stamp: 'jmv 9/17/2021 10:21:57' prior: 50781570! + setupDisplay: doGarbageCollection + " + DisplayScreen setupDisplay: true. + Display forceToScreen. + " + + self terminateScreenUpdater. + doGarbageCollection ifTrue: [ + Display setExtent: 0@0 depth: 0 bits: nil. + Smalltalk primitiveGarbageCollect. ]. + Display setExtent: self actualScreenSize depth: Display nativeDepth. + Display beDisplay. + self installScreenUpdater.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4867-just-primitiveGarbageCollect-onDisplaySetup-JuanVuletich-2021Sep17-10h21m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4866] on 17 September 2021 at 10:58:32 am'! +!PasteUpMorph methodsFor: 'misc' stamp: 'jmv 9/17/2021 10:58:19' prior: 50745763! + buildMagnifiedBackgroundImage + | image | + backgroundImageData + ifNil: [ backgroundImage _ nil ] + ifNotNil: [ + [ + backgroundImage _ nil. + Smalltalk primitiveGarbageCollect. + image _ Form fromBinaryStream: backgroundImageData readStream. + backgroundImage _ image magnifyTo: extent. + backgroundImage _ backgroundImage orderedDither32To16 asColorFormOfDepth: 8. + image _ nil. + Smalltalk primitiveGarbageCollect. + backgroundImage bits pin. + ] on: Error do: [backgroundImage := nil]. "Can happen if JPEG plugin not built" + self redrawNeeded + ]! ! + +"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." +self runningWorld color: (Color fromHexString: '#214A8C') lighter.! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4868-disableDesktopBackground-JuanVuletich-2021Sep17-10h39m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4868] on 20 September 2021 at 3:34:52 pm'! +!Morph methodsFor: 'change reporting' stamp: 'jmv 9/20/2021 12:32:14' prior: 50741058! + invalidateDisplayRect: damageRect for: aMorph + " + If we clip submorphs, then we clip damageRect. + + aMorph is the morph that changed and therefore should be redrawn. In some cases, damage reporting is done by no longer occupying some area, and requesting whatever appropriate morph to be drawn there. In such cases, aMorph should be nil. See senders." + + | clippedRect b | + self visible ifFalse: [ ^self]. + + clippedRect _ damageRect. + aMorph == self ifFalse: [ + self clipsSubmorphsReally ifTrue: [ + b _ self displayBounds. + b ifNil: [ ^self ]. + clippedRect _ damageRect intersect: b ]]. + owner ifNotNil: [ + owner invalidateDisplayRect: clippedRect for: aMorph ].! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4869-Transcript-artifactsInVG-fix-JuanVuletich-2021Sep20-15h34m-jmv.001.cs.st----! + +'From Cuis 5.0 [latest update: #4869] on 21 September 2021 at 9:53:48 am'! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:32'! +fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^true ]. + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^true ]]. + ^ false.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:50:59'! + isCloserThan: maxDistance toPixel: worldPoint + "Answer true if our closest point to aPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + Uses precise testing of the morph contour if available: + Morphs not in the WidgetMorph hierarchy should answer #true to wantsContour. + Note: Considers only the external border. Any inner pixel is considered 'inside' regardless of us being transparent there. + Note: Cheaper than #coversAnyPixelCloserThan:to: . Doesn't use #bitMask. Doesn't require maintenance." + + | center contourTop contourBottom | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - worldPoint y) abs < (privateDisplayBounds height // 2 + maxDistance) ifFalse: [ + ^false ]. + (center x - worldPoint x) abs < (privateDisplayBounds width // 2 + maxDistance) ifFalse: [ + ^false ]. + "Precise check with contour, if available" + (self valueOfProperty: #contour) ifNotNil: [ :contour | | y0 y1 x0 x1 | + contourTop _ self valueOfProperty: #contourY0. + contourBottom _ self valueOfProperty: #contourY1. + "Contour rows to consider are those within requested distance." + y0 _ worldPoint y - maxDistance max: contourTop. + y1 _ worldPoint y + maxDistance min: contourBottom. + y0 to: y1 do: [ :y | + x0 _ (contour at: (y - contourTop) * 2 + 1) - maxDistance. + x1 _ (contour at: (y - contourTop) * 2 + 2) + maxDistance. + "If a vertical line of 2*aNumber height centered on aPoint is inside the contour, quick exit" + (worldPoint x between: x0 and: x1) ifTrue: [ ^true ]. + "Check if aPoint is close enough to contour" + (x0@y - worldPoint) r < maxDistance ifTrue: [ ^true ]. + (x1@y - worldPoint) r < maxDistance ifTrue: [ ^true ]]. + "Not inside, not close enough to contour" + ^ false ]. + "If contour is not available, and aPoint is close enough to displayBounds, answer true, as it is the best we can know." + ^ true! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:33:07'! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + Some implementations (KernelMorph and WidgetMorph) may also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for VectorGraphics based morphs (i.e. morphs that answer true to #requiresVectorCanvas). + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self ownsPixel: worldPoint.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:12:00'! + ownsPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + Requires VectorGraphics. + Only valid for morphs that answer true to #requiresVectorCanvas" + + self topmostWorld ifNotNil: [ :w | + w canvas ifNotNil: [ :canvas | + ^ (canvas morphIdAt: worldPoint) = self morphId ]]. + ^ false.! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:25:55'! + coversLocalPoint: aLocalPoint + "Answer true as long as aLocalPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it." + + "If not visible, won't cover any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:36:45'! + coversPixel: worldPoint + "Answer true as long as worldPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it. + This implementation is cheap, we are a rectangular shape." + + ^ self coversLocalPoint: + (self internalizeFromWorld: worldPoint)! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:36' overrides: 50781835! + fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]. + self submorphsMightProtrude ifTrue: [ + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]]]. + ^ false.! ! +!KernelMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:35:38' overrides: 50781913! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + This implementation also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for morphs with a cheap #coversPixel:. + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self visible and: [self coversPixel: worldPoint].! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:26:19'! + coversLocalPoint: aLocalPoint + "Answer true as long as aLocalPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it." + + "If not visible, won't cover any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:36:52'! + coversPixel: worldPoint + "Answer true as long as worldPoint is inside our shape even if: + - a submorph (above us) also covers it + - a sibling that is above us or one of their submorphs also covers it. + This implementation is cheap, we are a rectangular shape." + + ^ self coversLocalPoint: + (self internalizeFromWorld: worldPoint)! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:31:41' overrides: 50781835! + fullOwnsOrCoversPixel: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape. + See comment at #ownsOrCoversPixel: for important notes on behavior." + + (self ownsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]. + self submorphsMightProtrude ifTrue: [ + self submorphsDo: [ :m | + (m fullOwnsOrCoversPixel: worldPoint) ifTrue: [ ^ true ]]]. + ^ false.! ! +!WidgetMorph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:35:48' overrides: 50781913! + ownsOrCoversPixel: worldPoint + "Answer true if we own the pixel, i.e. we are the last morph drawn at worldPoint. + This implementation also answer true if we cover but don't own the pixel, + meaning that some other morph was drawn later, covering us. + Therefore, senders need to be aware that the answer is meaningful only when it is known that no other morph covers us. + Note: This implementation is only used for morphs with a cheap #coversPixel:. + (See other implementors) + Note: Also see #ownsPixel: and #coversPixel:" + + ^ self visible and: [self coversPixel: worldPoint].! ! +!WindowEdgeAdjustingMorph methodsFor: 'geometry services' stamp: 'jmv 9/20/2021 11:30:16' overrides: 50782016! + coversLocalPoint: aLocalPoint + "We don't completely cover our bounds. Account for that." + + | sensitiveBorder | + ( self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [ ^false ]. + sensitiveBorder _ owner borderWidth. + selector caseOf: { + [ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]]. + [ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]]. + } + otherwise: [ + "all the morph is sensitive for horizontal and vertical (i.e. non corner) instances." + ^true ]! ! +!Morph methodsFor: 'events-processing' stamp: 'jmv 9/20/2021 12:13:48' prior: 50736153! + 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 fullOwnsOrCoversPixel: 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 ].! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:53:20' prior: 50766813! + contourIntersects: aContourArray top: aContourTop bottom: aContourBottom + "Check if contours intersect. + If contour is not available, use displayBounds. + Not to be called directly. Pefer a higher level service. See senders." + + | contour contourTop contourBottom x0Own x1Own x0Arg x1Arg | + contour _ self valueOfProperty: #contour. + contourTop _ (self valueOfProperty: #contourY0) ifNil: [aContourTop]. + contourBottom _ (self valueOfProperty: #contourY1) ifNil: [aContourBottom]. + + (contourTop max: aContourTop) to: (contourBottom min: aContourBottom) do: [ :y | + x0Own _ contour ifNil: [privateDisplayBounds left] ifNotNil: [ contour at: (y - contourTop) * 2 + 1 ]. + x1Own _ contour ifNil: [privateDisplayBounds right-1] ifNotNil: [ contour at: (y - contourTop) * 2 + 2 ]. + x0Arg _ aContourArray at: (y - aContourTop) * 2 + 1. + x1Arg _ aContourArray at: (y - aContourTop) * 2 + 2. + (x0Own <= x1Arg and: [ x0Arg <= x1Own ]) + ifTrue: [ ^true ]]. + + ^false! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:51:06'! + coversAnyPixelCloserThan: maxDistance to: worldPoint + "Answer true if our closest point to worldPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + See #bitMask. + Remember to do + self removeProperty: #bitMask. + when appropriate!! (i.e. when we change in such a way to make the bitMask invalid). + + Note: Requires VectorGraphics. Meant to be used only when needed. + Note: Prefer #isCloserThan:toPixel:, that doesn't use #bitMask, and doesn't require maintenance." + + | center maxDistanceSquared | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - worldPoint y) abs < (privateDisplayBounds height // 2 + maxDistance) ifFalse: [ + ^false ]. + (center x - worldPoint x) abs < (privateDisplayBounds width // 2 + maxDistance) ifFalse: [ + ^false ]. + "Precise check with bitMask" + (self coversPixel: worldPoint) ifTrue: [ ^true ]. + maxDistanceSquared _ maxDistance squared. + maxDistance negated to: maxDistance do: [ :dy | + maxDistance negated to: maxDistance do: [ :dx | + dx squared + dy squared <= maxDistanceSquared ifTrue: [ + (self coversPixel: worldPoint + (dx@dy)) ifTrue: [ ^true ]]]]. + ^false.! ! +!Morph methodsFor: 'geometry services' stamp: 'jmv 9/21/2021 09:38:06'! + coversPixel: worldPoint + "Answer true if pixel worldPoint is covered by us, even if we are not visible a it because of some + other morph above us also covers it. + See #bitMask. + Remember to do + self removeProperty: #bitMask. + when appropriate!! (i.e. when we change in such a way to make the bitMask invalid). + + Note: Subclasses such as KernelMorph and WidgetMorph redefine this method with an optimized + implementation that doesn't require computing and invalidating the #bitMask. Senders in the base image + and framework actually only use this optimized implementation. That's why general morphs don't care about + invalidting #bitMask. + + Note: If your morph #requiresVectorCanvas, and depends on this general implementation, remember to + `removeProperty: #bitMask` whenever it becomes invalid due to changes in your morphs. You may consider + using #ownsPixel: if appropriate, that doesn't require any maintenance and is cheaper (in cpu and memory). + + Note: This implementation requires VectorGraphics." + + self visible ifTrue: [ + ^(self bitMask pixelValueAt: worldPoint - self displayFullBounds topLeft) = 1 ]. + ^ false! ! +!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 9/20/2021 12:13:54' prior: 50740596! + transferHalo: event from: formerHaloOwner + "Progressively transfer the halo to the next likely recipient" + + formerHaloOwner == self + ifFalse: [ + self addHalo: event. + ^self ]. + + event shiftPressed ifTrue: [ + "Pass it outwards" + owner ifNotNil: [ + owner transferHalo: event from: formerHaloOwner. + ^self ]. + "We're at the top level; just keep it on ourselves" + ^self ]. + + self submorphsDo: [ :m | + (m wantsHalo and: [ m fullOwnsOrCoversPixel: event eventPosition ]) + ifTrue: [ + m transferHalo: event from: formerHaloOwner. + ^self ]]. + "We're at the bottom most level; just keep halo on ourselves"! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/20/2021 11:32:25' prior: 50735963! + 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 coversPixel: 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 9/20/2021 11:32:30' prior: 50740719! + maybeCollapse: event with: aHandle + "Ask hand to collapse my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle coversPixel: event eventPosition) + ifTrue: [ + target collapse ]. + self delete.! ! +!HaloMorph methodsFor: 'private' stamp: 'jmv 9/20/2021 11:32:34' prior: 50735988! + maybeDismiss: event with: aHandle + "Ask hand to dismiss my target if mouse comes up in it." + + event hand obtainHalo: self. + (aHandle coversPixel: 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 9/20/2021 11:32:38' prior: 50736006! + setDismissColor: event with: aHandle + "Called on mouseStillDown in the dismiss handle; set the color appropriately." + + | colorToUse | + event hand obtainHalo: self. + colorToUse _ (aHandle coversPixel: event eventPosition) + ifFalse: [ `Color red muchLighter` ] + ifTrue: [ `Color lightGray` ]. + aHandle color: colorToUse! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:44' prior: 50736050! + activateOwnerMenu: evt + "Activate our owner menu; e.g., pass control to it" + owner ifNil: [ ^false ]. "not applicable" + (owner coversPixel: evt eventPosition) + ifFalse: [ ^false ]. + owner activate: evt. + ^true! ! +!MenuItemMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:47' prior: 50739113! + activateSubmenu: event + "Activate our submenu; e.g., pass control to it" + + subMenu ifNil: [ ^false ]. "not applicable" + subMenu isInWorld ifFalse: [ ^false ]. + (subMenu coversPixel: event eventPosition) ifFalse: [^false]. + subMenu activate: event. + ^true! ! +!PluggableButtonMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:53' prior: 50736071 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + isPressed _ false. + mouseIsOver _ false. + (actWhen == #buttonUp and: [ + self coversPixel: aMouseButtonEvent eventPosition ]) + ifTrue: [ self performAction ]. + self redrawNeeded! ! +!MenuMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:36:05' prior: 50748164 overrides: 16874541! + mouseButton1Down: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse down event." + (stayUp or: [ self coversPixel: aMouseButtonEvent eventPosition ]) + ifFalse: [ + self deleteIfPopUp: aMouseButtonEvent. + self activeHand + newKeyboardFocus: prevKbdFocus; + newMouseFocus: prevMouseFocus. + ^ self ]. "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 9/20/2021 11:36:32' prior: 50748188 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + "Handle a mouse up event. + Note: This might be sent from a modal shell." + (self coversPixel: aMouseButtonEvent eventPosition) ifFalse:[ + "Mouse up outside. Release eventual focus and delete if pop up." + aMouseButtonEvent hand ifNotNil: [ :h | h releaseMouseFocus: self ]. + self deleteIfPopUp: aMouseButtonEvent. + self activeHand + newKeyboardFocus: prevKbdFocus; + newMouseFocus: prevMouseFocus. + ^ self]. + stayUp ifFalse: [ + "Still in pop-up transition; keep focus" + aMouseButtonEvent hand newMouseFocus: self ].! ! +!AutoCompleterMorph methodsFor: 'events' stamp: 'jmv 9/20/2021 11:32:58' prior: 50736083 overrides: 16874556! + mouseButton1Up: aMouseButtonEvent localPosition: localEventPosition + + (self coversPixel: 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 ]! ! +!MorphicEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:09' prior: 50737354! + 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 fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: self eventPosition] ]) + ifTrue: [ ^ self sendEventTo: aMorph ]. + + ^ #rejected! ! +!DropEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:16' prior: 50737382 overrides: 50782434! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + | dropped | + + "Try to get out quickly" + (aMorph fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: 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 9/20/2021 12:14:23' prior: 50737409 overrides: 50782434! + dispatchWith: aMorph + "Drop is done on the innermost target that accepts it." + + "Try to get out quickly" + (aMorph fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: position] ]) + ifTrue: [^ self sendEventTo: aMorph ]. + + ^#rejected! ! +!KeyboardEvent methodsFor: 'actions' stamp: 'jmv 9/20/2021 11:33:02' prior: 50736314! + closeCurrentWindowOf: aMorph + + aMorph owningWindow ifNotNil: [ :w | + (w coversPixel: position) + ifTrue: [ w delete ] ].! ! +!MouseButtonEvent methodsFor: 'dispatching' stamp: 'jmv 9/20/2021 12:14:44' prior: 50737428 overrides: 50782434! + 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 fullOwnsOrCoversPixel: 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 fullOwnsOrCoversPixel: 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 9/20/2021 12:14:35' prior: 50771902 overrides: 50782434! + 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 | + "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 fullOwnsOrCoversPixel: position :: 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 fullOwnsOrCoversPixel: 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.! ! + +BitBltCanvas removeSelector: #morph:isAtPoint:! + +!methodRemoval: BitBltCanvas #morph:isAtPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +morph: aMorph isAtPoint: aPoint + + aMorph basicDisplayBounds ifNotNil: [ :r | + (r containsPoint: aPoint) ifFalse: [ + ^false ]]. + "Give morphs with a non-rectangular shape (corner WindowEdgeAdjustingMorphs) + a chance to have a say." + ^ aMorph morphContainsPoint: + (aMorph internalizeFromWorld: aPoint)! + +WindowEdgeAdjustingMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: WindowEdgeAdjustingMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +morphContainsPoint: aLocalPoint + | sensitiveBorder | + ( self morphLocalBounds containsPoint: aLocalPoint) ifFalse: [ ^false ]. + sensitiveBorder _ owner borderWidth. + selector caseOf: { + [ #windowTopLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowTopRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ aLocalPoint y < sensitiveBorder ]]. + [ #windowBottomLeft: ] -> [ ^ aLocalPoint x < sensitiveBorder or: [ extent y- aLocalPoint y <= sensitiveBorder ]]. + [ #windowBottomRight: ] -> [ ^ extent x - aLocalPoint x <= sensitiveBorder or: [ extent y - aLocalPoint y <= sensitiveBorder ]]. + } + otherwise: [ + "all the morph is sensitive for horizontal and vertical (i.e. non corner) instances." + ^true ]! + +WidgetMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: WidgetMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +morphContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in a submorph in front of us, as long as it is inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! + +HaloMorph removeSelector: #containsGlobalPoint:! + +!methodRemoval: HaloMorph #containsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +containsGlobalPoint: worldPoint + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + ^self morphLocalBounds containsPoint: + (self internalizeFromWorld: worldPoint) ]]. + ^ false! + +KernelMorph removeSelector: #morphContainsPoint:! + +!methodRemoval: KernelMorph #morphContainsPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +morphContainsPoint: aLocalPoint + "Answer true even if aLocalPoint is in a submorph in front of us, as long as it is inside our shape." + + "If not visible, won't contain any point at all." + self visible ifFalse: [ ^false ]. + + "We know our local bounds, and completely fill them." + ^ self morphLocalBounds containsPoint: aLocalPoint! + +Morph removeSelector: #containsGlobalPoint:! + +!methodRemoval: Morph #containsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +containsGlobalPoint: worldPoint + "Answer true if pixel worldPoint is covered by us, and we are visible a it. + No other morph above us also covers it." + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + w canvas ifNotNil: [ :canvas | + ^ canvas morph: self isAtPoint: worldPoint ]]]. + ^ false! + +Morph removeSelector: #isCloserThan:to:! + +Morph removeSelector: #fullContainsGlobalPoint:! + +!methodRemoval: Morph #fullContainsGlobalPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +fullContainsGlobalPoint: worldPoint + "Answer true if worldPoint is in some submorph, even if not inside our shape." + + self visible ifTrue: [ + self topmostWorld ifNotNil: [ :w | + (self containsGlobalPoint: worldPoint) ifTrue: [ ^ true ]. + self submorphsDo: [ :m | + (m fullContainsGlobalPoint: worldPoint) ifTrue: [ ^ true ]]]]. + ^ false! + +Morph removeSelector: #isCloserThan:toPoint:! + +!methodRemoval: Morph #isCloserThan:toPoint: stamp: 'Install-4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st 9/21/2021 12:53:34'! +isCloserThan: aNumber toPoint: aPoint + "Answer true if our closest point to aPoint is less than aNumber pixels away. + In target surface (i.e. Display) coordinates. + Uses precise testing of the morph contour if available. See #knowsContour." + + | center contourTop contourBottom | + privateDisplayBounds ifNil: [ + ^false ]. + center _ privateDisplayBounds center. + "Quick checks: If not even within aNumber distance to display bounds, fail" + (center y - aPoint y) abs < (privateDisplayBounds height // 2 + aNumber) ifFalse: [ + ^false ]. + (center x - aPoint x) abs < (privateDisplayBounds width // 2 + aNumber) ifFalse: [ + ^false ]. + "Precise check with contour, if available" + (self valueOfProperty: #contour) ifNotNil: [ :contour | | y0 y1 x0 x1 | + contourTop _ self valueOfProperty: #contourY0. + contourBottom _ self valueOfProperty: #contourY1. + "Contour rows to consider are those within requested distance." + y0 _ aPoint y - aNumber max: contourTop. + y1 _ aPoint y + aNumber min: contourBottom. + y0 to: y1 do: [ :y | + x0 _ (contour at: (y - contourTop) * 2 + 1) - aNumber. + x1 _ (contour at: (y - contourTop) * 2 + 2) + aNumber. + "If a vertical line of 2*aNumber height centered on aPoint is inside the contour, quick exit" + (aPoint x between: x0 and: x1) ifTrue: [ ^true ]. + "Check if aPoint is close enough to contour" + (x0@y - aPoint) r < aNumber ifTrue: [ ^true ]. + (x1@y - aPoint) r < aNumber ifTrue: [ ^true ]]. + "Not inside, not close enough to contour" + ^ false ]. + "If contour is not available, and aPoint is close enough to displayBounds, answer true, as it is the best we can know." + ^ true! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4870-Morphic-Geometry-Tweaks-JuanVuletich-2021Sep21-08h34m-jmv.002.cs.st----! + +'From Cuis 5.0 [latest update: #4870] on 21 September 2021 at 10:47:45 am'! +!KernelMorph methodsFor: 'drawing' stamp: 'jmv 9/21/2021 10:47:14' overrides: 50781033! + imageForm: extentOrNil depth: depth + + | answerExtent answer auxCanvas | + self requiresVectorCanvas ifFalse: [ + answerExtent _ extent. + extentOrNil ifNotNil: [ answerExtent _ answerExtent min: extentOrNil * 4 ]. + auxCanvas _ BitBltCanvas depth: depth over: (self morphPosition floor extent: answerExtent ceiling). + auxCanvas fullDraw: self. + answer _ auxCanvas form divideByAlpha. + extentOrNil ifNotNil: [ answer _ answer magnifyTo: extentOrNil ]. + ^answer ]. + ^super imageForm: extentOrNil depth: depth.! ! + +----End fileIn of C:\Users\Juan Vuletich\Cuis-Smalltalk\Cuis-Smalltalk-Dev\CoreUpdates\4871-imageFormdepth-KernelMorph-JuanVuletich-2021Sep21-10h46m-jmv.001.cs.st----! + +----QUIT----(21 September 2021 12:53:41) Cuis5.0-4871.image priorSource: 14294643! \ No newline at end of file diff --git a/Cuis5.0-4871.image b/Cuis5.0-4871.image new file mode 100644 index 00000000..8d17e512 Binary files /dev/null and b/Cuis5.0-4871.image differ diff --git a/Documentation/GettingStarted-NoCommandLine.md b/Documentation/GettingStarted-NoCommandLine.md index 5e346c19..92b58775 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_202003021730.zip`](https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/202003021730/squeak.cog.spur_win32x86_202003021730.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-4834-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-4834-32.image. +* drop the Cuis5.0-4871-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-4871-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_202003021730.dmg`](https://github.com/OpenSmalltalk/opensmalltalk-vm/releases/download/202003021730/squeak.cog.spur_macos64x64_202003021730.dmg), saving it to your folder * double click on the dmg file * Drag Squeak to your folder -* drop the Cuis5.0-4834.image over the Squeak.app file +* drop the Cuis5.0-4871.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-4834.image, then this document is outdated. Use the Cuis image with the latest update number available. +* If you can't find Cuis5.0-4871.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 73e1db50..982deb33 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-4834.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871.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-4834.image over the Squeak.app file +* drop the Cuis5.0-4871.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-4834.image +./Squeak.app/Contents/MacOS/Squeak Cuis-Smalltalk-Dev-master/Cuis5.0-4871.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-4834.image +cogspur/Squeak.exe Cuis-Smalltalk-Dev/Cuis5.0-4871.image ``` ## For Raspberry Pi Raspian ## @@ -105,7 +105,7 @@ mv ./sqcogspurlinuxhtRPi ./cogspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4834-32.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871-32.image ``` ## For Chromebooks ## @@ -136,14 +136,14 @@ mv ./sqstkspurlinuxhtRPi ./stkspur ### Starting Cuis Smalltalk ### ``` -cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4834-32.image -stkspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4834-32.image +cogspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871-32.image +stkspur/squeak Cuis-Smalltalk-Dev/Cuis5.0-4871-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-4834-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-4871-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 diff --git a/Documentation/VectorGraphicsAndMorphic3.md b/Documentation/VectorGraphicsAndMorphic3.md index 0649d473..8584534d 100644 --- a/Documentation/VectorGraphicsAndMorphic3.md +++ b/Documentation/VectorGraphicsAndMorphic3.md @@ -21,16 +21,16 @@ In addition to MorphicTranslation, VectorCanvas and VectorEngine can handle more There are several example morphs using Vector Graphics, and showing some of the things that can be done. ``` -World / New morph... / From Alphabetica List... / M3Exp02Morph +World / New morph... / From Alphabetica List... / Sample01Star ``` -M3Exp02Morph and friends show how simple a Morph can be, and how the programmer is relieved from the complexity in detecting the mouse cursor touching arbitrary geometric shapes, clipping, occlusion, collision detection, scaling, rotation, and lower level problems as bounds detection, area invalidation, etc. Please play with all these examples with the Halos. Embed them one in another. Understand the code. Modify the code to try new things. See the drawing services provided by VectorCanvas, especially the 'stroke & fill' and 'paths' categories. Open an inspector on your morph, and see how the instance variable 'location' is modified as you move / scale / rotate it. See what happens if you embed your morph in another, and only move the outer morph. +Sample01Star and friends show how simple a Morph can be, and how the programmer is relieved from the complexity in detecting the mouse cursor touching arbitrary geometric shapes, clipping, occlusion, collision detection, scaling, rotation, and lower level problems as bounds detection, area invalidation, etc. Please play with all these examples with the Halos. Read the class comments. Embed them one in another. Understand the code. Modify the code to try new things. See the drawing services provided by VectorCanvas, especially the 'stroke & fill' and 'paths' categories. Open an inspector on your morph, and see how the instance variable 'location' is modified as you move / scale / rotate it. See what happens if you embed your morph in another, and only move the outer morph. You can also do: ``` Feature require: 'SVG'. -SVGElementMorph examplesMagician. +SVGMainMorph exampleWizard openInWorld. ``` -There are several other examples included. SVG support is quite complete, so you can also try other SVG files. Note that drawing complex SVG without the VectorEngine VM Plugin will slow down Cuis significantly. The Virtual Machine Plugin to enable fast drawing of vector graphics is in the process of getting integrated in the official OpenSmalltalk VMs. In the meantime, you might run one of the VMs built by members of our community, that include the plugin: https://www.dropbox.com/sh/rhkt4ayq24t2xbf/AACDb3mrjMUDB8Mptd-Bi6Zsa?dl=0 +There are several other examples included, chosen to show the capabilities of the VectorGraphics engine and SVG support. Browse the class side of SVGMainMorph, category 'examples'. SVG support is quite complete, so you can also try other SVG files as well. Note that drawing complex SVG without the VectorEngine VM Plugin will slow down Cuis significantly. The Virtual Machine Plugin to enable fast drawing of vector graphics is integrated in the OpenSmalltalk Virtual Machine GitHub repository, but not yet in the official builds. In the meantime, you might run one of the VMs built by members of our community, that include the plugin: https://www.dropbox.com/sh/rhkt4ayq24t2xbf/AACDb3mrjMUDB8Mptd-Bi6Zsa?dl=0 If you run Cuis with one of these VMs, and have selected a TrueType font as the system default, you'll see that the Morphic Halos include two new handles: "Change Scale" (center right) and "Rotate" (bottom left). Try them on any Morph! @@ -40,8 +40,8 @@ Vector Graphics is actually what got the Cuis project started. In 2003, ten year You can see more about the early development of the projects at: [The Morphic 3 Project](http://www.jvuletich.org/Morphic3/Morphic3-200911.html), [Morphic 3 in action](http://www.jvuletich.org/Morphic3/Morphic3-201006.html), [First public presentation of the project (video)](http://www.jvuletich.org/Morphic3/Smalltalks2007/Smalltalks2007.html) and [A short history of Cuis](CuisHistory.md). -A more recent landmark was in 2013, when a defensive publication on the techniques used in the project was made: [Prefiltering Antialiasing for General Vector Graphics](https://www.researchgate.net/publication/267152327_Prefiltering_Antialiasing_for_General_Vector_Graphics), [(also here)](https://priorart.ip.com/IPCOM/000232657). This meant the code could now be open-sourced without worries that someone might try to get a patent on it. +A more recent landmark was in 2013, when a defensive disclosure on the techniques used in the project was published: [Prefiltering Antialiasing for General Vector Graphics](https://www.researchgate.net/publication/267152327_Prefiltering_Antialiasing_for_General_Vector_Graphics), [(also here)](https://priorart.ip.com/IPCOM/000232657). This meant the code could now be open-sourced without worries of someone else trying to get a patent on it. -The following years, progress has been steady. The refactoring of Morphic is essentially complete. The most important feature is that in Cuis, each morph defines its own coordinate system, via the #morphLocalBounds method. Transformation to owner coordinates is an instance of the GeometryTransformation hierarchy, stored in the 'location' instance variable. This coordinate system is used by the Morph for its own drawing and also for positioning its submorphs. +The following years, progress has been steady. The refactoring of Morphic is essentially complete. The most important feature is that in Cuis, each morph defines its own coordinate system. Transformation to owner coordinates is an instance of the GeometryTransformation hierarchy, stored in the 'location' instance variable. This coordinate system is used by the Morph for its own drawing and also for positioning its submorphs. In 2019, support was added to read and use TrueType fonts. In 2020 I made it possible to include VectorGraphics based morphs (including morphs built from SVG files) to a regular World. In 2021, I wrote a VM plugin for the VectorEngine, gaining enough performance to use VectorGraphics for all morphs, including browsers and other dev tools.