Squeak-dev March 2021

squeak-dev@lists.squeakfoundation.org

32 participants
257 discussions

The Inbox: HelpSystem-Core-ct.134.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Christoph Thiede uploaded a new version of HelpSystem-Core to project The Inbox: http://source.squeak.org/inbox/HelpSystem-Core-ct.134.mcz ==================== Summary ==================== Name: HelpSystem-Core-ct.134 Author: ct Time: 2 March 2021, 3:45:09.69417 pm UUID: 427affe2-8ef9-464d-9f35-3b42e41eecc9 Ancestors: HelpSystem-Core-ct.124 Refactors removal of selectors. Complements System-ct.1221. Depends indeed on HelpSystem-Core-ct.124 (inbox). =============== Diff against HelpSystem-Core-ct.124 =============== Item was changed: ----- Method: ClassBasedHelpTopic>>removeSubtopic: (in category 'editing') ----- removeSubtopic: aTopic + | needsToStorePages oldPages | + aTopic isClassBasedHelpTopic ifTrue: [ + | result | + result := aTopic removeTopicClass. + result ifTrue: [self refresh]. + ^ result]. - | needsToStorePages confirmation oldPages | - aTopic isClassBasedHelpTopic - ifTrue: [ - | result | - result := aTopic removeTopicClass. - result ifTrue: [self refresh]. - ^ result]. aTopic key ifNil: [ self inform: 'Could not find topic' translated. ^ false]. + (self confirm: ('Are you sure you want to REMOVE the topic "{1}" from "{2}"?' translated format: {aTopic title. self title})) ifFalse: [^ false]. + needsToStorePages := self needsToStorePages. needsToStorePages ifTrue: [ (self okToWriteSelector: #pages) ifFalse: [^ false]. oldPages := self helpClass pages]. + + (self systemNavigation + confirmAndRemoveSelector: aTopic key + class: self helpClass theMetaClass) + ifFalse: [^ false]. + - confirmation := self systemNavigation - confirmRemovalOf: aTopic key - on: self helpClass theMetaClass. - confirmation = 3 ifTrue: [^ false]. - self helpClass theMetaClass removeSelector: aTopic key. needsToStorePages ifTrue: [ self storePages: (oldPages copyWithout: aTopic key)]. - self refresh. - confirmation = 2 ifTrue: [ - self systemNavigation browseAllCallsOn: aTopic key]. ^ true!

1 0

