[Pkg] The Trunk: System-bf.522.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Apr 11 22:30:51 UTC 2013
Bert Freudenberg uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-bf.522.mcz
==================== Summary ====================
Name: System-bf.522
Author: bf
Time: 11 April 2013, 3:29:35.918 pm
UUID: a0a9a561-1330-4df9-b47f-30d1e542c825
Ancestors: System-eem.521
* make project loading work
=============== Diff against System-eem.521 ===============
Item was changed:
----- Method: Project>>okToChange (in category 'release') -----
okToChange
"Answer whether the window in which the project is housed can be dismissed -- which is destructive. We never clobber a project without confirmation"
+ | ok is list |
self subProjects size >0 ifTrue:
[self inform:
('The project {1}
contains sub-projects. You must remove these
explicitly before removing their parent.' translated format:{self name}).
^ false].
+ ok := world isMorph not and: [world scheduledControllers size <= 1].
+ ok ifFalse: [self isMorphic ifTrue:
+ [self parent == CurrentProject
+ ifFalse: [^ true]]]. "view from elsewhere. just delete it."
+ ok := (self confirm:
+ ('Really delete the icon
+ and remove the project
+ {1} from Etoys?
+ (file will still be saved on disk)' translated format:{self name printString})).
+
+ ok ifFalse: [^ false].
- self parent == CurrentProject
- ifFalse: [^ true]. "view from elsewhere. just delete it."
- (self confirm:
- ('Really delete the project
- {1}
- and all its windows?' translated format:{self name}))
- ifFalse: [^ false].
+ world isMorph ifTrue:
+ [Smalltalk at: #WonderlandCameraMorph ifPresent:[:aClass |
+ world submorphs do: "special release for wonderlands"
+ [:m | (m isKindOf: aClass)
+ and: [m getWonderland release]]].
+ "Remove Player classes and metaclasses owned by project"
+ is := ImageSegment new arrayOfRoots: (Array with: self).
+ (list := is rootsIncludingPlayers) ifNotNil:
+ [list do: [:playerCls |
+ (playerCls respondsTo: #isMeta) ifTrue:
+ [playerCls isMeta ifFalse:
+ [playerCls removeFromSystemUnlogged]]]]].
- self prepareForDelete.
self removeChangeSetIfPossible.
"do this last since it will render project inaccessible to #allProjects and their ilk"
ProjectHistory forget: self.
Project deletingProject: self.
^ true
!
Item was changed:
----- Method: Project>>restoreReferences (in category 'file in/out') -----
restoreReferences
-
- "I just came in from an exported segment. Take all my players that were in References, and reinstall them."
+ | refs newPool |
+ refs := world valueOfProperty: #References ifAbsent: [nil].
+ (refs isMemberOf: OrderedCollection) ifTrue: [
+ world removeProperty: #References.
+ newPool := world referencePool.
+ refs do: [:assoc | newPool add: assoc].
+ ].
+ !
- "*** Note that (world valueOfProperty: #References) is temporary during loading and is not the same as the global References dictionary (in Smalltalk)."
- (world valueOfProperty: #References ifAbsent: [#()]) do: [:assoc | | key newKey extName | "just came in"
- key := assoc key.
- (References includesKey: key)
- ifTrue: ["must rename"
- extName := assoc value externalName. "what user sees"
- (References at: key) == assoc value ifTrue: [
- self error: 'why is this object already present?'].
- newKey := assoc value uniqueNameForReference.
- References removeKey: newKey.
- assoc key: newKey.
- References add: assoc. "use the known association"
-
- Preferences universalTiles
- ifTrue: [assoc value renameTo: newKey] "change names in scripts"
- ifFalse: [(assoc value renameInternal: extName) "keep externalName the same"
- ifNil: [assoc value renameTo: newKey]].
- "rename Project itself. Ignore others"
- ]
- ifFalse: [References add: assoc]].
- world removeProperty: #References.!
Item was changed:
----- Method: SmalltalkImage>>zapAllOtherProjects (in category 'shrinking') -----
zapAllOtherProjects
"Smalltalk zapAllOtherProjects"
"Note: as of this writing, the only reliable way to get rid of all but the current project is te execute the following, one line at a time...
Smalltalk zapAllOtherProjects.
ProjectHistory currentHistory initialize.
Smalltalk garbageCollect.
Project rebuildAllProjects.
"
Project allInstancesDo: [:p | p setParent: nil].
Project current setParent: Project current.
Project current isMorphic ifTrue: [ScheduledControllers := nil].
TheWorldMenu allInstancesDo: [:m | 1 to: m class instSize do: [:i | m instVarAt: i put: nil]].
ChangeSet classPool at: #AllChangeSets put: nil.
Project classPool at: #AllProjects put: nil.
ProjectHistory currentHistory initialize.
+ CommandHistory resetAllHistory.
ChangeSet initialize.
Project rebuildAllProjects. "Does a GC"
Project allProjects size > 1 ifTrue: [Project allProjects inspect]!
Item was changed:
----- Method: SmartRefStream>>initKnownRenames (in category 'read write') -----
initKnownRenames
renamed
+ at: #FlasherMorph put: #Flasher;
+ at: #AlansTextPlusMorph put: #TextPlusMorph;
+ at: #Project put: #MorphicProject;
+ at: #Presenter put: #EtoysPresenter;
+ yourself!
- at: #FlasherMorph put: #Flasher!
Item was changed:
----- Method: SmartRefStream>>mapClass:origName: (in category 'import image segment') -----
mapClass: newClass origName: originalName
"See if instances changed shape. If so, make a fake class for the old shape and return it. Remember the original class name."
| newName oldInstVars fakeClass |
newClass isMeta ifTrue: [^ newClass].
newName := newClass name.
(steady includes: newClass) & (newName == originalName) ifTrue: [^ newClass].
"instances in the segment have the right shape"
oldInstVars := structures at: originalName ifAbsent: [
self error: 'class is not in structures list']. "Missing in object file"
"Allow mapping from old to new string names"
(newName == #ByteString and:[originalName == #String]) ifTrue:[^newClass].
(newName == #WideString and:[originalName == #MultiString]) ifTrue:[^newClass].
(newName == #WideSymbol and:[originalName == #MultiSymbol]) ifTrue:[^newClass].
+ "Variable classes are not handled fully. This one is fine. --bf"
+ newName == #MethodContext ifTrue: [^newClass].
+
fakeClass := Object subclass: ('Fake37', originalName) asSymbol
instanceVariableNames: oldInstVars allButFirst
classVariableNames: ''
poolDictionaries: ''
category: 'Obsolete'.
ChangeSet current removeClassChanges: fakeClass name. "reduce clutter"
^ fakeClass
!
More information about the Packages
mailing list