'From etoys3.0 of 24 February 2008 [latest update: #1956] on 4 April 2008 at 3:08:13 pm'! "Change Set: narrowForgetDoIts-yo Date: 4 April 2008 Author: Yoshiki Ohshima #forgetDoIt doesn't have to be called for all classes. In the case where #DoIt or #DoItIn: method definition for a class appears in a .st file, it will be removed (as it used to be), because the change set goes through the fileInAnnouncing: method. In the case where the change set included in a project, it will be removed (as it used to be), because the change set goes through the fileInAnnouncing: method. In the case where the user actually modifies the project saving code and remove #forgetDoIts call from theirs, ImageSegment>>comeFullyUpOnReload removes it. fileInFor:announcing: is unchanged as SAR files are not of interest on XO and may have some other reasons to have #DoIt methods. " ! !ImageSegment methodsFor: 'fileIn/Out' stamp: 'yo 4/4/2008 15:04'! comeFullyUpOnReload: smartRefStream "fix up the objects in the segment that changed size. An object in the segment is the wrong size for the modern version of the class. Construct a fake class that is the old size. Replace the modern class with the old one in outPointers. Load the segment. Traverse the instances, making new instances by copying fields, and running conversion messages. Keep the new instances. Bulk forward become the old to the new. Let go of the fake objects and classes. After the install (below), arrayOfRoots is filled in. Globalize new classes. Caller may want to do some special install on certain objects in arrayOfRoots. May want to write the segment out to disk in its new form." | mapFakeClassesToReal ccFixups receiverClasses rootsToUnhiberhate myProject existing forgetDoItsClass | forgetDoItsClass _ Set new. RecentlyRenamedClasses _ nil. "in case old data hanging around" mapFakeClassesToReal _ smartRefStream reshapedClassesIn: outPointers. "Dictionary of just the ones that change shape. Substitute them in outPointers." ccFixups _ self remapCompactClasses: mapFakeClassesToReal refStrm: smartRefStream. ccFixups ifFalse: [^ self error: 'A class in the file is not compatible']. endMarker _ segment nextObject. "for enumeration of objects" endMarker == 0 ifTrue: [endMarker _ 'End' clone]. self fixCapitalizationOfSymbols. arrayOfRoots _ self loadSegmentFrom: segment outPointers: outPointers. "Can't use install. Not ready for rehashSets" mapFakeClassesToReal isEmpty ifFalse: [ self reshapeClasses: mapFakeClassesToReal refStream: smartRefStream ]. "When a Project is stored, arrayOfRoots has all objects in the project, except those in outPointers" arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: WideString) or: [importedObject isMemberOf: WideSymbol]) ifTrue: [ importedObject mutateJISX0208StringToUnicode. importedObject class = WideSymbol ifTrue: [ "self halt." Symbol hasInterned: importedObject asString ifTrue: [:multiSymbol | multiSymbol == importedObject ifFalse: [ importedObject becomeForward: multiSymbol. ]. ]. ]. ]. (importedObject isMemberOf: TTCFontSet) ifTrue: [ existing _ TTCFontSet familyName: importedObject familyName pointSize: importedObject pointSize. "supplies default" existing == importedObject ifFalse: [importedObject becomeForward: existing]. ]. ]. receiverClasses _ self restoreEndianness. "rehash sets" smartRefStream checkFatalReshape: receiverClasses. "Classes in this segment." arrayOfRoots do: [:importedObject | importedObject class class == Metaclass ifTrue: [forgetDoItsClass add: importedObject. self declare: importedObject]]. rootsToUnhiberhate := OrderedCollection new. arrayOfRoots do: [:importedObject | ((importedObject isMemberOf: ScriptEditorMorph) or: [(importedObject isKindOf: TileMorph) or: [(importedObject isKindOf: TileMorph) or: [importedObject isKindOf: CompoundTileMorph]]]) ifTrue: [ rootsToUnhiberhate add: importedObject ]. (importedObject isMemberOf: CompiledMethod) ifTrue: [ importedObject sourcePointer > 0 ifTrue: [importedObject zapSourcePointer]]. (importedObject isMemberOf: Project) ifTrue: [ myProject _ importedObject. importedObject ensureChangeSetNameUnique. Project addingProject: importedObject. importedObject restoreReferences. self dependentsRestore: importedObject. ScriptEditorMorph writingUniversalTiles: ((importedObject projectPreferenceAt: #universalTiles) ifNil: [false])]]. myProject ifNotNil: [ myProject world setProperty: #thingsToUnhibernate toValue: rootsToUnhiberhate asArray. ]. mapFakeClassesToReal isEmpty ifFalse: [ mapFakeClassesToReal keys do: [:aFake | aFake indexIfCompact > 0 ifTrue: [aFake becomeUncompact]. aFake removeFromSystemUnlogged]. SystemOrganization removeEmptyCategories]. forgetDoItsClass do: [:c | c forgetDoIts]. "^ self" ! ! !PositionableStream methodsFor: 'fileIn/Out' stamp: 'yo 4/4/2008 15:07'! fileInAnnouncing: announcement "This is special for reading expressions from text that has been formatted with exclamation delimitors. The expressions are read and passed to the Compiler. Answer the result of compilation. Put up a progress report with the given announcement as the title." | val chunk classes reader | classes := Set new. classes add: UndefinedObject; add: ObjectScanner. announcement displayProgressAt: Sensor cursorPoint from: 0 to: self size during: [:bar | [self atEnd] whileFalse: [bar value: self position. self skipSeparators. [val := (self peekFor: $!!) ifTrue: [ reader := Compiler evaluate: self nextChunk logged: false. (reader isMemberOf: ClassCategoryReader) ifTrue: [classes add: reader theClass]. reader scanFrom: self] ifFalse: [chunk := self nextChunk. self checkForPreamble: chunk. Compiler evaluate: chunk logged: true]] on: InMidstOfFileinNotification do: [:ex | ex resume: true]. self skipStyleChunk]. self close]. "Note: The main purpose of this banner is to flush the changes file." SmalltalkImage current logChange: '----End fileIn of ' , self name , '----'. classes do: [:c | c forgetDoIts]. ^val! !