The Inbox: Tools-ct.1028.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Christoph Thiede uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-ct.1028.mcz ==================== Summary ==================== Name: Tools-ct.1028 Author: ct Time: 2 March 2021, 3:44:29.75717 pm UUID: 9b55450f-acf1-274e-b4fd-a502f8a89d86 Ancestors: Tools-mt.1027 Refactors removal of selectors. Complements System-ct.1221. Includes deduplication, better reusage of the removal confirmation dialogs, and fixes the "remove and/or browse" options for the FileContentsBrowser. =============== Diff against Tools-mt.1027 =============== Item was changed: ----- Method: Browser>>removeMessage (in category 'message functions') ----- removeMessage + + self hasMessageSelected ifFalse: [^ false]. + + super removeMessage ifFalse: [^ false]. - "If a message is selected, create a Confirmer so the user can verify that - the currently selected message should be removed from the system. If - so, - remove it. If the Preference 'confirmMethodRemoves' is set to false, the - confirmer is bypassed." - | messageName confirmation | - self hasMessageSelected not - ifTrue: [^ self]. - self okToChange - ifFalse: [^ self]. - messageName := self selectedMessageName. - confirmation := self systemNavigation confirmRemovalOf: messageName on: self selectedClassOrMetaClass. - confirmation = 3 - ifTrue: [^ self]. - self selectedClassOrMetaClass removeSelector: messageName. self selectMessageNamed: nil. self changed: #messageList. self setClassOrganizer. + + ^ true! - "In case organization not cached" - confirmation = 2 - ifTrue: [self systemNavigation browseAllCallsOn: messageName]! Item was changed: ----- Method: ChangeSorter>>removeMessage (in category 'message list') ----- removeMessage + + ^ super removeMessage + ifTrue: [self update]; + yourself! - "Remove the selected msg from the system. Real work done by the - parent, a ChangeSorter" - | confirmation sel | - self okToChange - ifFalse: [^ self]. - currentSelector - ifNotNil: [confirmation := self systemNavigation confirmRemovalOf: (sel := self selectedMessageName) on: self selectedClassOrMetaClass. - confirmation = 3 - ifTrue: [^ self]. - self selectedClassOrMetaClass removeSelector: sel. - self update. - confirmation = 2 - ifTrue: [self systemNavigation browseAllCallsOn: sel]]! Item was added: + ----- Method: CodeHolder>>removeMessage (in category 'commands') ----- + removeMessage + "If a message is selected, create a Confirmer so the user can verify that the currently selected message should be removed from the system. If so, remove it. Answer a boolean indicating whether the removal was succesful." + self okToChange ifFalse: [^ false]. + + ^ self systemNavigation + confirmAndRemoveSelector: self selectedMessageName + class: self selectedClassOrMetaClass! Item was changed: ----- Method: Debugger>>removeMessage (in category 'context stack menu') ----- removeMessage + | oldContext method cleanIndex | - | oldContext method cleanIndex confirmation | self okToChange ifFalse: [^ false]. contextStackIndex isZero ifTrue: [^ false]. oldContext := self selectedContext. method := oldContext method. cleanIndex := self findCleanHomeBelow: method. contextStack at: cleanIndex ifAbsent: [ self inform: 'Sender of method not found on stack, can''t remove message'. ^ false]. (self confirm: 'I will have to revert to the sender of this message. Is that OK?') ifFalse: [^ false]. + super removeMessage ifFalse: [^ false]. - confirmation := self systemNavigation - confirmRemovalOf: method selector - on: method methodClass. - confirmation = 3 ifTrue: [^ self]. - self selectedClassOrMetaClass removeSelector: method selector. - self contextStackIndex: cleanIndex oldContextWas: oldContext; tryRestartFrom: self selectedContext. + + ^ true! - confirmation = 2 - ifTrue: [self systemNavigation browseAllCallsOn: method selector].! Item was changed: ----- Method: FileContentsBrowser>>removeMessage (in category 'removing') ----- removeMessage + + self hasMessageSelected ifFalse: [^ false]. + + super removeMessage ifFalse: [^ false]. - | messageName | - self hasMessageSelected - ifFalse: [^ self]. - self okToChange - ifFalse: [^ self]. - messageName := self selectedMessageName. - (self selectedClass confirmRemovalOf: messageName) - ifFalse: [^ false]. - self selectedClassOrMetaClass removeMethod: self selectedMessageName. self selectMessageNamed: nil. self setClassOrganizer. "In case organization not cached" + self changed: #messageList.! - self changed: #messageList! Item was changed: ----- Method: MessageSet>>removeMessage (in category 'message functions') ----- removeMessage + + self hasMessageSelected ifFalse: [^ false]. + + super removeMessage ifFalse: [^ false]. - "Remove the selected message from the system. 1/15/96 sw" - | messageName confirmation | - self hasMessageSelected - ifFalse: [^ self]. - self okToChange - ifFalse: [^ self]. - messageName := self selectedMessageName. - confirmation := self systemNavigation confirmRemovalOf: messageName on: self selectedClassOrMetaClass. - confirmation = 3 - ifTrue: [^ self]. - self selectedClassOrMetaClass removeSelector: messageName. self deleteFromMessageList: self selection. self reformulateList. + + ^ true! - confirmation = 2 - ifTrue: [self systemNavigation browseAllCallsOn: messageName]! Item was changed: ----- Method: MessageTrace>>removeMessage (in category 'actions') ----- removeMessage "Remove the selected messages from the system." self selectedMessages size = 0 ifTrue: [ ^self ]. self selectedMessages size = 1 ifTrue: [ ^super removeMessage ]. + (self confirm: ('Are you certain you want to remove all the {1} selected methods from the image?' translated format: {self selectedMessages size})) ifFalse: [ ^self ]. - (self confirm: 'Are you certain you want to remove all of the selected methods from the image?') ifFalse: [ ^self ]. self selectedMessages do: [ :each | each actualClass removeSelector: each methodSymbol. self deleteFromMessageList: each ]!

1 0

The Inbox: Kernel-jar.1376.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

