'From Pharo3.0 of 18 March 2013 [Latest update: #30275] on 17 July 2013 at 3:10:31 pm'! !TApplyingOnClassSide methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/17/2013 14:28'! externalTypeAlias: aName "redirect request to my instance side" ^ self instanceSide externalTypeAlias: aName! ! !TApplyingOnClassSide methodsFor: 'composition' stamp: 'SebastianTleye 7/17/2013 15:01'! uses: aTraitCompositionOrArray | copyOfOldTrait newComposition | copyOfOldTrait := self copy. newComposition := aTraitCompositionOrArray asTraitComposition. self assertConsistantCompositionsForNew: newComposition. self setTraitComposition: newComposition. SystemAnnouncer uniqueInstance traitDefinitionChangedFrom: copyOfOldTrait to: self.! ! !TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 13:50'! isObsolete "Return true if the receiver is obsolete" ^self soleInstance == nil "Either no thisClass" or:[self soleInstance classSide ~~ self "or I am not the class of thisClass" or:[self soleInstance isObsolete]] "or my instance is obsolete"! ! !TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 14:14'! canZapMethodDictionary "Return true if it is safe to zap the method dictionary on #obsolete" self soleInstance == nil ifTrue:[^true] ifFalse:[^self soleInstance canZapMethodDictionary]! ! !TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 13:53'! isAnonymous ^self soleInstance isAnonymous ! ! !TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/17/2013 14:33'! fileOutInitializerOn: aStream (self includesSelector: #initialize) ifTrue: [aStream cr. aStream nextChunkPut: self soleInstance name , ' initialize'].! ! !TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/17/2013 14:40'! nonTrivial "Answer whether the receiver has any methods or instance variables." ^ self instVarNames notEmpty or: [self hasMethods or: [self hasTraitComposition]]! ! !TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 14:48'! uses: aTraitCompositionOrArray instanceVariableNames: instVarString | newComposition newMetaClass copyOfOldMetaClass | copyOfOldMetaClass := self copy. newMetaClass := self instanceVariableNames: instVarString. newComposition := aTraitCompositionOrArray asTraitComposition. newMetaClass assertConsistantCompositionsForNew: newComposition. newMetaClass setTraitComposition: newComposition. SystemAnnouncer uniqueInstance classDefinitionChangedFrom: copyOfOldMetaClass to: newMetaClass! ! !TApplyingOnClassSide methodsFor: 'initialize' stamp: 'SebastianTleye 7/17/2013 15:08'! initializeFrom: anotherClassTrait self traitComposition: self traitComposition copyTraitExpression. self methodDict: self methodDict copy. self localSelectors: self localSelectors copy. self basicOrganization: self organization copy.! ! !TApplyingOnClassSide methodsFor: '*NativeBoost-Core' stamp: 'SebastianTleye 7/17/2013 14:28'! externalTypeAlias: aName "redirect request to my instance side" ^ self instanceSide externalTypeAlias: aName! ! !TApplyingOnClassSide methodsFor: 'composition' stamp: 'SebastianTleye 7/17/2013 15:01'! uses: aTraitCompositionOrArray | copyOfOldTrait newComposition | copyOfOldTrait := self copy. newComposition := aTraitCompositionOrArray asTraitComposition. self assertConsistantCompositionsForNew: newComposition. self setTraitComposition: newComposition. SystemAnnouncer uniqueInstance traitDefinitionChangedFrom: copyOfOldTrait to: self.! ! !TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 13:50'! isObsolete "Return true if the receiver is obsolete" ^self soleInstance == nil "Either no thisClass" or:[self soleInstance classSide ~~ self "or I am not the class of thisClass" or:[self soleInstance isObsolete]] "or my instance is obsolete"! ! !TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 14:14'! canZapMethodDictionary "Return true if it is safe to zap the method dictionary on #obsolete" self soleInstance == nil ifTrue:[^true] ifFalse:[^self soleInstance canZapMethodDictionary]! ! !TApplyingOnClassSide methodsFor: 'testing' stamp: 'SebastianTleye 7/17/2013 13:53'! isAnonymous ^self soleInstance isAnonymous ! ! !TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/17/2013 14:33'! fileOutInitializerOn: aStream (self includesSelector: #initialize) ifTrue: [aStream cr. aStream nextChunkPut: self soleInstance name , ' initialize'].! ! !TApplyingOnClassSide methodsFor: 'fileIn/Out' stamp: 'SebastianTleye 7/17/2013 14:40'! nonTrivial "Answer whether the receiver has any methods or instance variables." ^ self instVarNames notEmpty or: [self hasMethods or: [self hasTraitComposition]]! ! !TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 14:48'! uses: aTraitCompositionOrArray instanceVariableNames: instVarString | newComposition newMetaClass copyOfOldMetaClass | copyOfOldMetaClass := self copy. newMetaClass := self instanceVariableNames: instVarString. newComposition := aTraitCompositionOrArray asTraitComposition. newMetaClass assertConsistantCompositionsForNew: newComposition. newMetaClass setTraitComposition: newComposition. SystemAnnouncer uniqueInstance classDefinitionChangedFrom: copyOfOldMetaClass to: newMetaClass! ! !TApplyingOnClassSide methodsFor: 'initialize' stamp: 'SebastianTleye 7/17/2013 15:08'! initializeFrom: anotherClassTrait self traitComposition: self traitComposition copyTraitExpression. self methodDict: self methodDict copy. self localSelectors: self localSelectors copy. self basicOrganization: self organization copy.! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/17/2013 11:21'! removeSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector). self isTrait ifTrue: [ self notifyUsersOfChangedSelector: aSelector].! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/17/2013 11:23'! addSelectorSilently: selector withMethod: compiledMethod self methodDictAddSelectorSilently: selector withMethod: compiledMethod. self registerLocalSelector: selector. self isTrait ifTrue: [ self notifyUsersOfChangedSelector: selector].! ! !TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 10:09'! fuelNew "Answer an instance of mine in which serialized references will be injected." ^ self basicNew! ! !TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 10:09'! fuelNew: sizeRequested "Answer an instance of mine in which serialized references will be injected." ^ self basicNew: sizeRequested! ! !TBehavior methodsFor: 'accessing method dictionary' stamp: 'SebastianTleye 7/17/2013 11:21'! removeSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector). self isTrait ifTrue: [ self notifyUsersOfChangedSelector: aSelector].! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/17/2013 11:23'! addSelectorSilently: selector withMethod: compiledMethod self methodDictAddSelectorSilently: selector withMethod: compiledMethod. self registerLocalSelector: selector. self isTrait ifTrue: [ self notifyUsersOfChangedSelector: selector].! ! !TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 10:09'! fuelNew "Answer an instance of mine in which serialized references will be injected." ^ self basicNew! ! !TBehavior methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 10:09'! fuelNew: sizeRequested "Answer an instance of mine in which serialized references will be injected." ^ self basicNew: sizeRequested! ! !TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew: sizeRequested self error: 'Traits cannot create instances'.! ! !TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew self error: 'Traits cannot create instances'.! ! !TraitBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/17/2013 11:32'! name ^ self subclassResponsability.! ! !TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew: sizeRequested self error: 'Traits cannot create instances'.! ! !TraitBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew self error: 'Traits cannot create instances'.! ! !TraitBehavior methodsFor: 'naming' stamp: 'SebastianTleye 7/17/2013 11:32'! name ^ self subclassResponsability.! ! !ClassTrait methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 13:39'! adoptInstance: oldInstance from: oldMetaClass ^self error: 'Traits cannot adopt instances'.! ! !ClassTrait methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 14:39'! new self error: 'Traits have no instances'! ! !ClassTrait methodsFor: '*Tools-Debugger' stamp: 'SebastianTleye 7/17/2013 14:19'! canonicalArgumentName ^ 'aTrait'.! ! !ClassTrait methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 13:39'! adoptInstance: oldInstance from: oldMetaClass ^self error: 'Traits cannot adopt instances'.! ! !ClassTrait methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 14:39'! new self error: 'Traits have no instances'! ! !ClassTrait methodsFor: '*Tools-Debugger' stamp: 'SebastianTleye 7/17/2013 14:19'! canonicalArgumentName ^ 'aTrait'.! ! !Behavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 11:31'! name "Answer a String that is the name of the receiver." ^'a subclass of ', self superclass name.! ! !Behavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:06'! basicNew: sizeRequested "Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." self isVariable ifFalse: [self error: self printString, ' cannot have variable sized instances']. (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue: ["arg okay; space must be low." OutOfMemory signal. ^ self basicNew: sizeRequested "retry if user proceeds"]. self primitiveFailed! ! !Behavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:06'! basicNew "Primitive. Answer an instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable. Essential. See Object documentation whatIsAPrimitive." self isVariable ifTrue: [ ^ self basicNew: 0 ]. "space must be low" OutOfMemory signal. ^ self basicNew "retry if user proceeds"! ! !Behavior methodsFor: '*Slot' stamp: 'SebastianTleye 7/17/2013 11:42'! layout ^ layout! ! !Behavior methodsFor: 'traits' stamp: 'SebastianTleye 7/17/2013 13:13'! traitComposition: aTraitComposition "Compatibility purposes"! ! !Behavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 11:31'! name "Answer a String that is the name of the receiver." ^'a subclass of ', self superclass name.! ! !Behavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:06'! basicNew: sizeRequested "Primitive. Answer an instance of this class with the number of indexable variables specified by the argument, sizeRequested. Fail if this class is not indexable or if the argument is not a positive Integer, or if there is not enough memory available. Essential. See Object documentation whatIsAPrimitive." self isVariable ifFalse: [self error: self printString, ' cannot have variable sized instances']. (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue: ["arg okay; space must be low." OutOfMemory signal. ^ self basicNew: sizeRequested "retry if user proceeds"]. self primitiveFailed! ! !Behavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:06'! basicNew "Primitive. Answer an instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable. Essential. See Object documentation whatIsAPrimitive." self isVariable ifTrue: [ ^ self basicNew: 0 ]. "space must be low" OutOfMemory signal. ^ self basicNew "retry if user proceeds"! ! !Behavior methodsFor: '*Slot' stamp: 'SebastianTleye 7/17/2013 11:42'! layout ^ layout! ! !ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/17/2013 13:15'! baseClass ^self subclassResponsability.! ! !ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/17/2013 13:16'! classClass ^self subclassResponsibility.! ! !ClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:06'! classVersion "Default. Any class may return a later version to inform readers that use ReferenceStream. This method allows you to distinguish between class versions when the shape of the class hasn't changed (when there's no change in the instVar names). In the conversion methods you usually can tell by the inst var names what old version you have. In a few cases, though, the same inst var names were kept but their interpretation changed (like in the layoutFrame). By changing the class version when you keep the same instVars you can warn older and newer images that they have to convert." ^ 0! ! !ClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:06'! version "Allows polymorphism with TraitDescription>>version" ^ self classVersion! ! !ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/17/2013 13:15'! baseClass ^self subclassResponsability.! ! !ClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/17/2013 13:16'! classClass ^self subclassResponsibility.! ! !ClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:06'! classVersion "Default. Any class may return a later version to inform readers that use ReferenceStream. This method allows you to distinguish between class versions when the shape of the class hasn't changed (when there's no change in the instVar names). In the conversion methods you usually can tell by the inst var names what old version you have. In a few cases, though, the same inst var names were kept but their interpretation changed (like in the layoutFrame). By changing the class version when you keep the same instVars you can warn older and newer images that they have to convert." ^ 0! ! !ClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:06'! version "Allows polymorphism with TraitDescription>>version" ^ self classVersion! ! Metaclass removeSelector: #canZapMethodDictionary! Metaclass removeSelector: #externalTypeAlias:! Metaclass removeSelector: #fileOutInitializerOn:! Metaclass removeSelector: #isAnonymous! Metaclass removeSelector: #isObsolete! Metaclass removeSelector: #nonTrivial! Metaclass removeSelector: #uses:instanceVariableNames:! !Metaclass reorganize! (#'instance creation' new) (#'accessing parallel hierarchy' classClass baseClass) (#'*Tools-Debugger' canonicalArgumentName) (#'accessing hierarchy protocol' hasClassSide) (#copying veryDeepCopyWith: postCopy) (#'*Fuel' fuelAccept:) (#accessing environment name category traitComposition basicLocalSelectors basicLocalSelectors: localSelectors: soleInstance localSelectors traitComposition:) (#'*Ring-Core-Kernel' asFullRingDefinition asRingDefinition) (#'*Manifest-Core' criticTheNonMetaclassClass) (#initialize initializeFrom:) (#'initialize-release' uses:instanceVariableNames: adoptInstance:from: instanceVariableNames:) (#'instance variables' removeInstVarNamed: addInstVarNamed:) (#'pool variables' classPool) (#'class hierarchy' subclassesDo: removeSubclass: subclasses addObsoleteSubclass: addSubclass: removeObsoleteSubclass: obsoleteSubclasses) (#'accessing instances and variables' classVarNames) (#'*NativeBoost-Core' externalTypeAlias:) (#compiling possibleVariablesFor:continuedFrom: acceptsLoggingOfCompilation wantsChangeSetLogging binding bindingOf: wantsRecompilationProgressReported) (#testing isMeta isAnonymous canZapMethodDictionary isObsolete isSelfEvaluating) (#'fileIn/Out' nonTrivial definition fileOutOn:moveSource:toFile: fileOutOn:moveSource:toFile:initializing: fileOutInitializerOn:) (#composition noteNewBaseTraitCompositionApplied: assertConsistantCompositionsForNew: uses:) ! ClassDescription removeSelector: #hasClassSide! ClassDescription removeSelector: #layout! ClassDescription removeSelector: #removeInstVarNamed:! Behavior removeSelector: #fuelNew! Behavior removeSelector: #fuelNew:! Behavior removeSelector: #removeSelector:! !Behavior reorganize! (#testing isObsolete isBytes instSize isAnonymous isBits hasAbstractMethods isWeak isCompact canZapMethodDictionary isPointers shouldNotBeRedefined isMeta isWords isVariable isBehavior sourceMatchesBytecodeAt: instSpec isFixed) (#accessing isComposedBy: subclassDefinerClass name poolDictionaryNames numberOfInstanceVariables methodDict format classPool classDepth typeOfClass) (#initialization emptyMethodDictionary obsolete) (#'testing method dictionary' thoroughHasSelectorReferringTo:special:byte: isLocalAliasSelector: classBindingOf: canUnderstand: includesLocalSelector: whichSelectorsReferTo:special:byte: isDisabledSelector: thoroughWhichSelectorsReferTo:special:byte: whichSelectorsStoreInto: hasMethods canPerform: whichSelectorsAccess: whichSelectorsReferTo: whichClassIncludesSelector: isAliasSelector: includesSelector:) (#cleanup cleanUp cleanUp:) (#enumerating allSuperclassesDo: subclassesDo: selectSubclasses: withAllSuperAndSubclassesDo: allSubclassesDo: withAllSuperclassesDo: allInstancesDo: allUnreferencedInstanceVariables allSubInstancesDo: selectSuperclasses:) (#'*Manifest-Core' isManifest) (#'accessing method dictionary' allMethods compiledMethodAt:ifAbsent: selectors deregisterLocalSelector: methodDict: compress methodDictionary allSelectorsBelow: sourceCodeAt: allSelectorsAboveUntil: registerLocalSelector: removeSelector: >> lookupSelector: nextQuotePosIn:startingFrom: allSelectorsAbove selectorsWithArgs: methodDictionary: supermostPrecodeCommentFor: changeRecordsAt: methods sourceCodeAt:ifAbsent: selectorsAndMethodsDo: firstCommentAt: zapAllMethods allSelectorsWithout: compiledMethodAt: classAndMethodFor:do:ifAbsent: firstPrecodeCommentFor: precodeCommentOrInheritedCommentFor: commentsAt: commentsIn: selectorsDo: methodsDo: ultimateSourceCodeAt:ifAbsent: allSelectors) (#'*ast-core' parseTreeFor:) (#'*Ring-Core-Kernel' protocols methodNamed: methodsInProtocol:) (#'instance creation' new: basicNew: basicNew new) (#'*Nautilus' realClass) (#private spaceUsed becomeUncompact flushCache checkCanBeUncompact becomeCompactSimplyAt: becomeCompact indexIfCompact setFormat:) (#'initialize-release' initialize nonObsoleteClass superclass:methodDictionary:format:) (#compiling instVarNamesAndOffsetsDo: variablesAndOffsetsDo:) (#naming environment) (#'obsolete subclasses' allLocalCallsOn: basicObsoleteSubclasses addObsoleteSubclass: removeAllObsoleteSubclasses removeObsoleteSubclass: obsoleteSubclasses) (#'accessing class hierarchy' allSuperclasses superclass: withAllSubclasses withAllSuperclasses allSuperclassesIncluding: withAllSubclassesDo: superclass allSubclassesWithLevelDo:startingLevel: allSubclasses) (#'*Slot' layout) (#'*NativeBoost-Core' nbBindingOf: externalTypeAlias: nbFnArgument:generator:) (#queries copiesMethodsFromSuperclass copiedMethodsFromSuperclass whichClassDefinesInstVar: whichSuperclassSatisfies: copiesFromSuperclass: whichSelectorsRead: whichClassDefinesClassVar: whichSelectorsAssign: copiedFromSuperclass:) (#printing storeLiteral:on: printHierarchy literalScannedAs:notifying: longPrintOn: printOn:) (#'memory usage' instancesSizeInMemory) (#copying deepCopy copyOfMethodDictionary postCopy) (#'testing class hierarchy' kindOfSubclass includesBehavior: inheritsFrom:) (#'*Fuel' fuelNew fuelNew: fuelIgnoredInstanceVariableNames) (#'adding/removing methods' addSelectorSilently:withMethod: basicRemoveSelector: addSelector:withMethod:notifying: methodDictAddSelectorSilently:withMethod: basicAddSelector:withMethod: addSelector:withMethod: removeSelectorSilently: adoptInstance:) (#traits addTraitSelector:withMethod: traits flattenDownAllTraits traitComposition: users flattenDown: classesComposedWithMe traitsProvidingSelector: users: traitOrClassOfSelector: notifyUsersOfChangedSelector: updateMethodDictionarySelector: removeUser: traitCompositionIncludes: purgeLocalSelectors noteChangedSelectors: traitComposition setTraitCompositionFrom: traitTransformations removeFromComposition: traitCompositionString removeTraitSelector: setTraitComposition: notifyUsersOfChangedSelectors: hasTraitComposition ensureLocalSelectors applyChangesOfNewTraitCompositionReplacing: addUser: addToComposition: addExclusionOf:to: removeAlias:of:) (#'accessing instances and variables' subclassInstVarNames includesSharedPoolNamed: allClassVarNames classVarNames instVarNames instanceCount allSharedPools allowsSubInstVars allSubInstances allInstances sharedPools someInstance allInstVarNames) (#'*Rpackage-Core' originalName) (#'user interface' withAllSubAndSuperclassesDo: unreferencedInstanceVariables) (#'*Tools-Inspector' inspectAllInstances inspectSubInstances) (#'*System-Support' allCallsOn allUnsentMessages allCallsOnIn: referencedClasses allCallsOn:) (#'*Compiler-Kernel' decompilerClass binding parserClass compile: bindingOf: compile:classified:notifying:trailer:ifFail: compiler defaultMethodTrailer evaluatorClass compile:notifying: compileAll compileAllFrom: evaluate: compilerClass recompileChanges sourceCodeTemplate recompile:from: recompile:) (#'system startup' shutDown: shutDown startUp startUp:) ! ClassTrait removeSelector: #initializeFrom:! ClassTrait removeSelector: #isObsolete! ClassTrait removeSelector: #uses:! ClassTrait removeSelector: #uses:instanceVariableNames:! !ClassTrait reorganize! (#testing isMeta isAnonymous canZapMethodDictionary isObsolete isSelfEvaluating) (#'*Ring-Core-Kernel' asFullRingDefinition asRingDefinition) (#'accessing hierarchy protocol' hasClassSide) (#'initialize-release' uses:instanceVariableNames: adoptInstance:from: instanceVariableNames:) (#'instance creation' new) (#copying copy) ('fileIn/Out' definition nonTrivial fileOutInitializerOn:) (#'*refactoring-core' soleInstance) (#'accessing instances and variables' classVarNames) (#'pool variables' classPool) (#initialize initializeFrom: initializeWithBaseTrait:) (#'*Monticello' asMCDefinition) (#'*Tools-Debugger' canonicalArgumentName) (#'class hierarchy' subclassesDo: subclasses addObsoleteSubclass: removeSubclass: addSubclass: removeObsoleteSubclass: obsoleteSubclasses) (#'*Manifest-Core' criticTheNonMetaclassClass) (#'*Fuel' fuelAccept:) (#'*NativeBoost-Core' externalTypeAlias:) (#composition noteNewBaseTraitCompositionApplied: assertConsistantCompositionsForNew: uses:) (#accessing category name) (#'accessing parallel hierarchy' classTrait baseTrait: isClassTrait baseTrait isBaseTrait classTrait:) (#compiling possibleVariablesFor:continuedFrom: compile:classified:withStamp:notifying:logSource: binding wantsChangeSetLogging acceptsLoggingOfCompilation bindingOf: wantsRecompilationProgressReported) (#'instance variables' removeInstVarNamed: addInstVarNamed:) ! TraitDescription removeSelector: #category! TraitDescription removeSelector: #category:! TraitDescription removeSelector: #hasClassSide! !TraitDescription reorganize! (#accessing traitVersion instanceVariables instanceVariables: version) (#'*Fuel' instanceVariableNamesDo:) (#'initialize-release' updateInstances:from:isMeta: superclass:methodDictionary:format: obsolete updateInstancesFrom:) (#'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: localMethods definition printMethodChunk:withPreamble:on:moveSource:toFile: classComment: fileOutOrganizationOn: selectorsToFileOutCategory: putClassCommentToCondensedChangesFile:) (#converting asTraitComposition) (#copying copyTraitExpression copyAllCategoriesFrom: copy:from: copyMethodDictionaryFrom: copyCategory:from: copyCategory:from:classified: copyAll:from: copy:from:classified: copyAll:from:classified:) (#'accessing class hierarchy' commentInventory classesThatImplementAllOf: printSubclassesOn:level: subclassesDo:) (#enquiries subject allAliasesDict aliasesForSelector: changedSelectorsComparedTo: collectMethodsFor:into: trait) (#'instance variables' allInstVarNamesEverywhere instVarIndexFor: checkForInstVarsOK: instVarIndexFor:ifAbsent: instVarNames instVarNameForIndex: classThatDefinesClassVariable: classThatDefinesInstanceVariable: removeInstVarNamed: forceNewFrom: addInstVarNamed: hasInstVarNamed:) (#'*System-Support' allUnreferencedClassVariables) (#'*rpackage-core' isExtended package isDefinedInPackage: packageOrganizer isExtendedInPackage: packageFromOrganizer: packages packagesWithoutExtensions compileSilently: extendingPackages) (#'*refactoring-core-fixes' whichSelectorsReallyRead:) (#composition - addExclusionOf: + @) (#'*FuelTests' duringTestCompileSilently: duringTestCompileSilently:classified:) (#testing isTestCase) (#private linesOfCode addCompositionOnLeft: notifyRepackage:method:oldProtocol:newProtocol: instVarMappingFrom: addOnTheLeft: numberOfMethods setInstVarNames: newInstanceFrom:variable:size:map: spaceUsed errorCategoryName) (#'*NautilusCommon' correspondingForTest) (#'pool variable' hasSharedPools allSharedPools sharedPoolOfVarNamed: usesPoolVarNamed: usesLocalPoolVarNamed:) (#'accessing parallel hierarchy' isBaseTrait classTrait baseTrait isClassTrait hasClassSide isClassSide theMetaClass theNonMetaClass instanceSide isMeta classSide isInstanceSide) (#'*Spec-Builder' compileWithoutReturn:classified:) (#initialization) (#'accessing method dictionary' addAndClassifySelector:withMethod:inProtocol:notifying: addSelectorSilently:withMethod: methodsInCategory: removeSelector: addSelector:withMethod:notifying: removeCategory: allMethodsInCategory: allMethodCategoriesIntegratedThrough: uncategorizedMethods noteAddedSelector:meta:) (#'*Manifest-Core' criticNameOn: textBehavior mcWorkingCopy manifestBuilderForRuleChecker: criticClass) (#organization organization whichCategoryIncludesSelector: basicOrganization basicOrganization: zapOrganization addCategory:before: reorganize organization:) (#authors addAuthorsTo: authors) (#'users notification' notifyUsersOfChangedSelectors: notifyUsersOfRecategorizedSelector:from:to:) (#printing storeOn: classVariablesString instanceVariablesString printOn: sharedPoolsString) (#'accessing comment' comment: classCommentBlank hasComment comment comment:stamp:) (#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 compileSilently:classified: reformatAll) (#'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:) ! TraitBehavior removeSelector: #addSelectorSilently:withMethod:! TraitBehavior removeSelector: #pureAddSelectorSilently:withMethod:! TraitBehavior removeSelector: #pureRemoveSelector:! TraitBehavior removeSelector: #removeSelector:! !TraitBehavior reorganize! (#'*Tools-Inspector' inspectAllInstances inspectSubInstances) (#'*Compiler-Kernel' decompilerClass recompile: parserClass compile: bindingOf: compile:classified:notifying:trailer:ifFail: compiler defaultMethodTrailer evaluatorClass compile:notifying: compileAll evaluate: compileAllFrom: compilerClass recompile:from: sourceCodeTemplate recompileChanges binding) (#accessing isComposedBy: localSelectors poolDictionaryNames classDepth typeOfClass numberOfInstanceVariables classPool localSelectors:) (#initialization emptyMethodDictionary obsolete) (#'testing class hierarchy' kindOfSubclass inheritsFrom: includesBehavior:) (#'initialize-release' initialize nonObsoleteClass superclass:methodDictionary:format:) (#'instance creation' new: basicNew: basicNew new) (#cleanup cleanUp cleanUp:) (#'*Manifest-Core' isManifest) (#'user interface' withAllSubAndSuperclassesDo: unreferencedInstanceVariables) (#'accessing method dictionary' allMethods compiledMethodAt:ifAbsent: deregisterLocalSelector: selectors methodDict: allSelectorsAboveUntil: allSelectorsBelow: methodDictionary compress sourceCodeAt: basicLocalSelectors registerLocalSelector: >> lookupSelector: methodDict nextQuotePosIn:startingFrom: allSelectorsAbove methodDictionary: selectorsWithArgs: basicLocalSelectors: supermostPrecodeCommentFor: changeRecordsAt: removeSelector: zapAllMethods allSelectorsWithout: methods firstCommentAt: selectorsAndMethodsDo: sourceCodeAt:ifAbsent: compiledMethodAt: classAndMethodFor:do:ifAbsent: firstPrecodeCommentFor: commentsAt: precodeCommentOrInheritedCommentFor: commentsIn: methodsDo: selectorsDo: allSelectors ultimateSourceCodeAt:ifAbsent:) (#'adding/removing methods' addSelectorSilently:withMethod: basicRemoveSelector: methodDictAddSelectorSilently:withMethod: adoptInstance: addSelector:withMethod:notifying: addSelector:withMethod: basicAddSelector:withMethod: removeSelectorSilently:) (#'*System-Support' allCallsOnIn: allUnsentMessages allCallsOn referencedClasses allCallsOn:) (#'*Ring-Core-Kernel' protocols methodNamed: methodsInProtocol:) (#'*ast-core' parseTreeFor:) (#'*Tools-Browser' browse) (#'system startup' shutDown: shutDown startUp startUp:) (#'*Nautilus' realClass) (#'memory usage' instancesSizeInMemory) (#traits addTraitSelector:withMethod: traitComposition: flattenDownAllTraits traits users flattenDown: classesComposedWithMe traitsProvidingSelector: users: traitOrClassOfSelector: removeUser: notifyUsersOfChangedSelector: traitCompositionIncludes: updateMethodDictionarySelector: purgeLocalSelectors traitComposition noteChangedSelectors: hasTraitComposition removeFromComposition: traitTransformations setTraitCompositionFrom: traitCompositionString setTraitComposition: notifyUsersOfChangedSelectors: removeTraitSelector: applyChangesOfNewTraitCompositionReplacing: ensureLocalSelectors addUser: addToComposition: addExclusionOf:to: removeAlias:of:) (#'class compatibility' subclassDefinerClass) (#'*NativeBoost-Core' nbBindingOf: externalTypeAlias: nbFnArgument:generator:) (#'obsolete subclasses' basicObsoleteSubclasses allLocalCallsOn: addObsoleteSubclass: removeAllObsoleteSubclasses removeObsoleteSubclass: obsoleteSubclasses) (#testing isObsolete instSize isBytes isTrait isAnonymous isBits hasAbstractMethods isWeak isCompact canZapMethodDictionary isPointers shouldNotBeRedefined isMeta isWords isVariable sourceMatchesBytecodeAt: isFixed instSpec) (#naming environment name) (#compiling instVarNamesAndOffsetsDo: variablesAndOffsetsDo:) (#private spaceUsed becomeCompactSimplyAt: checkCanBeUncompact becomeCompact flushCache becomeUncompact indexIfCompact setFormat:) (#queries copiesMethodsFromSuperclass copiedFromSuperclass: whichClassDefinesInstVar: whichSuperclassSatisfies: copiesFromSuperclass: whichSelectorsRead: whichClassDefinesClassVar: whichSelectorsAssign: copiedMethodsFromSuperclass) (#'accessing instances and variables' allInstVarNames includesSharedPoolNamed: allClassVarNames classVarNames instVarNames instanceCount allSharedPools allowsSubInstVars allSubInstances allInstances sharedPools someInstance subclassInstVarNames) (#printing printHierarchy literalScannedAs:notifying: storeLiteral:on: printOn: longPrintOn:) (#'*Fuel' fuelNew fuelIgnoredInstanceVariableNames fuelNew:) (#'accessing class hierarchy' allSuperclasses superclass: withAllSubclasses withAllSuperclasses superclass allSuperclassesIncluding: withAllSubclassesDo: allSubclassesWithLevelDo:startingLevel: allSubclasses) (#copying deepCopy copyOfMethodDictionary postCopy) (#'testing method dictionary' thoroughHasSelectorReferringTo:special:byte: isLocalAliasSelector: classBindingOf: whichClassIncludesSelector: whichSelectorsStoreInto: whichSelectorsReferTo:special:byte: isDisabledSelector: hasMethods canUnderstand: thoroughWhichSelectorsReferTo:special:byte: canPerform: whichSelectorsAccess: includesLocalSelector: whichSelectorsReferTo: isAliasSelector: includesSelector:) (#'*Rpackage-Core' originalName) (#enumerating selectSuperclasses: subclassesDo: selectSubclasses: withAllSuperclassesDo: allSubclassesDo: withAllSuperAndSubclassesDo: allSubInstancesDo: allUnreferencedInstanceVariables allSuperclassesDo: allInstancesDo:) ! TApplyingOnClassSide removeSelector: #environment! !TApplyingOnClassSide reorganize! (#'*NativeBoost-Core' externalTypeAlias:) (#'class hierarchy' obsoleteSubclasses subclassesDo: subclasses addSubclass: removeObsoleteSubclass: addObsoleteSubclass: removeSubclass:) (#composition noteNewBaseTraitCompositionApplied: assertConsistantCompositionsForNew: uses:) ('accessing' category soleInstance name) ('testing' isSelfEvaluating isObsolete canZapMethodDictionary isAnonymous isMeta) (#'*Tools-Debugger' canonicalArgumentName) (#'accessing hierarchy protocol' hasClassSide) ('fileIn/Out' fileOutInitializerOn: nonTrivial definition) ('*Manifest-Core' criticTheNonMetaclassClass) (#'*Ring-Core-Kernel' asFullRingDefinition asRingDefinition) ('pool variables' classPool) ('initialize-release' uses:instanceVariableNames: adoptInstance:from: instanceVariableNames:) ('accessing instances and variables' classVarNames) ('compiling' binding possibleVariablesFor:continuedFrom: bindingOf: wantsChangeSetLogging acceptsLoggingOfCompilation wantsRecompilationProgressReported) (#'*Fuel' fuelAccept:) (#initialize initializeFrom:) (#'instance creation' new) ('instance variables' removeInstVarNamed: addInstVarNamed:) ! TClassDescription removeSelector: #classVersion! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:31'! name: aString ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:31'! name ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:24'! environment ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:25'! environment: anEnvironment ^self explicitRequirement.! ! !TClass methodsFor: 'pool variables' stamp: 'SebastianTleye 7/16/2013 17:29'! sharedPools: aCollection ^self explicitRequirement.! ! !TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 17:33'! asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: packageKeys in: aRGSlice ^self explicitRequirement.! ! !TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 17:33'! asRingDefinition ^self explicitRequirement.! ! !TClass methodsFor: '*Monticello' stamp: 'SebastianTleye 7/16/2013 17:27'! asClassDefinition ^self explicitRequirement.! ! !TClass methodsFor: '*Monticello' stamp: 'SebastianTleye 7/16/2013 17:34'! classDefinitions ^self explicitRequirement.! ! !TClass methodsFor: 'copying' stamp: 'SebastianTleye 7/16/2013 17:28'! copy ^self explicitRequirement.! ! !TClass methodsFor: '*Fuel' stamp: 'SebastianTleye 7/16/2013 17:35'! fuelAccept: aGeneralMapper ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:31'! name: aString ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:31'! name ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:24'! environment ^self explicitRequirement.! ! !TClass methodsFor: 'accessing' stamp: 'SebastianTleye 7/16/2013 17:25'! environment: anEnvironment ^self explicitRequirement.! ! !TClass methodsFor: 'pool variables' stamp: 'SebastianTleye 7/16/2013 17:29'! sharedPools: aCollection ^self explicitRequirement.! ! !TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 17:33'! asRingDefinitionWithMethods: methodsBoolean withSuperclasses: supersBoolean withSubclasses: subsBoolean withPackageKeys: packageKeys in: aRGSlice ^self explicitRequirement.! ! !TClass methodsFor: '*Ring-Core-Kernel' stamp: 'SebastianTleye 7/16/2013 17:33'! asRingDefinition ^self explicitRequirement.! ! !TClass methodsFor: '*Monticello' stamp: 'SebastianTleye 7/16/2013 17:27'! asClassDefinition ^self explicitRequirement.! ! !TClass methodsFor: '*Monticello' stamp: 'SebastianTleye 7/16/2013 17:34'! classDefinitions ^self explicitRequirement.! ! !TClass methodsFor: 'copying' stamp: 'SebastianTleye 7/16/2013 17:28'! copy ^self explicitRequirement.! ! !TClass methodsFor: '*Fuel' stamp: 'SebastianTleye 7/16/2013 17:35'! fuelAccept: aGeneralMapper ^self explicitRequirement.! ! !TClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:06'! version ^self explicitRequirement.! ! !TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 7/17/2013 11:46'! removeInstVarNamed: aString "Remove the argument, aString, as one of the receiver's instance variables. Create an error notification if the argument is not found." ^self subclassResponsibility! ! !TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/16/2013 17:16'! hasClassSide ^self subclassResponsibility.! ! !TClassDescription methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:06'! version ^self explicitRequirement.! ! !TClassDescription methodsFor: 'instance variables' stamp: 'SebastianTleye 7/17/2013 11:46'! removeInstVarNamed: aString "Remove the argument, aString, as one of the receiver's instance variables. Create an error notification if the argument is not found." ^self subclassResponsibility! ! !TClassDescription methodsFor: 'accessing parallel hierarchy' stamp: 'SebastianTleye 7/16/2013 17:16'! hasClassSide ^self subclassResponsibility.! ! !TApplyingOnClassSide methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:32'! soleInstance ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: '*Tools-Debugger' stamp: 'SebastianTleye 7/17/2013 14:19'! canonicalArgumentName ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 13:39'! adoptInstance: oldInstance from: oldMetaClass ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 13:34'! fuelAccept: aGeneralMapper ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 14:39'! new ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 13:32'! soleInstance ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: '*Tools-Debugger' stamp: 'SebastianTleye 7/17/2013 14:19'! canonicalArgumentName ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: 'initialize-release' stamp: 'SebastianTleye 7/17/2013 13:39'! adoptInstance: oldInstance from: oldMetaClass ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: '*Fuel' stamp: 'SebastianTleye 7/17/2013 13:34'! fuelAccept: aGeneralMapper ^self explicitRequirement.! ! !TApplyingOnClassSide methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 14:39'! new ^self explicitRequirement.! ! !TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew: sizeRequested ^self explicitRequirement.! ! !TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew ^self explicitRequirement.! ! !TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 11:31'! name ^self explicitRequirement.! ! !TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew: sizeRequested ^self explicitRequirement.! ! !TBehavior methodsFor: 'instance creation' stamp: 'SebastianTleye 7/17/2013 10:08'! basicNew ^self explicitRequirement. ! ! !TBehavior methodsFor: 'accessing' stamp: 'SebastianTleye 7/17/2013 11:31'! name ^self explicitRequirement.! !