'From Pharo3.0 of 18 March 2013 [Latest update: #30248] on 4 July 2013 at 5:22:08 pm'! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/4/2013 17:19'! setName: aSymbol self name: aSymbol.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/4/2013 17:19'! setName: aSymbol self name: aSymbol.! ! !TClassDescription methodsFor: 'users notification' stamp: 'SebastianTleye 7/4/2013 14:53'! notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory self users do: [:each | each noteRecategorizedSelector: element from: oldCategory to: newCategory]! ! !TClassAndTraitDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/4/2013 14:54'! notifyOfRecategorizedSelector: element from: oldCategory to: newCategory SystemAnnouncer uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self. SystemAnnouncer uniqueInstance suspendAllWhile: [self notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory].! ! !TClassAndTraitDescription methodsFor: 'organization updating' stamp: 'SebastianTleye 7/4/2013 14:54'! notifyOfRecategorizedSelector: element from: oldCategory to: newCategory SystemAnnouncer uniqueInstance selector: element recategorizedFrom: oldCategory to: newCategory inClass: self. SystemAnnouncer uniqueInstance suspendAllWhile: [self notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory].! ! !TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:04'! basicOrganization: aClassOrg ^self explicitRequirement.! ! !TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:01'! organization "Answer the instance of ClassOrganizer that represents the organization of the messages of the receiver." self basicOrganization ifNil: [ self basicOrganization: (self isTrait ifTrue: [ClassOrganization new] ifFalse: [ClassOrganization forClass: self]) ]. "Making sure that subject is set correctly. It should not be necessary." self basicOrganization ifNotNil: [ self basicOrganization setSubject: self ]. ^ self basicOrganization! ! !TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:03'! basicOrganization ^self explicitRequirement.! ! !TClassDescription methodsFor: 'users notification' stamp: 'SebastianTleye 7/4/2013 14:53'! notifyUsersOfChangedSelectors: aCollection self users do: [:each | each noteChangedSelectors: aCollection]! ! !TClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/4/2013 13:56'! instanceVariables ^self explicitRequirement.! ! !TClassDescription methodsFor: 'testing' stamp: 'SebastianTleye 7/4/2013 14:02'! isTestCase ^false! ! !TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:28'! classSide ^self theMetaClass.! ! !TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:28'! instanceSide ^ self theNonMetaClass! ! !TClassDescription methodsFor: 'pool variable' stamp: 'SebastianTleye 7/4/2013 15:23'! usesLocalPoolVarNamed: aString ^false.! ! !TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:04'! basicOrganization: aClassOrg ^self explicitRequirement.! ! !TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:01'! organization "Answer the instance of ClassOrganizer that represents the organization of the messages of the receiver." self basicOrganization ifNil: [ self basicOrganization: (self isTrait ifTrue: [ClassOrganization new] ifFalse: [ClassOrganization forClass: self]) ]. "Making sure that subject is set correctly. It should not be necessary." self basicOrganization ifNotNil: [ self basicOrganization setSubject: self ]. ^ self basicOrganization! ! !TClassDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 15:03'! basicOrganization ^self explicitRequirement.! ! !TClassDescription methodsFor: 'users notification' stamp: 'SebastianTleye 7/4/2013 14:53'! notifyUsersOfRecategorizedSelector: element from: oldCategory to: newCategory self users do: [:each | each noteRecategorizedSelector: element from: oldCategory to: newCategory]! ! !TClassDescription methodsFor: 'users notification' stamp: 'SebastianTleye 7/4/2013 14:53'! notifyUsersOfChangedSelectors: aCollection self users do: [:each | each noteChangedSelectors: aCollection]! ! !TClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/4/2013 13:56'! instanceVariables ^self explicitRequirement.! ! !TClassDescription methodsFor: 'testing' stamp: 'SebastianTleye 7/4/2013 14:02'! isTestCase ^false! ! !TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:28'! classSide ^self theMetaClass.! ! !TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:28'! instanceSide ^ self theNonMetaClass! ! !TClassDescription methodsFor: 'pool variable' stamp: 'SebastianTleye 7/4/2013 15:23'! usesLocalPoolVarNamed: aString ^false.! ! !TPureBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/4/2013 17:20'! localSelectors: aSet self basicLocalSelectors: aSet.! ! !TPureBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/4/2013 17:20'! localSelectors: aSet self basicLocalSelectors: aSet.! ! !Class methodsFor: 'private' stamp: 'SebastianTleye 7/4/2013 17:18'! name: aSymbol name := aSymbol! ! !Class methodsFor: 'private' stamp: 'SebastianTleye 7/4/2013 17:18'! name: aSymbol name := aSymbol! ! !TraitDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 14:59'! basicOrganization ^ organization ! ! !TraitDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 14:59'! basicOrganization: aClassOrg organization := aClassOrg! ! !TraitDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 14:59'! basicOrganization ^ organization ! ! !TraitDescription methodsFor: 'organization' stamp: 'SebastianTleye 7/4/2013 14:59'! basicOrganization: aClassOrg organization := aClassOrg! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! isClassTrait ^false! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! baseTrait ^ self! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! hasClassTrait ^self classTrait notNil.! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! isBaseTrait ^true! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! isClassTrait ^false! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! baseTrait ^ self! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! hasClassTrait ^self classTrait notNil.! ! !Trait methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/4/2013 14:46'! isBaseTrait ^true! ! Trait class removeSelector: #allSuperclassesFor:cache:! Trait class removeSelector: #canZapMethodDictionary! Trait class removeSelector: #doesNotIncludeInstanceOrSuperclassesFor:in:cache:! Trait class removeSelector: #fileOutPool:! Trait class removeSelector: #hasNoDependenciesFor:in:cache:! Trait class removeSelector: #hasNoDependenciesForMetaclass:in:cache:! Trait class removeSelector: #hasNoSuperclassesOf:in:cache:! Trait class removeSelector: #rootsOfTheWorld! Trait class removeSelector: #superclassOrder:! Trait class removeSelector: #template:! Trait class removeSelector: #templateForSubclassOf:category:! !Trait class reorganize! (#cleanup cleanUp) ('inquiries' rootsOfTheWorld) ('testing' canZapMethodDictionary) (#printing newTemplateIn:) ('private' hasNoDependenciesFor:in:cache:) ('fileIn/Out' doesNotIncludeInstanceOrSuperclassesFor:in:cache: superclassOrder: allSuperclassesFor:cache: fileOutPool: hasNoSuperclassesOf:in:cache: hasNoDependenciesForMetaclass:in:cache:) (#'instance creation' named:uses:category:env: new templateForSubclassOf:category: template: defaultEnvironment named:uses:category: named:) ! Trait removeSelector: #addClassVarNamed:! Trait removeSelector: #addInstVarNamed:! Trait removeSelector: #addSelector:withMethod:notifying:! Trait removeSelector: #addSelectorSilently:withMethod:! Trait removeSelector: #addSharedPool:! Trait removeSelector: #addSubclass:! Trait removeSelector: #allClassVarNames! Trait removeSelector: #allSharedPools! Trait removeSelector: #applyChangesOfNewTraitCompositionReplacing:! Trait removeSelector: #binding! Trait removeSelector: #bindingOf:! Trait removeSelector: #category! Trait removeSelector: #category:! Trait removeSelector: #classBuilder! Trait removeSelector: #classPoolFrom:! Trait removeSelector: #classVarNamed:! Trait removeSelector: #classVarNamed:put:! Trait removeSelector: #classVarNames! Trait removeSelector: #compile:notifying:! Trait removeSelector: #compileAll! Trait removeSelector: #compileAllFrom:! Trait removeSelector: #declare:! Trait removeSelector: #duplicateClassWithNewName:! Trait removeSelector: #ensureClassPool! Trait removeSelector: #externalName! Trait removeSelector: #fileOut! Trait removeSelector: #fileOutInitializerOn:! Trait removeSelector: #fileOutOn:moveSource:toFile:! Trait removeSelector: #fileOutPool:onFileStream:! Trait removeSelector: #fileOutSharedPoolsOn:! Trait removeSelector: #hasAbstractMethods! Trait removeSelector: #hasClassVarNamed:! Trait removeSelector: #hasMethods! Trait removeSelector: #hasSharedPools! Trait removeSelector: #isAnonymous! Trait removeSelector: #isMeta! Trait removeSelector: #isObsolete! Trait removeSelector: #isSelfEvaluating! Trait removeSelector: #isValidTraitName:! Trait removeSelector: #name:traitComposition:methodDict:localSelectors:organization:! Trait removeSelector: #newSubclass! Trait removeSelector: #possibleVariablesFor:continuedFrom:! Trait removeSelector: #reformatAll! Trait removeSelector: #removeClassVarNamed:! Trait removeSelector: #removeFromChanges! Trait removeSelector: #removeFromSystem! Trait removeSelector: #removeFromSystem:! Trait removeSelector: #removeFromSystemUnlogged! Trait removeSelector: #removeInstVarNamed:! Trait removeSelector: #removeSharedPool:! Trait removeSelector: #removeSubclass:! Trait removeSelector: #rename:! Trait removeSelector: #setName:! Trait removeSelector: #setName:andRegisterInCategory:environment:! Trait removeSelector: #sharedPoolOfVarNamed:! Trait removeSelector: #sharing:! Trait removeSelector: #shouldFileOutPool:! Trait removeSelector: #shouldFileOutPools! Trait removeSelector: #spaceUsed! Trait removeSelector: #subclass:! Trait removeSelector: #subclass:instanceVariableNames:! Trait removeSelector: #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #subclass:uses:! Trait removeSelector: #subclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #subclassesDo:! Trait removeSelector: #superclass:methodDict:format:name:organization:instVarNames:classPool:sharedPools:! Trait removeSelector: #superclass:methodDictionary:format:! Trait removeSelector: #unload! Trait removeSelector: #usesClassVarNamed:! Trait removeSelector: #usesLocalPoolVarNamed:! Trait removeSelector: #usesPoolVarNamed:! Trait removeSelector: #variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #variableByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #variableSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #variableWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #variablesAndOffsetsDo:! Trait removeSelector: #weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #weakSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category:! Trait removeSelector: #withAllSubclassesDo:! Trait removeSelector: #withClassVersion:! !Trait reorganize! (#'self evaluating' isSelfEvaluating) (#copying copy duplicateClassWithNewName:) (#'*Fuel' fuelAccept:) (#'instance variables' removeInstVarNamed: addInstVarNamed:) (#compatibility) (#initialization initialize obsolete) (#'*Ring-Core-Kernel' asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackageKeys:in: asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackages: asRingDefinition asFullRingDefinition) (#viewer externalName) (#'class variables' allClassVarNames classVarNamed: removeClassVarNamed: addClassVarNamed: ensureClassPool classVarNames hasClassVarNamed: classVarNamed:put: usesClassVarNamed:) (#traits applyChangesOfNewTraitCompositionReplacing:) (#'accessing class hierarchy' removeSubclass: addSubclass: allSubclassesWithLevelDo:startingLevel: subclassesDo:) (#private isValidTraitName: setName:andRegisterInCategory:environment: localSelectors:) (#testing hasAbstractMethods isObsolete hasMethods isAnonymous) (#'accessing method dictionary' addSelector:withMethod:notifying: addSelectorSilently:withMethod:) (#'subclass creation' classBuilder variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass: weakSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: variableSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: newSubclass weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass:instanceVariableNames: subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass:uses: variableByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: variableWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:) (#accessing basicCategory classPoolFrom: name basicCategory: setName: environment: name: environment) (#'*Monticello' asClassDefinition classDefinitions) (#compiling possibleVariablesFor:continuedFrom: compileAll compile:notifying: compileAllFrom: binding innerBindingOf: bindingOf: reformatAll) (#'class name' rename:) (#'initialize-release' sharing: declare: superclass:methodDict:format:name:organization:instVarNames:classPool:sharedPools: removeFromSystemUnlogged unload name:traitComposition:methodDict:localSelectors:organization: superclass:methodDictionary:format: removeFromSystem removeFromSystem:) (#'*FuelTests' renameSilently:) (#'fileIn/Out' shouldFileOutPools removeFromChanges fileOutSharedPoolsOn: withClassVersion: fileOut fileOutOn:moveSource:toFile: fileOutOn:moveSource:toFile:initializing: shouldFileOutPool: hasSharedPools fileOutPool:onFileStream: fileOutInitializerOn:) (#'accessing parallel hierarchy' classTrait isClassTrait baseTrait hasClassTrait isBaseTrait classTrait:) (#'pool variables' usesLocalPoolVarNamed: addSharedPool: sharedPoolOfVarNamed: usesPoolVarNamed: removeSharedPool: allSharedPools) (#organization category: category) (#'*refactoring-core' includesBehavior:) (#'*Nautilus' nautilusIcon) (#enumerating withAllSubclassesDo:) ! TraitDescription removeSelector: #+! TraitDescription removeSelector: #@! TraitDescription removeSelector: #addCompositionOnLeft:! TraitDescription removeSelector: #addOnTheLeft:! TraitDescription removeSelector: #aliasesForSelector:! TraitDescription removeSelector: #allAliasesDict! TraitDescription removeSelector: #allMethodsInCategory:! TraitDescription removeSelector: #allSelectorsWithout:! TraitDescription removeSelector: #asTraitComposition! TraitDescription removeSelector: #changedSelectorsComparedTo:! TraitDescription removeSelector: #classSide! TraitDescription removeSelector: #collectMethodsFor:into:! TraitDescription removeSelector: #fileOut! TraitDescription removeSelector: #instanceSide! TraitDescription removeSelector: #isTestCase! TraitDescription removeSelector: #notifyOfRecategorizedSelector:from:to:! TraitDescription removeSelector: #notifyUsersOfChangedSelectors:! TraitDescription removeSelector: #notifyUsersOfRecategorizedSelector:from:to:! TraitDescription removeSelector: #numberOfMethods! TraitDescription removeSelector: #organization! TraitDescription removeSelector: #organization:! TraitDescription removeSelector: #removeSelector:! TraitDescription removeSelector: #variablesAndOffsetsDo:! !TraitDescription reorganize! (#enquiries subject trait aliasesForSelector: changedSelectorsComparedTo: collectMethodsFor:into: allAliasesDict) (#'accessing comment' comment: classCommentBlank hasComment comment comment:stamp:) (#authors addAuthorsTo: authors) (#'*NautilusCommon' correspondingForTest) (#'fileIn/Out') (#'initialize-release' updateInstances:from:isMeta: superclass:methodDictionary:format: updateInstancesFrom:) (#'organization updating' applyChangesOfNewTraitCompositionReplacing: noteRecategorizedSelectors:oldComposition: noteMethodAdded: noteMethodChanged:to: notifyOfRecategorizedSelector:from:to: noteMethodRemoved: updateOrganizationSelector:oldCategory:newCategory: updateOrganizationDescription:oldCategory:newCategory:changedCategories: noteRecategorizedSelector:from:to: noteChangesFrom:) (#converting asTraitComposition) (#'as yet unclassified' updateOrganizationDescription:oldCategory:newCategory:changed:) (#printing storeOn: classVariablesString instanceVariablesString printOn: sharedPoolsString) (#'users notification' notifyUsersOfChangedSelectors: notifyUsersOfRecategorizedSelector:from:to:) (#compiling compile:classified: wantsRecompilationProgressReported compileSilently:classified:notifying: instVarNamesAndOffsetsDo: compileSilently: compile:classified:notifying: compile:classified:withStamp:notifying:logSource: compile:classified:withStamp:notifying: doneCompiling compile:notifying: logMethodSource:forMethod:inCategory:withStamp: noteCompilationOf:meta: acceptsLoggingOfCompilation wantsChangeSetLogging compileSilently:classified: reformatAll) (#testing isTestCase) (#organization organization whichCategoryIncludesSelector: category basicOrganization basicOrganization: zapOrganization category: reorganize addCategory:before: organization:) (#'*Slot' composeWithLayout:) (#'accessing method dictionary' addAndClassifySelector:withMethod:inProtocol:notifying: addSelectorSilently:withMethod: removeCategory: removeSelector: addSelector:withMethod:notifying: allMethodsInCategory: noteAddedSelector:meta: allMethodCategoriesIntegratedThrough: uncategorizedMethods methodsInCategory:) (#accessing traitVersion instanceVariables version classVersion) (#'instance variables' classThatDefinesClassVariable: instVarNames forceNewFrom: instVarNameForIndex: instVarIndexFor: classThatDefinesInstanceVariable: allInstVarNamesEverywhere instVarIndexFor:ifAbsent: hasInstVarNamed: checkForInstVarsOK:) (#'accessing parallel hierarchy' isBaseTrait hasClassTrait classSide baseTrait isClassTrait isClassSide theMetaClass instanceSide classTrait theNonMetaClass isInstanceSide isMeta) (#'filein/out' fileOutOn:moveSource:toFile: fileOutMethod:on: fileOutCategory: commentStamp:prior: printCategoryChunk:on:withStamp:priorMethod: commentStamp: fileOutChangedMessages:on: fileOutMethod: methodsFor: moveChangesTo: fileOutOn: fileOutChangedMessages:on:moveSource:toFile: fileOutCategory:on:moveSource:toFile: classComment:stamp: definition localMethods printMethodChunk:withPreamble:on:moveSource:toFile: classComment: fileOutOrganizationOn: selectorsToFileOutCategory: putClassCommentToCondensedChangesFile:) (#initialization obsolete) (#'accessing class hierarchy' commentInventory subclasses classesThatImplementAllOf: printSubclassesOn:level: subclassesDo:) (#'pool variable' usesLocalPoolVarNamed: allSharedPools sharedPoolOfVarNamed: usesPoolVarNamed: hasSharedPools) (#copying copyAll:from:classified: copyAllCategoriesFrom: copyTraitExpression copyMethodDictionaryFrom: copyCategory:from: copyCategory:from:classified: copyAll:from: copy:from:classified: copy:from:) (#'*rpackage-core' isExtended package isDefinedInPackage: packageOrganizer isExtendedInPackage: packageFromOrganizer: packages packagesWithoutExtensions extendingPackages) (#private spaceUsed errorCategoryName notifyRepackage:method:oldProtocol:newProtocol: instVarMappingFrom: addOnTheLeft: setInstVarNames: numberOfMethods linesOfCode newInstanceFrom:variable:size:map: addCompositionOnLeft:) (#composition - addExclusionOf: + @) (#'*FuelTests' duringTestCompileSilently: duringTestCompileSilently:classified:) ! !TraitBehavior reorganize! (#'class compatibility' subclassDefinerClass) (#'testing class hierarchy' kindOfSubclass inheritsFrom:) (#'obsolete subclasses' removeAllObsoleteSubclasses removeObsoleteSubclass: addObsoleteSubclass: allLocalCallsOn: obsoleteSubclasses) (#naming name) (#'*Rpackage-Core') (#'accessing instances and variables' someInstance includesSharedPoolNamed: allClassVarNames classVarNames instVarNames instanceCount allSharedPools allowsSubInstVars allSubInstances allInstances sharedPools subclassInstVarNames allInstVarNames) (#'accessing class hierarchy' allSuperclasses superclass: withAllSubclasses subclasses superclass withAllSubclassesDo: allSuperclassesIncluding: allSubclassesWithLevelDo:startingLevel: allSubclasses) (#'*Compiler-Kernel' recompile:from: bindingOf:) (#testing isObsolete includesBehavior: isBytes instSize isTrait isAnonymous isBits hasAbstractMethods isWeak isCompact isPointers shouldNotBeRedefined isWords isMeta isVariable isFixed sourceMatchesBytecodeAt: instSpec) (#initialization) (#copying) (#ambiguous traitCompositionIncludes: addSelector:withMethod:notifying: addSelector:withMethod: compileAll withAllSuperclasses methodDictAddSelectorSilently:withMethod: recompile: methodDictionary changeRecordsAt: updateMethodDictionarySelector: protocols obsolete allSelectors traitTransformations compileAllFrom: addExclusionOf:to: compile: ensureLocalSelectors compilerClass compiledMethodAt: environment firstPrecodeCommentFor: deepCopy selectorsAndMethodsDo: traitOrClassOfSelector: selectors removeFromComposition: removeAlias:of: notifyUsersOfChangedSelectors: literalScannedAs:notifying: traits compress compile:notifying: canZapMethodDictionary postCopy binding sourceCodeTemplate flattenDown: compile:classified:notifying:trailer:ifFail: copyOfMethodDictionary setTraitCompositionFrom: sourceCodeAt:ifAbsent: thoroughHasSelectorReferringTo:special:byte: evaluatorClass traitsProvidingSelector: localSelectors evaluate: registerLocalSelector: isLocalAliasSelector: selectorsDo: methodNamed: removeTraitSelector: lookupSelector: addToComposition: includesLocalSelector: firstCommentAt: isAliasSelector: >> emptyMethodDictionary storeLiteral:on: isDisabledSelector: recompileChanges includesSelector: defaultMethodTrailer sourceCodeAt: methods deregisterLocalSelector: methodsInProtocol: whichSelectorsReferTo: methodsDo: purgeLocalSelectors parserClass flattenDownAllTraits longPrintOn: spaceUsed noteChangedSelectors: removeSelectorSilently: decompilerClass applyChangesOfNewTraitCompositionReplacing: hasMethods compiler originalName whichSelectorsReferTo:special:byte: setTraitComposition: compiledMethodAt:ifAbsent: traitCompositionString notifyUsersOfChangedSelector: methodDictionary:) (#'initialize-release' initialize nonObsoleteClass superclass:methodDictionary:format:) (#'accessing method dictionary' removeSelector: supermostPrecodeCommentFor: basicLocalSelectors: methodDict: zapAllMethods allSelectorsAbove precodeCommentOrInheritedCommentFor: methodDict basicLocalSelectors nextQuotePosIn:startingFrom: addSelectorSilently:withMethod: selectorsWithArgs: allSelectorsWithout: allMethods allSelectorsAboveUntil: ultimateSourceCodeAt:ifAbsent: commentsIn: allSelectorsBelow: commentsAt: classAndMethodFor:do:ifAbsent:) (#'testing method dictionary' whichClassIncludesSelector: canPerform: classBindingOf: whichSelectorsAccess: whichSelectorsStoreInto: canUnderstand: thoroughWhichSelectorsReferTo:special:byte:) (#traits hasTraitComposition addUser: classesComposedWithMe removeUser: traitComposition users: users addTraitSelector:withMethod: traitComposition:) (#enumerating allInstancesDo: subclassesDo: selectSubclasses: withAllSuperAndSubclassesDo: allSubclassesDo: withAllSuperclassesDo: allSubInstancesDo: allUnreferencedInstanceVariables allSuperclassesDo: selectSuperclasses:) (#'*Tools-Browser' browse) (#compiling instVarNamesAndOffsetsDo: variablesAndOffsetsDo:) (#private becomeUncompact checkCanBeUncompact flushCache becomeCompactSimplyAt: becomeCompact indexIfCompact setFormat:) (#queries whichSelectorsAssign: whichClassDefinesClassVar: whichClassDefinesInstVar: whichSuperclassSatisfies: copiesFromSuperclass: whichSelectorsRead: copiedFromSuperclass: copiesMethodsFromSuperclass copiedMethodsFromSuperclass) (#'memory usage' instancesSizeInMemory) (#accessing isComposedBy: classDepth poolDictionaryNames typeOfClass numberOfInstanceVariables classPool) (#'user interface' withAllSubAndSuperclassesDo: unreferencedInstanceVariables) (#'instance creation' new: basicNew: basicNew new) (#printing printHierarchy printOn:) (#'system startup' shutDown: shutDown startUp: startUp) (#cleanup cleanUp cleanUp:) (#'adding/removing methods' basicAddSelector:withMethod: pureAddSelectorSilently:withMethod: pureRemoveSelector: adoptInstance: basicRemoveSelector: localSelectors:) ! Class removeSelector: #setName:! !Class reorganize! ('compiling' binding compile:notifying: innerBindingOf: bindingOf: possibleVariablesFor:continuedFrom: compileAllFrom: reformatAll compileAll) ('traits' applyChangesOfNewTraitCompositionReplacing:) ('viewer' externalName) ('testing' hasAbstractMethods isAnonymous isObsolete hasMethods) ('*Monticello' classDefinitions asClassDefinition) ('private' spaceUsed name: setName:andRegisterInCategory:environment: isValidTraitName:) ('enumerating' withAllSubclassesDo:) ('*HelpSystem-Core' asHelpTopic) ('*FuelTests' renameSilently:) ('accessing class hierarchy' removeSubclass: addSubclass: subclasses subclasses: subclassesDo:) ('pool variables' usesLocalPoolVarNamed: sharedPoolOfVarNamed: removeSharedPool: addSharedPool: allSharedPools sharedPools usesPoolVarNamed: sharedPools:) ('class name' rename:) ('*Spec-Builder' addInstVarNamed:type: subclass:category: addSourceCode:into:) ('copying' duplicateClassWithNewName: copy) ('*Slot' subclass:layoutClass:slots:sharedVariableNames:sharedPoolNames:category:) ('accessing' traitComposition: basicCategory basicCategory: classPool: traitComposition name classPoolFrom: setName: basicLocalSelectors basicLocalSelectors: classPool) ('organization' environment environment: category category:) ('*Ring-Core-Kernel' asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackageKeys:in: asRingDefinitionWithMethods:withSuperclasses:withSubclasses:withPackages: asRingDefinition asFullRingDefinition) ('instance variables' removeInstVarNamed: addInstVarNamed:) ('as yet unclassified' classBuilder) ('*Manifest-Core' criticTheNonMetaclassClass) ('*Fuel' fuelAccept:) ('fileIn/Out' shouldFileOutPool: fileOutOn:moveSource:toFile:initializing: hasSharedPools withClassVersion: fileOutPool:onFileStream: shouldFileOutPools fileOutInitializerOn: fileOutSharedPoolsOn: removeFromChanges fileOutOn:moveSource:toFile: fileOut) ('accessing method dictionary' addSelectorSilently:withMethod: addSelector:withMethod:notifying:) ('initialize-release' sharing: declare: name:traitComposition:methodDict:localSelectors:organization: superclass:methodDict:format:name:organization:instVarNames:classPool:sharedPools: removeFromSystem unload obsolete superclass:methodDictionary:format: removeFromSystem: removeFromSystemUnlogged) ('self evaluating' isSelfEvaluating) ('subclass creation' variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: variableByteSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass:instanceVariableNames: subclass:uses: variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: subclass: weakSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: variableSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category: newSubclass variableWordSubclass:uses:instanceVariableNames:classVariableNames:poolDictionaries:category:) ('*GroupManagerUI' prettyName) ('class variables' ensureClassPool removeClassVarNamed: usesClassVarNamed: allClassVarNames hasClassVarNamed: classVarNames classVarNamed: classVarNamed:put: addClassVarNamed:) ! ClassDescription removeSelector: #classSide! ClassDescription removeSelector: #instanceSide! !ClassDescription reorganize! (#'*Spec-Builder' compileWithoutReturn:classified:) (#'*refactoring-core-fixes' whichSelectorsReallyRead:) (#organization whichCategoryIncludesSelector: zapOrganization basicOrganization: organization basicOrganization reorganize addCategory:before: organization:) (#'*Manifest-Core' criticNameOn: textBehavior mcWorkingCopy manifestBuilderForRuleChecker: criticClass) (#'accessing method dictionary' addAndClassifySelector:withMethod:inProtocol:notifying: addSelectorSilently:withMethod: uncategorizedMethods removeSelector: addSelector:withMethod:notifying: allMethodsInCategory: removeCategory: noteAddedSelector:meta: allMethodCategoriesIntegratedThrough: methodsInCategory:) (#'accessing class hierarchy' commentInventory subclasses classesThatImplementAllOf: printSubclassesOn:level: subclassesDo:) (#'users notification' notifyUsersOfChangedSelectors: notifyUsersOfRecategorizedSelector:from:to:) (#'*System-Support' allUnreferencedClassVariables) (#'instance variables' removeInstVarNamed: instVarIndexFor: checkForInstVarsOK: instVarNameForIndex: instVarIndexFor:ifAbsent: instVarNames classThatDefinesClassVariable: classThatDefinesInstanceVariable: allInstVarNamesEverywhere forceNewFrom: addInstVarNamed: hasInstVarNamed:) (#traits addTraitSelector:withMethod:) (#'pool variable' hasSharedPools allSharedPools usesPoolVarNamed: sharedPoolOfVarNamed: usesLocalPoolVarNamed:) (#'organization updating' updateOrganizationDescription:oldCategory:newCategory:changedCategories: updateOrganizationSelector:oldCategory:newCategory: notifyOfRecategorizedSelector:from:to: noteRecategorizedSelectors:oldComposition: noteMethodChanged:to: noteRecategorizedSelector:from:to: applyChangesOfNewTraitCompositionReplacing: noteChangesFrom: noteMethodAdded: noteMethodRemoved: updateOrganizationDescription:oldCategory:newCategory:changed:) (#'*rpackage-core' package isExtended isDefinedInPackage: packageOrganizer isExtendedInPackage: compileSilently: packages packagesWithoutExtensions packageFromOrganizer: extendingPackages) (#testing isTestCase) (#'*NautilusCommon' correspondingForTest) (#'filein/out' fileOutOn:moveSource:toFile: fileOutMethod:on: fileOutCategory: commentStamp:prior: printCategoryChunk:on:withStamp:priorMethod: commentStamp: fileOutChangedMessages:on: fileOutMethod: methodsFor: fileOutChangedMessages:on:moveSource:toFile: localMethods moveChangesTo: fileOutCategory:on:moveSource:toFile: classComment:stamp: definition fileOutOn: printMethodChunk:withPreamble:on:moveSource:toFile: classComment: fileOutOrganizationOn: selectorsToFileOutCategory: putClassCommentToCondensedChangesFile:) (#printing storeOn: classVariablesString instanceVariablesString printOn: sharedPoolsString) (#private notifyRepackage:method:oldProtocol:newProtocol: numberOfMethods setInstVarNames: errorCategoryName newInstanceFrom:variable:size:map: linesOfCode instVarMappingFrom:) (#'*FuelTests' duringTestCompileSilently: duringTestCompileSilently:classified:) (#accessing version instanceVariables classVersion instanceVariables:) (#'*Fuel' instanceVariableNamesDo:) (#compiling compile:classified: wantsRecompilationProgressReported compileSilently:classified:notifying: instVarNamesAndOffsetsDo: compile:classified:notifying: compile:classified:withStamp:notifying:logSource: compile:classified:withStamp:notifying: doneCompiling compile:notifying: logMethodSource:forMethod:inCategory:withStamp: noteCompilationOf:meta: acceptsLoggingOfCompilation wantsChangeSetLogging reformatAll compileSilently:classified:) (#'initialize-release' updateInstances:from:isMeta: superclass:methodDictionary:format: obsolete updateInstancesFrom:) (#'accessing comment' comment: classCommentBlank hasComment comment comment:stamp:) (#copying copyAll:from:classified: copy:from: copyCategory:from: copyCategory:from:classified: copy:from:classified: copyAll:from: copyMethodDictionaryFrom: copyAllCategoriesFrom:) (#authors addAuthorsTo: authors) (#'*Slot' initializeLayoutWithSlots: layoutSized: superclass:layout: initializeLayout layout superclass:withLayoutType:slots:) (#'accessing parallel hierarchy' classSide theNonMetaClass theMetaClass isClassSide instanceSide isMeta isInstanceSide) ! !TBehavior reorganize! ('compiling' variablesAndOffsetsDo: instVarNamesAndOffsetsDo:) ('*Rpackage-Core' originalName) ('cleanup' cleanUp cleanUp:) ('*Ring-Core-Kernel' methodsInProtocol: protocols methodNamed:) ('naming' environment) ('instance creation' basicNew new new: basicNew:) ('user interface' unreferencedInstanceVariables withAllSubAndSuperclassesDo:) ('*Compiler-Kernel' recompile:from: compileAllFrom: compile: recompile: compiler compile:notifying: compileAll sourceCodeTemplate evaluatorClass defaultMethodTrailer parserClass binding decompilerClass compile:classified:notifying:trailer:ifFail: bindingOf: compilerClass evaluate: recompileChanges) ('queries' copiesFromSuperclass: whichClassDefinesClassVar: whichSelectorsRead: whichSelectorsAssign: copiedFromSuperclass: copiedMethodsFromSuperclass copiesMethodsFromSuperclass whichSuperclassSatisfies: whichClassDefinesInstVar:) ('traits' ensureLocalSelectors setTraitCompositionFrom: traitTransformations traitOrClassOfSelector: purgeLocalSelectors hasTraitComposition flattenDown: addToComposition: addTraitSelector:withMethod: removeFromComposition: noteChangedSelectors: traitsProvidingSelector: notifyUsersOfChangedSelector: users updateMethodDictionarySelector: addUser: traitCompositionString removeUser: traitCompositionIncludes: applyChangesOfNewTraitCompositionReplacing: removeTraitSelector: users: traits traitComposition: traitComposition notifyUsersOfChangedSelectors: addExclusionOf:to: flattenDownAllTraits setTraitComposition: classesComposedWithMe removeAlias:of:) ('accessing class hierarchy' allSubclasses withAllSuperclasses superclass subclasses allSuperclasses allSuperclassesIncluding: withAllSubclassesDo: withAllSubclasses superclass: allSubclassesWithLevelDo:startingLevel:) ('adding/removing methods' removeSelector: removeSelectorSilently: localSelectors: addSelector:withMethod:notifying: basicAddSelector:withMethod: methodDictAddSelectorSilently:withMethod: localSelectors addSelector:withMethod: addSelectorSilently:withMethod: adoptInstance:) ('enumerating' withAllSuperAndSubclassesDo: subclassesDo: allSuperclassesDo: allSubInstancesDo: allUnreferencedInstanceVariables allSubclassesDo: selectSubclasses: selectSuperclasses: allInstancesDo: withAllSuperclassesDo:) ('initialize-release' superclass:methodDictionary:format: nonObsoleteClass initialize) ('testing class hierarchy' includesBehavior: kindOfSubclass inheritsFrom:) ('testing' isFixed isBits sourceMatchesBytecodeAt: isVariable isObsolete isBytes canZapMethodDictionary isWords isCompact isWeak isMeta hasAbstractMethods instSpec isAnonymous isPointers instSize shouldNotBeRedefined) ('initialization' emptyMethodDictionary obsolete) ('memory usage' instancesSizeInMemory) ('accessing instances and variables' someInstance allSubInstances allInstVarNames classVarNames allowsSubInstVars instVarNames instanceCount includesSharedPoolNamed: sharedPools allClassVarNames subclassInstVarNames allSharedPools allInstances) ('printing' storeLiteral:on: longPrintOn: printOn: printHierarchy literalScannedAs:notifying:) ('accessing method dictionary' ultimateSourceCodeAt:ifAbsent: compiledMethodAt: selectors commentsIn: registerLocalSelector: allMethods compress methods supermostPrecodeCommentFor: allSelectors firstPrecodeCommentFor: sourceCodeAt:ifAbsent: selectorsAndMethodsDo: basicLocalSelectors: methodDictionary deregisterLocalSelector: changeRecordsAt: allSelectorsBelow: lookupSelector: precodeCommentOrInheritedCommentFor: compiledMethodAt:ifAbsent: allSelectorsAbove classAndMethodFor:do:ifAbsent: selectorsDo: firstCommentAt: zapAllMethods sourceCodeAt: commentsAt: selectorsWithArgs: basicLocalSelectors >> methodDict: nextQuotePosIn:startingFrom: allSelectorsWithout: methodDict methodsDo: methodDictionary: allSelectorsAboveUntil:) ('copying' postCopy copyOfMethodDictionary deepCopy) ('system startup' shutDown: shutDown startUp startUp:) ('testing method dictionary' includesSelector: whichSelectorsReferTo:special:byte: canPerform: includesLocalSelector: canUnderstand: isDisabledSelector: whichSelectorsAccess: isAliasSelector: classBindingOf: isLocalAliasSelector: whichSelectorsReferTo: thoroughHasSelectorReferringTo:special:byte: thoroughWhichSelectorsReferTo:special:byte: whichSelectorsStoreInto: hasMethods whichClassIncludesSelector:) ('accessing' subclassDefinerClass classDepth numberOfInstanceVariables isComposedBy: classPool name typeOfClass poolDictionaryNames) ('obsolete subclasses' addObsoleteSubclass: obsoleteSubclasses allLocalCallsOn: removeAllObsoleteSubclasses removeObsoleteSubclass:) ('private' flushCache indexIfCompact becomeUncompact becomeCompact spaceUsed basicRemoveSelector: becomeCompactSimplyAt: setFormat: checkCanBeUncompact) ! TClass removeSelector: #baseTrait! TClass removeSelector: #hasClassTrait! TClass removeSelector: #isBaseTrait! TClass removeSelector: #isClassTrait! TClass removeSelector: #isMeta!