A new version of Kernel was added to project The Inbox: http://source.squeak.org/inbox/Kernel-jar.1376.mcz ==================== Summary ==================== Name: Kernel-jar.1376 Author: jar Time: 28 February 2021, 7:58:42.007459 pm UUID: d063e740-7836-a94a-9796-488741d2b2b6 Ancestors: Kernel-codefrau.1374 Fix Process >> #isTerminated inconsistent behavior - for discussion =============== Diff against Kernel-codefrau.1374 =============== Item was changed: ----- Method: Process>>isTerminated (in category 'testing') ----- isTerminated "Answer if the receiver is terminated, or at least terminating." self isActiveProcess ifTrue: [^ false]. ^suspendedContext isNil + or: ["If the suspendedContext is the bottomContext and the pc is at the endPC, + then there is nothing more to do." - or: ["If the suspendedContext is the bottomContext it is the block in Process>>newProcess. - If so, and the pc is at the endPC, the block has already sent and returned - from value and there is nothing more to do." suspendedContext isBottomContext + and: [suspendedContext pc >= suspendedContext endPC + or: [suspendedContext closure - and: [suspendedContext closure ifNil: [suspendedContext methodClass == Process and: [suspendedContext selector == #terminate]] + ifNotNil: [false]]]]! - ifNotNil: [suspendedContext pc >= suspendedContext closure endPC]]]!

3 5

The Inbox: Morphic-ct.1732.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Christoph Thiede uploaded a new version of Morphic to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1732.mcz ==================== Summary ==================== Name: Morphic-ct.1732 Author: ct Time: 2 March 2021, 2:36:32.90317 pm UUID: 3670c695-6c43-d744-b2d7-03ac4e6217e8 Ancestors: Morphic-mt.1731 Updates description of #sendMouseWheelToKeyboardFocus preference. Reason: Since Windows 10, the MouseWheelRouting setting is enabled by default. =============== Diff against Morphic-mt.1731 =============== Item was changed: ----- Method: HandMorph class>>sendMouseWheelToKeyboardFocus (in category 'preferences') ----- sendMouseWheelToKeyboardFocus <preference: 'Send Mouse Wheel Events to Keyboard Focus' categoryList: #(Morphic keyboard mouse) + description: 'If enabled, follow the behavior known from older versions of Microsoft Windows, where the mouse wheel works for the widget that has the keyboard focus. If disabled, follow the Mac OS style, where the mouse wheel is send to the widget under the mouse position.' - description: 'If enabled, follow the behavior known from Microsoft Windows, where the mouse wheel works for the widget that has the keyboard focus. If disabled, follow the Mac OS style, where the mouse wheel is send to the widget under the mouse position' type: #Boolean> ^ SendMouseWheelToKeyboardFocus ifNil: [true]!

1 0

The Trunk: Tools-mt.1025.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1025.mcz ==================== Summary ==================== Name: Tools-mt.1025 Author: mt Time: 18 February 2021, 11:19:50.596465 am UUID: 3a18ed90-267b-f545-86b6-a8edb2631a80 Ancestors: Tools-mt.1024 Add scoping and inverted lookup to dependency browser. I am using it for "DependencyBrowser openInvertedOn: #(EToys)" =============== Diff against Tools-mt.1024 =============== Item was changed: CodeHolder subclass: #DependencyBrowser + instanceVariableNames: 'packageList packageDeps packageDepsList classDeps classDepsList classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex autoSelectString windowTitle' - instanceVariableNames: 'packageList packageDeps packageDepsList classDeps classDepsList classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex autoSelectString' classVariableNames: '' poolDictionaries: '' category: 'Tools-Browser'! !DependencyBrowser commentStamp: 'fbs 5/6/2011 11:29' prior: 0! A simple dependency browser showing five panes: [1]: Packages: The list of available packages in the system. [2]: Package Dependencies: The dependent packages of the currently selected package. [3]: Class Dependencies: The classes causing the dependencies. [4]: Class List: The classes introducing the dependencies. [5]: Messages: The messages introducing the dependencies.! Item was added: + ----- Method: DependencyBrowser class>>openInvertedOn: (in category 'opening') ----- + openInvertedOn: requiredPackageNames + "DependencyBrowser openInvertedOn: #(Monticello)" + + | model | + model := self new. + ^ ToolBuilder open: ( + model + packageList: (model packageList select: [:packageName | + model computePackageDependencies: packageName. + model packageDeps includesAnyOf: requiredPackageNames]); + windowTitle: ('Dependency Browser (inverted on {1})' format: {requiredPackageNames}); + yourself) + ! Item was added: + ----- Method: DependencyBrowser class>>openOn: (in category 'opening') ----- + openOn: packageNames + "DependencyBrowser openOn: #(Morphic EToys)" + + ^ ToolBuilder open: (self new + packageList: packageNames; + windowTitle: 'Dependency Browser (on selected packages)'; + yourself)! Item was added: + ----- Method: DependencyBrowser>>packageList: (in category 'package list') ----- + packageList: somePackageNames + + packageList := somePackageNames. + self packageListIndex: 0.! Item was added: + ----- Method: DependencyBrowser>>windowTitle (in category 'accessing') ----- + windowTitle + + ^ windowTitle ifNil: ['Dependency Browser']! Item was added: + ----- Method: DependencyBrowser>>windowTitle: (in category 'accessing') ----- + windowTitle: aString + + windowTitle := aString. + self changed: #windowTitle.!

