'From etoys3.0 of 18 March 2008 [latest update: #2059] on 30 July 2008 at 11:53:22 am'! "Change Set: MorphInFile-tk Date: 25 July 2008 Author: Ted Kaehler Fixes a bug in 'save Morph on file'. Example is saving a QuickGuide as a morph. During the scan phase when SmartRefStream writes to a DummyStream, all UserTexts had nil editors and paragraphs, meaning that they were released. These were not been recorded in 'structures'. During writing, the progress bar's displayWorld had forced a UserText to regenerate instances of MultiNewParagraph, NewParagraph, and TextLine in instance variable paragraph. They were written on the disk. Upon reading in, the classes could not be found in the structures list. This simple fix just forces those classes to be in structures."! !SmartRefStream methodsFor: 'read write' stamp: 'tk 7/25/2008 14:54'! instVarInfo: anObject "Return the object to write on the outgoing file that contains the structure of each class we are about to write out. Must be an Array whose first element is 'class structure'. Its second element is a Dictionary of pairs of the form #Rectangle -> #( 'origin' 'corner'). " "Make a pass through the objects, not writing, but recording the classes. Construct a database of their inst vars and any version info (classVersion)." | dummy refs cls newSupers | structures _ Dictionary new. superclasses _ Dictionary new. dummy _ ReferenceStream on: (DummyStream on: nil). "Write to a fake Stream, not a file" "Collect all objects" dummy rootObject: anObject. "inform him about the root" dummy nextPut: anObject. refs _ dummy references. objCount _ refs size. "for progress bar" "Note that Dictionary must not change its implementation!! If it does, how do we read this reading information?" (refs includesKey: #AnImageSegment) ifFalse: [ self uniClassInstVarsRefs: dummy. "catalog the extra objects in UniClass inst vars" refs keysDo: [:each | cls _ each class. "cls isObsolete ifTrue: [self error: 'Trying to write ', cls name]." (cls class ~~ Metaclass) & (cls isObsolete not) ifTrue: [ structures at: cls name put: false]]] ifTrue: [self recordImageSegment: refs]. "Save work by only computing inst vars once for each class" newSupers _ Set new. structures at: #Point put: false. "writeRectangle: does not put out class pointer" structures at: #Rectangle put: false. structures at: #LargePositiveInteger put: false. "used in slow case of WordArray" structures keysDo: [:nm | cls _ (nm endsWith: ' class') ifFalse: [Smalltalk at: nm] ifTrue: [(Smalltalk at: nm substrings first asSymbol) class]. cls allSuperclasses do: [:aSuper | structures at: aSuper name ifAbsent: [newSupers add: aSuper name]]]. "Don't modify structures during iteration" newSupers do: [:nm | structures at: nm put: 3]. "Get all superclasses into list" (structures includesKey: #TextMorph) ifTrue: [ "was released for dummy scan, but present during writing out." #(MultiNewParagraph NewParagraph TextLine) do: [:nnn | structures at: nnn put: 3]]. structures keysDo: [:nm | "Nothing added to classes during loop" cls _ (nm endsWith: ' class') ifFalse: [Smalltalk at: nm] ifTrue: [(Smalltalk at: nm substrings first asSymbol) class]. structures at: nm put: ((Array with: cls classVersion), (cls allInstVarNames)). superclasses at: nm ifAbsentPut: [cls superclass name]]. (refs includesKey: #AnImageSegment) ifTrue: [classInstVars _ #()] ifFalse: [self saveClassInstVars]. "of UniClassses" ^ (Array with: 'class structure' with: structures with: 'superclasses' with: superclasses)! !