'From Squeak3.3alpha of 30 January 2002 [latest update: #4881] on 9 June 2002 at 12:40:37 am'! "Change Set: ModuleAdditions Date: 9 June 2002 Author: Daniel Vainsencher A few collected utility methods I found useful. A simple way to move classes: Celeste moveTo: aModule. A simple, useful sanity test - aModule valid. a little more paranoia in: #moveName:toModule: rounding out the iteration protocols: aModule deepClasses aModule deepGlobalReferencesDo: [:a :b :c | block] "! !Class methodsFor: 'module changing' stamp: 'dvf 6/9/2002 00:25'! moveTo: aModule self module valid ifFalse: [self error: 'This class is stuck in an invalid module. Rescue it manually. Use #addAssoc:export: and then #module:. .']. aModule valid ifFalse: [self error: 'target module is invalid, I am not moving.']. ^self module moveName: self name toModule: aModule! ! !Module methodsFor: 'accessing'! deepClasses "Answer a SortedCollection of all class names." | classes | classes _ OrderedCollection new. self deepClassesDo: [:class | classes add: class]. ^ classes! ! !Module methodsFor: 'testing' stamp: 'dvf 5/11/2002 22:39'! valid ^(self path first = 'stray-Module') not! ! !Module methodsFor: 'changing defined names' stamp: 'dvf 5/11/2002 22:40'! moveName: aName toModule: newModule "make sure to preserve the association for the name across the modules, as it is used in method literals" | export assoc | assoc _ self localAssocFor: aName ifAbsent: [self error: 'name not defined']. newModule valid ifFalse: [self error: 'I cant move things to ', newModule path]. export _ self exportsName: aName. self simplyRemoveName: aName. newModule addAssoc: assoc export: export. (assoc value respondsTo: #module:) ifTrue: [assoc value module: newModule]. self invalidateCaches ! ! !Module methodsFor: 'code analysis' stamp: 'dvf 6/9/2002 00:21'! deepGlobalReferencesDo: aBlock "iterate over all global references from this module, i.e. literals in CompiledMethods + superclasses of my classes. block takes global assoc, and referring class and message selector" | | self localGlobalReferencesDo: aBlock. self deepSubmodulesDo: [:mod | mod localGlobalReferencesDo: aBlock]. ! !