3 2

The Inbox: System-ct.1220.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Christoph Thiede uploaded a new version of System to project The Inbox: http://source.squeak.org/inbox/System-ct.1220.mcz ==================== Summary ==================== Name: System-ct.1220 Author: ct Time: 2 March 2021, 2:06:08.80617 pm UUID: cf9872fd-fa5d-4bb6-bc1c-8ced48a02a48 Ancestors: System-mt.1219 Adds Jaromir Matas (jar) to the authors list. A late welcome aboard! :-) =============== Diff against System-mt.1219 =============== Item was changed: ----- Method: SystemNavigation class>>privateAuthorsRaw (in category 'class initialization') ----- (excessive size, no diff calculated) Item was changed: + (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors.......'! - (PackageInfo named: 'System') postscript: 'SystemNavigation initializeAuthors......'!

1 0

The Trunk: EToys-mt.429.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.429.mcz ==================== Summary ==================== Name: EToys-mt.429 Author: mt Time: 2 March 2021, 11:45:35.238687 am UUID: ef67f837-252c-6b4d-a9ff-b543b854da2a Ancestors: EToys-mt.428 Complements Morphic-mt.1731 =============== Diff against EToys-mt.428 =============== Item was changed: ----- Method: PasteUpMorph>>backgroundForm (in category '*Etoys-playfield') ----- backgroundForm ^ self backgroundSketch ifNil: [Form extent: self extent depth: Display depth] + ifNotNil: [:sketch | sketch form]! - ifNotNil: [backgroundMorph form]! Item was added: + ----- Method: PasteUpMorph>>backgroundGridMorph (in category '*Etoys-playfield-gridding') ----- + backgroundGridMorph + + ^ self valueOfProperty: #backgroundGridMorph! Item was added: + ----- Method: PasteUpMorph>>backgroundGridMorph: (in category '*Etoys-playfield-gridding') ----- + backgroundGridMorph: aMorph + + self setProperty: #backgroundGridMorph toValue: aMorph.! Item was added: + ----- Method: PasteUpMorph>>backgroundMorph (in category '*Etoys-playfield') ----- + backgroundMorph + + ^ self valueOfProperty: #backgroundMorph! Item was added: + ----- Method: PasteUpMorph>>backgroundMorph: (in category '*Etoys-playfield') ----- + backgroundMorph: aMorph + + self setProperty: #backgroundMorph toValue: aMorph.! Item was changed: ----- Method: PasteUpMorph>>backgroundSketch (in category '*Etoys-playfield') ----- backgroundSketch + self backgroundMorph ifNil: [^ nil]. + self backgroundMorph owner == self ifFalse: + [self backgroundMorph: nil]. "has been deleted" + ^ self backgroundMorph! - backgroundMorph ifNil: [^ nil]. - backgroundMorph owner == self ifFalse: - [backgroundMorph := nil]. "has been deleted" - ^ backgroundMorph! Item was changed: ----- Method: PasteUpMorph>>backgroundSketch: (in category '*Etoys-playfield') ----- backgroundSketch: aSketchMorphOrNil "Set the receiver's background graphic as indicated. If nil is supplied, remove any existing background graphic. In any case, delete any preexisting background graphic." + self backgroundMorph ifNotNil: [self backgroundMorph delete]. "replacing old background" - backgroundMorph ifNotNil: [backgroundMorph delete]. "replacing old background" + aSketchMorphOrNil ifNil: [self backgroundMorph: nil. ^ self]. - aSketchMorphOrNil ifNil: [backgroundMorph := nil. ^ self]. + self backgroundMorph: (StickySketchMorph new form: aSketchMorphOrNil form). + self backgroundMorph position: aSketchMorphOrNil position. + self addMorphBack: self backgroundMorph. - backgroundMorph := StickySketchMorph new form: aSketchMorphOrNil form. - backgroundMorph position: aSketchMorphOrNil position. - self addMorphBack: backgroundMorph. aSketchMorphOrNil delete. + self backgroundMorph lock. + self backgroundMorph disableLayout: true. + self backgroundMorph setProperty: #shared toValue: true. + self backgroundMorph morphicLayerNumber: self class backmostLayer. + ^ self backgroundMorph - backgroundMorph lock. - backgroundMorph setProperty: #shared toValue: true. - ^ backgroundMorph ! Item was changed: ----- Method: PasteUpMorph>>deleteBackgroundPainting (in category '*Etoys-playfield') ----- deleteBackgroundPainting + self backgroundMorph - backgroundMorph ifNotNil: + [self backgroundMorph delete. + self backgroundMorph: nil] - [backgroundMorph delete. - backgroundMorph := nil] ifNil: [self inform: 'There is presently no background painting to delete.' translated]! Item was added: + ----- Method: PasteUpMorph>>gridVisible (in category '*Etoys-playfield-gridding') ----- + gridVisible + + ^ self hasProperty: #gridVisible! Item was added: + ----- Method: PasteUpMorph>>gridVisibleOnOff (in category '*Etoys-playfield-gridding') ----- + gridVisibleOnOff + + self setProperty: #gridVisible toValue: self gridVisible not. + + self backgroundGridMorph ifNotNil: [:morph | morph delete]. + + self gridVisible ifFalse: [self backgroundGridMorph: nil. ^ self]. + + self backgroundGridMorph: (Morph new + fillStyle: (self + gridFormOrigin: self gridOrigin grid: self gridModulus + background: nil line: Color lightGray); + lock; + disableLayout: true; "The morphs itself visualizes the origin." + ownerChangedHandler: [:m | m bounds: m owner bounds]; + morphicLayerNumber: self class backmostLayer - 1). + + self addMorph: self backgroundGridMorph.! Item was added: + ----- Method: PasteUpMorph>>gridVisibleString (in category '*Etoys-playfield-gridding') ----- + gridVisibleString + "Answer a string to be used in a menu offering the opportunity + to show or hide the grid" + ^ (self gridVisible + ifTrue: ['<yes>'] + ifFalse: ['<no>']) + , 'grid visible when gridding' translated! Item was added: + ----- Method: PasteUpMorph>>griddingOn (in category '*Etoys-playfield-gridding') ----- + griddingOn + + ^ self layoutPolicy notNil and: [self layoutPolicy isGridLayout]! Item was added: + ----- Method: PasteUpMorph>>griddingOnOff (in category '*Etoys-playfield-gridding') ----- + griddingOnOff + "Change grid layout. Consider the #clearArea to ignore docking bars and other adhereing morphs." + + self layoutPolicy: (self griddingOn ifFalse: [GridLayout new]).! Item was added: + ----- Method: PasteUpMorph>>griddingString (in category '*Etoys-playfield-gridding') ----- + griddingString + "Answer a string to use in a menu offering the user the + opportunity to start or stop using gridding" + ^ (self griddingOn + ifTrue: ['<yes>'] + ifFalse: ['<no>']) + , 'use gridding' translated! Item was added: + ----- Method: PasteUpMorph>>setGridSpec (in category '*Etoys-playfield-gridding') ----- + setGridSpec + "Gridding rectangle provides origin and modulus" + | response result | + response := UIManager default + request: 'New grid origin (usually 0@0):' translated + initialAnswer: self gridOrigin printString. + response isEmpty ifTrue: [^ self]. + result := [Compiler evaluate: response] ifError: [^ self]. + (result isPoint and: [(result >= (0@0))]) + ifTrue: [self gridOrigin: result] + ifFalse: [self inform: ('Must be a Point with coordinates (for example 10@10)' translated )]. + + response := UIManager default + request: 'New grid spacing:' translated + initialAnswer: self gridModulus printString. + response isEmpty ifTrue: [^ self]. + result := [Compiler evaluate: response] ifError: [^ self]. + (result isPoint and: [(result > (0@0)) ]) + ifTrue: [self gridModulus: result] + ifFalse: [self inform: ('Must be a Point with coordinates (for example 10@10)' translated )]. + + !

