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]!
packages@lists.squeakfoundation.org