Packages November 2023

packages@lists.squeakfoundation.org

1 participants
89 discussions

The Trunk: MorphicExtras-dtl.352.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-dtl.352.mcz ==================== Summary ==================== Name: MorphicExtras-dtl.352 Author: dtl Time: 25 November 2023, 2:56:12.072673 pm UUID: f43eae26-9022-478f-998d-f9288ded844d Ancestors: MorphicExtras-dtl.351 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against MorphicExtras-dtl.351 =============== Item was removed: - ----- Method: AlignmentMorph>>addTransparentSpacerOfSize: (in category '*MorphicExtras-geometry') ----- - addTransparentSpacerOfSize: aPoint - "Required for several MorphicExtras and other non-Etoys stuff." - - self addMorphBack: ((Morph new extent: aPoint asPoint) color: Color transparent)! Item was removed: - ----- Method: BookMorph>>goToPage:transitionSpec:runTransitionScripts: (in category 'navigation') ----- - goToPage: pageNumber transitionSpec: transitionSpec runTransitionScripts: aBoolean - "Go the the given page number; use the transitionSpec supplied, and if the boolean parameter is true, run opening and closing scripts as appropriate" - - | pageMorph | - pages isEmpty ifTrue: [^ self]. - pageMorph := (self hasProperty: #dontWrapAtEnd) - ifTrue: [pages atPin: pageNumber] - ifFalse: [pages atWrap: pageNumber]. - ^ self goToPageMorph: pageMorph transitionSpec: transitionSpec runTransitionScripts: aBoolean! Item was removed: - ----- Method: BookMorph>>goToPageMorph:runTransitionScripts: (in category 'navigation') ----- - goToPageMorph: aMorph runTransitionScripts: aBoolean - "Set the given morph as the current page. If the boolean parameter is true, then opening and closing scripts will be run" - - self goToPage: (pages identityIndexOf: aMorph ifAbsent: [^ self "abort"]) transitionSpec: nil runTransitionScripts: aBoolean - ! Item was removed: - ----- Method: BookMorph>>goToPageMorph:transitionSpec:runTransitionScripts: (in category 'navigation') ----- - goToPageMorph: newPage transitionSpec: transitionSpec runTransitionScripts: aBoolean - "Install the given page as the new current page; use the given transition spec, and if the boolean parameter is true, run closing and opening scripts on the outgoing and incoming players" - - | pageIndex aWorld oldPageIndex ascending tSpec readIn | - pages isEmpty ifTrue: [^self]. - self setProperty: #searchContainer toValue: nil. "forget previous search" - self setProperty: #searchOffset toValue: nil. - self setProperty: #searchKey toValue: nil. - pageIndex := pages identityIndexOf: newPage ifAbsent: [^self "abort"]. - readIn := newPage isInMemory not. - oldPageIndex := pages identityIndexOf: currentPage ifAbsent: [nil]. - ascending := (oldPageIndex isNil or: [newPage == currentPage]) - ifTrue: [nil] - ifFalse: [oldPageIndex < pageIndex]. - tSpec := transitionSpec ifNil: - ["If transition not specified by requestor..." - - newPage valueOfProperty: #transitionSpec - ifAbsent: - [" ... then consult new page" - - self transitionSpecFor: self " ... otherwise this is the default"]]. - self flag: #arNote. "Probably unnecessary" - (aWorld := self world) ifNotNil: [self primaryHand releaseKeyboardFocus]. - currentPage ifNotNil: [currentPage updateCachedThumbnail]. - self currentPage notNil - ifTrue: - [(((pages at: pageIndex) owner isKindOf: TransitionMorph) - and: [(pages at: pageIndex) isInWorld]) - ifTrue: [^self "In the process of a prior pageTurn"]. - aBoolean - ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllClosingScripts]]. - ascending ifNotNil: - ["Show appropriate page transition and start new page when done" - - currentPage stopStepping. - (pages at: pageIndex) position: currentPage position. - ^(TransitionMorph - effect: tSpec second - direction: tSpec third - inverse: (ascending or: [transitionSpec notNil]) not) - showTransitionFrom: currentPage - to: (pages at: pageIndex) - in: self - whenStart: [self playPageFlipSound: tSpec first] - whenDone: - [currentPage - delete; - fullReleaseCachedState. - self insertPageMorphInCorrectSpot: (pages at: pageIndex). - self adjustCurrentPageForFullScreen. - self snapToEdgeIfAppropriate. - aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. - aBoolean - ifTrue: [self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts]]. - (aWorld := self world) ifNotNil: - ["WHY??" - - aWorld displayWorld]. - readIn - ifTrue: - [currentPage updateThumbnailUrlInBook: self url. - currentPage sqkPage computeThumbnail "just store it"]]]. - - "No transition, but at least decommission current page" - currentPage - delete; - fullReleaseCachedState]. - self insertPageMorphInCorrectSpot: (pages at: pageIndex). - self adjustCurrentPageForFullScreen. - self snapToEdgeIfAppropriate. - aWorld ifNotNil: [self world startSteppingSubmorphsOf: currentPage]. - self currentPlayerDo: [:aPlayer | aPlayer runAllOpeningScripts]. - (aWorld := self world) ifNotNil: - ["WHY??" - - aWorld displayWorld]. - readIn - ifTrue: - [currentPage updateThumbnailUrl. - currentPage sqkPage computeThumbnail "just store it"]! Item was removed: - ----- Method: BookMorph>>goto: (in category 'navigation') ----- - goto: aPlayer - self goToPageMorph: aPlayer costume! Item was removed: - ----- Method: BookMorph>>keepTogether (in category 'menu') ----- - keepTogether - "Mark this book so that each page will not go into a separate file. Do this when pages share referenes to a common Player. Don't want many copies of that Player when bring in. Do not write pages of book out. Write the PasteUpMorph that the entire book lives in." - - self setProperty: #keepTogether toValue: true.! Item was removed: - ----- Method: BooklikeMorph>>currentPlayerDo: (in category 'e-toy support') ----- - currentPlayerDo: aBlock - | aPlayer aPage | - (aPage := self currentPage) ifNil: [^ self]. - aPage allMorphsDo:[ :m| - (aPlayer := m player) ifNotNil: - [aBlock value: aPlayer]]! Item was removed: - ----- Method: EventHandler>>adaptToWorld: (in category '*MorphicExtras-initialization') ----- - adaptToWorld: aWorld - "If any of my recipients refer to a world or a hand, make them now refer - to the corresponding items in the new world. (instVarNamed: is slow, later - use perform of two selectors.)" - - - #(mouseDownRecipient mouseStillDownRecipient mouseUpRecipient - mouseEnterRecipient mouseLeaveRecipient mouseEnterDraggingRecipient - mouseLeaveDraggingRecipient clickRecipient doubleClickRecipient startDragRecipient keyStrokeRecipient valueParameter) do: - [:aName | | value newValue | - (value := self instVarNamed: aName asString) ifNotNil:[ - newValue := value adaptedToWorld: aWorld. - (newValue notNil and: [newValue ~~ value]) - ifTrue: - [self instVarNamed: aName asString put: newValue]]]! Item was removed: - ----- Method: FlapTab>>makeNewDrawing: (in category 'mouseover & dragover') ----- - makeNewDrawing: evt - self flapShowing ifTrue:[ - self world makeNewDrawing: evt. - ] ifFalse:[ - self world assureNotPaintingEvent: evt. - ].! Item was removed: - ----- Method: FlapTab>>startOrFinishDrawing: (in category 'mouseover & dragover') ----- - startOrFinishDrawing: evt - | w | - self flapShowing ifTrue:[ - (w := self world) makeNewDrawing: evt at: w center. - ] ifFalse:[ - self world endDrawing: evt. - ].! Item was removed: - ----- Method: FlapTab>>thicknessString (in category 'menu') ----- - thicknessString - ^ 'thickness... (currently ', self thickness printString, ')'! Item was removed: - ----- Method: Flaps class>>addAndEnableEToyFlaps (in category 'predefined flaps') ----- - addAndEnableEToyFlaps - "Initialize the standard default out-of-box set of global flaps. This method creates them and places them in my class variable #SharedFlapTabs, but does not itself get them displayed." - - | aSuppliesFlap | - SharedFlapTabs - ifNotNil: [^ self]. - SharedFlapTabs := OrderedCollection new. - - aSuppliesFlap := self newSuppliesFlapFromQuads: self quadsDefiningPlugInSuppliesFlap positioning: #right. - aSuppliesFlap referent setNameTo: 'Supplies Flap' translated. "Per request from Kim Rose, 7/19/02" - SharedFlapTabs add: aSuppliesFlap. "The #center designation doesn't quite work at the moment" - - (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false]) - ifTrue: [SharedFlapTabs add: self newSugarNavigatorFlap] - ifFalse: [Preferences showProjectNavigator - ifTrue:[ SharedFlapTabs add: self newNavigatorFlap]]. - - self enableGlobalFlapWithID: 'Supplies' translated. - - (Smalltalk globals at: #SugarNavigatorBar ifPresent: [:c | c showSugarNavigator] ifAbsent: [false]) - ifTrue: - [self enableGlobalFlapWithID: 'Sugar Navigator Flap' translated. - (self globalFlapTabWithID: 'Sugar Navigator Flap' translated) ifNotNil: - [:navTab | aSuppliesFlap sugarNavTab: navTab]] - ifFalse: [ - Preferences showProjectNavigator - ifTrue:[ self enableGlobalFlapWithID: 'Navigator' translated]]. - - SharedFlapsAllowed := true. - Project current flapsSuppressed: false. - ^ SharedFlapTabs - - "Flaps addAndEnableEToyFlaps"! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningPlugInSuppliesFlap (in category 'predefined flaps') ----- - defaultsQuadsDefiningPlugInSuppliesFlap - "Answer a list of quads which define the objects to appear in the default Supplies flap used in the Plug-in image" - - "PartsBin reconstructAllPartsIcons" - - ^ #( - (ObjectsTool newStandAlone 'Object Catalog' 'A tool that lets you browse the catalog of available objects') - (AllScriptsTool allScriptsToolForActiveWorld 'All Scripts' 'Stop, Step, and Go buttons for controlling all your scripts at once. The tool can also be "opened up" to control each script in your project individually.') - (TrashCanMorph new 'Trash' 'A tool for discarding objects') - (GrabPatchMorph new 'Grab Patch' 'Allows you to create a new Sketch by grabbing a rectangular patch from the screen') - (LassoPatchMorph new 'Lasso' 'Allows you to create a new Sketch by lassoing an area from the screen') - - (StickyPadMorph newStandAlone 'Sticky Pad' 'Each time you obtain one of these pastel, translucent, borderless rectangles, it will be a different color from the previous time.') - "(PaintInvokingMorph new 'Paint' 'Drop this into an area to start making a fresh painting there')" - (TextMorph boldAuthoringPrototype 'Text' 'Text that you can edit into anything you desire.') - (RecordingControlsMorph authoringPrototype 'Sound' 'A device for making sound recordings.') - (RectangleMorph authoringPrototype 'Rectangle' 'A rectangle') - (RectangleMorph roundRectPrototype 'RoundRect' 'A rectangle with rounded corners') - (EllipseMorph authoringPrototype 'Ellipse' 'An ellipse or circle') - (StarMorph authoringPrototype 'Star' 'A star') - (CurveMorph authoringPrototype 'Curve' 'A curve') - (PolygonMorph authoringPrototype 'Polygon' 'A straight-sided figure with any number of sides') - (ScriptableButton authoringPrototype 'Button' 'A Scriptable button') - "(BookMorph nextPageButton 'NextPage' 'A button that takes you to the next page') - (BookMorph previousPageButton 'PreviousPage' 'A button that takes you to the previous page')" - "(ScriptingSystem prototypicalHolder 'Holder' 'A place for storing alternative pictures in an animation, etc.')" - (PasteUpMorph authoringPrototype 'Playfield' 'A place for assembling parts or for staging animations') - (SimpleSliderMorph authoringPrototype 'Slider' 'A slider for showing and setting numeric values.') - (JoystickMorph authoringPrototype 'Joystick' 'A joystick-like control') - (BookMorph authoringPrototype 'Book' 'A multi-paged structure') - "(ClockMorph authoringPrototype 'Clock' 'A simple digital clock')" - (KedamaMorph newSet 'Particles' 'A Kedama World with pre-made components') - "(RandomNumberTile new 'Random' 'A random-number tile for use with tile scripting')") asOrderedCollection! Item was removed: - ----- Method: Flaps class>>defaultsQuadsDefiningScriptingFlap (in category 'flaps registry') ----- - defaultsQuadsDefiningScriptingFlap - "Answer a structure defining the default items in the Scripting flap. - previously in quadsDeiningScriptingFlap" - - ^ { - {#TrashCanMorph. #new. 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. - {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}. - {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}. - {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop}. - - {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}. - {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - {#FunctionTile. #randomNumberTile. 'Random' translatedNoop. 'A tile that will produce a random number in a given range' translatedNoop}. - {#ScriptingSystem. #anyButtonPressedTiles. 'ButtonDown?' translatedNoop. 'Tiles for querying whether the mouse button is down' translatedNoop}. - {#ScriptingSystem. #noButtonPressedTiles. 'ButtonUp?' translatedNoop. 'Tiles for querying whether the mouse button is up' translatedNoop}. - - {#SimpleSliderMorph. #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#TextFieldMorph. #exampleBackgroundField. 'Scrolling Field' translatedNoop. 'A scrolling data field which will have a different value on every card of the background' translatedNoop}. - - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - - - {#StackMorph. #authoringPrototype. 'Stack' translatedNoop. 'A multi-card data base' translatedNoop}. - {#TextMorph. #exampleBackgroundLabel. 'Background Label' translatedNoop. 'A piece of text that will occur on every card of the background' translatedNoop}. - {#TextMorph . #exampleBackgroundField. 'Background Field' translatedNoop. 'A data field which will have a different value on every card of the background' translatedNoop} - } asOrderedCollection! Item was removed: - ----- Method: Flaps class>>enableEToyFlaps (in category 'menu support') ----- - enableEToyFlaps - "Start using global flaps, plug-in version, given that they were not present." - - Cursor wait showWhile: - [self addAndEnableEToyFlaps. - self enableGlobalFlaps]! Item was removed: - ----- Method: Flaps class>>newLoneSuppliesFlap (in category 'predefined flaps') ----- - newLoneSuppliesFlap - "Answer a fully-instantiated flap named 'Supplies' to be placed at the bottom of the screen, for use when it is the only flap shown upon web launch. We're still evidently nurturing this method along, but it is a disused branch, whose lone sender has no senders..." - - | aFlapTab aStrip leftEdge | "Flaps setUpSuppliesFlapOnly" - aStrip := PartsBin newPartsBinWithOrientation: #leftToRight andColor: Color red muchLighter from: { - - {#TrashCanMorph. #new . 'Trash' translatedNoop. 'A tool for discarding objects' translatedNoop}. - {#ScriptingSystem. #scriptControlButtons. 'Status' translatedNoop. 'Buttons to run, stop, or single-step scripts' translatedNoop}. - {#AllScriptsTool. #allScriptsToolForActiveWorld. 'All Scripts' translatedNoop. 'A tool that lets you control all the running scripts in your world' translatedNoop}. - - {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop}. - {#RectangleMorph. #authoringPrototype. 'Rectangle' translatedNoop. 'A rectangle' translatedNoop}. - {#RectangleMorph. #roundRectPrototype. 'RoundRect' translatedNoop. 'A rectangle with rounded corners' translatedNoop}. - {#EllipseMorph. #authoringPrototype. 'Ellipse' translatedNoop. 'An ellipse or circle' translatedNoop}. - {#StarMorph. #authoringPrototype. 'Star' translatedNoop. 'A star' translatedNoop}. - {#PolygonMorph. #curvePrototype. 'Curve' translatedNoop. 'A curve' translatedNoop}. - {#PolygonMorph . #authoringPrototype. 'Polygon' translatedNoop. 'A straight-sided figure with any number of sides' translatedNoop}. - {#TextMorph . #authoringPrototype. 'Text' translatedNoop. 'Text that you can edit into anything you desire.' translatedNoop}. - {#SimpleSliderMorph . #authoringPrototype. 'Slider' translatedNoop. 'A slider for showing and setting numeric values.' translatedNoop}. - {#JoystickMorph . #authoringPrototype. 'Joystick' translatedNoop. 'A joystick-like control' translatedNoop}. - {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop}. - " {#ScriptableButton. #authoringPrototype. 'Button' translatedNoop. 'A Scriptable button' translatedNoop}." - {#PasteUpMorph. #authoringPrototype. 'Playfield' translatedNoop. 'A place for assembling parts or for staging animations' translatedNoop}. - {#BookMorph. #authoringPrototype. 'Book' translatedNoop. 'A multi-paged structure' translatedNoop}. - {#TabbedPalette. #authoringPrototype. 'Tabs' translatedNoop. 'A structure with tabs' translatedNoop}. - - {#RecordingControls. #authoringPrototype. 'Sound Recorder' translatedNoop. 'A device for making sound recordings.' translatedNoop}. - {#MagnifierMorph. #newRound . 'Magnifier' translatedNoop. 'A magnifying glass' translatedNoop}. - - {#ImageMorph. #authoringPrototype. 'Picture' translatedNoop. 'A non-editable picture of something' translatedNoop}. - {#ClockMorph. #authoringPrototype, 'Clock' translatedNoop, 'A simple digital clock' translatedNoop}. - {#BookMorph, #previousPageButton, 'Previous' translatedNoop, 'A button that takes you to the previous page' translatedNoop}. - {#BookMorph, #nextPageButton, 'Next' translatedNoop, 'A button that takes you to the next page' translatedNoop}. - }. - - aFlapTab := FlapTab new referent: aStrip beSticky. - aFlapTab setName: 'Supplies' translated edge: #bottom color: Color red lighter. - - aStrip extent: self currentWorld width @ 78. - leftEdge := ((Display width - (16 + aFlapTab width)) + 556) // 2. - - aFlapTab position: (leftEdge @ (self currentWorld height - aFlapTab height)). - - aStrip beFlap: true. - aStrip autoLineLayout: true. - - ^ aFlapTab! Item was removed: - ----- Method: Flaps class>>newPaintingFlap (in category 'predefined flaps') ----- - newPaintingFlap - "Add a flap with the paint palette in it" - - | aFlap aFlapTab | - "Flaps reinstateDefaultFlaps. Flaps newPaintingFlap" - - aFlap := PasteUpMorph new borderWidth: 0. - aFlap color: Color transparent. - aFlap layoutPolicy: TableLayout new. - aFlap hResizing: #shrinkWrap. - aFlap vResizing: #shrinkWrap. - aFlap cellPositioning: #topLeft. - aFlap clipSubmorphs: false. - - aFlap beSticky. "really?!!" - aFlap addMorphFront: PaintBoxMorph new. - aFlap beFlap: true. - aFlap fullBounds. "force layout" - - aFlapTab := FlapTab new referent: aFlap. - aFlapTab setNameTo: 'Painting' translated. - aFlapTab setProperty: #priorWording toValue: 'Paint' translated. - aFlapTab useGraphicalTab. - aFlapTab removeAllMorphs. - aFlapTab setProperty: #paintingFlap toValue: true. - aFlapTab addMorphFront: - "(SketchMorph withForm: (ScriptingSystem formAtKey: #PaintingFlapPic))" - self paintFlapButton. - aFlapTab cornerStyle: #rounded. - aFlapTab edgeToAdhereTo: #right. - aFlapTab setToPopOutOnDragOver: false. - aFlapTab setToPopOutOnMouseOver: false. - aFlapTab on: #mouseUp send: #startOrFinishDrawing: to: aFlapTab. - aFlapTab setBalloonText:'Click here to start or finish painting.' translated. - - aFlapTab fullBounds. "force layout" - aFlapTab position: (0@6). - self currentWorld addMorphFront: aFlapTab. - ^ aFlapTab! Item was removed: - ----- Method: Flaps class>>paintFlapButton (in category 'miscellaneous') ----- - paintFlapButton - "Answer a button to serve as the paint flap" - - | pb oldArgs brush myButton m | - pb := PaintBoxMorph new submorphNamed: #paint:. - pb - ifNil: - [(brush := Form extent: 16@16 depth: 16) fillColor: Color red] - ifNotNil: - [oldArgs := pb arguments. - brush := oldArgs third. - brush := brush copy: (2@0 extent: 42@38). - brush := brush scaledToSize: brush extent // 2]. - myButton := BorderedMorph new. - myButton color: (Color r: 0.833 g: 0.5 b: 0.0); borderStyle: (BorderStyle raised width: 2). - myButton addMorph: (m := brush asMorph lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - ^ myButton - - ! Item was removed: - ----- Method: Flaps class>>possiblyReplaceEToyFlaps (in category 'construction support') ----- - possiblyReplaceEToyFlaps - "If in eToyFriendly mode, and if it's ok to reinitialize flaps, replace the existing flaps with up-too-date etoy flaps. Caution: this is destructive of existing flaps. If preserving the contents of existing flaps is important, set the preference 'okToReinitializeFlaps' to true" - - PartsBin thumbnailForPartsDescription: StickyPadMorph descriptionForPartsBin. "Puts StickyPadMorph's custom icon back in the cache which typically will have been called" - (Preferences eToyFriendly and: [Preferences okToReinitializeFlaps]) ifTrue: - [Flaps disableGlobalFlaps: false. - Flaps addAndEnableEToyFlaps. - Smalltalk isMorphic ifTrue: [Project current world enableGlobalFlaps]]. - "PartsBin clearThumbnailCache" - - "Flaps possiblyReplaceEToyFlaps"! Item was removed: - ----- Method: Flaps class>>setUpSuppliesFlapOnly (in category 'menu support') ----- - setUpSuppliesFlapOnly - "Set up the Supplies flap as the only shared flap. A special version formulated for this stand-alone use is used, defined in #newLoneSuppliesFlap" - - | supplies | - SharedFlapTabs isEmptyOrNil ifFalse: "get rid of pre-existing guys if any" - [SharedFlapTabs do: - [:t | t referent delete. t delete]]. - - SharedFlapsAllowed := true. - SharedFlapTabs := OrderedCollection new. - SharedFlapTabs add: (supplies := self newLoneSuppliesFlap). - self enableGlobalFlapWithID: 'Supplies' translated. - supplies setToPopOutOnMouseOver: false. - - Smalltalk isMorphic ifTrue: [ - Project current world - addGlobalFlaps; - reformulateUpdatingMenus].! Item was removed: - ----- Method: Form>>graphicForViewerTab (in category '*MorphicExtras-other') ----- - graphicForViewerTab - "Answer the graphic to be used in the tab of a viewer open on me" - - ^ self! Item was removed: - ----- Method: MenuMorph>>allWordings (in category '*MorphicExtras-accessing') ----- - allWordings - "Answer a collection of the wordings of all items and subitems, omitting the window-list in the embed... branch and (unless a certain hard-coded preference is set) also omitting items from the debug menu" - - | verboten | - verboten := OrderedCollection with: 'embed into'. - Preferences debugMenuItemsInvokableFromScripts - ifFalse: [verboten add: 'debug...' translated]. - ^ self allWordingsNotInSubMenus: verboten! Item was removed: - ----- Method: MenuMorph>>allWordingsNotInSubMenus: (in category '*MorphicExtras-accessing') ----- - allWordingsNotInSubMenus: verbotenSubmenuContentsList - "Answer a collection of the wordings of all items and subitems, but omit the stay-up item, and also any items in any submenu whose tag is in verbotenSubmenuContents" - - | aList | - aList := OrderedCollection new. - self items do: [:anItem | aList addAll: (anItem allWordingsNotInSubMenus: verbotenSubmenuContentsList)]. - ^ aList! Item was removed: - ----- Method: ObjectlandMorph>>createEtoysProject (in category 'projects') ----- - createEtoysProject - - | etoysExample | - self flag: #forLater. "If we could enable etoysMode just for this project, this would be great" - - etoysExample := Player extraExampleCar. - ^ self - createProjectNamed: 'Fun with Etoys' translated - colorRamp: { - 1 -> Color plum darker. - 0 -> Color lightMagenta } - morphSpecs: { - (0.46 @ 0.6 exactCenter: 0.25 @ 0.6) -> [HelpBrowser new - rootTopic: SqueakTutorialsEToys; - showTopicNamed: #raceCar; - yourself]. - (0.3 @ 0.4 exactCenter: 0.7 @ 0.45) -> [etoysExample first addFlexShell]. "arena" - 0.3 @ 0.2 -> [AllScriptsTool newStandAlone]. - 0.7 @ 0.83 -> [etoysExample second] "script editor" } - initializeWorld: [:world | - self class liftUpSubmorphsOf: etoysExample first. - etoysExample first owner delete. - world stopRunningAll]! Item was removed: - ImageMorph subclass: #PaintInvokingMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Widgets'! - - !PaintInvokingMorph commentStamp: '<historical>' prior: 0! - When this is dropped inside some appropriate place, then painting is invoked for that place.! Item was removed: - ----- Method: PaintInvokingMorph class>>authoringPrototype (in category 'scripting') ----- - authoringPrototype - ^ self new image: (ScriptingSystem formAtKey: 'Painting'); markAsPartsDonor; setBalloonText: 'drop this into any playfield or book page to make a new painting there'; yourself! Item was removed: - ----- Method: PaintInvokingMorph class>>descriptionForPartsBin (in category 'parts bin') ----- - descriptionForPartsBin - ^ self partName: 'Paint' translatedNoop - categories: {'Graphics' translatedNoop} - documentation: 'Drop this icon to start painting a new object.' translatedNoop! Item was removed: - ----- Method: PaintInvokingMorph class>>initialize (in category 'class initialization') ----- - initialize - - self registerInFlapsRegistry.! Item was removed: - ----- Method: PaintInvokingMorph class>>registerInFlapsRegistry (in category 'class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#PaintInvokingMorph. #new . 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#PaintInvokingMorph. #new. 'Paint' translatedNoop. 'Drop this into an area to start making a fresh painting there' translatedNoop} - forFlapNamed: 'Scripting']! Item was removed: - ----- Method: PaintInvokingMorph class>>unload (in category 'class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: self] ! Item was removed: - ----- Method: PaintInvokingMorph>>initialize (in category 'initialization') ----- - initialize - super initialize. - self image: (ScriptingSystem formAtKey: 'Painting')! Item was removed: - ----- Method: PaintInvokingMorph>>initializeToStandAlone (in category 'parts bin') ----- - initializeToStandAlone - super initializeToStandAlone. - self image: (ScriptingSystem formAtKey: 'Painting')! Item was removed: - ----- Method: PaintInvokingMorph>>justDroppedInto:event: (in category 'dropping/grabbing') ----- - justDroppedInto: aPasteUpMorph event: anEvent - "This message is sent to a dropped morph after it has been dropped on--and been accepted by--a drop-sensitive morph" - aPasteUpMorph isPartsBin ifFalse:[ - self removeHalo. - self delete. - ^aPasteUpMorph makeNewDrawing: anEvent]. - ^super justDroppedInto: aPasteUpMorph event: anEvent! Item was removed: - ----- Method: PaintInvokingMorph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') ----- - wantsToBeDroppedInto: aMorph - "Only into PasteUps that are not part bins" - ^aMorph isPlayfieldLike! Item was removed: - ----- Method: PartsBin>>morphToDropFrom: (in category 'dropping/grabbing') ----- - morphToDropFrom: aMorph - "Answer the morph to drop if the user attempts to drop aMorph" - - | aButton | - ((aMorph isKindOf: IconicButton) and: [aMorph actionSelector == #launchPartVia:label:]) - ifTrue: [^ aMorph]. - "The above handles the unusual case of a button that's already set up in a manner suitable for living in PartsBin; the archetypal example is the attempt to reposition an object within a partsflap by dragging it via the black halo handle." - - aButton := IconicButton new. - aButton color: self color; - initializeToShow: aMorph withLabel: aMorph externalName andSend: #veryDeepCopy to: aMorph veryDeepCopy. - ^ aButton! Item was removed: - ----- Method: PasteUpMorph class>>supplementaryPartsDescriptions (in category '*MorphicExtras-parts bin') ----- - supplementaryPartsDescriptions - ^ {DescriptionForPartsBin - formalName: 'Holder' translatedNoop - categoryList: {'Scripting' translatedNoop} - documentation: 'A place for storing alternative pictures in an animation, ec.' translatedNoop - globalReceiverSymbol: #ScriptingSystem - nativitySelector: #prototypicalHolder}! Item was removed: - ----- Method: PasteUpMorph>>roundUpStrays (in category '*MorphicExtras-misc') ----- - roundUpStrays - self submorphs - reject: [:each | each wantsToBeTopmost] - thenDo: [:each | each goHome]. - super roundUpStrays! Item was removed: - ----- Method: Player class>>extraExampleCar (in category '*MorphicExtras-examples') ----- - extraExampleCar - "Player extraExampleCar do: #openInWorld" - - | trackMorph wheelMorph carMorph carPlayer alertMorph wheelPlayer parent | - trackMorph := SketchMorph withForm: (Form extraCarTrack magnifyBy: RealEstateAgent scaleFactor). - trackMorph assuredPlayer; name: 'Track'. - carMorph := SketchMorph withForm: (Form extraCar magnifyBy: RealEstateAgent scaleFactor). - carPlayer := self newSubclass new - costume: (carMorph name: #Car); - yourself. - wheelMorph := SketchMorph withForm: (Form extraWheel magnifyBy: RealEstateAgent scaleFactor). - wheelPlayer := self newSubclass new - costume: (wheelMorph name: #Wheel); - yourself. - alertMorph := RectangleMorph new - useRoundedCorners; - extent: 90 px @ 50 px; - color: Color black; - assuredPlayer; - name: 'Alert'; - yourself. - {trackMorph. carMorph. wheelMorph. alertMorph} do: [:morph | - carPlayer environment at: morph name asSymbol put: morph player]. - carPlayer environment at: #Wheel put: wheelPlayer. - - Utilities useAuthorInitials: 'Objectland' during: [ - carPlayer class compile: ((self extraExampleCarSource - asString lines allButFirst copyWithFirst: #drive) - joinSeparatedBy: Character cr)]. - (carPlayer class >> #drive) decompile asScriptEditorFor: carPlayer. - carPlayer changeScript: #drive toStatus: #ticking. - carPlayer presenter stopRunningScripts. - - parent := Morph new - color: Color transparent; - extent: 700 px @ 700 px; - addAllMorphsFront: {carMorph. trackMorph. wheelMorph. alertMorph} - yourself. - trackMorph position: 19 px @ 25 px. - wheelMorph center: (trackMorph pointAtFraction: 0.3 @ 1.15). - carMorph - center: (trackMorph pointAtFraction: 0.45 @ 0.89); - rotationDegrees: 100. - alertMorph - center: (wheelMorph pointAtFraction: 1.75 @ 0.5); - addMorph: ('Alert' asTextMorph - backgroundColor: (Color paleYellow alpha: 0.6); - center: (alertMorph pointAtFraction: 0.5 @ 1.2); - yourself). - - ^ {parent. carPlayer scriptEditorFor: #drive}! Item was removed: - ----- Method: Player class>>extraExampleCarSource (in category '*MorphicExtras-examples') ----- - extraExampleCarSource - - ^ 'extraExampleDrive - self forward: 5. - self turn: Wheel getHeading // 5'! Item was removed: - ----- Method: ProjectNavigationMorph>>buttonPaint (in category 'the buttons') ----- - buttonPaint - - | pb oldArgs brush myButton m | - - myButton := self makeButton: '' balloonText: 'Make a painting' translated for: #doNewPainting. - pb := PaintBoxMorph new submorphNamed: #paint:. - pb ifNil: [ - (brush := Form extent: 16@16 depth: 16) fillColor: Color red - ] ifNotNil: [ - oldArgs := pb arguments. - brush := oldArgs third. - brush := brush copy: (2@0 extent: 42@38). - brush := brush scaledToSize: brush extent // 2. - ]. - myButton addMorph: (m := brush asMorph lock). - myButton extent: m extent + (myButton borderWidth + 6). - m position: myButton center - (m extent // 2). - - ^myButton - - "brush := (ScriptingSystem formAtKey: 'Painting')." - - ! Item was removed: - ----- Method: ProjectNavigationMorph>>doNewPainting (in category 'the actions') ----- - doNewPainting - - | w f | - - w := self world. - w assureNotPaintingElse: [^ self]. - (f := self owner flapTab) ifNotNil: [f hideFlap]. - w makeNewDrawing: (self primaryHand lastEvent translatedTo: w center) - ! Item was removed: - ----- Method: ProjectNavigationMorph>>editProjectInfo (in category 'the actions') ----- - editProjectInfo - - Smalltalk at: #EToyProjectDetailsMorph ifPresent:[:aClass| - aClass - getFullInfoFor: (self world ifNil: [^self]) project - ifValid: [] - expandedFormat: true - ].! Item was removed: - ----- Method: ProjectNavigationMorph>>makeTheSimpleButtons (in category 'buttons') ----- - makeTheSimpleButtons - - ^{ - self buttonNewProject. - - self buttonPrev. - self buttonNext. - self buttonPublish. - self buttonFind. - self buttonFullScreen. - - self buttonPaint. - }, - ( - Preferences includeSoundControlInNavigator ifTrue: [{self buttonSound}] ifFalse: [#()] - ), - { - self buttonLanguage. - self buttonUndo. - self buttonQuit. - } - ! Item was removed: - ----- Method: ScrollableField>>cursorWrapped: (in category 'accessing') ----- - cursorWrapped: aNumber - "Set the cursor as indicated" - textMorph cursorWrapped: aNumber! Item was removed: - ----- Method: ScrollableField>>getAllButFirstCharacter (in category 'accessing') ----- - getAllButFirstCharacter - "Obtain all but the first character from the receiver; if that - would be empty, return a black dot" - ^ textMorph getAllButFirstCharacter ! Item was removed: - ----- Method: ScrollableField>>getNumericValue (in category 'accessing') ----- - getNumericValue - "Obtain a numeric value from the receiver; if no digits, return - zero" - ^ textMorph getNumericValue ! Item was removed: - ----- Method: ScrollableField>>insertCharacters: (in category 'accessing') ----- - insertCharacters: aString - "Insert the characters from the given source at my current - cursor position" - textMorph insertCharacters: aString ! Item was removed: - ----- Method: ScrollableField>>insertContentsOf: (in category 'accessing') ----- - insertContentsOf: aPlayer - "Insert the characters from the given player at my current - cursor position" - textMorph insertContentsOf: aPlayer ! Item was removed: - ----- Method: ScrollableField>>setNumericValue: (in category 'accessing') ----- - setNumericValue: aValue - "Set the contents of the receiver to be a string obtained from - aValue" - textMorph setNumericValue: aValue ! Item was removed: - ----- Method: SimpleButtonMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - target := target adaptedToWorld: aWorld.! Item was removed: - ----- Method: SimpleSliderMorph>>isLikelyRecipientForMouseOverHalos (in category 'e-toy support') ----- - isLikelyRecipientForMouseOverHalos - - self player ifNil: [^ false]. - self player getHeading = 0.0 ifTrue: [^ false]. - ^ true. - ! Item was removed: - ----- Method: SketchEditorMorph>>wantsHaloFromClick (in category 'e-toy support') ----- - wantsHaloFromClick - - ^ Preferences eToyFriendly not. - ! Item was removed: - ----- Method: StandardScriptingSystem class>>registerInFlapsRegistry (in category '*MorphicExtras-class initialization') ----- - registerInFlapsRegistry - "Register the receiver in the system's flaps registry" - self environment - at: #Flaps - ifPresent: [:cl | cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} - forFlapNamed: 'PlugIn Supplies'. - cl registerQuad: {#ScriptingSystem. #prototypicalHolder. 'Holder' translatedNoop. 'A place for storing alternative pictures in an animation, etc.' translatedNoop} - forFlapNamed: 'Supplies'. - cl registerQuad: {#ScriptingSystem. #newScriptingSpace. 'Scripting' translatedNoop. 'A confined place for drawing and scripting, with its own private stop/step/go buttons.' translatedNoop} - forFlapNamed: 'Widgets'. - cl registerQuad: {#ScriptingSystem. #holderWithAlphabet. 'Alphabet' translatedNoop. 'A source for single-letter objects' translatedNoop} - forFlapNamed: 'Widgets'.]! Item was removed: - ----- Method: StandardScriptingSystem class>>unload (in category '*MorphicExtras-class initialization') ----- - unload - "Unload the receiver from global registries" - - self environment at: #Flaps ifPresent: [:cl | - cl unregisterQuadsWithReceiver: ScriptingSystem] ! Item was removed: - ----- Method: StringButtonMorph>>adaptToWorld: (in category 'e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - target := target adaptedToWorld: aWorld.! Item was removed: - ----- Method: TabbedPalette>>becomeStandardPalette (in category 'misc menu items') ----- - becomeStandardPalette - self presenter standardPalette: self! Item was removed: - ----- Method: TheWorldMenu>>adaptToWorld: (in category '*MorphicExtras-mechanics') ----- - adaptToWorld: aWorld - - myWorld := aWorld. - myProject := nil. "figure it out if and when needed. maybe make it easier to find" - myHand := aWorld primaryHand.! Item was removed: - ----- Method: ThreePhaseButtonMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - self target: (target adaptedToWorld: aWorld).! Item was removed: - ----- Method: ThumbnailMorph>>isEtoyReadout (in category 'scripting') ----- - isEtoyReadout - "Answer whether the receiver can serve as an etoy readout" - - ^ true! Item was removed: - MorphicModel subclass: #TwoWayScrollPane - instanceVariableNames: 'getMenuSelector getMenuTitleSelector xScrollBar yScrollBar scroller' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Obsolete'! - - !TwoWayScrollPane commentStamp: '<historical>' prior: 0! - TwoWayScrollPane is now obsolete. You should be able to use ScrollPane to do both vertical and horizontal scrolling. - - As an example, see Morph>>inATwoWayScrollPane and change the first line to create a ScrollPane instead of a TwoWayScrollPane. It will still work. - - (EllipseMorph new extent: 200@150) inATwoWayScrollPane openInWorld - - Note that user preferences for ScrollPane may be geared toward text scrolling, so that the horizontal scrollbar may be hidden when not needed, while the vertical scrollbar is always shown. Use ScrollPane>>alwaysShowHScrollbar: or its variants to adjust this if you want the vertical & horizontal scrollbars to be shown consistently. - ! Item was removed: - ----- Method: TwoWayScrollPane class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "OK to instantiate" - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>colorForInsets (in category 'accessing') ----- - colorForInsets - "My submorphs use the surrounding color" - owner notNil and: - [ owner color isColor ifTrue: [ ^ owner color ] ]. - ^ Color white! Item was removed: - ----- Method: TwoWayScrollPane>>containsPoint: (in category 'geometry testing') ----- - containsPoint: aPoint - (super containsPoint: aPoint) ifTrue: [^ true]. - "Also include scrollbar when it is extended..." - "used to handle retractable scrolbar" - ^ false! Item was removed: - ----- Method: TwoWayScrollPane>>createScrollBarNamed: (in category 'initialization') ----- - createScrollBarNamed: aString - "creates a scroll bar named as aString" - | result | - result := ScrollBar new model: self slotName: aString. - result borderStyle: (BorderStyle inset width: 2). - ^ result! Item was removed: - ----- Method: TwoWayScrollPane>>createScroller (in category 'initialization') ----- - createScroller - "create a scroller" - | result | - result := TransformMorph new color: Color transparent. - result offset: 0 @ 0. - ^ result! Item was removed: - ----- Method: TwoWayScrollPane>>defaultBorderColor (in category 'initialization') ----- - defaultBorderColor - ^ Color transparent! Item was removed: - ----- Method: TwoWayScrollPane>>defaultBorderStyle (in category 'initialization') ----- - defaultBorderStyle - ^ BorderStyle inset! Item was removed: - ----- Method: TwoWayScrollPane>>doLayoutIn: (in category 'layout') ----- - doLayoutIn: layoutBounds - "layout has changed. update scroll deltas or whatever else" - - (owner notNil and: [owner hasProperty: #autoFitContents]) - ifTrue: [self fitContents]. - super doLayoutIn: layoutBounds.! Item was removed: - ----- Method: TwoWayScrollPane>>extent: (in category 'geometry') ----- - extent: newExtent - bounds extent = newExtent ifTrue: [^ self]. - super extent: (newExtent max: 36@32). - self resizeScrollBar; resizeScroller; setScrollDeltas. - ! Item was removed: - ----- Method: TwoWayScrollPane>>fitContents (in category 'layout') ----- - fitContents - "Adjust my size to fit my contents reasonably snugly" - - self extent: scroller submorphBounds extent - + (yScrollBar width @ xScrollBar height) - + (self borderWidth*2) - ! Item was removed: - ----- Method: TwoWayScrollPane>>getMenu: (in category 'menu') ----- - getMenu: shiftKeyState - "Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key." - - | menu aMenu aTitle | - getMenuSelector isNil ifTrue: [^nil]. - menu := MenuMorph new defaultTarget: model. - aTitle := getMenuTitleSelector - ifNotNil: [model perform: getMenuTitleSelector]. - getMenuSelector numArgs = 1 - ifTrue: - [aMenu := model perform: getMenuSelector with: menu. - aTitle ifNotNil: [aMenu addTitle: aTitle]. - ^aMenu]. - getMenuSelector numArgs = 2 - ifTrue: - [aMenu := model - perform: getMenuSelector - with: menu - with: shiftKeyState. - aTitle ifNotNil: [aMenu addTitle: aTitle]. - ^aMenu]. - ^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! Item was removed: - ----- Method: TwoWayScrollPane>>handlesMouseDown: (in category 'event handling') ----- - handlesMouseDown: evt - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>handlesMouseOver: (in category 'event handling') ----- - handlesMouseOver: evt - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar (in category 'retractable scroll bar') ----- - hideOrShowScrollBar - - ^self "we don't support retractable at the moment"! Item was removed: - ----- Method: TwoWayScrollPane>>hideOrShowScrollBar:forRange: (in category 'retractable scroll bar') ----- - hideOrShowScrollBar: scrollBar forRange: range - - (self hasProperty: #hideUnneededScrollbars) ifFalse: [^ self]. - (submorphs includes: scrollBar) - ifTrue: [range <= 0 ifTrue: [scrollBar model: nil; delete]] - ifFalse: [range > 0 ifTrue: [scrollBar model: self. self resizeScrollBar; addMorph: scrollBar]] - ! Item was removed: - ----- Method: TwoWayScrollPane>>initialize (in category 'initialization') ----- - initialize - "initialize the state of the receiver" - super initialize. - "" - self addMorph: (yScrollBar := self createScrollBarNamed: 'yScrollBar'); - addMorph: (xScrollBar := self createScrollBarNamed: 'xScrollBar'); - addMorph: (scroller := self createScroller). - "" - self extent: 150 @ 120! Item was removed: - ----- Method: TwoWayScrollPane>>keyStroke: (in category 'event handling') ----- - keyStroke: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - - scroller submorphs last keyStroke: evt! Item was removed: - ----- Method: TwoWayScrollPane>>leftOrRight (in category 'menu') ----- - leftOrRight "Change scroll bar location" - - "used to handle left vs right scrollbar"! Item was removed: - ----- Method: TwoWayScrollPane>>leftoverScrollRange (in category 'geometry') ----- - leftoverScrollRange - "Return the entire scrolling range minus the currently viewed area." - ^ self totalScrollRange - (self innerBounds extent * 3 // 4) max: 0@0 - ! Item was removed: - ----- Method: TwoWayScrollPane>>menuSelector: (in category 'menu') ----- - menuSelector: aSelector - getMenuSelector := aSelector! Item was removed: - ----- Method: TwoWayScrollPane>>menuTitleSelector: (in category 'menu') ----- - menuTitleSelector: aSelector - getMenuTitleSelector := aSelector! Item was removed: - ----- Method: TwoWayScrollPane>>mouseDown: (in category 'event handling') ----- - mouseDown: evt - evt yellowButtonPressed "First check for option (menu) click" - ifTrue: [^ self yellowButtonActivity: evt shiftPressed]. - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseDown: (evt transformedBy: (scroller transformFrom: self))]! Item was removed: - ----- Method: TwoWayScrollPane>>mouseEnter: (in category 'event handling') ----- - mouseEnter: event - - "used to handle retractable scrolbar"! Item was removed: - ----- Method: TwoWayScrollPane>>mouseLeave: (in category 'event handling') ----- - mouseLeave: event - - "used to handle retractable scrolbar"! Item was removed: - ----- Method: TwoWayScrollPane>>mouseMove: (in category 'event handling') ----- - mouseMove: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]! Item was removed: - ----- Method: TwoWayScrollPane>>mouseUp: (in category 'event handling') ----- - mouseUp: evt - "If pane is not full, pass the event to the last submorph, - assuming it is the most appropriate recipient (!!)" - scroller hasSubmorphs ifTrue: - [scroller submorphs last mouseUp: (evt transformedBy: (scroller transformFrom: self))]! Item was removed: - ----- Method: TwoWayScrollPane>>rejectsEvent: (in category 'events-processing') ----- - rejectsEvent: anEvent - - scroller submorphs isEmpty ifTrue: [^true]. "something messed up here" - scroller firstSubmorph isSyntaxMorph ifTrue: [^ super rejectsEvent: anEvent]. - ^self visible not "ignore locked status"! Item was removed: - ----- Method: TwoWayScrollPane>>resizeScrollBar (in category 'geometry') ----- - resizeScrollBar - "used to handle left vs right scrollbar" - yScrollBar bounds: (bounds topLeft extent: 16 @ (bounds height - 16)). - xScrollBar bounds: ((bounds left + 16) @ (bounds bottom - 16) extent: (bounds width - 16) @ 16). - ! Item was removed: - ----- Method: TwoWayScrollPane>>resizeScroller (in category 'geometry') ----- - resizeScroller - | inner | - "used to handle left vs right scrollbar" - inner := self innerBounds. - scroller bounds: (inner topLeft + (yScrollBar width@0) corner: (inner bottomRight - (0@xScrollBar height)))! Item was removed: - ----- Method: TwoWayScrollPane>>retractableOrNot (in category 'menu') ----- - retractableOrNot "Change scroll bar operation" - - "used to handle retractable scrolbar"! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarFills: (in category 'geometry') ----- - scrollBarFills: aRectangle - "Return true if a flop-out scrollbar fills the rectangle" - "used to handle retractable scrolbar" - ^ false! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - scrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBarOnLeft: (in category 'menu') ----- - scrollBarOnLeft: aBoolean - - "used to handle left vs right scrollbar"! Item was removed: - ----- Method: TwoWayScrollPane>>scrollBy: (in category 'geometry') ----- - scrollBy: delta - "Move the contents in the direction delta." - "For now, delta is assumed to have a zero x-component. Used by scrollIntoView:" - | r newOffset | - - newOffset := (scroller offset - delta max: 0@0) min: self leftoverScrollRange. - scroller offset: newOffset. - - r := self leftoverScrollRange. - r y = 0 - ifTrue: [yScrollBar value: 0.0] - ifFalse: [yScrollBar value: newOffset y asFloat / r y]. - r x = 0 - ifTrue: [xScrollBar value: 0.0] - ifFalse: [xScrollBar value: newOffset x asFloat / r x]. - ! Item was removed: - ----- Method: TwoWayScrollPane>>scrollIntoView:extra: (in category 'geometry') ----- - scrollIntoView: desiredRectangle extra: anumber - | shift | - - shift := desiredRectangle deltaToEnsureInOrCentered: ( - scroller offset extent: scroller bounds extent - ) extra: anumber. - shift = (0 @ 0) ifFalse: [self scrollBy: (0@0) - shift]. - ! Item was removed: - ----- Method: TwoWayScrollPane>>scroller (in category 'access') ----- - scroller - ^ scroller! Item was removed: - ----- Method: TwoWayScrollPane>>setScrollDeltas (in category 'geometry') ----- - setScrollDeltas - | range scrollDelta totalRange innerBounds | - totalRange := self totalScrollRange ifNil: [^ self]. - range := self leftoverScrollRange. - innerBounds := self innerBounds. - scrollDelta := 10 @ 10. - - self hideOrShowScrollBar: xScrollBar - forRange: totalRange x - (innerBounds width - yScrollBar width). - range x <= 0 - ifTrue: [xScrollBar scrollDelta: 0.02 pageDelta: 0.2. - xScrollBar interval: 1.0] - ifFalse: [xScrollBar scrollDelta: (scrollDelta x / range x) asFloat - pageDelta: (innerBounds width - scrollDelta x / range x) asFloat. - xScrollBar interval: (innerBounds width - scrollDelta x / totalRange x) asFloat]. - - self hideOrShowScrollBar: yScrollBar - forRange: totalRange y - (innerBounds height - xScrollBar height). - range y <= 0 - ifTrue: [yScrollBar scrollDelta: 0.02 pageDelta: 0.2. - yScrollBar interval: 1.0] - ifFalse: [yScrollBar scrollDelta: (scrollDelta y / range y) asFloat - pageDelta: (innerBounds height - scrollDelta y / range y) asFloat. - yScrollBar interval: (innerBounds height - scrollDelta y / totalRange y) asFloat]! Item was removed: - ----- Method: TwoWayScrollPane>>shiftedYellowButtonActivity (in category 'scroll bar events') ----- - shiftedYellowButtonActivity - ^ self yellowButtonActivity: true! Item was removed: - ----- Method: TwoWayScrollPane>>totalScrollRange (in category 'geometry') ----- - totalScrollRange - - "Return the entire scrolling range." - ^ ((scroller localSubmorphBounds ifNil: [^nil]) encompass: 0@0) extent - - ! Item was removed: - ----- Method: TwoWayScrollPane>>unshiftedYellowButtonActivity (in category 'scroll bar events') ----- - unshiftedYellowButtonActivity - ^ self yellowButtonActivity: false! Item was removed: - ----- Method: TwoWayScrollPane>>wantsSlot (in category 'access') ----- - wantsSlot - "For now do it the old way, until we sort this out" - ^ true! Item was removed: - ----- Method: TwoWayScrollPane>>wantsYellowButtonMenu (in category 'menu') ----- - wantsYellowButtonMenu - "Answer true if the receiver wants a yellow button menu" - ^ getMenuSelector notNil! Item was removed: - ----- Method: TwoWayScrollPane>>xScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - xScrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed! Item was removed: - ----- Method: TwoWayScrollPane>>xScrollBarValue: (in category 'scroll bar events') ----- - xScrollBarValue: scrollValue - - "although there appear to be no senders, see Slider>>setValue:" - - scroller hasSubmorphs ifFalse: [^ self]. - scroller offset: self leftoverScrollRange x * scrollValue @ scroller offset y! Item was removed: - ----- Method: TwoWayScrollPane>>xScrollerHeight (in category 'retractable scroll bar') ----- - xScrollerHeight - - (submorphs includes: xScrollBar) "Sorry the logic is reversed :( " - ifFalse: [^ 0 @ 0] "already included" - ifTrue: [^ 0 @ xScrollBar height] "leave space for it" - ! Item was removed: - ----- Method: TwoWayScrollPane>>yScrollBarMenuButtonPressed: (in category 'scroll bar events') ----- - yScrollBarMenuButtonPressed: event - ^ self yellowButtonActivity: event shiftPressed! Item was removed: - ----- Method: TwoWayScrollPane>>yScrollBarValue: (in category 'scroll bar events') ----- - yScrollBarValue: scrollValue - - "although there appear to be no senders, see Slider>>setValue:" - - scroller hasSubmorphs ifFalse: [^ self]. - scroller offset: scroller offset x @ (self leftoverScrollRange y * scrollValue)! Item was removed: - ----- Method: TwoWayScrollPane>>yellowButtonActivity: (in category 'scroll bar events') ----- - yellowButtonActivity: shiftKeyState - | menu | - (menu := self getMenu: shiftKeyState) ifNotNil: - [menu setInvokingView: self. - menu popUpEvent: self activeHand lastEvent in: self world]! Item was removed: - ----- Method: UpdatingMenuItemMorph>>adaptToWorld: (in category '*MorphicExtras-e-toy support') ----- - adaptToWorld: aWorld - super adaptToWorld: aWorld. - wordingProvider := wordingProvider adaptedToWorld: aWorld.! Item was removed: - ----- Method: UpdatingRectangleMorph>>isEtoyReadout (in category 'accessing') ----- - isEtoyReadout - "Answer whether the receiver can serve as an etoy readout" - - ^ true! Item was removed: - FlapTab subclass: #ViewerFlapTab - instanceVariableNames: 'scriptedPlayer' - classVariableNames: '' - poolDictionaries: '' - category: 'MorphicExtras-Flaps'! - - !ViewerFlapTab commentStamp: 'kfr 10/28/2003 06:31' prior: 0! - ViewerFlapTab are flap tabs for etoy scripting viewers.! Item was removed: - ----- Method: ViewerFlapTab class>>defaultNameStemForInstances (in category 'printing') ----- - defaultNameStemForInstances - ^ 'viewerFlapTab' translatedNoop! Item was removed: - ----- Method: ViewerFlapTab class>>includeInNewMorphMenu (in category 'new-morph participation') ----- - includeInNewMorphMenu - "Not to be instantiated from the menu" - ^ false! Item was removed: - ----- Method: ViewerFlapTab>>addCustomMenuItems:hand: (in category 'menu') ----- - addCustomMenuItems: aMenu hand: aHandMorph - "Add further items to the menu as appropriate. NB: Cannot call super here." - - aMenu add: 'flap color...' translated target: self action: #changeFlapColor. - aMenu addLine. - aMenu addUpdating: #edgeString action: #setEdgeToAdhereTo. - aMenu addUpdating: #dragoverString action: #toggleDragOverBehavior. - aMenu addUpdating: #mouseoverString action: #toggleMouseOverBehavior. - aMenu addLine. - aMenu addUpdating: #compactFlapString target: self action: #changeCompactFlap. - - aMenu add: 'destroy this flap' translated action: #destroyFlap! Item was removed: - ----- Method: ViewerFlapTab>>adjustPositionAfterHidingFlap (in category 'show & hide') ----- - adjustPositionAfterHidingFlap - "we add the width of flap itself to our referent, to reflect the actual width from the edge of the screen, including the space we leave for other flaps. see also ViewerFlapTab>>fitOnScreen" - self flag: #todo. - self referent width: self referent width + self width. - super adjustPositionAfterHidingFlap.! Item was removed: - ----- Method: ViewerFlapTab>>allNonSubmorphMorphs (in category 'submorphs - accessing') ----- - allNonSubmorphMorphs - "Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy. Especially the non-showing pages in BookMorphs." - - ^ flapShowing - ifTrue: [#()] - ifFalse: [Array with: referent]! Item was removed: - ----- Method: ViewerFlapTab>>changeCompactFlap (in category 'compact') ----- - changeCompactFlap - self makeFlapCompact: self isFlapCompact not.! Item was removed: - ----- Method: ViewerFlapTab>>compactFlapString (in category 'compact') ----- - compactFlapString - ^ (self isFlapCompact - ifTrue: ['<on>compact flap'] - ifFalse: ['<off>']), 'compact flap' translated! Item was removed: - ----- Method: ViewerFlapTab>>fitOnScreen (in category 'positioning') ----- - fitOnScreen - | constrainer | - super fitOnScreen. - "We want to leave a margin for the flaps on the side and for the global flaps at the top (like the Sugar navbar) so we reduce the referents top and its width. We undo this before hiding the flap in ViewerFlapTab>>adjustPositionAfterHidingFlap" - self flag: #todo. - constrainer := (owner ifNil: [self]) clearArea. - self flapShowing ifTrue: [ - Flaps globalFlapTabsIfAny - do: [:each | - (each edgeToAdhereTo = #top and: [each bottom > self referent top]) - ifTrue: [self referent top: each bottom]. - (each edgeToAdhereTo = #top and: [each bottom > self top]) - ifTrue: [self top: each bottom]]. - self referent width: constrainer right - self width - self right].! Item was removed: - ----- Method: ViewerFlapTab>>graphicalMorphForTab (in category 'menu') ----- - graphicalMorphForTab - "Answer a graphical morph to serve as my tab's display" - - ^ ThumbnailMorph new objectToView: scriptedPlayer viewSelector: #graphicForViewerTab! Item was removed: - ----- Method: ViewerFlapTab>>hibernate (in category 'transition') ----- - hibernate - "drop my viewer to save space when writing to the disk." - - referent submorphs do: - [:m | (m isViewer) ifTrue: [m delete]]! Item was removed: - ----- Method: ViewerFlapTab>>initializeFor:topAt: (in category 'transition') ----- - initializeFor: aPlayer topAt: aTop - - scriptedPlayer := aPlayer. - self useGraphicalTab. - self top: aTop! Item was removed: - ----- Method: ViewerFlapTab>>isCurrentlyGraphical (in category 'accessing') ----- - isCurrentlyGraphical - ^ true! Item was removed: - ----- Method: ViewerFlapTab>>isFlapCompact (in category 'compact') ----- - isFlapCompact - "Return true if the referent of the receiver represents a 'compact' flap" - referent layoutPolicy ifNil:[^false]. - referent layoutPolicy isTableLayout ifFalse:[^false]. - referent vResizing == #shrinkWrap ifFalse:[^false]. - ^true! Item was removed: - ----- Method: ViewerFlapTab>>makeFlapCompact: (in category 'compact') ----- - makeFlapCompact: aBool - "Return true if the referent of the receiver represents a 'compact' flap" - aBool ifTrue:[ - referent - layoutPolicy: TableLayout new; - vResizing: #shrinkWrap; - useRoundedCorners. - ] ifFalse:[ - referent - layoutPolicy: nil; - vResizing: #rigid; - useSquareCorners. - ].! Item was removed: - ----- Method: ViewerFlapTab>>scriptedPlayer (in category 'access') ----- - scriptedPlayer - ^ scriptedPlayer! Item was removed: - ----- Method: ViewerFlapTab>>unhibernate (in category 'transition') ----- - unhibernate - "recreate my viewer" - - | wasShowing viewer | - referent ifNotNil: [referent isViewer ifTrue: [^self]]. - wasShowing := flapShowing. - "guard against not-quite-player-players" - viewer := ((scriptedPlayer respondsTo: #costume) - and: [scriptedPlayer costume isMorph]) - ifTrue: [self presenter viewMorph: scriptedPlayer costume] - ifFalse: [self presenter viewObjectDirectly: scriptedPlayer]. - wasShowing ifFalse: [self hideFlap]. - ^viewer! Item was removed: - ----- Method: WebCamMorph class>>additionsToViewerCategories (in category 'scripting') ----- - additionsToViewerCategories - "Answer a list of (<categoryName> <list of category specs>) pairs that characterize the phrases this kind of morph wishes to add to various Viewer categories." - ^ #( - - (#'camera' ( - (slot resolution '160x120, 320x240, 640x480 or 1280x960' - WebCamResolution readWrite Player getWebCamResolution Player setWebCamResolution:) - (slot orientation 'Natural (mirrored) or navtive (as from the camera' - WebCamOrientation readWrite Player getWebCamOrientation Player setWebCamOrientation:) - (slot cameraIsOn 'Whether the camera is on/off' Boolean readWrite Player getWebCamIsOn Player setWebCamIsOn:) - (slot useFrameSize 'Resize the player to match the camera''s frame size' - Boolean readWrite Player getUseFrameSize Player setUseFrameSize:) - (slot lastFrame 'A player with the last frame' Player readOnly Player getLastFrame unused unused) - (slot showFPS 'Whether to show the samera''s frames per second' Boolean readWrite Player getShowFPS Player setShowFPS:) - )) - ) - !

1 0

The Trunk: MorphicTests-dtl.95.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of MorphicTests to project The Trunk: http://source.squeak.org/trunk/MorphicTests-dtl.95.mcz ==================== Summary ==================== Name: MorphicTests-dtl.95 Author: dtl Time: 25 November 2023, 2:56:38.809269 pm UUID: fc0b02dd-3e58-4172-bc2a-92e2f76578ab Ancestors: MorphicTests-mt.94 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against MorphicTests-mt.94 =============== Item was removed: - ----- Method: PasteUpMorphTest>>testCursorWrapped (in category 'tests') ----- - testCursorWrapped - "self debug: #testCursorWrapped" - | holder | - holder := PasteUpMorph new. - self assert: holder cursor = 1. - holder cursorWrapped: 2. - self assert: holder cursor = 1. - holder addMorph: Morph new; - addMorph: Morph new; - addMorph: Morph new. - holder cursorWrapped: 3. - self assert: holder cursor = 3. - holder cursorWrapped: 5. - self assert: holder cursor = 2. - holder cursorWrapped: 0. - self assert: holder cursor = 3. - holder cursorWrapped: -1. - self assert: holder cursor = 2.! Item was removed: - ----- Method: PasteUpMorphTest>>testCursorWrappedWithFraction (in category 'tests') ----- - testCursorWrappedWithFraction - "self debug: #testCursorWrappedWithFraction" - | holder | - holder := PasteUpMorph new. - holder addMorph: Morph new; - addMorph: Morph new; - addMorph: Morph new. - holder cursorWrapped: 3.5. - self assert: holder cursor = 3.5. - holder cursorWrapped: 5.5. - self assert: holder cursor = 2.5. - holder cursorWrapped: 0.5. - self assert: holder cursor = 3.5. - holder cursorWrapped: -0.5. - self assert: holder cursor = 2.5.! Item was removed: - ----- Method: PasteUpMorphTest>>testGridToGradient (in category 'tests') ----- - testGridToGradient - "A trivial test for checking that you can change from a grid to a - gradient background. A recent [FIX] will make this pass." - | pum | - pum := PasteUpMorph new. - pum setStandardTexture. - "The following should fail without the fix" - self - shouldnt: [pum gradientFillColor: Color red] - raise: MessageNotUnderstood!

1 0

The Trunk: Network-dtl.283.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-dtl.283.mcz ==================== Summary ==================== Name: Network-dtl.283 Author: dtl Time: 25 November 2023, 2:57:19.332774 pm UUID: 23b8dbc2-ede3-4297-929e-1b8dbcd3261e Ancestors: Network-ul.282 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against Network-ul.282 =============== Item was removed: - ----- Method: SuperSwikiServer>>matchingEntries: (in category 'for real') ----- - matchingEntries: criteria - | result | - eToyUserListUrl ifNil:[^self entries]. - result := self sendToSwikiProjectServer: { - 'action: listmatchingprojects'. - } , criteria. - (result beginsWith: 'OK') - ifFalse: [^self entries]. "If command not supported" - ^self parseListEntries: result!

1 0

The Trunk: Protocols-dtl.88.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of Protocols to project The Trunk: http://source.squeak.org/trunk/Protocols-dtl.88.mcz ==================== Summary ==================== Name: Protocols-dtl.88 Author: dtl Time: 25 November 2023, 2:57:42.163542 pm UUID: 7a05094b-2aea-490c-8430-42b3f207f4db Ancestors: Protocols-ct.87 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against Protocols-ct.87 =============== Item was removed: - ----- Method: BooleanType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - ^ true! Item was removed: - ----- Method: ColorType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ Color random! Item was removed: - ----- Method: DataType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ 'no value'! Item was removed: - ----- Method: GraphicType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ ScriptingSystem formAtKey: #PaintTab! Item was removed: - ----- Method: InstanceBrowser>>viewViewee (in category 'menu commands') ----- - viewViewee - "Open a viewer on the object I view" - - objectViewed beViewed! Item was removed: - ----- Method: NumberType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ (1 to: 9) atRandom! Item was removed: - ----- Method: PasteUpMorph>>abandonVocabularyPreference (in category '*Protocols') ----- - abandonVocabularyPreference - "Remove any memory of a preferred vocabulary in the project" - - | standardViewers aVocabulary | - self removeProperty: #currentVocabularySymbol. - - standardViewers := (self submorphsSatisfying: [:m | m isKindOf: ViewerFlapTab]) collect: - [:m | m referent firstSubmorph]. - aVocabulary := Vocabulary vocabularyNamed: #eToy. - standardViewers do: - [:m | ((m valueOfProperty: #currentVocabularySymbol ifAbsent: [nil]) == #Vector) ifTrue: - [m switchToVocabulary: aVocabulary]] - - "ActiveWorld abandonVocabularyPreference"! Item was removed: - ----- Method: PasteUpMorph>>installVectorVocabulary (in category '*Protocols') ----- - installVectorVocabulary - "Install the experimental Vector vocabulary as the default for the current project" - - | standardViewers aVocabulary | - self setProperty: #currentVocabularySymbol toValue: #Vector. - standardViewers := (self submorphsSatisfying: [:m | m isKindOf: ViewerFlapTab]) collect: - [:m | m referent firstSubmorph]. - aVocabulary := Vocabulary vocabularyNamed: #Vector. - standardViewers do: [:m | m switchToVocabulary: aVocabulary]! Item was removed: - ----- Method: PasteUpMorph>>makeVectorUseConformToPreference (in category '*Protocols') ----- - makeVectorUseConformToPreference - "Make certain that the use of vectors in this project conforms to the current preference setting." - - | prefValue currentValue | - prefValue := Preferences useVectorVocabulary. - currentValue := self currentlyUsingVectorVocabulary. - prefValue ~~ currentValue ifTrue: - [currentValue - ifTrue: - [self abandonVocabularyPreference] - ifFalse: - [self installVectorVocabulary]]! Item was removed: - ----- Method: PointType>>initialValueForASlotFor: (in category 'initialization') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ 0@0! Item was removed: - ----- Method: SoundType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ 'croak'! Item was removed: - ----- Method: StringType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ 'abc'! Item was removed: - ----- Method: SymbolListType>>initialValueForASlotFor: (in category 'initial value') ----- - initialValueForASlotFor: aPlayer - "Answer the value to give initially to a newly created slot of the given type in the given player" - - ^ self choices first! Item was removed: - ----- Method: Vocabulary>>isEToyVocabulary (in category 'queries') ----- - isEToyVocabulary - ^false!

1 0

The Trunk: ReleaseBuilder-dtl.245.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-dtl.245.mcz ==================== Summary ==================== Name: ReleaseBuilder-dtl.245 Author: dtl Time: 25 November 2023, 2:58:05.159503 pm UUID: 8c5aec2b-4f0b-43b6-9956-2b2521bfd05d Ancestors: ReleaseBuilder-mt.244 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against ReleaseBuilder-mt.244 =============== Item was removed: - ----- Method: ReleaseBuilder class>>beautifyEtoys (in category 'scripts - ui') ----- - beautifyEtoys - "If users invoke Etoys features without preparing the system's look-and-feel via #setEtoysMode, some icons look strange. Fix that to improve the first impression." - - (self environment classNamed: #ReleaseBuilderSqueakland) - ifNotNil: [:builder | builder loadMostUsedEtoysForms].!

1 0

The Trunk: ST80-dtl.297.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of ST80 to project The Trunk: http://source.squeak.org/trunk/ST80-dtl.297.mcz ==================== Summary ==================== Name: ST80-dtl.297 Author: dtl Time: 25 November 2023, 2:58:29.966847 pm UUID: 6de75e3c-8b94-4a42-b960-dc0da87a9cbf Ancestors: ST80-ct.296 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against ST80-ct.296 =============== Item was removed: - ----- Method: ParagraphEditor class>>yellowButtonExpertMenu (in category 'class initialization') ----- - yellowButtonExpertMenu - - ^ SelectionMenu fromArray: StringHolder yellowButtonMenuItems. - ! Item was removed: - ----- Method: ParagraphEditor class>>yellowButtonNoviceMenu (in category 'class initialization') ----- - yellowButtonNoviceMenu - - ^ MenuMorph fromArray: { - {'set font... (k)' translated. #offerFontMenu}. - {'set style... (K)' translated. #changeStyle}. - {'set alignment... (u)' translated. #chooseAlignment}. - #-. - {'make project link (P)' translated. #makeProjectLink}. - #-. - {'find...(f)' translated. #find}. - {'find again (g)' translated. #findAgain}. - {'set search string (h)' translated. #setSearchString}. - #-. - {'do again (j)' translated. #again}. - {'undo (z)' translated. #undo}. - #-. - {'copy (c)' translated. #copySelection}. - {'cut (x)' translated. #cut}. - {'paste (v)' translated. #paste}. - {'paste...' translated. #pasteRecent}. - #-. - {'accept (s)' translated. #accept}. - {'cancel (l)' translated. #cancel}. - }. - ! Item was removed: - ----- Method: ScreenController>>standardGraphicsLibrary (in category 'menu messages') ----- - standardGraphicsLibrary - "Open a standard, throwaway window chock full of useful expressions. 1/17/96 sw" - - ScriptingSystem inspectFormDictionary!

1 0

The Trunk: System-dtl.1435.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-dtl.1435.mcz ==================== Summary ==================== Name: System-dtl.1435 Author: dtl Time: 25 November 2023, 2:59:05.733281 pm UUID: bbc4490f-7bf2-4d8a-9a96-feb3fcdcb59c Ancestors: System-ct.1434 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against System-ct.1434 =============== Item was removed: - ----- Method: DeepCopier>>mapUniClasses (in category 'like fullCopy') ----- - mapUniClasses - "For new Uniclasses, map their class vars to the new objects. And their additional class instance vars. (scripts slotInfo) and cross references like (player321)." - "Players also refer to each other using associations in the References dictionary. Search the methods of our Players for those. Make new entries in References and point to them." - | pp | - - newUniClasses ifFalse: [^ self]. "All will be siblings. uniClasses is empty" - "Uniclasses use class vars to hold onto siblings who are referred to in code" - pp := (Smalltalk at: #Player ifAbsent:[^self]) class superclass instSize. - uniClasses do: [:playersClass | "values = new ones" - playersClass classPool associationsDo: [:assoc | - assoc value: (assoc value veryDeepCopyWith: self)]. - playersClass scripts: (playersClass privateScripts veryDeepCopyWith: self). "pp+1" - "(pp+2) slotInfo was deepCopied in copyUniClass and that's all it needs" - pp+3 to: playersClass class instSize do: [:ii | - playersClass instVarAt: ii put: - ((playersClass instVarAt: ii) veryDeepCopyWith: self)]. - ]. - - "Make new entries in References and point to them." - References keys "copy" do: [:playerName | | oldPlayer newKey | - oldPlayer := References at: playerName. - (references includesKey: oldPlayer) ifTrue: [ - newKey := (references at: oldPlayer) "new player" uniqueNameForReference. - "now installed in References" - (references at: oldPlayer) renameTo: newKey]]. - uniClasses "values" do: [:newClass | | newSelList oldSelList | - oldSelList := OrderedCollection new. newSelList := OrderedCollection new. - newClass selectorsAndMethodsDo: [:sel :m | - m literals do: [:assoc | | newAssoc newKey | - assoc isVariableBinding ifTrue: [ - (References associationAt: assoc key ifAbsent: [nil]) == assoc ifTrue: [ - newKey := (references at: assoc value ifAbsent: [assoc value]) - externalName asSymbol. - (assoc key ~= newKey) & (References includesKey: newKey) ifTrue: [ - newAssoc := References associationAt: newKey. - newClass methodDictionary at: sel put: - (newClass compiledMethodAt: sel) shallowCopy. "were sharing it" - (newClass compiledMethodAt: sel) - literalAt: ((newClass compiledMethodAt: sel) literals indexOf: assoc) - put: newAssoc. - (oldSelList includes: assoc key) ifFalse: [ - oldSelList add: assoc key. newSelList add: newKey]]]]]]. - oldSelList with: newSelList do: [:old :new | - newClass replaceSilently: old to: new]]. "This is text replacement and can be wrong"! Item was removed: - ----- Method: DeepCopier>>newUniClasses (in category 'like fullCopy') ----- - newUniClasses - "If false, all new Players are merely siblings of the old players" - - ^ newUniClasses! Item was removed: - ----- Method: DeepCopier>>newUniClasses: (in category 'like fullCopy') ----- - newUniClasses: newVal - "If false, all new players are merely siblings of the old players" - - newUniClasses := newVal! Item was removed: - ----- Method: DeepCopier>>uniClasses (in category 'like fullCopy') ----- - uniClasses - ^uniClasses! Item was removed: - ----- Method: NativeImageSegment>>findRogueRootsAllMorphs: (in category 'testing') ----- - findRogueRootsAllMorphs: rootArray - "This is a tool to track down unwanted pointers into the segment. If we don't deal with these pointers, the segment turns out much smaller than it should. These pointers keep a subtree of objects out of the segment. - 1) assemble all objects should be in seg: morph tree, presenter, scripts, player classes, metaclasses. Put in a Set. - 2) Remove the roots from this list. Ask for senders of each. Of the senders, forget the ones that are in the segment already. Keep others. The list is now all the 'incorrect' pointers into the segment." - - | inSeg testRoots scriptEditors pointIn wld xRoots | - Smalltalk garbageCollect. - inSeg := IdentitySet new: 200. - arrayOfRoots := rootArray. - (testRoots := self rootsIncludingPlayers) ifNil: [testRoots := rootArray]. - testRoots do: - [:obj | - (obj isKindOf: Project) - ifTrue: - [inSeg add: obj. - wld := obj world. - inSeg add: wld presenter]. - (obj isKindOf: Presenter) ifTrue: [inSeg add: obj]]. - xRoots := wld ifNil: [testRoots] ifNotNil: [testRoots , (Array with: wld)]. - xRoots do: - [:obj | - "root is a project" - - obj isMorph - ifTrue: - [obj allMorphs do: - [:mm | - inSeg add: mm. - mm player ifNotNil: [inSeg add: mm player]]. - obj isWorldMorph ifTrue: [inSeg add: obj presenter]]]. - scriptEditors := IdentitySet new. - inSeg do: - [:obj | - obj isPlayerLike - ifTrue: - [scriptEditors addAll: (obj class tileScriptNames - collect: [:nn | obj scriptEditorFor: nn])]]. - scriptEditors do: [:se | inSeg addAll: se allMorphs]. - testRoots do: [:each | inSeg remove: each ifAbsent: []]. - "want them to be pointed at from outside" - pointIn := IdentitySet new: 400. - inSeg do: [:ob | pointIn addAll: (Utilities pointersTo: ob except: inSeg)]. - testRoots do: [:each | pointIn remove: each ifAbsent: []]. - pointIn remove: inSeg array ifAbsent: []. - pointIn remove: pointIn array ifAbsent: []. - inSeg do: - [:obj | - obj isMorph - ifTrue: - [pointIn remove: (obj instVarAt: 3) - ifAbsent: - ["submorphs" - - ]. - "associations in extension" - pointIn remove: obj extension ifAbsent: []. - obj extension ifNotNil: - [obj extension otherProperties ifNotNil: - [obj extension otherProperties associationsDo: - [:ass | - pointIn remove: ass ifAbsent: [] - "*** and extension actorState" - "*** and ActorState instantiatedUserScriptsDictionary ScriptInstantiations"]]]]. - obj isPlayerLike - ifTrue: [obj class scripts values do: [:us | pointIn remove: us ifAbsent: []]]]. - "*** presenter playerlist" - self halt: 'Examine local variables pointIn and inSeg'. - ^pointIn! Item was removed: - ----- Method: NativeImageSegment>>rootsIncludingPlayers (in category 'read/write segment') ----- - rootsIncludingPlayers - "Return a new roots array with more objects. (Caller should store into rootArray.) Player (non-systemDefined) gets its class and metaclass put into the Roots array. Then ask for the segment again." - - | extras havePresenter players morphs existing | - userRootCnt ifNil: [userRootCnt := arrayOfRoots size]. - extras := OrderedCollection new. - arrayOfRoots do: [:root | - (root isKindOf: Presenter) ifTrue: [havePresenter := root]. - (root isKindOf: PasteUpMorph) ifTrue: [ - root isWorldMorph ifTrue: [havePresenter := root presenter]]. - (root isKindOf: Project) ifTrue: [havePresenter := root world presenter]]. - havePresenter ifNotNil: [ - havePresenter flushPlayerListCache. "old and outside guys" - morphs := IdentitySet new: 400. - havePresenter associatedMorph allMorphsAndBookPagesInto: morphs. - players := (morphs select: [:m | m player ~~ nil] - thenCollect: [:m | m player]) asArray. - players := players select: [:ap | (arrayOfRoots includes: ap class) not - & (ap class isSystemDefined not)]. - extras addAll: (players collect: [:each | each class]). - extras addAll: (players collect: [:each | each class class]). - extras addAll: morphs. "Make then ALL roots!!" - ]. - existing := arrayOfRoots asIdentitySet. - extras := extras reject: [ :each | existing includes: each]. - extras isEmpty ifTrue: [^ nil]. "no change" - - havePresenter := players := morphs := nil. - ^ arrayOfRoots, extras "will contain multiples of some, but reduced later"! Item was removed: - ----- Method: NativeImageSegment>>savePlayerReferences: (in category 'read/write segment') ----- - savePlayerReferences: dictOfAllObjects - | save world | - "Save our associations we own in the shared References table. They will be installed when the segment is imported." - - save := OrderedCollection new. - References associationsDo: [:assoc | - (dictOfAllObjects includesKey: assoc) ifTrue: [save add: assoc]]. - 1 to: 5 do: [:ii | ((arrayOfRoots at: ii) respondsTo: #isCurrentProject) ifTrue: [ - world := (arrayOfRoots at: ii) world]]. - world setProperty: #References toValue: save. - "assume it is not refed from outside and will be traced"! Item was removed: - ----- Method: Preferences class>>annotationEditingWindow (in category 'support - misc') ----- - annotationEditingWindow - "Answer a window affording editing of annotations" - | aPanel ins outs current aWindow aButton info standardHeight standardWidth | - standardHeight := 200. - standardWidth := (2 sqrt reciprocal * standardHeight) rounded. - Smalltalk isMorphic - ifFalse: [self error: 'annotations can be edited only in morphic']. - aPanel := AlignmentMorph newRow extent: 2 * standardWidth @ standardHeight. - ins := AlignmentMorph newColumn extent: standardWidth @ standardHeight. - ins color: Color green muchLighter. - ins enableDrop: true; - beSticky. - outs := AlignmentMorph newColumn extent: standardWidth @ standardHeight. - outs color: Color red muchLighter. - outs enableDrop: true; - beSticky. - aPanel addMorph: outs; - addMorphFront: ins. - outs position: ins position + (standardWidth @ 0). - current := self defaultAnnotationRequests. - info := self annotationInfo. - current - do: [:sym | | pair aMorph | - pair := info - detect: [:aPair | aPair first == sym]. - aMorph := StringMorph new contents: pair first. - aMorph setBalloonText: pair last. - aMorph enableDrag: true. - aMorph - on: #startDrag - send: #startDrag:with: - to: aMorph. - ins addMorphBack: aMorph]. - info - do: [:aPair | (current includes: aPair first) - ifFalse: [| aMorph | - aMorph := StringMorph new contents: aPair first. - aMorph setBalloonText: aPair last. - aMorph enableDrag: true. - aMorph - on: #startDrag - send: #startDrag:with: - to: aMorph. - outs addMorph: aMorph]]. - aPanel layoutChanged. - aWindow := SystemWindowWithButton new setLabel: 'Annotations'. - aButton := SimpleButtonMorph new target: Preferences; - actionSelector: #acceptAnnotationsFrom:; - - arguments: (Array with: aWindow); - label: 'apply'; - borderWidth: 0; - borderColor: Color transparent; - color: Color transparent. - aButton submorphs first color: Color blue. - aButton setBalloonText: 'After moving all the annotations you want to the left (green) side, and all the ones you do NOT want to the right (pink) side, hit this "apply" button to have your choices take effect.'. - aWindow buttonInTitle: aButton; - adjustExtraButton. - ^ aPanel wrappedInWindow: aWindow"Preferences annotationEditingWindow openInHand"! Item was removed: - ----- Method: Preferences class>>automaticViewerPlacement (in category 'standard queries') ----- - automaticViewerPlacement - ^ self - valueOfFlag: #automaticViewerPlacement - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>batchPenTrails (in category 'standard queries') ----- - batchPenTrails - ^ self - valueOfFlag: #batchPenTrails - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>capitalizedReferences (in category 'standard queries') ----- - capitalizedReferences - ^ self - valueOfFlag: #capitalizedReferences - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>cautionBeforeClosing (in category 'standard queries') ----- - cautionBeforeClosing - ^ self - valueOfFlag: #cautionBeforeClosing - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>chooseEToysFont (in category 'prefs - fonts') ----- - chooseEToysFont - "present a menu with the possible fonts for the eToys" - self - chooseFontWithPrompt: 'eToys font...' translated - andSendTo: self - withSelector: #setEToysFontTo: - highlightSelector: #standardEToysFont! Item was removed: - ----- Method: Preferences class>>chooseEToysTitleFont (in category 'prefs - fonts') ----- - chooseEToysTitleFont - "present a menu with the possible fonts for the eToys" - self - chooseFontWithPrompt: 'eToys Title font...' translated - andSendTo: self - withSelector: #setEToysTitleFontTo: - highlightSelector: #standardEToysTitleFont! Item was removed: - ----- Method: Preferences class>>classicTilesSettingToggled (in category 'updating - system') ----- - classicTilesSettingToggled - "The current value of the largeTiles flag has changed; now react" - - Smalltalk isMorphic ifTrue: - [Preferences universalTiles - ifFalse: - [self inform: - 'note that this will only have a noticeable - effect if the universalTiles preference is - set to true, which it currently is not' translated] - ifTrue: - [Project current world recreateScripts]]! Item was removed: - ----- Method: Preferences class>>compactViewerFlaps (in category 'standard queries') ----- - compactViewerFlaps - ^ self - valueOfFlag: #compactViewerFlaps - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>debugMenuItemsInvokableFromScripts (in category 'prefs - misc') ----- - debugMenuItemsInvokableFromScripts - "If true, then items occurring in an object's debug menu will be included in the alternatives offered as arguments to a doMenuItem: tile in the scripting system" - ^ false! Item was removed: - ----- Method: Preferences class>>defaultPaintingExtent (in category 'prefs - misc') ----- - defaultPaintingExtent - "Answer the preferred size for the onion-skin paint area when launching a new painting within a paste-up morph. Feel free to change the parameters to suit your configuration." - - ^ 800 @ 600! Item was removed: - ----- Method: Preferences class>>dropProducesWatcher (in category 'standard queries') ----- - dropProducesWatcher - ^ self - valueOfFlag: #dropProducesWatcher - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>eToyFriendly (in category 'standard queries') ----- - eToyFriendly - ^ self - valueOfFlag: #eToyFriendly - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>eToyFriendlyChanged (in category 'updating - system') ----- - eToyFriendlyChanged - "The eToyFriendly preference changed; React" - - ScriptingSystem customizeForEToyUsers: Preferences eToyFriendly! Item was removed: - ----- Method: Preferences class>>eToyLoginEnabled (in category 'standard queries') ----- - eToyLoginEnabled - ^ self - valueOfFlag: #eToyLoginEnabled - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>editAnnotations (in category 'support - misc') ----- - editAnnotations - "Put up a window that allows the user to edit annotation specifications" - - | aWindow | - self currentWorld addMorphCentered: (aWindow := self annotationEditingWindow). - aWindow beKeyWindow. - - "Preferences editAnnotations" - - ! Item was removed: - ----- Method: Preferences class>>enableLocalSave (in category 'standard queries') ----- - enableLocalSave - ^ self - valueOfFlag: #enableLocalSave - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>expandedPublishing (in category 'standard queries') ----- - expandedPublishing - ^ self - valueOfFlag: #expandedPublishing - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>fenceEnabled (in category 'standard queries') ----- - fenceEnabled - ^ self - valueOfFlag: #fenceEnabled - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>fenceSoundEnabled (in category 'standard queries') ----- - fenceSoundEnabled - ^ self - valueOfFlag: #fenceSoundEnabled - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>fenceSoundEnabled: (in category 'standard queries') ----- - fenceSoundEnabled: aBoolean - self setPreference: #fenceSoundEnabled toValue: aBoolean! Item was removed: - ----- Method: Preferences class>>haloTransitions (in category 'standard queries') ----- - haloTransitions - ^ self - valueOfFlag: #haloTransitions - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>includeSoundControlInNavigator (in category 'standard queries') ----- - includeSoundControlInNavigator - ^ self - valueOfFlag: #includeSoundControlInNavigator - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>keepTickingWhilePainting (in category 'standard queries') ----- - keepTickingWhilePainting - ^ self - valueOfFlag: #keepTickingWhilePainting - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>largeTilesSettingToggled (in category 'updating - system') ----- - largeTilesSettingToggled - "The current value of the largeTiles flag has changed; now react" - - Smalltalk isMorphic ifTrue: - [Preferences universalTiles - ifFalse: - [self inform: - 'note that this will only have a noticeable - effect if the universalTiles preference is - set to true, which it currently is not' translated] - ifTrue: - [Project current world recreateScripts]]! Item was removed: - ----- Method: Preferences class>>magicHalos (in category 'standard queries') ----- - magicHalos - ^ self - valueOfFlag: #magicHalos - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>menuColorFromWorld (in category 'standard queries') ----- - menuColorFromWorld - ^ self - valueOfFlag: #menuColorFromWorld - ifAbsent: [true - "success"]! Item was removed: - ----- Method: Preferences class>>menuColorString (in category 'support - misc') ----- - menuColorString - ^ ((self valueOfFlag: #menuColorFromWorld) - ifTrue: ['stop menu-color-from-world'] - ifFalse: ['start menu-color-from-world']) translated! Item was removed: - ----- Method: Preferences class>>messengersInViewers (in category 'prefs - misc') ----- - messengersInViewers - "A coming technology..." - - ^ false! Item was removed: - ----- Method: Preferences class>>mouseOverHalos (in category 'standard queries') ----- - mouseOverHalos - ^ self - valueOfFlag: #mouseOverHalos - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>mouseOverHalosChanged (in category 'updating - system') ----- - mouseOverHalosChanged - Project current world wantsMouseOverHalos: self mouseOverHalos! Item was removed: - ----- Method: Preferences class>>mvcProjectsAllowed (in category 'standard queries') ----- - mvcProjectsAllowed - ^ self - valueOfFlag: #mvcProjectsAllowed - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>navigatorOnLeftEdge (in category 'standard queries') ----- - navigatorOnLeftEdge - ^ self - valueOfFlag: #navigatorOnLeftEdge - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>noviceMode (in category 'standard queries') ----- - noviceMode - ^ self - valueOfFlag: #noviceMode - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>noviceModeSettingChanged (in category 'updating - system') ----- - noviceModeSettingChanged - "The current value of the noviceMode flag has changed; - now react" - TheWorldMainDockingBar updateInstances. - PasteUpMorph allSubInstances - select: [:each | each isWorldMorph] - thenDo: [:each | each initializeDesktopCommandKeySelectors]. - Smalltalk at: #ParagraphEditor ifPresent: [:aClass| aClass initialize]! Item was removed: - ----- Method: Preferences class>>okToReinitializeFlaps (in category 'standard queries') ----- - okToReinitializeFlaps - ^ self - valueOfFlag: #okToReinitializeFlaps - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>oliveHandleForScriptedObjects (in category 'standard queries') ----- - oliveHandleForScriptedObjects - ^ self - valueOfFlag: #oliveHandleForScriptedObjects - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>propertySheetFromHalo (in category 'standard queries') ----- - propertySheetFromHalo - ^ self - valueOfFlag: #propertySheetFromHalo - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>selectiveHalos (in category 'standard queries') ----- - selectiveHalos - ^ self - valueOfFlag: #selectiveHalos - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>setEToysFontTo: (in category 'prefs - fonts') ----- - setEToysFontTo: aFont - "change the font used in eToys environment" - - UserInterfaceTheme setFont: #eToysFont to: aFont.! Item was removed: - ----- Method: Preferences class>>setEToysTitleFontTo: (in category 'prefs - fonts') ----- - setEToysTitleFontTo: aFont - "change the font used in eToys environment" - - UserInterfaceTheme setFont: #eToysTitleFont to: aFont.! Item was removed: - ----- Method: Preferences class>>showAdvancedNavigatorButtons (in category 'standard queries') ----- - showAdvancedNavigatorButtons - ^ self - valueOfFlag: #showAdvancedNavigatorButtons - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>showFlapsWhenPublishing (in category 'standard queries') ----- - showFlapsWhenPublishing - ^ self - valueOfFlag: #showFlapsWhenPublishing - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>simpleMenus (in category 'standard queries') ----- - simpleMenus - ^ self - valueOfFlag: #simpleMenus - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>standardEToysFont (in category 'prefs - fonts') ----- - standardEToysFont - - ^ (UserInterfaceTheme current get: #eToysFont) - ifNil: [self standardButtonFont]! Item was removed: - ----- Method: Preferences class>>standardEToysTitleFont (in category 'prefs - fonts') ----- - standardEToysTitleFont - - ^ (UserInterfaceTheme current get: #eToysTitleFont) - ifNil: [self standardEToysFont]! Item was removed: - ----- Method: Preferences class>>tabAmongFields (in category 'standard queries') ----- - tabAmongFields - ^ self - valueOfFlag: #tabAmongFields - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>tileTranslucentDrag (in category 'standard queries') ----- - tileTranslucentDrag - ^ self - valueOfFlag: #tileTranslucentDrag - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>typeCheckingInTileScripting (in category 'standard queries') ----- - typeCheckingInTileScripting - ^ self - valueOfFlag: #typeCheckingInTileScripting - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>uniTilesClassic (in category 'standard queries') ----- - uniTilesClassic - ^ self - valueOfFlag: #uniTilesClassic - ifAbsent: [ true ]! Item was removed: - ----- Method: Preferences class>>universalTiles (in category 'standard queries') ----- - universalTiles - ^ self - valueOfFlag: #universalTiles - ifAbsent: [false]! Item was removed: - ----- Method: Preferences class>>universalTilesSettingToggled (in category 'updating - system') ----- - universalTilesSettingToggled - "The current value of the universalTiles flag has changed; now react" - - (self preferenceAt: #universalTiles ifAbsent: [^ self]) localToProject ifFalse: - [^ self inform: - 'This is troubling -- you may regret having done that, because - the change will apply to *all projects*, including pre-existing ones. Unfortunately this check is done after the damage is done, so you - may be hosed. Fortunately, however, you can simply reverse your choice right now and perhaps no deep damage will have been done.']. - - self universalTiles "User just switched project to classic tiles" - ifFalse: - [self inform: - 'CAUTION -- if you had any scripted objects in - this project that already used universal tiles, - there is no reasonable way to go back to classic - tiles. Recommended course of action in that case: - just toggle this preference right back to true.'] - ifTrue: - [Preferences capitalizedReferences ifFalse: - [Preferences enable: #capitalizedReferences. - self inform: - 'Note that the "capitalizedReferences" flag - has now been automatically set to true for - you, since this is required for the use of - universal tiles.']. - Project current isMorphic ifTrue: - [Project current world recreateScripts]]! Item was removed: - ----- Method: Preferences class>>unlimitedPaintArea (in category 'standard queries') ----- - unlimitedPaintArea - ^ self - valueOfFlag: #unlimitedPaintArea - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>useCategoryListsInViewers (in category 'prefs - misc') ----- - useCategoryListsInViewers - "Temporarily hard-coded pending viewer work underway" - ^ false! Item was removed: - ----- Method: Preferences class>>useVectorVocabulary (in category 'standard queries') ----- - useVectorVocabulary - ^ self - valueOfFlag: #useVectorVocabulary - ifAbsent: [ false ]! Item was removed: - ----- Method: Preferences class>>vectorVocabularySettingChanged (in category 'updating - system') ----- - vectorVocabularySettingChanged - "The current value of the useVectorVocabulary flag has changed; now react. No senders, but invoked by the Preference object associated with the #useVectorVocabulary preference." - - Smalltalk isMorphic ifFalse: [^ self]. - Project current world makeVectorUseConformToPreference.! Item was removed: - ----- Method: Preferences class>>viewersInFlaps (in category 'standard queries') ----- - viewersInFlaps - ^ self - valueOfFlag: #viewersInFlaps - ifAbsent: [ true ]! Item was removed: - ----- Method: Project class>>publishInSexp (in category 'preferences') ----- - publishInSexp - - ^ (Smalltalk classNamed: 'SISSDictionaryForScanning') - ifNil: [false] - ifNotNil: [:siss | siss publishInSexp]! Item was removed: - ----- Method: Project>>restoreReferences (in category 'file in/out') ----- - restoreReferences - - | refs newPool | - refs := world valueOfProperty: #References ifAbsent: [nil]. - (refs isMemberOf: OrderedCollection) ifTrue: [ - world removeProperty: #References. - newPool := world referencePool. - refs do: [:assoc | newPool add: assoc]. - ]. - ! Item was removed: - ----- Method: ProjectLauncher>>cancelLogin (in category 'eToy login') ----- - cancelLogin - "This is fine - we just proceed here. Later we may do something utterly different ;-)" - ^self proceedWithLogin! Item was removed: - ----- Method: ProjectLauncher>>doEtoyLogin (in category 'eToy login') ----- - doEtoyLogin - "Pop up the eToy login if we have a server that provides us with a known user list" - - "Find us a server who could do eToy authentification for us" - eToyAuthentificationServer := - (ServerDirectory localProjectDirectories, ServerDirectory servers values) - detect:[:any| any hasEToyUserList] - ifNone:[nil]. - eToyAuthentificationServer "no server provides user information" - ifNil:[^self startUpAfterLogin]. - self prepareForLogin. - (Smalltalk at: #EtoyLoginMorph ifAbsent:[^self cancelLogin]) - loginAndDo:[:userName| self loginAs: userName] - ifCanceled:[self cancelLogin]. - ! Item was removed: - ----- Method: ProjectLauncher>>loginAs: (in category 'eToy login') ----- - loginAs: userName - "Assuming that we have a valid user url; read its contents and see if the user is really there." - | actualName userList | - eToyAuthentificationServer ifNil:[ - self proceedWithLogin. - ^true]. - userList := eToyAuthentificationServer eToyUserList. - userList ifNil:[ - self inform: - 'Sorry, I cannot find the user list. - (this may be due to a network problem) - Please hit Cancel if you wish to use Squeak.' translated. - ^false]. - "case insensitive search" - actualName := userList detect:[:any| any sameAs: userName] ifNone:[nil]. - actualName isNil ifTrue:[ - self inform: 'Unknown user: ' translated ,userName. - ^false]. - Utilities authorName: actualName. - eToyAuthentificationServer eToyUserName: actualName. - self proceedWithLogin. - ^true! Item was removed: - ----- Method: ProjectLauncher>>prepareForLogin (in category 'eToy login') ----- - prepareForLogin - "Prepare for login - e.g., hide everything so only the login morph is visible." - | world | - world := Project current world. - world submorphsDo:[:m| - m isLocked ifFalse:[m hide]]. "hide all those guys" - world displayWorldSafely. - ! Item was removed: - ----- Method: ProjectLauncher>>proceedWithLogin (in category 'eToy login') ----- - proceedWithLogin - eToyAuthentificationServer := nil. - Project current world submorphsDo:[:m| m show]. - WorldState addDeferredUIMessage: [self startUpAfterLogin].! Item was removed: - ----- Method: ProjectLauncher>>startUpAfterLogin (in category 'running') ----- - startUpAfterLogin - | scriptName loader isUrl | - self setupFlaps. - Smalltalk firstArgMightBeDocument - ifTrue: [scriptName := Smalltalk documentPath. - scriptName := scriptName convertFromSystemString. - scriptName isEmpty - ifFalse: ["figure out if script name is a URL by itself" - isUrl := (scriptName asLowercase beginsWith: 'http://') - or: [(scriptName asLowercase beginsWith: 'file://') - or: [scriptName asLowercase beginsWith: 'ftp://']]. - isUrl - ifFalse: [| encodedPath pathTokens | - "Allow for ../dir/scriptName arguments" - pathTokens := scriptName splitBy: FileDirectory slash. - pathTokens := pathTokens - collect: [:s | s encodeForHTTP]. - encodedPath := pathTokens - reduce: [:acc :each | acc , FileDirectory slash , each]. - scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] - ifFalse: [scriptName := '']. - scriptName isEmptyOrNil - ifTrue: [^ Preferences eToyFriendly - ifTrue: [self currentWorld addGlobalFlaps]]. - loader := CodeLoader new. - loader - loadSourceFiles: (Array with: scriptName). - (scriptName asLowercase endsWith: '.pr') - ifTrue: [self installProjectFrom: loader] - ifFalse: [loader installSourceFiles]!

1 0

The Trunk: Tests-dtl.502.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-dtl.502.mcz ==================== Summary ==================== Name: Tests-dtl.502 Author: dtl Time: 25 November 2023, 3:00:09.415683 pm UUID: 43f664b8-4d13-4dfd-8a6c-08aff54d4454 Ancestors: Tests-mt.501 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against Tests-mt.501 =============== Item was removed: - ----- Method: PackageDependencyTest>>testEtoys (in category 'tests') ----- - testEtoys - "Etoys clean-up is to be done for the after 5.2 release --pre" - - self testPackage: #EToys dependsExactlyOn: #( - Balloon - #'Chronology-Core' - Collections - Compiler - Compression - Files - Graphics - Kernel - Morphic - MorphicExtras - Multilingual - Network - Protocols - SUnit - System - #'ToolBuilder-Kernel' - Tools - ).!

1 0

The Trunk: Tools-dtl.1240.mcz
by commits＠source.squeak.org 25 Nov '23

25 Nov '23

David T. Lewis uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-dtl.1240.mcz ==================== Summary ==================== Name: Tools-dtl.1240 Author: dtl Time: 25 November 2023, 3:00:44.687355 pm UUID: 2e9ba404-07c3-423a-8f5a-000907dbefc3 Ancestors: Tools-ct.1239 Move methods to Etoys if they are referenced only by the full Etoys image, based on Marcel's unload-etoys.33.cs Etoys removal script. Reference squeak-dev 29-Aug-2023 Let's discuss the future of Etoys in Squeak 6.1 (and beyond) =============== Diff against Tools-ct.1239 =============== Item was removed: - PluggableTextMorph subclass: #BrowserCommentTextMorph - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Browser'! - - !BrowserCommentTextMorph commentStamp: '<historical>' prior: 0! - I am a PluggableTextMorph that knows enough to make myself invisible when necessary.! Item was removed: - ----- Method: BrowserCommentTextMorph>>hideOrShowPane (in category 'displaying') ----- - hideOrShowPane - (self model editSelection == #editClass) - ifTrue: [ self showPane ] - ifFalse: [ self hidePane ]! Item was removed: - ----- Method: BrowserCommentTextMorph>>hidePane (in category 'displaying') ----- - hidePane - | win | - self window ifNotNil: [:window | window removePaneSplitters]. - - self lowerPane ifNotNil: - [ :lp | - lp layoutFrame bottomFraction: self layoutFrame bottomFraction. - lp layoutFrame bottomOffset: SystemWindow borderWidth negated]. - win := self window ifNil: [ ^self ]. - self delete. - win updatePanesFromSubmorphs. - win addPaneSplitters! Item was removed: - ----- Method: BrowserCommentTextMorph>>lowerPane (in category 'accessing') ----- - lowerPane - "Answer the AlignmentMorph that I live beneath" - ^self valueOfProperty: #browserLowerPane! Item was removed: - ----- Method: BrowserCommentTextMorph>>noteNewOwner: (in category 'updating') ----- - noteNewOwner: win - super noteNewOwner: win. - self setProperty: #browserWindow toValue: win. - win ifNil: [ ^self ]. - win setProperty: #browserClassCommentPane toValue: self. - self setProperty: #browserLowerPane - toValue: (win submorphThat: [ :m | - m isAlignmentMorph - and: [ m layoutFrame bottomFraction notNil - and: [ m layoutFrame bottomFraction >= self layoutFrame topFraction ]]] - ifNone: [])! Item was removed: - ----- Method: BrowserCommentTextMorph>>showPane (in category 'displaying') ----- - showPane - owner ifNil: [ - | win | - win := self window ifNil: [ ^self ]. - win addMorph: self fullFrame: self layoutFrame. - win updatePanesFromSubmorphs ]. - - self lowerPane ifNotNil: [ :lp | lp layoutFrame bottomFraction: self layoutFrame topFraction ]. - - self window ifNotNil: [:win | win addPaneSplitters]! Item was removed: - ----- Method: BrowserCommentTextMorph>>update: (in category 'updating') ----- - update: anAspect - super update: anAspect. - anAspect == #editSelection ifFalse: [ ^self ]. - self hideOrShowPane! Item was removed: - ----- Method: BrowserCommentTextMorph>>window (in category 'accessing') ----- - window - ^self owner ifNil: [ self valueOfProperty: #browserWindow ].! Item was removed: - ----- Method: ChangeList>>buildMorphicCodePaneWith: (in category 'menu actions') ----- - buildMorphicCodePaneWith: editString - - | codePane | - - codePane := AcceptableCleanTextMorph - on: self - text: #contents - accept: #contents: - readSelection: #contentsSelection - menu: #codePaneMenu:shifted:. - codePane font: Preferences standardCodeFont. - editString ifNotNil: [ - codePane editString: editString. - codePane hasUnacceptedEdits: true - ]. - ^codePane - ! Item was removed: - ----- Method: CodeHolder>>installTextualCodingPane (in category 'diffs') ----- - installTextualCodingPane - "Install text into the code pane" - - | aWindow codePane aPane boundsToUse | - (aWindow := self containingWindow) ifNil: [self error: 'where''s that window?']. - codePane := self codeTextMorph ifNil: [self error: 'no code pane']. - aPane := self buildMorphicCodePaneWith: nil. - boundsToUse := (codePane bounds origin- (1@1)) corner: (codePane owner bounds corner " (1@1"). - aWindow replacePane: codePane with: aPane. - aPane vResizing: #spaceFill; hResizing: #spaceFill; borderWidth: 0. - aPane bounds: boundsToUse. - aPane owner clipSubmorphs: false. - - self contentsChanged! Item was removed: - ----- Method: CodeHolder>>restoreTextualCodingPane (in category 'diffs') ----- - restoreTextualCodingPane - "If the receiver is showing tiles, restore the textual coding pane" - - contentsSymbol == #tiles ifTrue: - [contentsSymbol := #source. - self installTextualCodingPane]! Item was removed: - ----- Method: Inspector>>addEtoysItemsTo: (in category 'menu - construction') ----- - addEtoysItemsTo: aMenu - - aMenu addLine; addTranslatedList: { - { 'tile for this value (t)'. [self selectionOrObject tearOffTile] }. - { 'viewer for this value (v)'. [self selectionOrObject beViewed] }}.! Item was removed: - CodeHolder subclass: #MethodHolder - instanceVariableNames: 'methodClass methodSelector' - classVariableNames: '' - poolDictionaries: '' - category: 'Tools-Base'! Item was removed: - ----- Method: MethodHolder>>addModelMenuItemsTo:forMorph:hand: (in category 'menu') ----- - addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph - aCustomMenu addLine. - aCustomMenu add: 'whose script is this?' translated target: self action: #identifyScript - ! Item was removed: - ----- Method: MethodHolder>>changeMethodSelectorTo: (in category 'miscellaneous') ----- - changeMethodSelectorTo: aSelector - "Change my method selector as noted. Reset currentCompiledMethod" - - methodSelector := aSelector. - currentCompiledMethod := methodClass compiledMethodAt: aSelector ifAbsent: [nil]! Item was removed: - ----- Method: MethodHolder>>compiledMethod (in category 'miscellaneous') ----- - compiledMethod - - ^ methodClass compiledMethodAt: methodSelector! Item was removed: - ----- Method: MethodHolder>>contents (in category 'contents') ----- - contents - "Answer the contents, with due respect for my contentsSymbol" - - contents := methodClass sourceCodeAt: methodSelector ifAbsent: ['']. - currentCompiledMethod := methodClass compiledMethodAt: methodSelector ifAbsent: [nil]. - - self showingDecompile ifTrue: [^ self decompiledSourceIntoContents]. - self showingDocumentation ifTrue: [^ self commentContents]. - ^ contents := self sourceStringPrettifiedAndDiffed asText makeSelectorBoldIn: methodClass! Item was removed: - ----- Method: MethodHolder>>contents:notifying: (in category 'contents') ----- - contents: input notifying: aController - | selector | - (selector := methodClass newParser parseSelector: input asText) ifNil: - [self inform: 'Sorry - invalid format for the - method name and arguments -- cannot accept.'. - ^ false]. - - selector == methodSelector ifFalse: - [self inform: - 'You cannot change the name of - the method here -- it must continue - to be ', methodSelector. - ^ false]. - - selector := methodClass - compile: input asText - classified: self selectedMessageCategoryName - notifying: aController. - selector == nil ifTrue: [^ false]. - contents := input asString copy. - currentCompiledMethod := methodClass compiledMethodAt: methodSelector. - ^ true! Item was removed: - ----- Method: MethodHolder>>identifyScript (in category 'miscellaneous') ----- - identifyScript - | msg aPlayer | - msg := methodClass isUniClass - ifTrue: - [aPlayer := methodClass someInstance. - aPlayer costume - ifNotNil: - ['This holds code for a script - named ', methodSelector, ' belonging - to an object named ', aPlayer externalName] - ifNil: - ['This formerly held code for a script - named ', methodSelector, ' for a Player - who once existed but now is moribund.']] - ifFalse: - ['This holds code for the method - named ', methodSelector, ' - for class ', methodClass name]. - self inform: msg! Item was removed: - ----- Method: MethodHolder>>methodClass:methodSelector: (in category 'miscellaneous') ----- - methodClass: aClass methodSelector: aSelector - methodClass := aClass. - methodSelector := aSelector. - currentCompiledMethod := aClass compiledMethodAt: aSelector ifAbsent: [nil]! Item was removed: - ----- Method: MethodHolder>>selectedClass (in category 'selection') ----- - selectedClass - ^ methodClass theNonMetaClass! Item was removed: - ----- Method: MethodHolder>>selectedClassOrMetaClass (in category 'selection') ----- - selectedClassOrMetaClass - ^ methodClass! Item was removed: - ----- Method: MethodHolder>>selectedMessageCategoryName (in category 'selection') ----- - selectedMessageCategoryName - ^ methodClass organization categoryOfElement: methodSelector! Item was removed: - ----- Method: MethodHolder>>selectedMessageName (in category 'selection') ----- - selectedMessageName - ^ methodSelector! Item was removed: - ----- Method: MethodHolder>>versions (in category 'miscellaneous') ----- - versions - "Return a VersionsBrowser (containing a list of ChangeRecords) of older versions of this method." - - ^ VersionsBrowser new scanVersionsOf: self compiledMethod - class: self selectedClass - meta: methodClass isMeta - category: self selectedMessageCategoryName - "(classOfMethod whichCategoryIncludesSelector: selectorOfMethod)" - selector: methodSelector! Item was removed: - ----- Method: ObjectExplorer>>viewerForValue (in category 'menus - actions') ----- - viewerForValue - - self object beViewed.!

1 0

The Trunk: MonticelloConfigurations-mt.184.mcz
by commits＠source.squeak.org 24 Nov '23

24 Nov '23

Marcel Taeumel uploaded a new version of MonticelloConfigurations to project The Trunk: http://source.squeak.org/trunk/MonticelloConfigurations-mt.184.mcz ==================== Summary ==================== Name: MonticelloConfigurations-mt.184 Author: mt Time: 24 November 2023, 9:09:19.952532 am UUID: 6df77c5e-92e1-8743-9d39-54032c216486 Ancestors: MonticelloConfigurations-mt.183 Re-adds fix from ct.182 that got somehow lost in mt.183 =============== Diff against MonticelloConfigurations-mt.183 =============== Item was changed: ----- Method: MCMcmUpdater>>updateMessageFor: (in category 'private') ----- updateMessageFor: previousUpdateLevel | ciTemplate ciStamp | ciTemplate := ' CI status: <a href="{8}"><img src="{7}" /> {9}</{10}>'. ciStamp := SystemVersion current ciStatusTimestamp ifNil: [SystemVersion current isRelease ifTrue: [ciTemplate := '' "Drop outdated/unavailable CI info for releases"] ifFalse: ['(build inaccessible!!)' translated]]. ^ ('Update completed. Version: {1} Update: {3}{2} Url: <a href="{4}">{4}</{10}> Map: ''{5}''', ciTemplate, '{6}{11}' translated format: { SystemVersion current version escapeEntities. SystemVersion current highestUpdate. (previousUpdateLevel = SystemVersion current highestUpdate ifTrue: [''] ifFalse: [previousUpdateLevel asString, ' -> ']) escapeEntities. self repository escapeEntities. MCMcmUpdater updateMapName escapeEntities. SystemVersion current description ifEmpty: [''] ifNotEmpty: [:d | ' {1}' format: { d escapeEntities. Preferences standardButtonFont familyName. Preferences standardButtonFont pointSize. }]. SystemVersion current ciStatusBadgeUrl. SystemVersion current ciStatusPageUrl. ciStamp. "mt: Avoid triggering the Windows Defender. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-December/217346…" 'a'. SystemVersion current recommendedVMUpdateInfo ifNil: [''] ifNotNil: [:info | ' A newer VM is recommended ({1} -> {2})!! Visit the <a href="{3}">project page</{4}> to download it.' translated format: { + info key. + info value. - info key escapeEntities. - info value escapeEntities. SystemVersion current vmUpdateURL. 'a'. "avoid Windows Defender again" Preferences standardButtonFont familyName. Preferences standardButtonFont pointSize }] }) asTextFromHtml!

1 0

← Newer
1
2
3
4
5
6
7
8
9
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages November 2023