1 0

The Trunk: Morphic-mt.1731.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1731.mcz ==================== Summary ==================== Name: Morphic-mt.1731 Author: mt Time: 2 March 2021, 11:44:21.476687 am UUID: d06129c7-0def-1645-9066-c8a5720bf5d2 Ancestors: Morphic-mt.1730 Adds the possibility to handle #ownerChanged through composition (instead of subclassing/overwriting). Note that #cull: also works with symbols and message sends, not just blocks. :-) Got inspired by #eventHandler and how #mouseDown: (etc.) is implemented in Morph. Use it to extract Etoys-specific background morph and grid. =============== Diff against Morphic-mt.1730 =============== Item was changed: + ----- Method: Morph>>ownerChanged (in category 'layout') ----- - ----- Method: Morph>>ownerChanged (in category 'change reporting') ----- ownerChanged "This morph's owner has changed its geometry and is about to update its layout. This is a simple layout hook to update this morph's geometry according to its owner. For more advanced strategies, use a LayoutPolicy with some LayoutProperties. See #layoutPolicy: and maybe also #doLayoutIn:." + self snapToEdgeIfAppropriate. + + self ownerChangedHandler + ifNotNil: [:handler | handler cull: self].! - self snapToEdgeIfAppropriate.! Item was added: + ----- Method: Morph>>ownerChangedHandler (in category 'layout') ----- + ownerChangedHandler + + ^ self valueOfProperty: #ownerChangedHandler! Item was added: + ----- Method: Morph>>ownerChangedHandler: (in category 'layout') ----- + ownerChangedHandler: aHandler + + self + setProperty: #ownerChangedHandler + toValue: aHandler. + + self layoutChanged.! Item was changed: ----- Method: MorphicProject class>>applyUserInterfaceTheme (in category 'preferences') ----- applyUserInterfaceTheme self current addDeferredUIMessage: [ "After all immediate changes where applied, we can reset to values that match the current world configuration:" self worldGridOrigin: nil. self worldGridModulus: nil. + self worldGridEnabled - self current world griddingOn ifTrue: [self current world firstHand turnOnGridding]].! Item was changed: ----- Method: MorphicProject class>>worldGridEnabled (in category 'preferences') ----- worldGridEnabled <preference: 'Snap Morphs to World Grid' categoryList: #('Morphic' 'Tools') description: 'When true, morphs placed in the world will align with a regular grid. This includes tool windows.' type: #Boolean> + + | world | + world := self current world. + ^ self current isMorphic and: [world layoutPolicy notNil and: [world layoutPolicy isGridLayout]]! - ^ self current isMorphic and: [self current world griddingOn]! Item was changed: ----- Method: MorphicProject class>>worldGridEnabled: (in category 'preferences') ----- worldGridEnabled: aBooleanOrNil + (aBooleanOrNil ifNil: [false]) + ifTrue: [self current world layoutPolicy: GridLayout new] + ifFalse: [self current world layoutPolicy: nil]. - (aBooleanOrNil ifNil: [false]) = self current world griddingOn - ifFalse: [self current world griddingOnOff]. "Auto-configure origin and modulus to match world properties." self worldGridOrigin: nil. self worldGridModulus: nil. "Snap to grid when dragging something." + self worldGridEnabled - self current world griddingOn ifTrue: [self current world firstHand turnOnGridding] ifFalse: [self current world firstHand turnOffGridding].! Item was changed: BorderedMorph subclass: #PasteUpMorph + instanceVariableNames: 'presenter model cursor padding turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState' - instanceVariableNames: 'presenter model cursor padding backgroundMorph turtleTrailsForm turtlePen lastTurtlePositions isPartsBin indicateCursor wantsMouseOverHalos worldState' classVariableNames: 'GlobalCommandKeysEnabled WindowEventHandler' poolDictionaries: '' category: 'Morphic-Worlds'! !PasteUpMorph commentStamp: '<historical>' prior: 0! A morph whose submorphs comprise a paste-up of rectangular subparts which "show through". Anything called a 'Playfield' is a PasteUpMorph. Facilities commonly needed on pages of graphical presentations and on simulation playfields, such as the painting of new objects, turtle trails, gradient fills, background paintings, parts-bin behavior, collision-detection, etc., are (or will be) provided. A World, the entire Smalltalk screen, is a PasteUpMorph. A World responds true to isWorld. Morph subclasses that have specialized menus (BookMorph) build them in the message addBookMenuItemsTo:hand:. A PasteUpMorph that is a world, builds its menu in HandMorph buildWorldMenu. presenter A Presenter in charge of stopButton stepButton and goButton, mouseOverHalosEnabled soundsEnabled fenceEnabled coloredTilesEnabled. model <not used> cursor ?? padding ?? backgroundMorph A Form that covers the background. turtleTrailsForm Moving submorphs may leave trails on this form. turtlePen Draws the trails. lastTurtlePositions A Dictionary of (aPlayer -> aPoint) so turtle trails can be drawn only once each step cycle. The point is the start of the current stroke. isPartsBin If true, every object dragged out is copied. autoLineLayout ?? indicateCursor ?? resizeToFit ?? wantsMouseOverHalos If true, simply moving the cursor over a submorph brings up its halo. worldState If I am also a World, keeps the hands, damageRecorder, stepList etc. griddingOn If true, submorphs are on a grid ! Item was changed: ----- Method: PasteUpMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas "Draw in order: - background color - - grid, if any - - background sketch, if any - Update and draw the turtleTrails form. See the comment in updateTrailsForm. - cursor box if any Later (in drawSubmorphsOn:) I will skip drawing the background sketch." "draw background fill" super drawOn: aCanvas. - "draw grid" - (self griddingOn and: [self gridVisible]) - ifTrue: - [aCanvas fillRectangle: self bounds - fillStyle: (self - gridFormOrigin: self gridOrigin - grid: self gridModulus - background: nil - line: Color lightGray)]. - - "draw background sketch." - backgroundMorph ifNotNil: [ - self clipSubmorphs ifTrue: [ - aCanvas clipBy: self clippingBounds - during: [ :canvas | canvas fullDrawMorph: backgroundMorph ]] - ifFalse: [ aCanvas fullDrawMorph: backgroundMorph ]]. - "draw turtle trails" (lastTurtlePositions isNil or: [lastTurtlePositions isEmpty]) ifFalse:[ self updateTrailsForm. ]. turtleTrailsForm ifNotNil: [aCanvas paintImage: turtleTrailsForm at: self position]. "draw cursor" (submorphs notEmpty and: [self indicateCursor]) ifTrue: [aCanvas frameRectangle: self selectedRect width: 2 color: Color black]! Item was removed: - ----- Method: PasteUpMorph>>drawSubmorphsOn: (in category 'painting') ----- - drawSubmorphsOn: aCanvas - "Display submorphs back to front, but skip my background sketch." - - | drawBlock | - submorphs isEmpty ifTrue: [^self]. - drawBlock := [:canvas | submorphs reverseDo: [:m | m ~~ backgroundMorph ifTrue: [ canvas fullDrawMorph: m ]]]. - self clipSubmorphs - ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock] - ifFalse: [drawBlock value: aCanvas]! Item was removed: - ----- Method: PasteUpMorph>>gridVisible (in category 'gridding') ----- - gridVisible - - ^ self hasProperty: #gridVisible! Item was removed: - ----- Method: PasteUpMorph>>gridVisibleOnOff (in category 'gridding') ----- - gridVisibleOnOff - - self setProperty: #gridVisible toValue: self gridVisible not. - self changed! Item was removed: - ----- Method: PasteUpMorph>>gridVisibleString (in category 'gridding') ----- - gridVisibleString - "Answer a string to be used in a menu offering the opportunity - to show or hide the grid" - ^ (self gridVisible - ifTrue: ['<yes>'] - ifFalse: ['<no>']) - , 'grid visible when gridding' translated! Item was removed: - ----- Method: PasteUpMorph>>griddingOn (in category 'gridding') ----- - griddingOn - - ^ self layoutPolicy notNil and: [self layoutPolicy isGridLayout]! Item was removed: - ----- Method: PasteUpMorph>>griddingOnOff (in category 'gridding') ----- - griddingOnOff - "Change grid layout. Consider the #clearArea to ignore docking bars and other adhereing morphs." - - self layoutPolicy: (self griddingOn ifFalse: [GridLayout new]).! Item was removed: - ----- Method: PasteUpMorph>>griddingString (in category 'gridding') ----- - griddingString - "Answer a string to use in a menu offering the user the - opportunity to start or stop using gridding" - ^ (self griddingOn - ifTrue: ['<yes>'] - ifFalse: ['<no>']) - , 'use gridding' translated! Item was removed: - ----- Method: PasteUpMorph>>privateRemoveMorph: (in category 'private') ----- - privateRemoveMorph: aMorph - backgroundMorph == aMorph ifTrue: [ backgroundMorph := nil ]. - ^super privateRemoveMorph: aMorph. - ! Item was removed: - ----- Method: PasteUpMorph>>setGridSpec (in category 'gridding') ----- - setGridSpec - "Gridding rectangle provides origin and modulus" - | response result | - response := UIManager default - request: 'New grid origin (usually 0@0):' translated - initialAnswer: self gridOrigin printString. - response isEmpty ifTrue: [^ self]. - result := [Compiler evaluate: response] ifError: [^ self]. - (result isPoint and: [(result >= (0@0))]) - ifTrue: [self gridOrigin: result] - ifFalse: [self inform: ('Must be a Point with coordinates (for example 10@10)' translated )]. - - response := UIManager default - request: 'New grid spacing:' translated - initialAnswer: self gridModulus printString. - response isEmpty ifTrue: [^ self]. - result := [Compiler evaluate: response] ifError: [^ self]. - (result isPoint and: [(result > (0@0)) ]) - ifTrue: [self gridModulus: result] - ifFalse: [self inform: ('Must be a Point with coordinates (for example 10@10)' translated )]. - - !

