'From etoys2.1 of 27 August 2007 [latest update: #1566] on 27 August 2007 at 7:57:40 pm'! "Change Set: player-ref-tk Date: 27 August 2007 Author: Ted Kaehler Fixes bug that prevented the Revert feature of bookmorphs from working. The test for replacing literals in methods in Players in DeepCopier>>mapUniClasses was too strict. Factored this code out into a separate method. To revive old Projects where Revert does not work, get expanded book controls, and choose 'Save entire book for later revert'. When a Project file on the disk gets bigger and bigger, it is usually because Revert is making many new Player classes, and they are staying around. To clean a project, execute this: Player abandonUnnecessaryUniclasses. Player freeUnreferencedSubclasses. "! !DeepCopier methodsFor: 'full copy' stamp: 'tk 8/27/2007 15:11'! 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 newKey pool newP | 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 _ Player 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)]. ]. pool _ nil. "Make new entries in References and point to them." references keysDo: [:old | old isPlayerLike ifTrue: [ pool ifNil: [pool _ old costume referenceWorld referencePool]. newKey _ (newP _ references at: old) uniqueNameForReference. "now installed in References" newP costume setNameTo: newKey]]. pool ifNil: [^ self]. self mapUniClassMethods: pool.! ! !DeepCopier methodsFor: 'full copy' stamp: 'tk 8/27/2007 15:10'! mapUniClassMethods: pool "Players also refer to each other using associations in the References dictionary. Search the literals of the methods of our Players for those. There are already new entries in project-local References and point to them." | newKey newAssoc oldSelList newSelList newValue | uniClasses "values" do: [:newClass | oldSelList _ OrderedCollection new. newSelList _ OrderedCollection new. newClass selectorsDo: [:sel | (newClass compiledMethodAt: sel) literals do: [:assoc | assoc isVariableBinding ifTrue: [ newValue _ references at: assoc value ifAbsent: []. newValue ifNotNil: [ newKey _ newValue externalName asSymbol. (assoc key ~= newKey) & (pool includesKey: newKey) ifTrue: [ newAssoc _ pool associationAt: newKey. newClass methodDictionary at: sel put: (newClass compiledMethodAt: sel) clone. "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"! ! !DeepCopier reorganize! ('accessing' newUniClasses newUniClasses: references uniClasses) ('full copy' fixDependents initialize initialize: mapUniClasses mapUniClassMethods: objInMemory:) ('checking' checkBasicClasses checkClass: checkDeep checkNewTarget checkVariables intervalForChecks isItTimeToCheckVariables warnIverNotCopiedIn:sel:) !