1 0

The Trunk: MorphicTests-mt.72.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Marcel Taeumel uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-mt.72.mcz ==================== Summary ==================== Name: MorphicTests-mt.72 Author: mt Time: 2 March 2021, 11:03:22.265687 am UUID: b86bc3c1-fdde-7343-9628-073d9dd73d70 Ancestors: MorphicTests-mt.71 More tests for the new grid layout. =============== Diff against MorphicTests-mt.71 =============== Item was changed: ----- Method: GridLayoutTest>>test01Position (in category 'tests') ----- test01Position + | m o | - | m | m := self addMorph. + o := container position. { 0@0 . 0@0 . 9@9 . 0@0 . 10@10 . 20@20 . 25@25 . 20@20 } pairsDo: [:newPosition :expectedGrid | + m position: newPosition + o. - m position: newPosition. container fullBounds. + self assert: expectedGrid + o equals: m position].! - self assert: expectedGrid equals: m position].! Item was added: + ----- Method: GridLayoutTest>>test05SnapToEdge (in category 'tests') ----- + test05SnapToEdge + "The grid should be ignored for morphs that snap to their owner's edges." + + | m | + m := Morph new color: Color random; extent: 10@10; yourself. + container addMorph: m. + + "1) Manual snap-to-edge will not work." + m position: 0@(100 - 10). + container fullBounds. + self assert: 0@100 equals: m position. + + "2) Use snap-to-edge property." + m setToAdhereToEdge: #bottom. + container fullBounds. + self assert: 0@(100 - 10) equals: m position.! Item was added: + ----- Method: GridLayoutTest>>test06Origin (in category 'tests') ----- + test06Origin + "The grid's origin should be relative to its morph's position so that the morph can be moved around without the grid changing." + + container position: 0@0. + container removeAllMorphs. + self test01Position. + + container position: 10@10. + container removeAllMorphs. + self test01Position.!

1 0

The Trunk: Morphic-mt.1730.mcz
by commits＠source.squeak.org 02 Mar '21

02 Mar '21

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.1730.mcz ==================== Summary ==================== Name: Morphic-mt.1730 Author: mt Time: 2 March 2021, 11:01:40.072687 am UUID: 5fa729ff-1ebb-3a4e-8283-f88485971bd6 Ancestors: Morphic-mt.1729 A fix and a tweak. (Note that it is interesting that damage-recording-based drawing via #changed and deferred layout computation via #layoutChanged are in conflict with each other. Also see #privateInvalidateMorph: and its senders.) =============== Diff against Morphic-mt.1729 =============== Item was changed: ----- Method: Morph>>position: (in category 'geometry') ----- position: aPoint "Change the position of this morph, which is the top left corner of its bounds." | delta box | delta := (aPoint - self bounds topLeft) rounded. "Skip drawing and layout updates for null changes." (delta x = 0 and: [delta y = 0]) ifTrue: [^ self]. "Optimize drawing. Record one damage rectangle for short distance and two damage rectangles for large distances." + box := fullBounds ifNil: [self outerBounds]. "Avoid premature layout computation. Like in #extent: and #changed." - box := self fullBounds. (delta dotProduct: delta) > 100 "More than 10 pixels?" ifTrue: [self invalidRect: box; invalidRect: (box translateBy: delta)] ifFalse: [self invalidRect: (box merge: (box translateBy: delta))]. "Move this morph and *all* of its submorphs." self privateFullMoveBy: delta. "For all known layout policies, my layout and the layout of my children is fine. Only the layout of my owner might be affected. So, tell about it." self owner ifNotNil: [:o | self flag: #todo. "mt: Maybe we can save a lot of effort and troubles by only calling #layoutChanged if the owner has a layout policy installed? Take the thumbs of scroll-bars as an example..." o layoutChanged].! Item was changed: ----- Method: Morph>>setToAdhereToEdge: (in category 'menus') ----- setToAdhereToEdge: anEdge anEdge ifNil: [^ self]. anEdge == #none ifTrue: [^ self removeProperty: #edgeToAdhereTo]. self setProperty: #edgeToAdhereTo toValue: anEdge. + self layoutChanged. !

1 0

Jump to page: