SystemOrganization addCategory: #'Refactoring-Core-Conditions'! SystemOrganization addCategory: #'Refactoring-Core-Model'! SystemOrganization addCategory: #'Refactoring-Core-Refactorings'! SystemOrganization addCategory: #'Refactoring-Core-Support'! !ClassDescription methodsFor: '*refactoring-core-deprecated' stamp: 'lr 10/31/2009 17:30'! metaclass self deprecated: 'Use aClass>>#theMetaClass instead'. ^ self theMetaClass! ! !ClassDescription methodsFor: '*refactoring-core-deprecated' stamp: 'lr 10/31/2009 17:31'! nonMetaclass self deprecated: 'Use aClass>>#theNonMetaClass instead'. ^ self theNonMetaClass! ! !ClassDescription methodsFor: '*refactoring-core-fixes' stamp: 'lr 5/15/2010 18:12'! whichSelectorsReallyRead: aString "This is a modified version of #whichSelectorsRead: that does exclude the writers." | index | index := self instVarIndexFor: aString ifAbsent: [ ^ IdentitySet new ]. ^ methodDict keys select: [ :each | (methodDict at: each) readsField: index ]! ! !SharedPool class methodsFor: '*refactoring-core' stamp: 'dvf 9/17/2003 03:10'! keys ^self classPool keys! ! Notification subclass: #RBRefactoringWarning instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RBRefactoringWarning commentStamp: 'lr 10/5/2010 16:17' prior: 0! The receiver is a warning that usually requires the user to validate. This is used in situations where either the behavior of the program will not be strictly preserved or the change may have a wider impact than the user may think. ! !Trait methodsFor: '*refactoring-core' stamp: 'md 3/14/2006 16:44'! includesBehavior: aClass ^false! ! !ClassTrait methodsFor: '*refactoring-core' stamp: 'md 3/14/2006 16:45'! includesBehavior: aClass ^false! ! !ClassTrait methodsFor: '*refactoring-core' stamp: 'md 3/14/2006 16:37'! soleInstance ^baseTrait! ! Error subclass: #RBRefactoringError instanceVariableNames: 'actionBlock' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RBRefactoringError commentStamp: 'lr 10/5/2010 16:17' prior: 0! The receiver is signaled whenever a precondition of a refactoring is violated. The action block, if defined, might help the user to resolve the issue.! !RBRefactoringError class methodsFor: 'signalling' stamp: 'lr 10/5/2010 16:07'! signal: aString with: aBlock ^ self new actionBlock: aBlock; signal: aString! ! !RBRefactoringError methodsFor: 'accessing' stamp: 'lr 10/5/2010 16:07'! actionBlock ^ actionBlock ! ! !RBRefactoringError methodsFor: 'accessing' stamp: 'lr 10/5/2010 16:07'! actionBlock: aBlock actionBlock := aBlock! ! Object subclass: #RBAbstractClass instanceVariableNames: 'name newMethods instanceVariableNames model superclass subclasses removedMethods realClass' classVariableNames: 'LookupSuperclass' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBAbstractClass class methodsFor: 'class initialization' stamp: ''! initialize LookupSuperclass := Object new! ! !RBAbstractClass methodsFor: 'comparing' stamp: ''! = aRBClass ^self class = aRBClass class and: [self name = aRBClass name and: [self model = aRBClass model]]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! addInstanceVariable: aString self privateInstanceVariableNames add: aString. model addInstanceVariable: aString to: self! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! addMethod: aRBMethod self newMethods at: aRBMethod selector put: aRBMethod. removedMethods notNil ifTrue: [removedMethods remove: aRBMethod selector ifAbsent: []]! ! !RBAbstractClass methodsFor: 'private' stamp: ''! addSubclass: aRBClass self subclasses add: aRBClass! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! allClassVariableNames ^self subclassResponsibility! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! allInstanceVariableNames | sprClass | sprClass := self superclass. ^sprClass isNil ifTrue: [self instanceVariableNames] ifFalse: [sprClass allInstanceVariableNames , self instanceVariableNames]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! allPoolDictionaryNames ^self subclassResponsibility! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! allSelectors | class selectors | class := self. selectors := Set new. [class notNil] whileTrue: [selectors addAll: class selectors. class := class superclass]. ^selectors! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! allSubclasses | allSubclasses index | index := 1. allSubclasses := self subclasses asOrderedCollection. [index <= allSubclasses size] whileTrue: [allSubclasses addAll: (allSubclasses at: index) subclasses. index := index + 1]. ^allSubclasses! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! allSuperclasses | supers sprClass | supers := OrderedCollection new. sprClass := self superclass. [sprClass notNil] whileTrue: [supers add: sprClass. sprClass := sprClass superclass]. ^supers! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'md 1/17/2006 14:17'! bindingOf: aString ^self realClass classPool associationAt: aString asSymbol ifAbsent: [self realClass classPool associationAt: aString asString ifAbsent: [nil]]! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 7/23/2010 08:02'! classBinding ^ Smalltalk globals associationAt: self name! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:47'! compile: aString ^ self compile: aString withAttributesFrom: (self methodFor: (RBParser parseMethodPattern: aString))! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:47'! compile: aString classified: aSymbolCollection | change method | change := model compile: aString in: self classified: aSymbolCollection. method := RBMethod for: self source: aString selector: change selector. self addMethod: method. ^ change! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:16'! compile: aString withAttributesFrom: aRBMethod | change method | change := model compile: aString in: self classified: aRBMethod protocols. method := RBMethod for: self source: aString selector: change selector. self addMethod: method. ^ change! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:48'! compileTree: aRBMethodNode ^ (self methodFor: aRBMethodNode selector) compileTree: aRBMethodNode! ! !RBAbstractClass methodsFor: 'testing' stamp: 'dc 5/18/2007 14:53'! definesClassVariable: aSymbol self realClass isTrait ifTrue: [^false]. (self directlyDefinesClassVariable: aSymbol) ifTrue: [^true]. ^self superclass notNil and: [self superclass definesClassVariable: aSymbol]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesInstanceVariable: aString (self directlyDefinesInstanceVariable: aString) ifTrue: [^true]. ^self superclass notNil and: [self superclass definesInstanceVariable: aString]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesMethod: aSelector (self directlyDefinesMethod: aSelector) ifTrue: [^true]. ^self superclass notNil and: [self superclass definesMethod: aSelector]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesPoolDictionary: aSymbol (self directlyDefinesPoolDictionary: aSymbol) ifTrue: [^true]. ^self inheritsPoolDictionaries and: [self superclass notNil and: [self superclass definesPoolDictionary: aSymbol]]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesVariable: aVariableName ^(self definesClassVariable: aVariableName) or: [self definesInstanceVariable: aVariableName]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesClassVariable: aString self subclassResponsibility! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesInstanceVariable: aString ^self instanceVariableNames includes: aString! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesMethod: aSelector self isDefined ifTrue: [(self hasRemoved: aSelector) ifTrue: [^false]. (self realClass includesSelector: aSelector) ifTrue: [^true]]. ^newMethods notNil and: [newMethods includesKey: aSelector]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesPoolDictionary: aString self subclassResponsibility! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesVariable: aVariableName ^(self directlyDefinesClassVariable: aVariableName) or: [self directlyDefinesInstanceVariable: aVariableName]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'cwp 5/10/2010 23:49'! existingMethodsThatReferTo: aSymbol | existingMethods special byte | special := Smalltalk hasSpecialSelector: aSymbol ifTrueSetByte: [ :value | byte := value ]. existingMethods := self realClass thoroughWhichSelectorsReferTo: aSymbol special: special byte: byte. (newMethods isNil and: [ removedMethods isNil ]) ifTrue: [ ^ existingMethods ]. ^ existingMethods reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 1/18/2010 19:39'! existingMethodsThatReferToClassVariable: aString | binding existingMethods | binding := (self bindingOf: aString) ifNil: [ ^ #() ]. existingMethods := self realClass whichSelectorsReferTo: binding. (newMethods isNil and: [ removedMethods isNil ]) ifTrue: [ ^ existingMethods ]. ^ existingMethods reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 1/18/2010 19:40'! existingMethodsThatReferToInstanceVariable: aString | existingMethods | existingMethods := self realClass whichSelectorsAccess: aString. (newMethods isNil and: [ removedMethods isNil ]) ifTrue: [ ^ existingMethods ]. ^ existingMethods reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hasRemoved: aSelector ^removedMethods notNil and: [removedMethods includes: aSelector]! ! !RBAbstractClass methodsFor: 'comparing' stamp: ''! hash ^self name hash bitXor: self class hash! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesClassVariable: aString (self definesClassVariable: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesClassVariable: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesInstanceVariable: aString (self definesInstanceVariable: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesInstanceVariable: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesMethod: aSelector (self definesMethod: aSelector) ifTrue: [^true]. ^self subclassRedefines: aSelector! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesPoolDictionary: aString (self definesPoolDictionary: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesPoolDictionary: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesVariable: aString (self definesVariable: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesVariable: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! includesClass: aRBClass | currentClass | currentClass := self. [currentClass notNil and: [currentClass ~= aRBClass]] whileTrue: [currentClass := currentClass superclass]. ^currentClass = aRBClass! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! inheritsPoolDictionaries ^false! ! !RBAbstractClass methodsFor: 'initialize-release' stamp: ''! initialize name := #'Unknown Class'! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! instanceVariableNames ^self privateInstanceVariableNames copy! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! instanceVariableNames: aCollectionOfStrings instanceVariableNames := aCollectionOfStrings asOrderedCollection! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! isAbstract (self whichSelectorsReferToSymbol: #subclassResponsibility) isEmpty ifFalse: [^true]. model allReferencesToClass: self do: [:each | ^false]. ^true! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! isDefined ^self realClass notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! isMeta self subclassResponsibility! ! !RBAbstractClass methodsFor: 'deprecated' stamp: 'lr 10/31/2009 17:32'! metaclass self deprecated: 'Use aClass>>#theMetaClass instead'. ^ self theMetaClass! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! methodFor: aSelector ^self newMethods at: aSelector ifAbsent: [| compiledMethod class | (self hasRemoved: aSelector) ifTrue: [^nil]. class := self realClass. class isNil ifTrue: [^nil]. compiledMethod := class compiledMethodAt: aSelector ifAbsent: [nil]. compiledMethod isNil ifTrue: [nil] ifFalse: [RBMethod for: self fromMethod: compiledMethod andSelector: aSelector]]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! model ^model! ! !RBAbstractClass methodsFor: 'initialize-release' stamp: ''! model: aRBSmalltalk model := aRBSmalltalk! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! name ^name! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! name: aSymbol name := aSymbol! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! newMethods ^newMethods isNil ifTrue: [newMethods := IdentityDictionary new] ifFalse: [newMethods]! ! !RBAbstractClass methodsFor: 'deprecated' stamp: 'lr 10/31/2009 17:32'! nonMetaclass self deprecated: 'Use aClass>>#theNonMetaClass instead'. ^ self theNonMetaClass! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! parseTreeFor: aSelector | class | class := self whoDefinesMethod: aSelector. class isNil ifTrue: [^nil]. ^(class methodFor: aSelector) parseTree! ! !RBAbstractClass methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self name! ! !RBAbstractClass methodsFor: 'private' stamp: ''! privateInstanceVariableNames instanceVariableNames isNil ifTrue: [self isDefined ifTrue: [self instanceVariableNames: self realClass instVarNames] ifFalse: [instanceVariableNames := OrderedCollection new]]. ^instanceVariableNames! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'jmb 1/23/2003 15:50'! protocolsFor: aSelector | change | change := self isMeta ifTrue: [model changes changeForMetaclass: name selector: aSelector] ifFalse: [model changes changeForClass: name selector: aSelector]. ^change isNil ifTrue: [self isDefined ifTrue: [Array with: (BrowserEnvironment new whichProtocolIncludes: aSelector in: self realClass)] ifFalse: [#(#accessing)]] ifFalse: [change protocols]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! realClass ^realClass! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! realClass: aClass realClass := aClass. superclass isNil ifTrue: [superclass := LookupSuperclass]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! removeInstanceVariable: aString self privateInstanceVariableNames remove: aString. model removeInstanceVariable: aString from: self! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! removeMethod: aSelector self newMethods removeKey: aSelector ifAbsent: []. model removeMethod: aSelector from: self. self removedMethods add: aSelector! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! removeSubclass: aRBClass self subclasses remove: aRBClass ifAbsent: []! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! removedMethods ^removedMethods isNil ifTrue: [removedMethods := Set new] ifFalse: [removedMethods]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! renameInstanceVariable: oldName to: newName around: aBlock self privateInstanceVariableNames at: (self privateInstanceVariableNames indexOf: oldName asString) put: newName asString. model renameInstanceVariable: oldName to: newName in: self around: aBlock! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! selectors | selectors | selectors := Set new. selectors addAll: self newMethods keys. self isDefined ifTrue: [selectors addAll: self realClass selectors. removedMethods notNil ifTrue: [removedMethods do: [:each | selectors remove: each ifAbsent: []]]]. ^selectors! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! soleInstance ^ self theNonMetaClass! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! sourceCodeFor: aSelector | class | class := self whoDefinesMethod: aSelector. class isNil ifTrue: [^nil]. ^(class methodFor: aSelector) source! ! !RBAbstractClass methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPutAll: self name! ! !RBAbstractClass methodsFor: 'testing' stamp: 'lr 1/3/2010 11:47'! subclassRedefines: aSelector "Return true, if one of your subclasses redefines the method with name, aMethod" ^ self allSubclasses anySatisfy: [ :each | each directlyDefinesMethod: aSelector ]! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 2/3/2008 13:33'! subclasses ^subclasses isNil ifTrue: [subclasses := self isDefined ifTrue: [((self realClass subclasses collect: [:each | model classFor: each]) reject: [ :each | each isNil ]) asOrderedCollection] ifFalse: [OrderedCollection new]] ifFalse: [subclasses]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! superclass ^superclass == LookupSuperclass ifTrue: [model classFor: self realClass superclass] ifFalse: [superclass]! ! !RBAbstractClass methodsFor: 'private' stamp: ''! superclass: aRBClass self superclass notNil ifTrue: [self superclass removeSubclass: self]. superclass := aRBClass. superclass notNil ifTrue: [superclass addSubclass: self].! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:09'! theMetaClass ^ model metaclassNamed: self name! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! theNonMetaClass ^ model classNamed: self name! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! typeOfClassVariable: aSymbol ^model classNamed: #Object! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:43'! whichSelectorsReferToClass: aRBClass | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToClassNamed: aRBClass name) ifTrue: [ selectors add: each selector ] ] ]. (self isDefined and: [ aRBClass isDefined ]) ifTrue: [ selectors addAll: (self existingMethodsThatReferTo: aRBClass classBinding). selectors addAll: (self existingMethodsThatReferTo: aRBClass name) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'! whichSelectorsReferToClassVariable: aString | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToVariable: aString) ifTrue: [ selectors add: each selector ] ] ]. self isDefined ifTrue: [ selectors addAll: (self existingMethodsThatReferToClassVariable: aString) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'! whichSelectorsReferToInstanceVariable: aString | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToVariable: aString) ifTrue: [ selectors add: each selector ] ] ]. self isDefined ifTrue: [ selectors addAll: (self existingMethodsThatReferToInstanceVariable: aString) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'! whichSelectorsReferToSymbol: aSymbol | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToSymbol: aSymbol) ifTrue: [ selectors add: each selector ] ] ]. self isDefined ifTrue: [ selectors addAll: (self existingMethodsThatReferTo: aSymbol) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! whoDefinesClassVariable: aString | sprClass | (self directlyDefinesClassVariable: aString) ifTrue: [^self]. sprClass := self superclass. ^sprClass isNil ifTrue: [nil] ifFalse: [sprClass whoDefinesClassVariable: aString]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! whoDefinesInstanceVariable: aString | sprClass | (self directlyDefinesInstanceVariable: aString) ifTrue: [^self]. sprClass := self superclass. ^sprClass isNil ifTrue: [nil] ifFalse: [sprClass whoDefinesInstanceVariable: aString]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! whoDefinesMethod: aSelector | sprClass | (self directlyDefinesMethod: aSelector) ifTrue: [^self]. sprClass := self superclass. ^sprClass isNil ifTrue: [nil] ifFalse: [sprClass whoDefinesMethod: aSelector]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! withAllSubclasses ^(self allSubclasses) add: self; yourself! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! withAllSuperclasses ^(self allSuperclasses) add: self; yourself! ! RBAbstractClass subclass: #RBClass instanceVariableNames: 'classVariableNames poolDictionaryNames category comment' classVariableNames: 'LookupComment' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBClass class methodsFor: 'instance creation' stamp: ''! existingNamed: aSymbol ^(self named: aSymbol) realName: aSymbol; yourself! ! !RBClass class methodsFor: 'class initialization' stamp: 'lr 7/1/2008 10:57'! initialize LookupComment := Object new! ! !RBClass class methodsFor: 'instance creation' stamp: ''! named: aSymbol ^(self new) name: aSymbol; yourself! ! !RBClass methodsFor: 'variable accessing' stamp: ''! addClassVariable: aString self privateClassVariableNames add: aString asSymbol. model addClassVariable: aString to: self! ! !RBClass methodsFor: 'variable accessing' stamp: ''! addPoolDictionary: aString self privatePoolDictionaryNames add: aString asSymbol. model addPool: aString to: self! ! !RBClass methodsFor: 'accessing' stamp: ''! allClassVariableNames | sprClass | sprClass := self superclass. ^sprClass isNil ifTrue: [self classVariableNames] ifFalse: [sprClass allClassVariableNames , self classVariableNames]! ! !RBClass methodsFor: 'accessing' stamp: ''! allPoolDictionaryNames | sprClass | sprClass := self superclass. ^sprClass isNil ifTrue: [self poolDictionaryNames] ifFalse: [sprClass allPoolDictionaryNames , self poolDictionaryNames]! ! !RBClass methodsFor: 'accessing' stamp: 'bh 11/8/2000 15:22'! category ^category isNil ifTrue: [self isDefined ifTrue: [category := self realClass category] ifFalse: [model environment whichCategoryIncludes: self name]] ifFalse: [category] ! ! !RBClass methodsFor: 'accessing' stamp: ''! category: aSymbol category := aSymbol! ! !RBClass methodsFor: 'accessing' stamp: ''! classVariableNames ^self privateClassVariableNames copy! ! !RBClass methodsFor: 'accessing' stamp: ''! classVariableNames: aCollectionOfStrings classVariableNames := (aCollectionOfStrings collect: [:each | each asSymbol]) asOrderedCollection! ! !RBClass methodsFor: 'accessing' stamp: 'lr 7/1/2008 11:09'! comment ^ comment = LookupComment ifTrue: [ comment := self isDefined ifTrue: [ self realClass comment ] ifFalse: [ nil ] ] ifFalse: [ comment ]! ! !RBClass methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:55'! comment: aString model comment: (comment := aString) in: self! ! !RBClass methodsFor: 'accessing' stamp: 'bh 11/8/2000 14:38'! definitionString | definitionStream | definitionStream := WriteStream on: ''. definitionStream nextPutAll: self superclass printString; nextPutAll: ' subclass: #'; nextPutAll: self name; nextPutAll: ' instanceVariableNames: '''. self instanceVariableNames do: [:each | definitionStream nextPutAll: each; nextPut: $ ]. definitionStream nextPutAll: ''' classVariableNames: '''. self classVariableNames do: [:each | definitionStream nextPutAll: each; nextPut: $ ]. definitionStream nextPutAll: ''' poolDictionaries: '''. self poolDictionaryNames do: [:each | definitionStream nextPutAll: each; nextPut: $ ]. definitionStream nextPutAll: ''' category: #'''. definitionStream nextPutAll: self category asString. definitionStream nextPut: $'. ^definitionStream contents! ! !RBClass methodsFor: 'testing' stamp: ''! directlyDefinesClassVariable: aString ^self classVariableNames includes: aString asSymbol! ! !RBClass methodsFor: 'testing' stamp: ''! directlyDefinesPoolDictionary: aString ^self poolDictionaryNames includes: aString asSymbol! ! !RBClass methodsFor: 'initialize-release' stamp: 'lr 7/1/2008 10:58'! initialize super initialize. comment := LookupComment! ! !RBClass methodsFor: 'testing' stamp: ''! isMeta ^false! ! !RBClass methodsFor: 'accessing' stamp: ''! poolDictionaryNames ^self privatePoolDictionaryNames copy! ! !RBClass methodsFor: 'accessing' stamp: ''! poolDictionaryNames: aCollectionOfStrings poolDictionaryNames := (aCollectionOfStrings collect: [:each | each asSymbol]) asOrderedCollection! ! !RBClass methodsFor: 'private' stamp: ''! privateClassVariableNames (self isDefined and: [classVariableNames isNil]) ifTrue: [self classVariableNames: self realClass classVarNames]. ^classVariableNames! ! !RBClass methodsFor: 'private' stamp: 'djr 3/31/2010 14:00'! privatePoolDictionaryNames (self isDefined and: [poolDictionaryNames isNil]) ifTrue: [self poolDictionaryNames: (self realClass sharedPools collect: [:each | self realClass environment keyAtValue: each])]. ^poolDictionaryNames! ! !RBClass methodsFor: 'initialize-release' stamp: 'lr 7/23/2010 07:49'! realName: aSymbol self realClass: (self class environment at: aSymbol)! ! !RBClass methodsFor: 'variable accessing' stamp: ''! removeClassVariable: aString self privateClassVariableNames remove: aString asSymbol. model removeClassVariable: aString from: self! ! !RBClass methodsFor: 'variable accessing' stamp: ''! removePoolDictionary: aString self privatePoolDictionaryNames remove: aString asSymbol! ! !RBClass methodsFor: 'variable accessing' stamp: ''! renameClassVariable: oldName to: newName around: aBlock self privateClassVariableNames at: (self privateClassVariableNames indexOf: oldName asSymbol) put: newName asSymbol. model renameClassVariable: oldName to: newName in: self around: aBlock! ! !RBClass methodsFor: 'accessing' stamp: 'lr 7/23/2010 08:03'! sharedPools ^ self allPoolDictionaryNames collect: [ :each | Smalltalk globals at: each asSymbol ifAbsent: [ Dictionary new ] ]! ! !RBClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! theNonMetaClass ^ self! ! RBAbstractClass subclass: #RBMetaclass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBMetaclass class methodsFor: 'instance creation' stamp: ''! existingNamed: aSymbol ^(self named: aSymbol) realName: aSymbol; yourself! ! !RBMetaclass class methodsFor: 'instance creation' stamp: ''! named: aSymbol ^(self new) name: aSymbol; yourself! ! !RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! allClassVariableNames ^ self theNonMetaClass allClassVariableNames! ! !RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! allPoolDictionaryNames ^ self theNonMetaClass allPoolDictionaryNames! ! !RBMetaclass methodsFor: 'testing' stamp: 'lr 10/26/2009 22:08'! directlyDefinesClassVariable: aString ^ self theNonMetaClass directlyDefinesClassVariable: aString! ! !RBMetaclass methodsFor: 'testing' stamp: 'lr 10/26/2009 22:08'! directlyDefinesPoolDictionary: aString ^ self theNonMetaClass directlyDefinesPoolDictionary: aString! ! !RBMetaclass methodsFor: 'testing' stamp: ''! isMeta ^true! ! !RBMetaclass methodsFor: 'printing' stamp: ''! printOn: aStream super printOn: aStream. aStream nextPutAll: ' class'! ! !RBMetaclass methodsFor: 'initialize-release' stamp: 'lr 7/23/2010 08:03'! realName: aSymbol self realClass: (Smalltalk globals at: aSymbol) classSide! ! !RBMetaclass methodsFor: 'printing' stamp: ''! storeOn: aStream super storeOn: aStream. aStream nextPutAll: ' class'! ! !RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:09'! theMetaClass ^ self! ! Object subclass: #RBAbstractCondition instanceVariableNames: 'errorMacro' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBAbstractCondition methodsFor: 'logical operations' stamp: ''! & aCondition ^RBConjunctiveCondition new left: self right: aCondition! ! !RBAbstractCondition methodsFor: 'checking' stamp: ''! check self subclassResponsibility! ! !RBAbstractCondition methodsFor: 'accessing' stamp: ''! errorBlock ^self errorBlockFor: false! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorBlockFor: aBoolean ^nil! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorMacro ^errorMacro isNil ifTrue: ['unknown'] ifFalse: [errorMacro]! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorMacro: aString errorMacro := aString! ! !RBAbstractCondition methodsFor: 'accessing' stamp: ''! errorString ^self errorStringFor: false! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorStringFor: aBoolean ^self errorMacro expandMacrosWith: aBoolean! ! !RBAbstractCondition methodsFor: 'logical operations' stamp: ''! not ^RBNegationCondition on: self! ! !RBAbstractCondition methodsFor: 'logical operations' stamp: ''! | aCondition "(A | B) = (A not & B not) not" ^(self not & aCondition not) not! ! RBAbstractCondition subclass: #RBCondition instanceVariableNames: 'block type errorBlock' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBCondition class methodsFor: 'instance creation' stamp: ''! canUnderstand: aSelector in: aClass ^self new type: (Array with: #understandsSelector with: aClass with: aSelector) block: [aClass definesMethod: aSelector] errorString: aClass printString , ' <1?:does not >understand<1?s:> ' , aSelector printString! ! !RBCondition class methodsFor: 'utilities' stamp: ''! checkClassVarName: aName in: aClass | string | aName isString ifFalse: [^false]. string := aName asString. (self reservedNames includes: string) ifTrue: [^false]. string isEmpty ifTrue: [^false]. string first isUppercase ifFalse: [^false]. ^RBScanner isVariable: string! ! !RBCondition class methodsFor: 'utilities' stamp: ''! checkInstanceVariableName: aName in: aClass | string | aName isString ifFalse: [^false]. string := aName asString. string isEmpty ifTrue: [^false]. (self reservedNames includes: string) ifTrue: [^false]. string first isUppercase ifTrue: [^false]. ^RBScanner isVariable: string! ! !RBCondition class methodsFor: 'utilities' stamp: ''! checkMethodName: aName in: aClass ^aName isString and: [RBScanner isSelector: aName]! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesClassVariable: aString in: aClass ^self new type: (Array with: #definesClassVar with: aClass with: aString) block: [aClass definesClassVariable: aString] errorString: aClass printString , ' <1?:does not >define<1?s:> class variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesInstanceVariable: aString in: aClass ^self new type: (Array with: #definesInstVar with: aClass with: aString) block: [aClass definesInstanceVariable: aString] errorString: aClass printString , ' <1?:does not >define<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesSelector: aSelector in: aClass ^self new type: (Array with: #definesSelector with: aClass with: aSelector) block: [aClass directlyDefinesMethod: aSelector] errorString: aClass printString , ' <1?:does not >define<1?s:> ' , aSelector printString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesTempVar: aString in: aClass ignoreClass: subclass | condition | condition := self new. condition type: (Array with: #definesTempVarIgnoring with: aClass with: aString with: subclass) block: [| method | method := self methodDefiningTemporary: aString in: aClass ignore: [:class :aSelector | class includesClass: subclass]. method notNil ifTrue: [condition errorMacro: method printString , ' defines variable ' , aString]. method notNil] errorString: aClass printString , ' <1?:does not >define<1?s:> temporary variable ' , aString. ^condition! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesTemporaryVariable: aString in: aClass | condition | condition := self new. condition type: (Array with: #definesTempVar with: aClass with: aString) block: [| method | method := self methodDefiningTemporary: aString in: aClass ignore: [:class :selector | false]. method notNil ifTrue: [condition errorMacro: method printString , ' defines variable ' , aString]. method notNil] errorString: aClass printString , ' <1?:does not >define<1?s:> temporary variable ' , aString. ^condition! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! directlyDefinesClassVariable: aString in: aClass ^self new type: (Array with: #directlyDefinesClassVar with: aClass with: aString) block: [aClass directlyDefinesClassVariable: aString] errorString: aClass printString , ' <1?:does not >directly define<1?s:> class variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! directlyDefinesInstanceVariable: aString in: aClass ^self new type: (Array with: #directlyDefinesInstanceVariable with: aClass with: aString) block: [aClass directlyDefinesInstanceVariable: aString] errorString: aClass printString , ' <1?:does not >directly define<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! empty "Returns an empty condition" ^self new type: (Array with: #empty) block: [true] errorString: 'Empty'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hasSubclasses: aClass ^self new type: (Array with: #hasSubclasses with: aClass) block: [aClass subclasses isEmpty not] errorString: aClass printString , ' has <1?:no >subclasses'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hasSuperclass: aClass ^self new type: (Array with: #hasSuperclass with: aClass) block: [aClass superclass isNil not] errorString: aClass printString , ' has <1?a:no> superclass'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hierarchyOf: aClass canUnderstand: aSelector ^self new type: (Array with: #hierarchyUnderstandsSelector with: aClass with: aSelector) block: [aClass hierarchyDefinesMethod: aSelector] errorString: aClass printString , ' <1?or a subclass:and all subclasses do not> understand<1?s:> ' , aSelector printString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hierarchyOf: aClass definesVariable: aString ^self new type: (Array with: #hierarchyDefinesInstVar with: aClass with: aString) block: [aClass hierarchyDefinesVariable: aString] errorString: aClass printString , ' or one of its subclasses <1?:does not >define<1?s:> variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hierarchyOf: aClass referencesInstanceVariable: aString ^self new type: (Array with: #hierarchyReferencesInstVar with: aClass with: aString) block: [(aClass withAllSubclasses detect: [:each | (each whichSelectorsReferToInstanceVariable: aString) isEmpty not] ifNone: [nil]) notNil] errorString: aClass printString , ' or subclass <1?:does not >reference<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isAbstractClass: aClass ^self new type: (Array with: #IsAbstractClass with: aClass) block: [aClass isAbstract] errorString: aClass printString , ' is <1?:not >an abstract class'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isClass: anObject ^self new type: (Array with: #IsClass with: anObject) block: [anObject isBehavior] errorString: anObject printString , ' is <1?:not >a behavior'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isEmptyClass: anObject ^self new type: (Array with: #IsEmptyClass with: anObject) block: [anObject classVariableNames isEmpty and: [anObject instanceVariableNames isEmpty and: [anObject selectors isEmpty]]] errorString: anObject printString , ' is <1?:not > empty'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isGlobal: aString in: aRBSmalltalk ^self new type: (Array with: #isGlobal with: aString) block: [aRBSmalltalk includesGlobal: aString asSymbol] errorString: aString , ' is <1?:not >a class or global variable'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isImmediateSubclass: subclass of: superClass ^self new type: (Array with: #immediateSubclass with: superClass with: subclass) block: [subclass superclass = superClass] errorString: subclass printString , ' is <1?:not >an immediate subclass of ' , superClass printString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isMetaclass: anObject ^self new type: (Array with: #IsMetaclass with: anObject) block: [anObject isMeta] errorString: anObject printString , ' is <1?:not >a metaclass'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isSymbol: aString ^self new type: (Array with: #isSymbol with: aString) block: [aString isSymbol] errorString: aString , ' is <1?:not >a symbol'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidClassName: aString ^self new type: (Array with: #validClassName with: aString) block: [self validClassName: aString] errorString: aString , ' is <1?:not >a valid class name'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidClassVarName: aString for: aClass ^self new type: (Array with: #validClassVarName with: aString with: aClass) block: [self checkClassVarName: aString in: aClass] errorString: aString , ' is <1?:not >a valid class variable name'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidInstanceVariableName: aString for: aClass ^self new type: (Array with: #validInstVarName with: aString with: aClass) block: [self checkInstanceVariableName: aString in: aClass] errorString: aString , ' is <1?:not >a valid instance variable name'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidMethodName: aString for: aClass ^self new type: (Array with: #validMethodName with: aString with: aClass) block: [self checkMethodName: aString in: aClass] errorString: aString printString , ' is <1?:not >a valid method name'! ! !RBCondition class methodsFor: 'utilities' stamp: 'lr 11/2/2009 00:14'! methodDefiningTemporary: aString in: aClass ignore: aBlock | searcher method | searcher := RBParseTreeSearcher new. method := nil. "Shut-up the warning" searcher matches: aString do: [:aNode :answer | ^method]. aClass withAllSubclasses do: [:class | class selectors do: [:each | (aBlock value: class value: each) ifFalse: [| parseTree | method := class methodFor: each. parseTree := class parseTreeFor: each. parseTree notNil ifTrue: [searcher executeTree: parseTree]]]]. ^nil! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! referencesInstanceVariable: aString in: aClass ^self new type: (Array with: #referencesInstVar with: aClass with: aString) block: [(aClass whichSelectorsReferToInstanceVariable: aString) isEmpty not] errorString: aClass printString , ' <1?:does not >reference<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'utilities' stamp: ''! reservedNames ^#('self' 'true' 'false' 'nil' 'thisContext' 'super')! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! subclassesOf: aClass referToSelector: aSelector ^self new type: (Array with: #subclassReferences with: aClass with: aSelector) block: [(aClass subclasses detect: [:each | (each selectors detect: [:sel | | tree | tree := each parseTreeFor: sel. tree notNil and: [tree superMessages includes: aSelector]] ifNone: [nil]) notNil] ifNone: [nil]) notNil] errorString: '<1?:no:a> subclass of ' , aClass printString , ' refers to ' , aSelector printString! ! !RBCondition class methodsFor: 'utilities' stamp: ''! validClassName: aString "Class names and class variable names have the same restrictions" ^self checkClassVarName: aString in: self! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! withBlock: aBlock ^self new withBlock: aBlock! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! withBlock: aBlock errorString: aString ^self new type: #unknown block: aBlock errorString: aString! ! !RBCondition methodsFor: 'checking' stamp: ''! check ^block value! ! !RBCondition methodsFor: 'initialize-release' stamp: ''! errorBlock: anObject errorBlock := anObject! ! !RBCondition methodsFor: 'accessing' stamp: ''! errorBlockFor: aBoolean ^errorBlock! ! !RBCondition methodsFor: 'printing' stamp: 'bh 4/10/2001 16:51'! printOn: aStream aStream nextPutAll: type asString! ! !RBCondition methodsFor: 'initialize-release' stamp: 'lr 11/19/2009 11:45'! type: aSymbol block: aBlock errorString: aString type := aSymbol. block := aBlock. self errorMacro: aString! ! !RBCondition methodsFor: 'initialize-release' stamp: ''! withBlock: aBlock block := aBlock. type := #(#generic)! ! RBAbstractCondition subclass: #RBConjunctiveCondition instanceVariableNames: 'left right failed' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBConjunctiveCondition methodsFor: 'checking' stamp: ''! check left check ifFalse: [failed := #leftFailed. ^false]. right check ifFalse: [failed := #rightFailed. ^false]. ^true! ! !RBConjunctiveCondition methodsFor: 'private' stamp: 'lr 11/2/2009 23:38'! errorBlockFor: aBoolean ^aBoolean ifTrue: [nil] ifFalse: [failed = #leftFailed ifTrue: [left errorBlock] ifFalse: [right errorBlock]]! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! errorMacro ^errorMacro isNil ifTrue: [self longMacro] ifFalse: [super errorMacro]! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! errorStringFor: aBoolean ^aBoolean ifTrue: [self neitherFailed] ifFalse: [self perform: failed]! ! !RBConjunctiveCondition methodsFor: 'initialize-release' stamp: ''! left: aCondition right: aCondition2 left := aCondition. right := aCondition2. failed := #unknownFailed! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! leftFailed ^left errorStringFor: false! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! longMacro ^'(' , left errorMacro , ') <1?AND:OR> (' , right errorMacro , ')'! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! neitherFailed ^(left errorStringFor: true) , ' AND ' , (right errorStringFor: true)! ! !RBConjunctiveCondition methodsFor: 'printing' stamp: 'bh 4/10/2001 16:52'! printOn: aStream aStream nextPutAll: left asString; nextPutAll: ' & '; nextPutAll: right asString ! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! rightFailed ^right errorStringFor: false! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! unknownFailed ^(left errorStringFor: false) , ' OR ' , (right errorStringFor: false)! ! RBAbstractCondition subclass: #RBNegationCondition instanceVariableNames: 'condition' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBNegationCondition class methodsFor: 'instance creation' stamp: ''! on: aCondition ^self new condition: aCondition! ! !RBNegationCondition methodsFor: 'checking' stamp: ''! check ^condition check not! ! !RBNegationCondition methodsFor: 'initialize-release' stamp: ''! condition: aCondition condition := aCondition. self errorMacro: condition errorMacro! ! !RBNegationCondition methodsFor: 'private' stamp: ''! errorBlockFor: aBoolean ^condition errorBlockFor: aBoolean not! ! !RBNegationCondition methodsFor: 'private' stamp: ''! errorStringFor: aBoolean ^condition errorStringFor: aBoolean not! ! !RBNegationCondition methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: 'NOT '; print: condition! ! Object subclass: #RBMethod instanceVariableNames: 'class compiledMethod source selector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBMethod class methodsFor: 'instance creation' stamp: ''! for: aRBClass fromMethod: aCompiledMethod andSelector: aSymbol ^(self new) modelClass: aRBClass; method: aCompiledMethod; selector: aSymbol; yourself! ! !RBMethod class methodsFor: 'instance creation' stamp: ''! for: aRBClass source: aString selector: aSelector ^(self new) modelClass: aRBClass; selector: aSelector; source: aString; yourself! ! !RBMethod methodsFor: 'compiling' stamp: 'lr 11/1/2009 23:53'! compileTree: aBRMethodNode | method sourceCode change | sourceCode := aBRMethodNode newSource. change := self modelClass model compile: sourceCode in: self modelClass classified: self protocols. method := self class for: self modelClass source: sourceCode selector: aBRMethodNode selector. self modelClass addMethod: method. ^ change! ! !RBMethod methodsFor: 'private' stamp: 'lr 1/3/2010 11:47'! literal: anObject containsReferenceTo: aSymbol anObject = aSymbol ifTrue: [ ^ true ]. anObject class = Array ifFalse: [ ^ false ]. ^ anObject anySatisfy: [ :each | self literal: each containsReferenceTo: aSymbol ]! ! !RBMethod methodsFor: 'accessing' stamp: ''! method ^compiledMethod! ! !RBMethod methodsFor: 'accessing' stamp: ''! method: aCompiledMethod compiledMethod := aCompiledMethod! ! !RBMethod methodsFor: 'accessing' stamp: ''! modelClass ^class! ! !RBMethod methodsFor: 'accessing' stamp: ''! modelClass: aRBClass class := aRBClass! ! !RBMethod methodsFor: 'accessing' stamp: ''! parseTree ^RBParser parseMethod: self source onError: [:str :pos | ^nil]! ! !RBMethod methodsFor: 'printing' stamp: ''! printOn: aStream class printOn: aStream. aStream nextPutAll: '>>'; nextPutAll: self selector! ! !RBMethod methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:15'! protocols ^ self modelClass protocolsFor: self selector! ! !RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! refersToClassNamed: aSymbol | searcher | searcher := RBParseTreeSearcher new. searcher matches: aSymbol asString do: [:node :answer | true]. ^(searcher executeTree: self parseTree initialAnswer: false) or: [self refersToSymbol: aSymbol]! ! !RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! refersToSymbol: aSymbol | searcher | searcher := RBParseTreeSearcher new. searcher matches: aSymbol printString do: [:node :answer | true]; matches: '`#literal' do: [:node :answer | answer or: [self literal: node value containsReferenceTo: aSymbol]]. (RBScanner isSelector: aSymbol) ifTrue: [searcher matches: '`@object ' , (RBParseTreeSearcher buildSelectorString: aSymbol) do: [:node :answer | true]]. ^searcher executeTree: self parseTree initialAnswer: false! ! !RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! refersToVariable: aString | searcher tree | tree := self parseTree. ((tree defines: aString) or: [tree body defines: aString]) ifTrue: [^false]. searcher := RBParseTreeSearcher new. searcher matches: aString do: [:node :answer | true]; matches: '[:`@vars | | `@temps | `@.Stmts]' do: [:node :answer | answer or: [((node defines: aString) or: [node body defines: aString]) not and: [searcher executeTree: node body initialAnswer: false]]]. ^searcher executeTree: self parseTree initialAnswer: false! ! !RBMethod methodsFor: 'accessing' stamp: ''! selector ^selector! ! !RBMethod methodsFor: 'accessing' stamp: ''! selector: aSymbol selector := aSymbol! ! !RBMethod methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:15'! source ^ source ifNil: [ source := (class realClass sourceCodeAt: selector) asString ]! ! !RBMethod methodsFor: 'accessing' stamp: ''! source: aString source := aString! ! Object subclass: #RBMethodName instanceVariableNames: 'selector arguments' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RBMethodName class methodsFor: 'instance creation' stamp: ''! selector: aSymbol arguments: stringCollection ^(self new) selector: aSymbol; arguments: stringCollection; yourself! ! !RBMethodName methodsFor: 'accessing' stamp: ''! arguments ^arguments! ! !RBMethodName methodsFor: 'accessing' stamp: ''! arguments: nameCollection arguments := nameCollection. self changed: #arguments! ! !RBMethodName methodsFor: 'testing' stamp: 'lr 6/15/2010 10:26'! isValid ^ (RBCondition checkMethodName: self selector in: self class) and: [ self selector numArgs = self arguments size ]! ! !RBMethodName methodsFor: 'printing' stamp: 'lr 6/15/2010 10:25'! printOn: aStream | argumentStream | self isValid ifFalse: [ ^ aStream nextPutAll: '(invalid)' ]. argumentStream := self arguments readStream. self selector keywords keysAndValuesDo: [ :key :part | key = 1 ifFalse: [ aStream space ]. aStream nextPutAll: part. (self selector isUnary or: [ argumentStream atEnd ]) ifTrue: [ ^ self ]. aStream space; nextPutAll: argumentStream next ]! ! !RBMethodName methodsFor: 'accessing' stamp: ''! selector ^selector! ! !RBMethodName methodsFor: 'accessing' stamp: 'lr 6/15/2010 10:25'! selector: aSymbol selector := aSymbol asSymbol. self changed: #selector! ! Object subclass: #RBNamespace instanceVariableNames: 'changes environment newClasses removedClasses changedClasses rootClasses implementorsCache sendersCache' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBNamespace class methodsFor: 'instance creation' stamp: ''! onEnvironment: aBrowserEnvironment ^(self new) environment: aBrowserEnvironment; yourself! ! !RBNamespace methodsFor: 'private-changes' stamp: 'lr 10/26/2009 22:09'! addChangeToClass: aRBClass ^ changedClasses at: aRBClass name put: (Array with: aRBClass theNonMetaClass with: aRBClass theMetaClass)! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! addClassVariable: aString to: aRBClass ^changes addClassVariable: aString to: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! addInstanceVariable: aString to: aRBClass ^changes addInstanceVariable: aString to: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! addPool: aString to: aRBClass ^changes addPool: aString to: aRBClass! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 3/17/2010 19:11'! allClassesDo: aBlock | seen evalBlock | seen := Set new. evalBlock := [ :each | seen add: each first name. aBlock value: each first; value: each last ]. newClasses do: evalBlock. changedClasses do: evalBlock. environment classesDo: [ :each | each isObsolete ifFalse: [ | class | class := each theNonMetaClass. ((seen includes: class name) or: [ self hasRemoved: (self classNameFor: class) ]) ifFalse: [ (class := self classFor: each) isNil ifFalse: [ seen add: class name. aBlock value: class; value: class theMetaClass ] ] ] ]! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:40'! allImplementorsOf: aSelector ^ implementorsCache at: aSelector ifAbsentPut: [ self privateImplementorsOf: aSelector ]! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 18:53'! allImplementorsOf: aSelector do: aBlock (self allImplementorsOf: aSelector) do: aBlock! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:44'! allReferencesTo: aSymbol ^ sendersCache at: aSymbol ifAbsentPut: [ self privateReferencesTo: aSymbol ]! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:44'! allReferencesTo: aSymbol do: aBlock (self allReferencesTo: aSymbol) do: aBlock! ! !RBNamespace methodsFor: 'accessing' stamp: ''! allReferencesToClass: aRBClass do: aBlock self allClassesDo: [:each | (each whichSelectorsReferToClass: aRBClass) do: [:sel | aBlock value: (each methodFor: sel)]]! ! !RBNamespace methodsFor: 'private-changes' stamp: 'lr 10/26/2009 22:09'! changeClass: aRBClass changedClasses at: aRBClass name put: (Array with: aRBClass theNonMetaClass with: aRBClass theMetaClass). self flushCaches! ! !RBNamespace methodsFor: 'accessing' stamp: ''! changes ^changes! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/31/2009 17:35'! classFor: aBehavior aBehavior isNil ifTrue: [ ^ nil ]. ^ aBehavior isMeta ifTrue: [ self metaclassNamed: aBehavior theNonMetaClass name ] ifFalse: [ self classNamed: aBehavior theNonMetaClass name ]! ! !RBNamespace methodsFor: 'private' stamp: 'lr 10/31/2009 17:37'! classNameFor: aBehavior ^ aBehavior theNonMetaClass name! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/26/2009 22:09'! classNamed: aSymbol | class classes index | aSymbol isNil ifTrue: [ ^ nil ]. (self hasRemoved: aSymbol) ifTrue: [ ^ nil ]. (newClasses includesKey: aSymbol) ifTrue: [ ^ (newClasses at: aSymbol) first ]. (changedClasses includesKey: aSymbol) ifTrue: [ ^ (changedClasses at: aSymbol) first ]. class := environment at: aSymbol ifAbsent: [ nil ]. (class isBehavior or: [ class isTrait ]) ifTrue: [ classes := self createNewClassFor: class. ^ class isMeta ifTrue: [ classes last ] ifFalse: [ classes first ] ]. index := aSymbol indexOfSubCollection: ' class' startingAt: 1 ifAbsent: [ ^ nil ]. class := self classNamed: (aSymbol copyFrom: 1 to: index - 1) asSymbol. ^ class isNil ifTrue: [ nil ] ifFalse: [ class theMetaClass ]! ! !RBNamespace methodsFor: 'changes' stamp: 'lr 7/1/2008 11:06'! comment: aString in: aClass ^ changes comment: aString in: aClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! compile: aString in: aRBClass classified: aSymbol | change | change := changes compile: aString in: aRBClass classified: aSymbol. self flushCaches. ^change! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/31/2009 17:36'! createNewClassFor: aBehavior | nonMeta meta className | className := aBehavior theNonMetaClass name. nonMeta := (RBClass existingNamed: className) model: self; yourself. meta := (RBMetaclass existingNamed: className) model: self; yourself. ^changedClasses at: className put: (Array with: nonMeta with: meta)! ! !RBNamespace methodsFor: 'changes' stamp: 'lr 10/26/2009 22:09'! defineClass: aString | change newClass newClassName | change := changes defineClass: aString. newClassName := change changeClassName. newClass := self classNamed: newClassName. newClass isNil ifTrue: [ | newMetaclass | removedClasses remove: newClassName ifAbsent: [ ]; remove: newClassName , ' class' ifAbsent: [ ]. newClass := RBClass named: newClassName. newMetaclass := RBMetaclass named: newClassName. newClass model: self. newMetaclass model: self. newClasses at: newClassName put: (Array with: newClass with: newMetaclass) ]. newClass superclass: (self classNamed: change superclassName). newClass superclass isNil ifTrue: [ self rootClasses add: newClass. newClass theMetaClass superclass: (self classFor: Object class superclass) ] ifFalse: [ newClass theMetaClass superclass: newClass superclass theMetaClass ]. newClass instanceVariableNames: change instanceVariableNames. newClass classVariableNames: change classVariableNames. newClass poolDictionaryNames: change poolDictionaryNames. newClass category: change category. ^ change! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 1/20/2010 18:08'! description ^ self changes name! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 1/20/2010 18:08'! description: aString self changes name: aString! ! !RBNamespace methodsFor: 'accessing' stamp: ''! environment ^environment! ! !RBNamespace methodsFor: 'accessing' stamp: ''! environment: aBrowserEnvironment environment := aBrowserEnvironment! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! flushCaches implementorsCache := IdentityDictionary new. sendersCache := IdentityDictionary new! ! !RBNamespace methodsFor: 'private' stamp: ''! hasCreatedClassFor: aBehavior | className | className := self classNameFor: aBehavior. ^(newClasses includesKey: className) or: [changedClasses includesKey: className]! ! !RBNamespace methodsFor: 'testing' stamp: ''! hasRemoved: aSymbol ^removedClasses includes: aSymbol! ! !RBNamespace methodsFor: 'testing' stamp: ''! includesClassNamed: aSymbol ^(self classNamed: aSymbol) notNil! ! !RBNamespace methodsFor: 'testing' stamp: ''! includesGlobal: aSymbol (self hasRemoved: aSymbol) ifTrue: [^false]. (self includesClassNamed: aSymbol) ifTrue: [^true]. environment at: aSymbol ifAbsent: [^false]. ^true! ! !RBNamespace methodsFor: 'initialize-release' stamp: ''! initialize changes := CompositeRefactoryChange new. environment := BrowserEnvironment new. newClasses := IdentityDictionary new. changedClasses := IdentityDictionary new. removedClasses := Set new. implementorsCache := IdentityDictionary new. sendersCache := IdentityDictionary new! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'dc 5/8/2007 13:44'! metaclassNamed: aSymbol | class | aSymbol isNil ifTrue: [^nil]. (self hasRemoved: aSymbol) ifTrue: [^nil]. (newClasses includesKey: aSymbol) ifTrue: [^(newClasses at: aSymbol) last]. (changedClasses includesKey: aSymbol) ifTrue: [^(changedClasses at: aSymbol) last]. class := environment at: aSymbol ifAbsent: [nil]. (class isBehavior or: [class isTrait]) ifTrue: [^ (self createNewClassFor: class) last]. ^ nil! ! !RBNamespace methodsFor: 'accessing' stamp: ''! name ^changes name! ! !RBNamespace methodsFor: 'accessing' stamp: ''! name: aString ^changes name: aString! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! performChange: aCompositeRefactoryChange around: aBlock | oldChanges | changes addChange: aCompositeRefactoryChange. oldChanges := changes. changes := aCompositeRefactoryChange. aBlock ensure: [changes := oldChanges]. ^aCompositeRefactoryChange! ! !RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'! privateImplementorsOf: aSelector | classes | classes := Set new. self allClassesDo: [ :class | (class directlyDefinesMethod: aSelector) ifTrue: [ classes add: class ] ]. ^ classes! ! !RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'! privateReferencesTo: aSelector | methods | methods := OrderedCollection new. self allClassesDo: [ :class | (class whichSelectorsReferToSymbol: aSelector) do: [ :selector | methods add: (class methodFor: selector) ] ]. ^ methods! ! !RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'! privateRootClasses | classes | classes := OrderedCollection new. Class rootsOfTheWorld do: [ :each | | class | class := self classFor: each. (class notNil and: [ class superclass isNil ]) ifTrue: [ classes add: class ] ]. ^ classes! ! !RBNamespace methodsFor: 'changes' stamp: ''! removeClass: aRBClass self removeClassNamed: aRBClass name! ! !RBNamespace methodsFor: 'changes' stamp: ''! removeClassNamed: aSymbol (self classNamed: aSymbol) subclasses do: [:each | self removeClassNamed: each name]. removedClasses add: aSymbol; add: aSymbol , ' class'. newClasses removeKey: aSymbol ifAbsent: []. changedClasses removeKey: aSymbol ifAbsent: []. self flushCaches. ^changes removeClassNamed: aSymbol! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! removeClassVariable: aString from: aRBClass ^changes removeClassVariable: aString from: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! removeInstanceVariable: aString from: aRBClass ^changes removeInstanceVariable: aString from: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! removeMethod: aSelector from: aRBClass self flushCaches. ^changes removeMethod: aSelector from: aRBClass! ! !RBNamespace methodsFor: 'changes' stamp: 'lr 3/19/2010 13:24'! renameClass: aRBClass to: aSymbol around: aBlock | change value dict | change := RenameClassChange rename: aRBClass name to: aSymbol. self performChange: change around: aBlock. self flushCaches. dict := (newClasses includesKey: aRBClass name) ifTrue: [newClasses] ifFalse: [changedClasses]. removedClasses add: aRBClass name; add: aRBClass name , ' class'. value := dict at: aRBClass name. dict removeKey: aRBClass name. dict at: aSymbol put: value. value first name: aSymbol. value last name: aSymbol. value first subclasses do: [:each | each superclass: value first]. value last subclasses do: [:each | each superclass: value last]. ^change! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! renameClassVariable: oldName to: newName in: aRBClass around: aBlock ^self performChange: (RenameClassVariableChange rename: oldName to: newName in: aRBClass) around: aBlock! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! renameInstanceVariable: oldName to: newName in: aRBClass around: aBlock ^self performChange: (RenameInstanceVariableChange rename: oldName to: newName in: aRBClass) around: aBlock! ! !RBNamespace methodsFor: 'changes' stamp: ''! reparentClasses: aRBClassCollection to: newClass aRBClassCollection do: [:aClass | self defineClass: (self replaceClassNameIn: aClass definitionString to: newClass name)]! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! replaceClassNameIn: definitionString to: aSymbol | parseTree | parseTree := RBParser parseExpression: definitionString. parseTree receiver: (RBVariableNode named: aSymbol). ^parseTree formattedCode! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:38'! rootClasses ^ rootClasses ifNil: [ rootClasses := self privateRootClasses]! ! !RBNamespace methodsFor: 'accessing-classes' stamp: ''! whichCategoryIncludes: aSymbol ^self environment whichCategoryIncludes: aSymbol! ! Object subclass: #RBRefactoryTyper instanceVariableNames: 'model class variableTypes bestGuesses variableMessages backpointers methodName selectorLookup' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RBRefactoryTyper class methodsFor: 'instance creation' stamp: ''! newFor: aRBNamespace ^(self new) model: aRBNamespace; yourself! ! !RBRefactoryTyper class methodsFor: 'accessing' stamp: 'lr 11/2/2009 00:14'! typesFor: variableName in: aParseTree model: aRBSmalltalk | searcher messages | searcher := RBParseTreeSearcher new. searcher matches: variableName , ' `@message: ``@args' do: [:aNode :answer | answer add: aNode selector; yourself]. messages := searcher executeTree: aParseTree initialAnswer: Set new. ^(self new) model: aRBSmalltalk; findTypeFor: messages! ! !RBRefactoryTyper methodsFor: 'private' stamp: 'lr 8/10/2009 16:36'! backpointersDictionary "Create a special dictionary, because the host systems wrongly treats #abc and 'abc' as equal." ^ PluggableDictionary new equalBlock: [ :a :b | a class == b class and: [ a = b ] ]; hashBlock: [ :a | a class identityHash bitXor: a hash ]; yourself! ! !RBRefactoryTyper methodsFor: 'private' stamp: 'lr 8/10/2009 16:37'! backpointersSetWith: anObject "Create a special set, because the host systems wrongly treats #abc and 'abc' as equal." ^ PluggableSet new equalBlock: [ :a :b | a class == b class and: [ a = b ] ]; hashBlock: [ :a | a class identityHash bitXor: a hash ]; add: anObject; yourself! ! !RBRefactoryTyper methodsFor: 'printing' stamp: ''! collectionNameFor: aString ^'-<1s>-' expandMacrosWith: aString! ! !RBRefactoryTyper methodsFor: 'equivalence classes' stamp: 'lr 11/2/2009 00:14'! computeEquivalenceClassesForMethodsAndVars | searcher | backpointers := self backpointersDictionary. class instanceVariableNames do: [:each | backpointers at: each put: (self backpointersSetWith: each)]. class withAllSubclasses do: [:sub | sub selectors do: [:each | backpointers at: each put: (self backpointersSetWith: each)]]. searcher := RBParseTreeSearcher new. searcher matches: '^``@object' do: [:aNode :answer | self processNode: aNode value]. self executeSearch: searcher! ! !RBRefactoryTyper methodsFor: 'selectors' stamp: 'lr 11/19/2009 11:45'! computeMessagesSentToVariables | searcher | variableMessages := Dictionary new. class instanceVariableNames do: [:each | variableMessages at: each put: Set new]. searcher := RBParseTreeSearcher new. class instanceVariableNames do: [:each | | block | block := [:aNode :answer | (variableMessages at: each ifAbsentPut: [Set new]) add: aNode selector. self processCollectionMessagesFor: each in: aNode]. searcher matches: each , ' `@messageName: ``@args' do: block. (backpointers at: each) do: [:sel | sel isSymbol ifTrue: [searcher matches: ('(self <1s>) `@messageName: ``@args' expandMacrosWith: (RBParseTreeSearcher buildSelectorString: sel)) asString do: block]]]. searcher answer: variableMessages. self executeSearch: searcher! ! !RBRefactoryTyper methodsFor: 'computing types' stamp: ''! computeTypes variableMessages keysAndValuesDo: [:key :value | variableTypes at: key put: (self findTypeFor: value)]! ! !RBRefactoryTyper methodsFor: 'private' stamp: ''! executeSearch: searcher class withAllSubclasses do: [:each | each selectors do: [:sel | | parseTree | methodName := sel. parseTree := each parseTreeFor: sel. parseTree notNil ifTrue: [searcher executeTree: parseTree]]]! ! !RBRefactoryTyper methodsFor: 'computing types' stamp: 'lr 5/29/2010 09:45'! findTypeFor: selectorCollection ^selectorCollection inject: self rootClasses into: [:classes :each | self refineTypes: classes with: (selectorLookup at: each ifAbsentPut: [self implementorsOf: each])]! ! !RBRefactoryTyper methodsFor: 'assignments' stamp: 'lr 5/29/2010 18:10'! guessTypeFromAssignment: aNode | type set newType | type := nil. aNode value isAssignment ifTrue: [^self guessTypeFromAssignment: (RBAssignmentNode variable: aNode variable value: aNode value value)]. aNode value isBlock ifTrue: [type := model classFor: [] class]. aNode value isLiteral ifTrue: [aNode value value isNil ifTrue: [^self]. type := model classFor: (self typeFor: aNode value value)]. aNode value isMessage ifTrue: [aNode value receiver isVariable ifTrue: [type := model classNamed: aNode value receiver name asSymbol]. aNode value selector = #asValue ifTrue: [type := model classNamed: #ValueHolder]. (#(#and: #or: #= #== #~= #~~ #<= #< #~~ #> #>=) includes: aNode value selector) ifTrue: [type := model classFor: Boolean]]. type isNil ifTrue: [^self]. set := variableTypes at: aNode variable name. newType := set detect: [:each | type includesClass: each] ifNone: [nil]. newType isNil ifTrue: [^self]. ((self rootClasses includes: newType) or: [ newType = (model classFor: Object) ]) ifTrue: [newType := type]. (bestGuesses at: aNode variable name ifAbsentPut: [Set new]) add: newType! ! !RBRefactoryTyper methodsFor: 'accessing' stamp: ''! guessTypesFor: anInstVarName ^bestGuesses at: anInstVarName ifAbsent: [self typesFor: anInstVarName]! ! !RBRefactoryTyper methodsFor: 'accessing' stamp: ''! guessTypesFor: anInstVarName in: aClass class = aClass ifFalse: [self runOn: aClass]. ^bestGuesses at: anInstVarName ifAbsent: [self typesFor: anInstVarName in: aClass]! ! !RBRefactoryTyper methodsFor: 'computing types' stamp: 'lr 5/29/2010 09:46'! implementorsOf: aSelector | classes | classes := OrderedCollection new. self rootClasses do: [:each | self implementorsOf: aSelector in: each storeIn: classes]. ^classes! ! !RBRefactoryTyper methodsFor: 'computing types' stamp: ''! implementorsOf: aSelector in: aClass storeIn: classes (aClass directlyDefinesMethod: aSelector) ifTrue: [classes add: aClass. ^self]. aClass subclasses do: [:each | self implementorsOf: aSelector in: each storeIn: classes]! ! !RBRefactoryTyper methodsFor: 'initialize-release' stamp: ''! initialize model := RBNamespace new. class := model classFor: Object. variableTypes := Dictionary new. variableMessages := Dictionary new. selectorLookup := IdentityDictionary new. bestGuesses := Dictionary new! ! !RBRefactoryTyper methodsFor: 'equivalence classes' stamp: 'lr 8/10/2009 15:27'! merge: aName "rr 3/15/2004 14:05 add: the ifAbsent: keyword in the last line, as I encountered a failing case" | set1 set2 | set1 := backpointers at: methodName ifAbsent: [nil]. set2 := backpointers at: aName ifAbsent: [nil]. (set1 isNil or: [set2 isNil or: [set1 == set2]]) ifTrue: [^self]. set1 addAll: set2. set2 do: [:each | backpointers at: each put: set1]! ! !RBRefactoryTyper methodsFor: 'private' stamp: ''! model ^model! ! !RBRefactoryTyper methodsFor: 'private' stamp: ''! model: aRBSmalltalk model := aRBSmalltalk! ! !RBRefactoryTyper methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: class name; cr. class instanceVariableNames do: [:each | aStream tab; nextPutAll: each; tab; nextPut: $<. self printTypeFor: each on: aStream. aStream nextPut: $>; cr]! ! !RBRefactoryTyper methodsFor: 'printing' stamp: ''! printType: aClass for: aString on: aStream | name colTypes | colTypes := #(). name := self collectionNameFor: aString. (aClass includesClass: (model classFor: Collection)) ifTrue: [colTypes := self guessTypesFor: name]. colTypes isEmpty ifFalse: [aStream nextPut: $(]. aClass printOn: aStream. colTypes isEmpty ifFalse: [aStream nextPutAll: ' of: '. colTypes size > 1 ifTrue: [aStream nextPut: $(]. self printTypeFor: name on: aStream. colTypes size > 1 ifTrue: [aStream nextPut: $)]]. colTypes isEmpty ifFalse: [aStream nextPut: $)]! ! !RBRefactoryTyper methodsFor: 'printing' stamp: ''! printTypeFor: aString on: aStream | types | types := (self guessTypesFor: aString) asSortedCollection: [:a :b | a name < b name]. 1 to: types size do: [:i | i == 1 ifFalse: [aStream nextPutAll: ' | ']. self printType: (types at: i) for: aString on: aStream]! ! !RBRefactoryTyper methodsFor: 'selectors-collections' stamp: 'lr 5/29/2010 09:40'! processCollectionFor: key messagesTo: aName in: aBlock | searcher | searcher := RBParseTreeSearcher new. searcher matches: aName , ' `@message: ``@args' do: [ :aNode :answer | self processCollectionMessagesFor: key in: aNode. answer add: aNode selector; yourself ]. searcher executeTree: aBlock initialAnswer: (variableMessages at: (self collectionNameFor: key) ifAbsentPut: [ Set new ])! ! !RBRefactoryTyper methodsFor: 'selectors-collections' stamp: 'lr 5/29/2010 09:40'! processCollectionMessagesFor: variableName in: aParseTree | parent block | aParseTree isMessage ifFalse: [ ^ self ]. (#(anyOne at: at:ifAbsent: at:ifAbsentPut: atPin: atRandom atRandom: atWrap: eight fifth first fourth last middle ninth second seventh sixth third) includes: aParseTree selector) ifTrue: [ parent := aParseTree parent. (parent notNil and: [ parent isMessage ]) ifFalse: [ ^ self ]. aParseTree == parent receiver ifFalse: [ ^ self ]. (variableMessages at: (self collectionNameFor: variableName) ifAbsentPut: [Set new]) add: parent selector. self processCollectionMessagesFor: (self collectionNameFor: variableName) in: parent ]. (#(allSatisfy: anySatisfy: collect: collect:as: detect: detect:ifNone: detectMax: detectMin: detectSum: do: do:displayingProgress: do:separatedBy: gather: noneSatisfy: reject: select:) includes: aParseTree selector) ifTrue: [ block := aParseTree arguments first. block isBlock ifFalse: [ ^ self ]. self processCollectionFor: variableName messagesTo: block arguments first name in: block ]. (#(reduce: reduceLeft: reduceRight:) includes: aParseTree selector) ifTrue: [ block := aParseTree arguments last. block isBlock ifFalse: [ ^ self ]. block arguments do: [ :node | self processCollectionFor: variableName messagesTo: node name in: block ] ]. #inject:into: = aParseTree selector ifTrue: [ block := aParseTree arguments last. block isBlock ifFalse: [ ^ self ]. self processCollectionFor: variableName messagesTo: block arguments last name in: block ]! ! !RBRefactoryTyper methodsFor: 'equivalence classes' stamp: ''! processNode: aNode (aNode isVariable and: [class instanceVariableNames includes: aNode name]) ifTrue: [^self merge: aNode name]. (aNode isMessage and: [aNode receiver isVariable and: [aNode receiver name = 'self']]) ifTrue: [^self merge: aNode selector]. aNode isAssignment ifTrue: [self processNode: aNode value; processNode: aNode variable]. (aNode isMessage and: [#(#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:) includes: aNode selector]) ifTrue: [aNode arguments do: [:each | each isBlock ifTrue: [each body statements isEmpty ifFalse: [self processNode: each body statements last]]]]! ! !RBRefactoryTyper methodsFor: 'computing types' stamp: ''! refineTypes: aClassCollection with: anotherClassCollection | classSet | classSet := Set new. aClassCollection do: [:each | anotherClassCollection do: [:cls | (cls includesClass: each) ifTrue: [classSet add: cls] ifFalse: [(each includesClass: cls) ifTrue: [classSet add: each]]]]. ^classSet! ! !RBRefactoryTyper methodsFor: 'assignments' stamp: 'lr 11/2/2009 23:38'! refineTypesByLookingAtAssignments | searcher needsSearch | needsSearch := false. searcher := RBParseTreeSearcher new. variableTypes keysAndValuesDo: [:key :value | (key first = $-) ifFalse: [needsSearch := true. searcher matches: key , ' := ``@object' do: [:aNode :answer | self guessTypeFromAssignment: aNode]]]. needsSearch ifTrue: [self executeSearch: searcher]! ! !RBRefactoryTyper methodsFor: 'private' stamp: 'lr 5/29/2010 10:01'! rootClasses ^ model rootClasses! ! !RBRefactoryTyper methodsFor: 'accessing' stamp: ''! runOn: aClass variableTypes := Dictionary new. variableMessages := Dictionary new. bestGuesses := Dictionary new. class := model classFor: aClass. class instanceVariableNames isEmpty ifTrue: [^self]. self selectedClass: aClass; computeEquivalenceClassesForMethodsAndVars; computeMessagesSentToVariables; computeTypes; refineTypesByLookingAtAssignments! ! !RBRefactoryTyper methodsFor: 'accessing' stamp: ''! selectedClass: aClass class := model classFor: aClass! ! !RBRefactoryTyper methodsFor: 'assignments' stamp: 'lr 7/1/2008 10:25'! typeFor: anObject anObject isString ifTrue: [ ^ String ]. anObject isInteger ifTrue: [ ^ Integer ]. ^ (anObject == true or: [ anObject == false ]) ifTrue: [ Boolean ] ifFalse: [ anObject class ]! ! !RBRefactoryTyper methodsFor: 'accessing' stamp: ''! typesFor: anInstVarName ^variableTypes at: anInstVarName ifAbsent: [Set new]! ! !RBRefactoryTyper methodsFor: 'accessing' stamp: ''! typesFor: anInstVarName in: aClass class = aClass ifFalse: [self runOn: aClass]. ^variableTypes at: anInstVarName ifAbsent: [Set new]! ! Object subclass: #Refactoring instanceVariableNames: 'model options' classVariableNames: 'RefactoringOptions' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! Refactoring subclass: #AbstractVariablesRefactoring instanceVariableNames: 'tree fromClass instVarReaders instVarWriters classVarReaders classVarWriters toClasses ignore' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AbstractVariablesRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ^self model: aRBSmalltalk abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: nil! ! !AbstractVariablesRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: aVariableName ^(self new) model: aRBSmalltalk; abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: aVariableName; yourself! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractClassVariable: aString | refactoring rewriter nonMetaClass | nonMetaClass := fromClass theNonMetaClass. refactoring := CreateAccessorsForVariableRefactoring model: self model variable: aString class: nonMetaClass classVariable: true. self performComponentRefactoring: refactoring. rewriter := RBParseTreeRewriter new. fromClass isMeta ifTrue: [ rewriter replace: aString , ' := ``@object' with: ('self <1s> ``@object' expandMacrosWith: refactoring setterMethod); replace: aString with: 'self ' , refactoring getterMethod ] ifFalse: [ rewriter replace: aString , ' := ``@object' with: ('self class <1s> ``@object' expandMacrosWith: refactoring setterMethod); replace: aString with: 'self class ' , refactoring getterMethod ]. (rewriter executeTree: tree) ifTrue: [ tree := rewriter tree ]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 2/6/2010 13:33'! abstractClassVariables | variables | (classVarReaders isEmpty and: [ classVarWriters isEmpty ]) ifTrue: [ ^ self ]. variables := Set new. variables addAll: classVarReaders; addAll: classVarWriters. variables do: [ :each | self abstractClassVariable: each ]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractInstanceVariable: aString | refactoring rewriter | refactoring := CreateAccessorsForVariableRefactoring model: self model variable: aString class: fromClass classVariable: false. self performComponentRefactoring: refactoring. rewriter := RBParseTreeRewriter new. rewriter replace: aString , ' := ``@object' with: ('self <1s> ``@object' expandMacrosWith: refactoring setterMethod); replace: aString with: 'self ' , refactoring getterMethod. (rewriter executeTree: tree) ifTrue: [tree := rewriter tree]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 2/6/2010 13:34'! abstractInstanceVariables | variables | (instVarReaders isEmpty and: [ instVarWriters isEmpty ]) ifTrue: [ ^ self]. variables := Set new. variables addAll: instVarReaders; addAll: instVarWriters. variables do: [ :each | self abstractInstanceVariable: each ]! ! !AbstractVariablesRefactoring methodsFor: 'initialize-release' stamp: ''! abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: aVariableName | poolRefactoring | tree := aBRProgramNode. fromClass := self classObjectFor: fromBehavior. toClasses := behaviorCollection collect: [:each | self classObjectFor: each]. ignore := aVariableName. poolRefactoring := ExpandReferencedPoolsRefactoring model: self model forMethod: tree fromClass: fromClass toClasses: toClasses. self performComponentRefactoring: poolRefactoring. self computeVariablesToAbstract! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! classVariableNames | nonMetaClass | nonMetaClass := fromClass theNonMetaClass. ^ (nonMetaClass allClassVariableNames collect: [ :each | each asString ]) asSet! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! computeVariablesToAbstract | searcher | instVarReaders := Set new. instVarWriters := Set new. classVarReaders := Set new. classVarWriters := Set new. searcher := RBParseTreeSearcher new. searcher matches: '`var := ``@anything' do: [:aNode :answer | self processAssignmentNode: aNode]; matches: '`var' do: [:aNode :answer | self processReferenceNode: aNode]. searcher executeTree: tree. self removeDefinedClassVariables! ! !AbstractVariablesRefactoring methodsFor: 'testing' stamp: 'lr 2/6/2010 13:34'! hasVariablesToAbstract ^ instVarReaders notEmpty or: [ instVarWriters notEmpty or: [ classVarReaders notEmpty or: [ classVarWriters notEmpty ] ] ]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! instanceVariableNames ^fromClass allInstanceVariableNames asSet! ! !AbstractVariablesRefactoring methodsFor: 'accessing' stamp: ''! parseTree ^tree! ! !AbstractVariablesRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition empty! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! processAssignmentNode: aNode | varName | varName := aNode variable name. ignore = varName ifTrue: [^self]. (aNode whoDefines: varName) notNil ifTrue: [^self]. (self instanceVariableNames includes: varName) ifTrue: [instVarWriters add: varName]. (self classVariableNames includes: varName) ifTrue: [classVarWriters add: varName]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! processReferenceNode: aNode | varName | varName := aNode name. ignore = varName ifTrue: [^self]. (aNode whoDefines: varName) notNil ifTrue: [^self]. (self instanceVariableNames includes: varName) ifTrue: [instVarReaders add: varName]. (self classVariableNames includes: varName) ifTrue: [classVarReaders add: varName]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! removeDefinedClassVariables | selectionBlock nonMetaClass | nonMetaClass := fromClass theNonMetaClass. selectionBlock := [ :varName | (toClasses detect: [ :each | (each theNonMetaClass includesClass: (nonMetaClass whoDefinesClassVariable: varName)) not ] ifNone: [ nil ]) notNil ]. classVarReaders := classVarReaders select: selectionBlock. classVarWriters := classVarWriters select: selectionBlock! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! transform self hasVariablesToAbstract ifTrue: [self refactoringWarning: 'This method has direct variable references whichwill need to be converted to getter/setters.' expandMacros]. self abstractInstanceVariables. self abstractClassVariables! ! Refactoring subclass: #ClassRefactoring instanceVariableNames: 'className' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! ClassRefactoring subclass: #AddClassRefactoring instanceVariableNames: 'category superclass subclasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddClassRefactoring class methodsFor: 'instance creation' stamp: ''! addClass: aName superclass: aClass subclasses: aCollection category: aSymbol ^self new addClass: aName superclass: aClass subclasses: aCollection category: aSymbol! ! !AddClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk addClass: aName superclass: aClass subclasses: aCollection category: aSymbol ^(self new) model: aRBSmalltalk; addClass: aName superclass: aClass subclasses: aCollection category: aSymbol; yourself! ! !AddClassRefactoring methodsFor: 'initialize-release' stamp: ''! addClass: aName superclass: aClass subclasses: aCollection category: aSymbol self className: aName. superclass := self classObjectFor: aClass. subclasses := aCollection collect: [:each | self classObjectFor: each]. category := aSymbol! ! !AddClassRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | cond | cond := ((RBCondition isMetaclass: superclass) errorMacro: 'Superclass must not be a metaclass') not. cond := subclasses inject: cond into: [:sub :each | sub & ((RBCondition isMetaclass: each) errorMacro: 'Subclass must <1?not :>be a metaclass') not & (RBCondition isImmediateSubclass: each of: superclass)]. ^cond & (RBCondition isValidClassName: className) & (RBCondition isGlobal: className in: self model) not & (RBCondition isSymbol: category) & ((RBCondition withBlock: [category isEmpty not]) errorMacro: 'Invalid category name')! ! !AddClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' addClass: #'; nextPutAll: className; nextPutAll: ' superclass: '. superclass storeOn: aStream. aStream nextPutAll: ' subclasses: '. subclasses asArray storeOn: aStream. aStream nextPutAll: ' category: '. category storeOn: aStream. aStream nextPut: $)! ! !AddClassRefactoring methodsFor: 'transforming' stamp: 'bh 4/10/2001 14:25'! transform (self model) defineClass: ('<1p> subclass: #<2s> instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: <3p>' expandMacrosWith: superclass with: className with: category asString); reparentClasses: subclasses to: (self model classNamed: className asSymbol)! ! ClassRefactoring subclass: #ChildrenToSiblingsRefactoring instanceVariableNames: 'parent subclasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ChildrenToSiblingsRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk name: aClassName class: aClass subclasses: subclassCollection ^(self new) model: aRBSmalltalk; name: aClassName class: aClass subclasses: subclassCollection; yourself! ! !ChildrenToSiblingsRefactoring class methodsFor: 'instance creation' stamp: ''! name: aClassName class: aClass subclasses: subclassCollection ^(self new) name: aClassName class: aClass subclasses: subclassCollection; yourself! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-accessing' stamp: ''! abstractSuperclass ^self model classNamed: className asSymbol! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! addSuperclass self performComponentRefactoring: (AddClassRefactoring model: self model addClass: className superclass: parent superclass subclasses: (Array with: parent) category: parent category)! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! changeIsKindOfReferences | replacer | replacer := RBParseTreeRewriter new. replacer replace: '``@object isKindOf: ' , parent name with: '``@object isKindOf: ' , className. self convertAllReferencesToClass: parent using: replacer! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! computeSubclassSupersOf: aClass | selectors | selectors := Set new. aClass subclasses do: [:each | each selectors do: [:sel | selectors addAll: (each parseTreeFor: sel) superMessages]]. ^selectors! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! createSubclassResponsibilityFor: aSelector in: aClass | source | (aClass superclass definesMethod: aSelector) ifTrue: [^self]. source := self subclassResponsibilityFor: aSelector in: aClass. source isNil ifTrue: [^self]. aClass superclass compile: source classified: (aClass protocolsFor: aSelector)! ! !ChildrenToSiblingsRefactoring methodsFor: 'initialize-release' stamp: ''! name: aClassName class: aClass subclasses: subclassCollection className := aClassName asSymbol. parent := self model classFor: aClass. subclasses := subclassCollection collect: [:each | self model classFor: each]! ! !ChildrenToSiblingsRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^subclasses inject: ((RBCondition isMetaclass: parent) errorMacro: 'Superclass must not be a metaclass') not & (RBCondition isValidClassName: className) & (RBCondition isGlobal: className in: self model) not into: [:sub :each | sub & ((RBCondition isMetaclass: each) errorMacro: 'Subclass must <1?not :>be a metaclass') not & (RBCondition isImmediateSubclass: each of: parent)]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: 'lr 10/26/2009 22:09'! pullUpClassInstanceVariables | newSuperclass | newSuperclass := self abstractSuperclass theMetaClass. parent theMetaClass instanceVariableNames do: [ :each | self performComponentRefactoring: (PullUpInstanceVariableRefactoring model: self model variable: each class: newSuperclass) ]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: ''! pullUpClassVariables | newSuperclass | newSuperclass := self abstractSuperclass. parent classVariableNames do: [:each | self performComponentRefactoring: (PullUpClassVariableRefactoring model: self model variable: each class: newSuperclass)]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: ''! pullUpInstanceVariables | newSuperclass | newSuperclass := self abstractSuperclass. parent instanceVariableNames do: [:each | self performComponentRefactoring: (PullUpInstanceVariableRefactoring model: self model variable: each class: newSuperclass)]! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'! pullUpMethods self pushUpMethodsFrom: parent. self pushUpMethodsFrom: parent theMetaClass! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: ''! pullUpPoolVariables "Don't remove the pool variables from the subclass since they might be referenced there." | newSuperclass | newSuperclass := self abstractSuperclass. parent poolDictionaryNames do: [:each | newSuperclass addPoolDictionary: each]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! pushUp: aSelector in: aClass | source | source := aClass sourceCodeFor: aSelector. source isNil ifFalse: [aClass superclass compile: source classified: (aClass protocolsFor: aSelector)]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! pushUpMethodsFrom: aClass | selectorsToPushUp | selectorsToPushUp := self selectorsToPushUpFrom: aClass. aClass selectors do: [:each | (selectorsToPushUp includes: each) ifTrue: [self pushUp: each in: aClass] ifFalse: [self createSubclassResponsibilityFor: each in: aClass]]. selectorsToPushUp do: [:each | aClass removeMethod: each]! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! pushUpVariables self pullUpInstanceVariables. self pullUpClassInstanceVariables. self pullUpClassVariables. self pullUpPoolVariables! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! reparentSubclasses self model reparentClasses: subclasses to: self abstractSuperclass! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! selectorsToPushUpFrom: aClass | superSelectors | superSelectors := self computeSubclassSupersOf: aClass. ^aClass selectors select: [:each | (superSelectors includes: each) or: [self shouldPushUp: each from: aClass]]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: 'lr 10/26/2009 22:09'! shouldPushUp: aSelector from: aClass ^ ((aClass isMeta ifTrue: [ subclasses collect: [ :each | each theMetaClass ] ] ifFalse: [ subclasses ]) detect: [ :each | (each directlyDefinesMethod: aSelector) not ] ifNone: [ nil ]) notNil! ! !ChildrenToSiblingsRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' name: #'; nextPutAll: className; nextPutAll: ' class: '. parent storeOn: aStream. aStream nextPutAll: ' subclasses: '. subclasses asArray storeOn: aStream. aStream nextPut: $)! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! subclassResponsibilityFor: aSelector in: aClass | methodNode position source | source := aClass sourceCodeFor: aSelector. methodNode := RBParser parseMethod: source onError: [:err :pos | ^nil]. position := methodNode arguments isEmpty ifTrue: [methodNode selectorParts last stop] ifFalse: [methodNode arguments last stop]. ^'<1s>self subclassResponsibility' expandMacrosWith: (source copyFrom: 1 to: position)! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'! transform self addSuperclass; pushUpVariables; pullUpMethods; changeIsKindOfReferences; reparentSubclasses! ! !ClassRefactoring class methodsFor: 'instance creation' stamp: ''! className: aName ^self new className: aName! ! !ClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk className: aName ^(self new) model: aRBSmalltalk; className: aName; yourself! ! !ClassRefactoring methodsFor: 'initialize-release' stamp: ''! className: aName className := aName! ! ClassRefactoring subclass: #RenameClassRefactoring instanceVariableNames: 'newName class' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk rename: aClass to: aNewName ^(self new) model: aRBSmalltalk; className: aClass name newName: aNewName; yourself! ! !RenameClassRefactoring class methodsFor: 'instance creation' stamp: ''! rename: aClass to: aNewName ^self new className: aClass name newName: aNewName! ! !RenameClassRefactoring methodsFor: 'initialize-release' stamp: ''! className: aName newName: aNewName className := aName asSymbol. class := self model classNamed: className. newName := aNewName asSymbol! ! !RenameClassRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition withBlock: [class notNil and: [class isMeta not]] errorString: className , ' is not a valid class name') & (RBCondition isValidClassName: newName) & (RBCondition isGlobal: newName in: self model) not! ! !RenameClassRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameReferences | replacer | replacer := (RBParseTreeRewriter replaceLiteral: className with: newName) replace: className with: newName; replaceArgument: newName withValueFrom: [:aNode | self refactoringError: newName , ' already exists within the reference scope']; yourself. self model allReferencesToClass: class do: [:method | (method modelClass hierarchyDefinesVariable: newName) ifTrue: [self refactoringError: newName , ' is already defined in hierarchy of ' , method modelClass printString]. self convertMethod: method selector for: method modelClass using: replacer]! ! !RenameClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' rename: '. class storeOn: aStream. aStream nextPutAll: ' to: #'; nextPutAll: newName; nextPut: $)! ! !RenameClassRefactoring methodsFor: 'transforming' stamp: ''! transform self model renameClass: class to: newName around: [self renameReferences]! ! Refactoring subclass: #ExpandReferencedPoolsRefactoring instanceVariableNames: 'pools fromClass parseTree toClasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExpandReferencedPoolsRefactoring class methodsFor: 'instance creation' stamp: ''! forMethod: aParseTree fromClass: aClass toClasses: classCollection ^(self new) forMethod: aParseTree fromClass: aClass toClasses: classCollection; yourself! ! !ExpandReferencedPoolsRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBNamespace forMethod: aParseTree fromClass: aClass toClasses: classCollection ^(self new) model: aRBNamespace; forMethod: aParseTree fromClass: aClass toClasses: classCollection; yourself! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! computePoolsToMove | poolVariables searcher | poolVariables := self poolVariableNamesFor: fromClass. pools := Set new. searcher := RBParseTreeSearcher new. searcher matches: '`var' do: [:aNode :answer | | varName pool | varName := aNode name. (aNode whoDefines: varName) isNil ifTrue: [(poolVariables includes: varName) ifTrue: [pool := self whichPoolDefines: varName. pool notNil ifTrue: [pools add: pool]]]]. searcher executeTree: parseTree! ! !ExpandReferencedPoolsRefactoring methodsFor: 'initialize-release' stamp: ''! forMethod: aParseTree fromClass: aClass toClasses: classCollection fromClass := self model classFor: aClass. parseTree := aParseTree. toClasses := classCollection collect: [:each | self model classFor: each]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'testing' stamp: ''! hasPoolsToMove ^pools isEmpty not! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! movePool: aSymbol toClass: aClass | nonMetaClass | nonMetaClass := aClass theNonMetaClass. (nonMetaClass definesPoolDictionary: aSymbol) ifFalse: [ nonMetaClass addPoolDictionary: aSymbol ]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''! movePoolVariables pools do: [:poolDict | toClasses do: [:each | self movePool: poolDict toClass: each]]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 7/23/2010 08:04'! poolVariableNamesIn: poolName ^(Smalltalk globals at: poolName ifAbsent: [Dictionary new]) keys collect: [:name | name asString]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition empty! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''! transform self computePoolsToMove. self hasPoolsToMove ifTrue: [self refactoringWarning: 'This method contains references to poolswhich may need to be moved.' expandMacros]. self movePoolVariables! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''! whichPoolDefines: varName | currentClass | currentClass := fromClass. [currentClass isNil] whileFalse: [currentClass allPoolDictionaryNames do: [:each | ((self poolVariableNamesIn: each) includes: varName) ifTrue: [^each]]. currentClass := currentClass superclass]. ^nil! ! Refactoring subclass: #MethodRefactoring instanceVariableNames: 'class' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! MethodRefactoring subclass: #AddMethodRefactoring instanceVariableNames: 'protocols source' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddMethodRefactoring class methodsFor: 'instance creation' stamp: ''! addMethod: aString toClass: aClass inProtocols: protocolList ^self new addMethod: aString toClass: aClass inProtocols: protocolList! ! !AddMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk addMethod: aString toClass: aClass inProtocols: protocolList ^(self new) model: aRBSmalltalk; addMethod: aString toClass: aClass inProtocols: protocolList; yourself! ! !AddMethodRefactoring methodsFor: 'initialize-release' stamp: ''! addMethod: aString toClass: aClass inProtocols: protocolList class := self classObjectFor: aClass. source := aString. protocols := protocolList! ! !AddMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | selector method | method := RBParser parseMethod: source onError: [:string :position | ^RBCondition withBlock: [self refactoringError: 'The sources could not be parsed']]. selector := method selector. selector isNil ifTrue: [self refactoringError: 'Invalid source.']. ^(RBCondition canUnderstand: selector in: class) not! ! !AddMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' addMethod: '''; nextPutAll: source; nextPutAll: ''' toClass: '. class storeOn: aStream. aStream nextPutAll: ' inProtocols: '. protocols storeOn: aStream. aStream nextPut: $)! ! !AddMethodRefactoring methodsFor: 'transforming' stamp: ''! transform class compile: source classified: protocols! ! MethodRefactoring subclass: #ChangeMethodNameRefactoring instanceVariableNames: 'newSelector oldSelector permutation implementors' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! ChangeMethodNameRefactoring subclass: #AddParameterRefactoring instanceVariableNames: 'initializer senders' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddParameterRefactoring class methodsFor: 'instance creation' stamp: ''! addParameterToMethod: aSelector in: aClass newSelector: newSelector initializer: init ^self new addParameterToMethod: aSelector in: aClass newSelector: newSelector initializer: init! ! !AddParameterRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk addParameterToMethod: aSelector in: aClass newSelector: newSelector initializer: init ^(self new) model: aRBSmalltalk; addParameterToMethod: aSelector in: aClass newSelector: newSelector initializer: init; yourself! ! !AddParameterRefactoring methodsFor: 'initialize-release' stamp: 'md 3/15/2006 17:28'! addParameterToMethod: aSelector in: aClass newSelector: newSel initializer: init self renameMethod: aSelector in: aClass to: newSel permutation: (1 to: newSel numArgs). initializer := init! ! !AddParameterRefactoring methodsFor: 'preconditions' stamp: ''! checkSendersAccessTo: name | violatorClass | (#('self' 'super') includes: name) ifTrue: [^self]. violatorClass := self senders detect: [:each | (self canReferenceVariable: name in: each) not] ifNone: [nil]. violatorClass notNil ifTrue: [self refactoringError: ('<1s> doesn''t appear to be defined in <2p>' expandMacrosWith: name with: violatorClass)]! ! !AddParameterRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'! checkVariableReferencesIn: aParseTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '`var' do: [:aNode :answer | | name | name := aNode name. (aNode whoDefines: name) isNil ifTrue: [self checkSendersAccessTo: name]]. searcher executeTree: aParseTree! ! !AddParameterRefactoring methodsFor: 'private' stamp: 'lr 2/21/2010 14:52'! modifyImplementorParseTree: parseTree in: aClass | name newArg allTempVars | allTempVars := parseTree allDefinedVariables. name := self safeVariableNameFor: aClass temporaries: allTempVars. newArg := RBVariableNode named: name. parseTree renameSelector: newSelector andArguments: parseTree arguments , (Array with: newArg)! ! !AddParameterRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^RBCondition withBlock: [oldSelector numArgs + 1 = newSelector numArgs ifFalse: [self refactoringError: newSelector printString , ' doesn''t have the proper number of arguments.']. self verifyInitializationExpression. true]! ! !AddParameterRefactoring methodsFor: 'private' stamp: ''! newSelectorString | stream keywords | stream := WriteStream on: String new. keywords := newSelector keywords. 1 to: keywords size do: [:i | stream nextPutAll: (keywords at: i). i == keywords size ifTrue: [stream nextPut: $(; nextPutAll: initializer; nextPut: $)] ifFalse: [stream nextPutAll: ' ``@arg'; nextPutAll: i printString]. stream nextPut: $ ]. ^stream contents! ! !AddParameterRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! parseTreeRewriter | rewriteRule oldString newString | rewriteRule := RBParseTreeRewriter new. oldString := self buildSelectorString: oldSelector. newString := self newSelectorString. rewriteRule replace: '``@object ' , oldString with: '``@object ' , newString. ^rewriteRule! ! !AddParameterRefactoring methodsFor: 'private' stamp: ''! safeVariableNameFor: aClass temporaries: allTempVars | baseString i newString | newString := baseString := 'anObject'. i := 0. [(allTempVars includes: newString) or: [aClass definesInstanceVariable: newString]] whileTrue: [i := i + 1. newString := baseString , i printString]. ^newString! ! !AddParameterRefactoring methodsFor: 'private' stamp: ''! senders senders isNil ifTrue: [senders := Set new. self model allReferencesTo: oldSelector do: [:each | senders add: each modelClass]]. ^senders! ! !AddParameterRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' addParameterToMethod: #'; nextPutAll: oldSelector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' newSelector: #'; nextPutAll: newSelector; nextPutAll: ' initializer: '''; nextPutAll: initializer; nextPutAll: ''')'! ! !AddParameterRefactoring methodsFor: 'preconditions' stamp: ''! verifyInitializationExpression | tree | tree := RBParser parseExpression: initializer onError: [:msg :index | self refactoringError: 'Illegal initialization code because:.' , msg]. tree isValue ifFalse: [self refactoringError: 'The initialization code cannot be a return node or a list of statements']. self checkVariableReferencesIn: tree! ! !ChangeMethodNameRefactoring methodsFor: 'testing' stamp: ''! hasPermutedArguments oldSelector numArgs = newSelector numArgs ifFalse: [^true]. 1 to: oldSelector numArgs do: [:i | (permutation at: i) = i ifFalse: [^true]]. ^false! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: ''! implementors implementors isNil ifTrue: [implementors := self model allImplementorsOf: oldSelector]. ^implementors! ! !ChangeMethodNameRefactoring methodsFor: 'testing' stamp: ''! implementorsCanBePrimitives ^false! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: 'lr 11/23/2009 10:58'! modifyImplementorParseTree: parseTree in: aClass | oldArgs | oldArgs := parseTree arguments. parseTree renameSelector: newSelector andArguments: (permutation collect: [:each | oldArgs at: each]) ! ! !ChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^self subclassResponsibility! ! !ChangeMethodNameRefactoring methodsFor: 'accessing' stamp: ''! newSelector ^newSelector! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! parseTreeRewriter | rewriteRule oldString newString | rewriteRule := RBParseTreeRewriter new. oldString := self buildSelectorString: oldSelector. newString := self buildSelectorString: newSelector withPermuteMap: permutation. rewriteRule replace: '``@object ' , oldString with: '``@object ' , newString. ^rewriteRule! ! !ChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: ''! preconditions "This refactoring only preserves behavior if all implementors are renamed." | conditions | conditions := self myConditions & (RBCondition definesSelector: oldSelector in: class) & (RBCondition isValidMethodName: newSelector for: class). conditions := self implementors inject: conditions into: [:condition :each | condition & (RBCondition hierarchyOf: each canUnderstand: newSelector) not]. ^conditions & (RBCondition withBlock: [self implementors size > 1 ifTrue: [self refactoringWarning: ('This will modify all <1p> implementors.' expandMacrosWith: self implementors size)]. true])! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 12/23/2009 19:59'! removeRenamedImplementors oldSelector = newSelector ifTrue: [ ^ self ]. self implementors do: [ :each | each removeMethod: oldSelector ]! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:58'! renameImplementors self implementors do: [:each | | parseTree | parseTree := each parseTreeFor: oldSelector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse source code.']. self implementorsCanBePrimitives ifFalse: [parseTree isPrimitive ifTrue: [self refactoringError: ('<1p>''s implementation of #<2s> is a primitive' expandMacrosWith: each with: oldSelector)]]. self modifyImplementorParseTree: parseTree in: each. (each methodFor: oldSelector) compileTree: parseTree]! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: ''! renameMessageSends self convertAllReferencesTo: oldSelector using: self parseTreeRewriter! ! !ChangeMethodNameRefactoring methodsFor: 'initialize-release' stamp: 'md 3/15/2006 17:27'! renameMethod: aSelector in: aClass to: newSel permutation: aMap oldSelector := aSelector asSymbol. newSelector := newSel asSymbol. class := self classObjectFor: aClass. permutation := aMap! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 12/23/2009 20:00'! transform self renameImplementors. self renameMessageSends. self removeRenamedImplementors! ! ChangeMethodNameRefactoring subclass: #RemoveParameterRefactoring instanceVariableNames: 'parameterIndex argument' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! RemoveParameterRefactoring subclass: #InlineParameterRefactoring instanceVariableNames: 'expressions' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineParameterRefactoring class methodsFor: 'instance creation' stamp: ''! inlineParameter: aString in: aClass selector: aSelector ^self new inlineParameter: aString in: aClass selector: aSelector! ! !InlineParameterRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk inlineParameter: aString in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; inlineParameter: aString in: aClass selector: aSelector; yourself! ! !InlineParameterRefactoring methodsFor: 'private' stamp: ''! allExpressionsToInline | coll | coll := Set new. self model allReferencesTo: oldSelector do: [:each | | tree | tree := each parseTree. tree notNil ifTrue: [coll addAll: (self expressionsToInlineFrom: tree)]]. ^coll asOrderedCollection! ! !InlineParameterRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! expressionsToInlineFrom: aTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '``@obj ' , (self buildSelectorString: oldSelector) do: [:aNode :answer | answer add: (aNode arguments at: parameterIndex); yourself]. ^searcher executeTree: aTree initialAnswer: OrderedCollection new! ! !InlineParameterRefactoring methodsFor: 'initialize-release' stamp: ''! inlineParameter: aString in: aClass selector: aSelector oldSelector := aSelector. class := self classObjectFor: aClass. argument := aString! ! !InlineParameterRefactoring methodsFor: 'transforming' stamp: ''! modifyImplementorParseTree: parseTree in: aClass | node assignment | node := (parseTree arguments at: parameterIndex) copy. parseTree body addTemporaryNamed: node name. assignment := RBAssignmentNode variable: node copy value: expressions first. parseTree body addNodeFirst: assignment. super modifyImplementorParseTree: parseTree in: aClass! ! !InlineParameterRefactoring methodsFor: 'preconditions' stamp: ''! myConditions self getNewSelector. expressions := self allExpressionsToInline. ^(RBCondition definesSelector: oldSelector in: class) & ((RBCondition withBlock: [expressions isEmpty not]) errorMacro: 'No callers. Use Remove Method instead.') & ((RBCondition withBlock: [expressions size = 1]) errorMacro: 'All values passed as this argument must be identical.') & ((RBCondition withBlock: [expressions first isLiteral]) errorMacro: 'All values passed must be literal.')! ! !InlineParameterRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' inlineParameter: '''; nextPutAll: argument; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: oldSelector; nextPut: $)! ! !RemoveParameterRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk removeParameter: aString in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; removeParameter: aString in: aClass selector: aSelector; yourself! ! !RemoveParameterRefactoring class methodsFor: 'instance creation' stamp: ''! removeParameter: aString in: aClass selector: aSelector ^self new removeParameter: aString in: aClass selector: aSelector! ! !RemoveParameterRefactoring methodsFor: 'private' stamp: 'md 8/2/2005 22:25'! computeNewSelector | keywords stream | oldSelector numArgs == 0 ifTrue: [self refactoringError: 'This method contains no arguments']. oldSelector isInfix ifTrue: [self refactoringError: 'Cannot remove parameters of infix selectors']. keywords := oldSelector keywords asOrderedCollection. keywords size = 1 ifTrue: [^(keywords first copyWithout: $:) asSymbol]. keywords removeAt: parameterIndex. stream := WriteStream on: ''. keywords do: [:each | stream nextPutAll: each]. ^stream contents asSymbol! ! !RemoveParameterRefactoring methodsFor: 'transforming' stamp: ''! getNewSelector | tree | (class directlyDefinesMethod: oldSelector) ifFalse: [self refactoringError: 'Method doesn''t exist']. tree := class parseTreeFor: oldSelector. tree isNil ifTrue: [self refactoringError: 'Cannot parse sources']. parameterIndex := tree argumentNames indexOf: argument ifAbsent: [self refactoringError: 'Select a parameter!!!!']. permutation := (1 to: oldSelector numArgs) copyWithout: parameterIndex. newSelector := self computeNewSelector! ! !RemoveParameterRefactoring methodsFor: 'transforming' stamp: ''! hasReferencesToTemporaryIn: each | tree | tree := each parseTreeFor: oldSelector. tree isNil ifTrue: [self refactoringError: 'Cannot parse sources.']. ^tree references: (tree argumentNames at: parameterIndex)! ! !RemoveParameterRefactoring methodsFor: 'preconditions' stamp: 'lr 3/9/2010 16:08'! myConditions | imps | imps := self model allImplementorsOf: oldSelector. self getNewSelector. ^imps inject: (RBCondition definesSelector: oldSelector in: class) into: [:cond :each | cond & (RBCondition withBlock: [(self hasReferencesToTemporaryIn: each) not] errorString: 'This argument is still referenced in at least one implementor!!!!')]! ! !RemoveParameterRefactoring methodsFor: 'initialize-release' stamp: ''! removeParameter: aString in: aClass selector: aSelector oldSelector := aSelector. class := self classObjectFor: aClass. argument := aString! ! !RemoveParameterRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' removeParameter: '''; nextPutAll: argument; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: oldSelector. aStream nextPut: $)! ! ChangeMethodNameRefactoring subclass: #RenameMethodRefactoring instanceVariableNames: 'hasPermutedArguments' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameMethodRefactoring class methodsFor: 'instance creation' stamp: 'md 3/15/2006 17:29'! model: aRBSmalltalk renameMethod: aSelector in: aClass to: newSelector permutation: aMap ^(self new) model: aRBSmalltalk; renameMethod: aSelector in: aClass to: newSelector permutation: aMap; yourself! ! !RenameMethodRefactoring class methodsFor: 'instance creation' stamp: 'md 3/15/2006 17:26'! renameMethod: aSelector in: aClass to: newSelector permutation: aMap ^self new renameMethod: aSelector in: aClass to: newSelector permutation: aMap! ! !RenameMethodRefactoring methodsFor: 'testing' stamp: ''! hasPermutedArguments ^hasPermutedArguments isNil ifTrue: [hasPermutedArguments := super hasPermutedArguments] ifFalse: [hasPermutedArguments]! ! !RenameMethodRefactoring methodsFor: 'testing' stamp: ''! implementorsCanBePrimitives ^self hasPermutedArguments not! ! !RenameMethodRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^RBCondition withBlock: [oldSelector numArgs = newSelector numArgs] errorString: newSelector printString , ' doesn''t have the correct number of arguments.'! ! !RenameMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! parseTreeRewriter | rewriteRule oldString newString | oldString := self buildSelectorString: oldSelector. newString := self buildSelectorString: newSelector withPermuteMap: permutation. rewriteRule := self hasPermutedArguments ifTrue: [RBParseTreeRewriter new] ifFalse: [RBParseTreeRewriter replaceLiteral: oldSelector with: newSelector]. rewriteRule replace: '``@object ' , oldString with: '``@object ' , newString. ^rewriteRule! ! !RenameMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | newCondition | newCondition := (RBCondition withBlock: [newSelector = oldSelector] errorString: 'The selectors are <1?:not >equivalent') & (RBCondition withBlock: [permutation asArray ~= (1 to: oldSelector numArgs) asArray] errorString: 'The arguments are <1?:not >permuted'). ^newCondition | super preconditions! ! !RenameMethodRefactoring methodsFor: 'printing' stamp: 'lr 3/9/2010 16:09'! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' renameMethod: #'; nextPutAll: oldSelector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' to: #'; nextPutAll: newSelector; nextPutAll: ' permutation: '. permutation storeOn: aStream. aStream nextPut: $)! ! MethodRefactoring subclass: #ExtractMethodRefactoring instanceVariableNames: 'selector extractionInterval extractedParseTree modifiedParseTree parameters needsReturn' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExtractMethodRefactoring class methodsFor: 'instance creation' stamp: ''! extract: anInterval from: aSelector in: aClass ^self new extract: anInterval from: aSelector in: aClass! ! !ExtractMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk extract: anInterval from: aSelector in: aClass ^(self new) model: aRBSmalltalk; extract: anInterval from: aSelector in: aClass; yourself! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkAssignments: variableNames | node outsideVars removeAssigned | removeAssigned := variableNames copy. node := self placeholderNode. outsideVars := variableNames select: [:each | (node whoDefines: each) references: each]. outsideVars size == 1 ifTrue: [self checkSingleAssignment: outsideVars asArray first]. outsideVars size > 1 ifTrue: [self refactoringError: 'Cannot extract assignment without all references.']. removeAssigned removeAll: outsideVars. (RBReadBeforeWrittenTester readBeforeWritten: removeAssigned in: extractedParseTree) isEmpty ifFalse: [self refactoringError: 'Cannot extract assignment if read before written.']. removeAssigned do: [:each | (node whoDefines: each) removeTemporaryNamed: each]. self createTemporariesInExtractedMethodFor: variableNames! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkReturn needsReturn := self placeholderNode isUsed. extractedParseTree containsReturn ifFalse: [^self]. extractedParseTree lastIsReturn ifTrue: [^self]. (modifiedParseTree isLast: self placeholderNode) ifFalse: [self refactoringError: 'Couldn''t extract code since it contains a return.']. self checkSelfReturns! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! checkSelfReturns | searcher | searcher := RBParseTreeSearcher new. searcher matches: '^self' do: [:aNode :answer | answer]; matches: '^`@anything' do: [:aNode :answer | true]. (searcher executeTree: extractedParseTree initialAnswer: false) ifTrue: [self placeholderNode asReturn]! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! checkSingleAssignment: varName ((RBReadBeforeWrittenTester isVariable: varName readBeforeWrittenIn: extractedParseTree) or: [extractedParseTree containsReturn]) ifTrue: [self refactoringError: 'Cannot extract assignments to temporaries without all references']. extractedParseTree addNode: (RBReturnNode value: (RBVariableNode named: varName)). modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: varName , ' := ' , self methodDelimiter in: modifiedParseTree! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkSpecialExtractions | node | node := self placeholderNode parent. node isNil ifTrue: [^self]. (node isAssignment and: [node variable = self placeholderNode]) ifTrue: [self refactoringError: 'Cannot extract left hand side of an assignment']. node isCascade ifTrue: [self refactoringError: 'Cannot extract first message of a cascaded message']! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkTemporaries | temps accesses assigned | temps := self remainingTemporaries. accesses := temps select: [:each | extractedParseTree references: each]. assigned := accesses select: [:each | extractedParseTree assigns: each]. assigned isEmpty ifFalse: [self checkAssignments: assigned]. ^parameters := (accesses asOrderedCollection) removeAll: assigned; yourself! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! createTemporariesInExtractedMethodFor: assigned assigned do: [:each | extractedParseTree body addTemporaryNamed: each]! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'bh 5/10/2000 21:58'! existingSelector "Try to find an existing method instead of creating a new one" ^class allSelectors detect: [:each | self isMethodEquivalentTo: each] ifNone: [nil]! ! !ExtractMethodRefactoring methodsFor: 'initialize-release' stamp: ''! extract: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. extractionInterval := anInterval! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! extractMethod | parseTree isSequence extractCode subtree newCode | extractCode := self getExtractedSource. extractedParseTree := RBParser parseExpression: extractCode onError: [:string :pos | self refactoringError: 'Invalid source to extract - ', string]. extractedParseTree isNil ifTrue: [self refactoringError: 'Invalid source to extract']. (extractedParseTree isSequence and: [extractedParseTree statements isEmpty]) ifTrue: [self refactoringError: 'Select some code to extract']. isSequence := extractedParseTree isSequence or: [extractedParseTree isReturn]. extractedParseTree := RBMethodNode selector: #value arguments: #() body: (extractedParseTree isSequence ifTrue: [extractedParseTree] ifFalse: [RBSequenceNode temporaries: #() statements: (OrderedCollection with: extractedParseTree)]). extractedParseTree body temporaries isEmpty not ifTrue: [extractedParseTree body temporaries: #()]. extractedParseTree source: extractCode. parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse ' , selector printString]. subtree := isSequence ifTrue: [RBParseTreeSearcher treeMatchingStatements: extractedParseTree body formattedCode in: parseTree] ifFalse: [RBParseTreeSearcher treeMatching: extractCode in: parseTree]. subtree isNil ifTrue: [self refactoringError: 'Could not extract code from method']. newCode := self methodDelimiter. isSequence ifTrue: [| stmts | stmts := extractedParseTree body statements. stmts isEmpty ifFalse: [stmts last isAssignment ifTrue: [| name | name := stmts last variable name. (self shouldExtractAssignmentTo: name) ifFalse: [newCode := '<1s> := <2s>' expandMacrosWith: name with: newCode. stmts at: stmts size put: stmts last value]]]]. modifiedParseTree := isSequence ifTrue: [RBParseTreeRewriter replaceStatements: subtree formattedCode with: newCode in: parseTree onInterval: extractionInterval] ifFalse: [RBParseTreeRewriter replace: subtree formattedCode with: newCode in: parseTree onInterval: extractionInterval]! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! getExtractedSource | source | source := class sourceCodeFor: selector. ((extractionInterval first between: 1 and: source size) and: [extractionInterval last between: 1 and: source size]) ifFalse: [self refactoringError: 'Invalid interval']. ^source copyFrom: extractionInterval first to: extractionInterval last! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! getNewMethodName | newSelector methodName newMethodName | methodName := RBMethodName new. methodName arguments: parameters. [newMethodName := self requestMethodNameFor: methodName. newMethodName isNil ifTrue: [self refactoringError: 'Did not extract code']. newSelector := newMethodName selector. (self checkMethodName: newSelector in: class) ifFalse: [self refactoringWarning: newSelector , ' is not a valid selector name.'. newSelector := nil]. (class hierarchyDefinesMethod: newSelector asSymbol) ifTrue: [(self shouldOverride: newSelector in: class) ifFalse: [newSelector := nil]]. newSelector isNil] whileTrue: []. parameters := newMethodName arguments asOrderedCollection. ^newSelector asSymbol! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! isMethodEquivalentTo: aSelector selector == aSelector ifTrue: [^false]. aSelector numArgs ~~ parameters size ifTrue: [^false]. (self isParseTreeEquivalentTo: aSelector) ifFalse: [^false]. self reorderParametersToMatch: aSelector. ^true! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! isParseTreeEquivalentTo: aSelector | tree definingClass | definingClass := class whoDefinesMethod: aSelector. tree := definingClass parseTreeFor: aSelector. tree isNil ifTrue: [^false]. tree isPrimitive ifTrue: [^false]. (tree body equalTo: extractedParseTree body exceptForVariables: (tree arguments collect: [:each | each name])) ifFalse: [^false]. (definingClass = class or: [(tree superMessages detect: [:each | (class superclass whichClassIncludesSelector: aSelector) ~= (definingClass superclass whichClassIncludesSelector: each)] ifNone: [nil]) isNil]) ifFalse: [^false]. ^self shouldUseExistingMethod: aSelector! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! methodDelimiter ^'#''place.holder.for.method'''! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:00'! nameNewMethod: aSymbol | args newSend | args := parameters collect: [:parm | RBVariableNode named: parm]. extractedParseTree renameSelector: aSymbol andArguments: args asArray. aSymbol numArgs = 0 ifTrue: [modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: 'self ' , aSymbol asString in: modifiedParseTree. ^self]. newSend := WriteStream on: ''. aSymbol keywords with: parameters do: [:key :arg | newSend nextPutAll: key asString; nextPut: $ ; nextPutAll: arg asString; nextPut: $ ]. modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: 'self ' , newSend contents in: modifiedParseTree! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! placeholderNode | node | node := RBParseTreeSearcher treeMatching: self methodDelimiter in: modifiedParseTree. node isNil ifTrue: [self refactoringError: 'Cannot extract code']. ^node! ! !ExtractMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [self extractMethod. self checkSpecialExtractions. self checkReturn. needsReturn ifTrue: [extractedParseTree addReturn]. self checkTemporaries. true])! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! remainingTemporaries | temps | temps := modifiedParseTree allDefinedVariables asSet. extractedParseTree allDefinedVariables do: [:each | temps remove: each ifAbsent: []]. ^temps! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! reorderParametersToMatch: aSelector | tree dictionary | tree := class parseTreeFor: aSelector. dictionary := Dictionary new. tree body equalTo: extractedParseTree body withMapping: dictionary. parameters := tree arguments collect: [:each | dictionary at: each name ifAbsent: [self refactoringError: 'An internal error occured, please report this error.']]! ! !ExtractMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' extract: '. extractionInterval storeOn: aStream. aStream nextPutAll: ' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:04'! transform | existingSelector | existingSelector := self existingSelector. self nameNewMethod: (existingSelector isNil ifTrue: [self getNewMethodName] ifFalse: [existingSelector]). existingSelector isNil ifTrue: [class compile: extractedParseTree newSource withAttributesFrom: (class methodFor: selector)]. class compileTree: modifiedParseTree! ! MethodRefactoring subclass: #ExtractMethodToComponentRefactoring instanceVariableNames: 'selector extractionInterval extractedMethodSelector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExtractMethodToComponentRefactoring class methodsFor: 'instance creation' stamp: ''! extract: anInterval from: aSelector in: aClass ^self new extract: anInterval from: aSelector in: aClass! ! !ExtractMethodToComponentRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk extract: anInterval from: aSelector in: aClass ^(self new) model: aRBSmalltalk; extract: anInterval from: aSelector in: aClass; yourself! ! !ExtractMethodToComponentRefactoring methodsFor: 'initialize-release' stamp: ''! extract: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. extractionInterval := anInterval! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! extractMethod | refactoring | refactoring := ExtractMethodRefactoring model: self model extract: extractionInterval from: selector in: class. refactoring setOption: #methodName toUse: [:ref :methodName | extractedMethodSelector := ref uniqueMethodNameFor: methodName arguments size. methodName selector: extractedMethodSelector; yourself]. self performComponentRefactoring: refactoring! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! inlineForwarder | refactoring | refactoring := InlineAllSendersRefactoring model: self model sendersOf: extractedMethodSelector in: class. refactoring setOption: #inlineExpression toUse: [:ref :string | true]. self performComponentRefactoring: refactoring! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! moveMethod | variable refactoring | variable := self selectVariableToMoveMethodTo: extractedMethodSelector class: class. variable isNil ifTrue: [self refactoringError: 'Did not extract method']. refactoring := MoveMethodRefactoring model: self model selector: extractedMethodSelector class: class variable: variable. self performComponentRefactoring: refactoring! ! !ExtractMethodToComponentRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition empty! ! !ExtractMethodToComponentRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' extract: '. extractionInterval storeOn: aStream. aStream nextPutAll: ' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! transform self extractMethod; moveMethod; inlineForwarder! ! MethodRefactoring subclass: #ExtractToTemporaryRefactoring instanceVariableNames: 'sourceInterval selector newVariableName parseTree' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExtractToTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! extract: anInterval to: aString from: aSelector in: aClass ^self new extract: anInterval to: aString from: aSelector in: aClass! ! !ExtractToTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk extract: anInterval to: aString from: aSelector in: aClass ^(self new) model: aRBSmalltalk; extract: anInterval to: aString from: aSelector in: aClass; yourself! ! !ExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! checkVariableName (class whoDefinesInstanceVariable: newVariableName) notNil ifTrue: [self refactoringError: ('<1p> defines an instance variable named <2s>' expandMacrosWith: class with: newVariableName)]. (class whoDefinesClassVariable: newVariableName) notNil ifTrue: [self refactoringError: ('<1p> defines a class variabled named <2s>' expandMacrosWith: class with: newVariableName)]. (self parseTree allDefinedVariables includes: newVariableName) ifTrue: [self refactoringError: ('<1s> is already a temporary variable name' expandMacrosWith: newVariableName)]! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! compileNewMethod class compileTree: self parseTree! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! constructAssignmentFrom: aNode | valueNode | valueNode := RBVariableNode named: newVariableName. ^RBAssignmentNode variable: valueNode value: aNode! ! !ExtractToTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''! extract: anInterval to: aString from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. sourceInterval := anInterval. newVariableName := aString! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! insertTemporary | node statementNode | node := self parseTree whichNodeIsContainedBy: sourceInterval. (node notNil and: [node isValue]) ifFalse: [self refactoringError: 'Cannot assign to non-value nodes']. statementNode := node statementNode. node replaceWith: (RBVariableNode named: newVariableName). (statementNode parent) addNode: (self constructAssignmentFrom: node) before: (node == statementNode ifTrue: [RBVariableNode named: newVariableName] ifFalse: [statementNode]); addTemporaryNamed: newVariableName! ! !ExtractToTemporaryRefactoring methodsFor: 'private-accessing' stamp: ''! parseTree parseTree isNil ifTrue: [parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']]. ^parseTree! ! !ExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition isValidInstanceVariableName: newVariableName for: class) & (RBCondition withBlock: [self verifySelectedInterval. self checkVariableName. true])! ! !ExtractToTemporaryRefactoring methodsFor: 'private-accessing' stamp: ''! selectedSource | source | source := class sourceCodeFor: selector. source isNil ifTrue: [self refactoringError: 'Couldn''t find sources']. ((sourceInterval first between: 1 and: source size) and: [sourceInterval last between: 1 and: source size]) ifFalse: [self refactoringError: 'Invalid interval']. ^source copyFrom: sourceInterval first to: sourceInterval last! ! !ExtractToTemporaryRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' extract: '. sourceInterval storeOn: aStream. aStream nextPutAll: ' to: '''; nextPutAll: newVariableName; nextPutAll: ''' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! transform self insertTemporary; compileNewMethod! ! !ExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! verifySelectedInterval | selectedParseTree selectedSources | selectedSources := self selectedSource. selectedParseTree := RBParser parseExpression: selectedSources onError: [:message :position | self refactoringError: 'Invalid selection']. selectedParseTree isSequence ifTrue: [self refactoringError: 'Cannot assign temp to multiple statements']! ! MethodRefactoring subclass: #InlineAllSendersRefactoring instanceVariableNames: 'selector numberReplaced numberNotReplaced' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineAllSendersRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk sendersOf: aSelector in: aClass ^(self new) model: aRBSmalltalk; sendersOf: aSelector in: aClass; yourself! ! !InlineAllSendersRefactoring class methodsFor: 'instance creation' stamp: ''! sendersOf: aSelector in: aClass ^self new sendersOf: aSelector in: aClass! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! checkInlinedMethods numberReplaced = 0 ifTrue: [self refactoringError: 'Could not inline any senders']! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! inlineMessagesInClass: aClass andSelector: aSelector | messagesToInline previousCountOfMessages | previousCountOfMessages := 4294967295. "Some really large number > # of initial self sends." [messagesToInline := self numberOfSelfSendsIn: (aClass parseTreeFor: aSelector). messagesToInline > 0 and: [previousCountOfMessages > messagesToInline]] whileTrue: [| node | previousCountOfMessages := messagesToInline. node := self selfSendIn: (aClass parseTreeFor: aSelector). self onError: [self performComponentRefactoring: (InlineMethodRefactoring model: self model inline: node sourceInterval inMethod: aSelector forClass: aClass). numberReplaced := numberReplaced + 1] do: []]. numberNotReplaced := numberNotReplaced + messagesToInline! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! inlineSelfSends class withAllSubclasses do: [:each | | selectors | selectors := each selectors. selectors remove: selector ifAbsent: []. selectors do: [:sel | self inlineMessagesInClass: each andSelector: sel]]! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! messagePattern ^'self ' , (self buildSelectorString: selector)! ! !InlineAllSendersRefactoring methodsFor: 'accessing' stamp: ''! messagesNotReplaced ^numberNotReplaced! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! numberOfSelfSendsIn: aParseTree | search | search := RBParseTreeSearcher new. search matches: self messagePattern do: [:aNode :answer | answer + 1]. ^search executeTree: aParseTree initialAnswer: 0! ! !InlineAllSendersRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition canUnderstand: selector in: class! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! removeMethod self onError: [self performComponentRefactoring: (RemoveMethodRefactoring model: self model removeMethods: (Array with: selector) from: class)] do: []! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! selfSendIn: aTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: self messagePattern do: [:aNode :answer | ^aNode]. ^searcher executeTree: aTree initialAnswer: nil! ! !InlineAllSendersRefactoring methodsFor: 'initialize-release' stamp: ''! sendersOf: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. numberReplaced := numberNotReplaced := 0! ! !InlineAllSendersRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' sendersOf: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! transform self inlineSelfSends; removeMethod; checkInlinedMethods! ! MethodRefactoring subclass: #InlineMethodRefactoring instanceVariableNames: 'sourceInterval inlineParseTree sourceParseTree sourceSelector sourceMessage inlineClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! InlineMethodRefactoring subclass: #InlineMethodFromComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! abstractVariableReferences | refactoring | refactoring := AbstractVariablesRefactoring model: self model abstractVariablesIn: inlineParseTree from: inlineClass toAll: (Array with: class). self performComponentRefactoring: refactoring. inlineParseTree := refactoring parseTree! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! addArgumentToSelector: aSymbol ^aSymbol isInfix ifTrue: [#value:value:] ifFalse: [(aSymbol , 'value:') asSymbol]! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:03'! addSelfReferenceToInlineParseTree | variableName rewriter newArguments | variableName := self newNameForSelf. rewriter := RBParseTreeRewriter rename: 'self' to: variableName. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]. newArguments := inlineParseTree arguments asOrderedCollection. newArguments addFirst: (RBVariableNode named: variableName). inlineParseTree renameSelector: (self addArgumentToSelector: inlineParseTree selector) andArguments: newArguments. sourceMessage receiver replaceWith: (RBVariableNode named: variableName)! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:02'! addSelfReferenceToSourceMessage | newArguments | newArguments := sourceMessage arguments asOrderedCollection. newArguments addFirst: sourceMessage receiver copy. sourceMessage renameSelector: (self addArgumentToSelector: sourceMessage selector) andArguments: newArguments! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! checkSuperMessages inlineParseTree superMessages isEmpty ifFalse: [self refactoringError: 'Cannot inline method since it sends a super message']! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! findSelectedMessage sourceParseTree := class parseTreeFor: sourceSelector. sourceParseTree isNil ifTrue: [self refactoringError: 'Could not parse sources']. sourceMessage := sourceParseTree whichNodeIsContainedBy: sourceInterval. sourceMessage isNil ifTrue: [self refactoringError: 'The selection doesn''t appear to be a message send']. sourceMessage isCascade ifTrue: [sourceMessage := sourceMessage messages last]. sourceMessage isMessage ifFalse: [self refactoringError: 'The selection doesn''t appear to be a message send']! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! inlineClass | imps | inlineClass notNil ifTrue: [^inlineClass]. imps := (self model allImplementorsOf: self inlineSelector) asOrderedCollection. imps size = 1 ifTrue: [^inlineClass := imps first]. imps isEmpty ifTrue: [self refactoringError: 'Nobody defines a method named ' , self inlineSelector]. inlineClass := self requestImplementorToInline: imps. inlineClass isNil ifTrue: [self refactoringError: 'No implementor selected']. ^inlineClass! ! !InlineMethodFromComponentRefactoring methodsFor: 'testing' stamp: ''! isOverridden ^(self inlineClass allSubclasses detect: [:each | each directlyDefinesMethod: self inlineSelector] ifNone: [nil]) notNil! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! newNameForSelf | variableName index originalName nonMetaClass | nonMetaClass := inlineClass theNonMetaClass. variableName := originalName := (nonMetaClass name first isVowel ifTrue: [ 'an' ] ifFalse: [ 'a' ]) , nonMetaClass name. index := 1. [ variableName := self safeVariableNameBasedOn: variableName. inlineParseTree allDefinedVariables includes: variableName ] whileTrue: [ variableName := originalName , index printString. index := index + 1 ]. ^ variableName! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! renameSelfReferences self addSelfReferenceToSourceMessage. self addSelfReferenceToInlineParseTree.! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! safeVariableNameBasedOn: aString "Creates an unused variable name containing aString" | baseString newString i allTempVars | allTempVars := inlineParseTree allTemporaryVariables. baseString := aString copy. baseString at: 1 put: baseString first asLowercase. newString := baseString. i := 0. [(allTempVars includes: newString) or: [class definesInstanceVariable: newString]] whileTrue: [i := i + 1. newString := baseString , i printString]. ^newString! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! transform self abstractVariableReferences. self renameSelfReferences. super transform! ! !InlineMethodRefactoring class methodsFor: 'instance creation' stamp: ''! inline: anInterval inMethod: aSelector forClass: aClass ^self new inline: anInterval inMethod: aSelector forClass: aClass! ! !InlineMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk inline: anInterval inMethod: aSelector forClass: aClass ^(self new) model: aRBSmalltalk; inline: anInterval inMethod: aSelector forClass: aClass; yourself! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! addSelfReturn inlineParseTree addSelfReturn! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! addTemporary: sourceNode assignedTo: replacementNode | newName | newName := self renameConflictingTemporary: sourceNode name. (inlineParseTree body) addTemporaryNamed: newName; addNodeFirst: (RBAssignmentNode variable: (RBVariableNode named: newName) value: replacementNode)! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! checkSuperMessages self inlineClass = class ifTrue: [^self]. self inlineClass superclass isNil ifTrue: [^self]. inlineParseTree superMessages do: [:each | (self inlineClass superclass whoDefinesMethod: each) = (class superclass whoDefinesMethod: each) ifFalse: [self refactoringError: ('Cannot inline method since it sends a super message <1s> that is overriden' expandMacrosWith: each)]]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! compileMethod class compileTree: sourceParseTree! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! findSelectedMessage sourceParseTree := class parseTreeFor: sourceSelector. sourceParseTree isNil ifTrue: [self refactoringError: 'Could not parse sources']. sourceMessage := sourceParseTree whichNodeIsContainedBy: sourceInterval. sourceMessage isNil ifTrue: [self refactoringError: 'The selection doesn''t appear to be a message send']. sourceMessage isCascade ifTrue: [sourceMessage := sourceMessage messages last]. sourceMessage isMessage ifFalse: [self refactoringError: 'The selection doesn''t appear to be a message send']. (sourceMessage receiver isVariable and: [#('self' 'super') includes: sourceMessage receiver name]) ifFalse: [self refactoringError: 'Cannot inline non-self messages']! ! !InlineMethodRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! hasMultipleReturns "Do we have multiple returns? If the last statement isn't a return, then we have an implicit return of self." | searcher | searcher := RBParseTreeSearcher new. searcher matches: '^``@object' do: [:aNode :hasAReturn | hasAReturn ifTrue: [^true]. true]. searcher executeTree: inlineParseTree initialAnswer: inlineParseTree lastIsReturn not. ^false! ! !InlineMethodRefactoring methodsFor: 'initialize-release' stamp: ''! inline: anInterval inMethod: aSelector forClass: aClass sourceSelector := aSelector. class := self classObjectFor: aClass. sourceInterval := anInterval! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! inlineClass ^inlineClass isNil ifTrue: [inlineClass := (sourceMessage receiver name = 'super' ifTrue: [class superclass] ifFalse: [class]) whoDefinesMethod: self inlineSelector] ifFalse: [inlineClass]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! inlineSelector sourceMessage isNil ifTrue: [self findSelectedMessage]. ^sourceMessage selector! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! inlineSourceReplacing: aParseTree | statements nodeUnderSequence | statements := inlineParseTree body statements. (statements size > 1 and: [aParseTree isEvaluatedFirst not]) ifTrue: [self refactoringWarning: 'To inline this method, we need to move some of its statements before the original message send.This could change the order of execution, which can change the behavior.Do you want to proceed?' expandMacros]. nodeUnderSequence := aParseTree. [nodeUnderSequence parent isSequence] whileFalse: [nodeUnderSequence := nodeUnderSequence parent]. (nodeUnderSequence parent) addNodes: (statements copyFrom: 1 to: (statements size - 1 max: 0)) before: nodeUnderSequence; addTemporariesNamed: inlineParseTree body temporaryNames. aParseTree parent replaceNode: aParseTree withNode: (statements isEmpty ifTrue: [RBVariableNode named: 'self'] ifFalse: [statements last])! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! insertInlinedMethod | node | node := sourceMessage. self moveComments. node parent isCascade ifTrue: [self rewriteCascadedMessage. node := node parent]. node parent isReturn ifTrue: [node := node parent] ifFalse: [self removeReturns]. self replaceArguments. self inlineSourceReplacing: node. sourceParseTree removeDeadCode. self removeEmptyIfTrues. self removeImmediateBlocks! ! !InlineMethodRefactoring methodsFor: 'testing' stamp: ''! isOverridden ^(class allSubclasses detect: [:each | each directlyDefinesMethod: self inlineSelector] ifNone: [nil]) notNil! ! !InlineMethodRefactoring methodsFor: 'testing' stamp: ''! isPrimitive ^inlineParseTree isPrimitive! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! moveComments inlineParseTree nodesDo: [:each | each comments: (each comments collect: [:anInterval | | start stop source | source := sourceParseTree source. start := source size + 1. source := source , (inlineParseTree source copyFrom: anInterval first to: anInterval last). stop := source size. sourceParseTree source: source. start to: stop])]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! normalizeIfTrues | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2' with: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1] ifFalse: [``@.s2. ^``@r2]'; replace: '| `@temps | ``@.s1. ``@boolean ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2' with: '| `@temps | ``@.s1. ``@boolean ifTrue: [``@.s2. ^``@r2] ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]'. [rewriter executeTree: inlineParseTree] whileTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! normalizeReturns | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'. [rewriter executeTree: inlineParseTree] whileTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! parseInlineMethod self inlineClass isNil ifTrue: [self refactoringError: ('<1p> or its superclasses don''t contain method <2s>' expandMacrosWith: class with: self inlineSelector)]. inlineParseTree := self inlineClass parseTreeFor: self inlineSelector. inlineParseTree isNil ifTrue: [self refactoringError: 'Could not parse sources']. inlineParseTree lastIsReturn ifFalse: [inlineParseTree addSelfReturn]! ! !InlineMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: sourceSelector in: class) & (RBCondition withBlock: [self findSelectedMessage. self isOverridden ifTrue: [self refactoringWarning: ('<1p>>><2s> is overriden. Do you want to inline it anyway?' expandMacrosWith: self inlineClass with: self inlineSelector)]. self parseInlineMethod. self isPrimitive ifTrue: [self refactoringError: 'Cannot inline primitives']. self checkSuperMessages. self rewriteInlinedTree. (sourceMessage parent isReturn or: [self hasMultipleReturns not]) ifFalse: [self refactoringError: 'Cannot inline method since it contains multiple returns that cannot be rewritten']. true])! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! removeEmptyIfTrues | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '``@boolean ifTrue: [] ifFalse: [| `@temps | ``@.Stmts]' with: '``@boolean ifFalse: [|`@temps | ``@.Stmts]'; replace: '``@boolean ifFalse: [] ifTrue: [| `@temps | ``@.Stmts]' with: '``@boolean ifTrue: [|`@temps | ``@.Stmts]'; replace: '``@boolean ifTrue: [| `@temps | ``@.Stmts] ifFalse: []' with: '``@boolean ifTrue: [|`@temps | ``@.Stmts]'; replace: '``@boolean ifFalse: [| `@temps | ``@.Stmts] ifTrue: []' with: '``@boolean ifFalse: [|`@temps | ``@.Stmts]'. (rewriter executeTree: sourceParseTree) ifTrue: [sourceParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! removeImmediateBlocks | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '[``.object] value' with: '``.object' when: [:aNode | aNode parent isCascade not]. rewriter replace: '| `@temps | ``@.Stmts1. [| `@bTemps | ``@.bStmts] value. ``@.Stmts2' with: '| `@temps `@bTemps | ``@.Stmts1. ``@.bStmts. ``@.Stmts2'. (rewriter executeTree: sourceParseTree) ifTrue: [sourceParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! removeReturns | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '^``@object' with: '``@object'. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! renameConflictingTemporaries inlineParseTree allDefinedVariables do: [:each | self renameConflictingTemporary: each]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! renameConflictingTemporary: aName | allNames newName index seqNode | allNames := (Set new) addAll: inlineParseTree allDefinedVariables; yourself. allNames remove: aName ifAbsent: []. seqNode := sourceMessage. [seqNode isSequence] whileFalse: [seqNode := seqNode parent]. allNames addAll: seqNode allDefinedVariables. "Add those variables defined in blocks. This might cause a few variables to be renamed that don't need to be, but this should be safe." newName := aName. index := 0. [(sourceMessage whoDefines: newName) notNil or: [(class hierarchyDefinesVariable: newName) or: [allNames includes: newName]]] whileTrue: [index := index + 1. newName := aName , index printString]. newName = aName ifFalse: [self renameTemporary: aName to: newName]. ^newName! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameTemporary: oldName to: newName | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: oldName with: newName; replaceArgument: oldName with: newName. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceArgument: sourceNode with: replacementNode | rewriter | rewriter := RBParseTreeRewriter new. rewriter replaceTree: sourceNode withTree: replacementNode. (rewriter executeTree: inlineParseTree body) ifTrue: [inlineParseTree body: rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 5/9/2010 11:32'! replaceArguments sourceMessage arguments reversed with: inlineParseTree arguments reversed do: [ :replacement :source | (replacement isImmediate or: [ self shouldInlineExpression: replacement newSource ]) ifTrue: [ self replaceArgument: source with: replacement ] ifFalse: [ self addTemporary: source assignedTo: replacement ] ]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! rewriteCascadedMessage | index messages | messages := sourceMessage parent messages. index := (1 to: messages size) detect: [:i | sourceMessage == (messages at: i)] ifNone: [0]. inlineParseTree body addNodesFirst: (messages copyFrom: 1 to: index - 1). self removeReturns. inlineParseTree body addNodes: (messages copyFrom: index + 1 to: messages size). inlineParseTree addReturn! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! rewriteInlinedTree sourceMessage parent isReturn ifTrue: [(sourceParseTree isLast: sourceMessage parent) ifFalse: [self addSelfReturn]] ifFalse: [self writeGuardClauses; normalizeIfTrues; normalizeReturns; addSelfReturn]! ! !InlineMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' inline: '. sourceInterval storeOn: aStream. aStream nextPutAll: ' inMethod: #'; nextPutAll: sourceSelector; nextPutAll: ' forClass: '. class storeOn: aStream. aStream nextPut: $)! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! transform self renameConflictingTemporaries; insertInlinedMethod; compileMethod! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! writeGuardClauses | rewriter | rewriter := RBParseTreeRewriter new. rewriter replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^`@r2]'; replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^`@r2] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]'; replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^self]'; replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^self] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]'. [rewriter executeTree: inlineParseTree] whileTrue: [inlineParseTree := rewriter tree]! ! MethodRefactoring subclass: #InlineTemporaryRefactoring instanceVariableNames: 'sourceInterval selector sourceTree assignmentNode definingNode' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! inline: anInterval from: aSelector in: aClass ^self new inline: anInterval from: aSelector in: aClass! ! !InlineTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk inline: anInterval from: aSelector in: aClass ^(self new) model: aRBSmalltalk; inline: anInterval from: aSelector in: aClass; yourself! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''! compileMethod class compileTree: sourceTree! ! !InlineTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! hasOnlyOneAssignment | searcher | searcher := RBParseTreeSearcher new. searcher matches: assignmentNode variable name , ' := ``@object' do: [:aNode :answer | answer + 1]. ^(searcher executeTree: definingNode initialAnswer: 0) == 1! ! !InlineTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''! inline: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. sourceInterval := anInterval! ! !InlineTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [self verifySelectedInterval. true])! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''! replaceAssignment assignmentNode parent isSequence ifTrue: [assignmentNode parent removeNode: assignmentNode] ifFalse: [assignmentNode replaceWith: assignmentNode value]! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceReferences | rewriter | rewriter := RBParseTreeRewriter new. rewriter replaceTree: assignmentNode variable withTree: assignmentNode value. definingNode removeTemporaryNamed: assignmentNode variable name. rewriter executeTree: definingNode! ! !InlineTemporaryRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' inline: '. sourceInterval storeOn: aStream. aStream nextPutAll: ' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''! transform self replaceAssignment; replaceReferences; compileMethod! ! !InlineTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! verifySelectedInterval sourceTree := class parseTreeFor: selector. sourceTree isNil ifTrue: [self refactoringError: 'Could not parse source']. assignmentNode := sourceTree whichNodeIsContainedBy: sourceInterval. assignmentNode isAssignment ifFalse: [self refactoringError: 'The selected node is not an assignment statement']. definingNode := assignmentNode whoDefines: assignmentNode variable name. self hasOnlyOneAssignment ifFalse: [self refactoringError: 'There are multiple assignments to the variable']. (RBReadBeforeWrittenTester isVariable: assignmentNode variable name writtenBeforeReadIn: definingNode) ifFalse: [self refactoringError: 'The variable is possible read before it is assigned']! ! !MethodRefactoring methodsFor: 'private' stamp: ''! buildSelectorString: aSelector aSelector numArgs = 0 ifTrue: [^aSelector]. ^self buildSelectorString: aSelector withPermuteMap: (1 to: aSelector numArgs)! ! !MethodRefactoring methodsFor: 'private' stamp: ''! buildSelectorString: aSelector withPermuteMap: anIntegerCollection | stream keywords | aSelector numArgs == 0 ifTrue: [^aSelector asString]. stream := WriteStream on: String new. keywords := aSelector keywords. keywords with: anIntegerCollection do: [:each :i | stream nextPutAll: each; nextPutAll: ' ``@arg'; nextPutAll: i printString; nextPut: $ ]. ^stream contents! ! MethodRefactoring subclass: #MoveMethodRefactoring instanceVariableNames: 'selector variable moveToClasses parseTree hasOnlySelfReturns selfVariableName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !MoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk selector: aSymbol class: aClass variable: aVariableName ^(self new) model: aRBSmalltalk; selector: aSymbol class: aClass variable: aVariableName; yourself! ! !MoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''! selector: aSymbol class: aClass variable: aVariableName ^(self new) selector: aSymbol class: aClass variable: aVariableName; yourself! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! abstractVariables self performComponentRefactoring: self abstractVariablesRefactoring. parseTree := self abstractVariablesRefactoring parseTree! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! abstractVariablesRefactoring ^AbstractVariablesRefactoring model: self model abstractVariablesIn: parseTree from: class toAll: moveToClasses ignoring: variable! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! addSelfReturn self hasOnlySelfReturns ifTrue: [^self]. parseTree addSelfReturn! ! !MoveMethodRefactoring methodsFor: 'private' stamp: ''! buildParseTree parseTree := (class parseTreeFor: selector) copy. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'! checkAssignmentsToVariable | searcher | searcher := RBParseTreeSearcher new. searcher matches: variable , ' := `@object' do: [:aNode :answer | true]. (searcher executeTree: parseTree initialAnswer: false) ifTrue: [self refactoringError: ('Cannot move the method into <1s> since it is assigned' expandMacrosWith: variable)]! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkForPrimitiveMethod parseTree isPrimitive ifTrue: [self refactoringError: 'Cannot move primitive methods']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'! checkForSuperReferences | searcher | searcher := RBParseTreeSearcher new. searcher matches: 'super `@message: `@args' do: [:aNode :answer | true]. (searcher executeTree: parseTree initialAnswer: false) ifTrue: [self refactoringError: 'Cannot move the method since it has a super message send.']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkTemporaryVariableNames | varNames | varNames := parseTree allDefinedVariables. selfVariableName notNil ifTrue: [varNames add: selfVariableName]. varNames do: [:name | moveToClasses do: [:each | (self canReferenceVariable: name in: each) ifTrue: [self refactoringError: ('<1p> already defines a variable called <2s>' expandMacrosWith: each with: name)]]]! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! compileDelagatorMethod | statementNode delegatorNode tree | delegatorNode := RBMessageNode receiver: (RBVariableNode named: variable) selectorParts: parseTree selectorParts arguments: (parseTree argumentNames collect: [:each | RBVariableNode named: (each = selfVariableName ifTrue: ['self'] ifFalse: [each])]). self hasOnlySelfReturns ifFalse: [delegatorNode := RBReturnNode value: delegatorNode]. statementNode := RBSequenceNode temporaries: #() statements: (Array with: delegatorNode). (tree := class parseTreeFor: selector) body: statementNode. class compileTree: tree! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:05'! compileNewMethods moveToClasses do: [:each | each compile: parseTree newSource withAttributesFrom: (class methodFor: selector)]! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! getArgumentNameForSelf self needsToReplaceSelfReferences ifFalse: [^self]. [selfVariableName := self requestSelfArgumentName. (self checkInstanceVariableName: selfVariableName in: class) ifTrue: [self verifyTemporaryVariableDoesNotOverride ifFalse: [self refactoringWarning: 'The variable is already defined in one of the classes you''re moving the method to.Try another?' expandMacros. selfVariableName := nil]] ifFalse: [self refactoringWarning: 'The variable name is not a valid Smalltalk temporary variable nameTry again?' expandMacros. selfVariableName := nil]. selfVariableName isNil] whileTrue: []! ! !MoveMethodRefactoring methodsFor: 'private-accessing' stamp: ''! getClassForGlobalOrClassVariable | definingClass type | definingClass := class whoDefinesClassVariable: variable. definingClass isNil ifTrue: [type := self model classNamed: variable. type isNil ifTrue: [type := self model classNamed: #Object]] ifFalse: [type := definingClass typeOfClassVariable: variable]. moveToClasses := self selectVariableTypesFrom: (Array with: type) selected: (Array with: type). moveToClasses isNil ifTrue: [self refactoringError: 'Method not moved']! ! !MoveMethodRefactoring methodsFor: 'private-accessing' stamp: 'lr 10/5/2010 16:14'! getClassesForInstanceVariable | definingClass typer types | definingClass := class whoDefinesInstanceVariable: variable. typer := RBRefactoryTyper newFor: self model. typer runOn: definingClass. types := typer typesFor: variable. types isEmpty ifTrue: [types := OrderedCollection with: (self model classNamed: #Object)]. moveToClasses := self selectVariableTypesFrom: types selected: (typer guessTypesFor: variable). moveToClasses isNil ifTrue: [self refactoringError: 'Method not moved']! ! !MoveMethodRefactoring methodsFor: 'private-accessing' stamp: 'lr 10/5/2010 16:14'! getClassesForTemporaryVariable | types | types := RBRefactoryTyper typesFor: variable in: parseTree model: self model. types isEmpty ifTrue: [types := OrderedCollection with: (self model classNamed: #Object)]. moveToClasses := self selectVariableTypesFrom: types selected: types. moveToClasses isNil ifTrue: [self refactoringError: 'Method not moved']! ! !MoveMethodRefactoring methodsFor: 'private-accessing' stamp: ''! getClassesToMoveTo self isMovingToArgument ifTrue: [self getClassesForTemporaryVariable] ifFalse: [self isMovingToInstVar ifTrue: [self getClassesForInstanceVariable] ifFalse: [self getClassForGlobalOrClassVariable]]. moveToClasses isEmpty ifTrue: [self refactoringError: 'No classes selected, method not moved.']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/23/2009 11:03'! getNewMethodName "rr 3/16/2004 15:12 : changed the code to really remove the variable which the extracted selector is moved to, as in the new location it is now the self pseudo-argument. The previous version was only removing it from the arguments, which was causing a bug." | newSelector parameters alreadyDefined methodName newMethodName | self removeArgument. parameters := parseTree argumentNames asOrderedCollection. "parameters remove: variable ifAbsent: []." self needsToReplaceSelfReferences ifTrue: [parameters add: selfVariableName]. methodName := RBMethodName selector: (self uniqueMethodNameFor: parameters size) arguments: parameters. [newMethodName := self requestMethodNameFor: methodName. newMethodName isNil ifTrue: [self refactoringError: 'Did not move method']. newMethodName isValid ifTrue: [newSelector := newMethodName selector] ifFalse: [self refactoringWarning: 'Invalid method name']. parameters := newMethodName arguments. (self checkMethodName: newSelector in: class) ifFalse: [self refactoringWarning: newSelector , ' is not a valid selector name.'. newSelector := nil]. alreadyDefined := moveToClasses detect: [:each | each hierarchyDefinesMethod: newSelector] ifNone: [nil]. alreadyDefined notNil ifTrue: [self refactoringWarning: ('<1s> is already defined by <2p> or a super/subclassTry another?' expandMacrosWith: newSelector with: alreadyDefined). newSelector := nil]. newSelector isNil] whileTrue: []. parseTree renameSelector: newSelector andArguments: (parameters collect: [:each | RBVariableNode named: each]) asArray! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! hasOnlySelfReturns ^hasOnlySelfReturns isNil ifTrue: [| searcher | searcher := RBParseTreeSearcher new. searcher matches: '^self' do: [:aNode :answer | answer]; matches: '^`@object' do: [:aNode :answer | false]. hasOnlySelfReturns := searcher executeTree: parseTree initialAnswer: true] ifFalse: [hasOnlySelfReturns]! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! hasSelfReferences | searcher | searcher := RBParseTreeSearcher new. searcher matches: 'self' do: [:aNode :answer | true]. self hasOnlySelfReturns ifTrue: [searcher matches: '^self' do: [:aNode :answer | answer]]. ^searcher executeTree: parseTree initialAnswer: false! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: ''! isMovingToArgument ^(parseTree arguments collect: [:each | each name]) includes: variable! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: ''! isMovingToInstVar ^self isMovingToArgument not and: [(class whoDefinesInstanceVariable: variable) notNil]! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: ''! needsToReplaceSelfReferences ^self hasSelfReferences or: [self abstractVariablesRefactoring hasVariablesToAbstract]! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [self buildParseTree. self checkForPrimitiveMethod. self checkForSuperReferences. self checkAssignmentsToVariable. self getClassesToMoveTo. self getArgumentNameForSelf. self checkTemporaryVariableNames. self getNewMethodName. true])! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'rr 3/16/2004 15:15'! removeArgument "Removes the excess argument if any. This argument is the variable which is referenced by self in the classes the method is moved to. " | removeIndex | removeIndex := parseTree argumentNames indexOf: variable. removeIndex = 0 ifFalse: [parseTree arguments: ((parseTree arguments asOrderedCollection) removeAt: removeIndex; yourself) asArray. parseTree selectorParts: ((parseTree selectorParts asOrderedCollection) removeAt: removeIndex; yourself) asArray].! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceSelfReferences | replacer | self needsToReplaceSelfReferences ifTrue: [ replacer := RBParseTreeRewriter new. replacer replace: 'self' with: selfVariableName. self hasOnlySelfReturns ifTrue: [replacer replace: '^self' with: '^self']. replacer executeTree: parseTree. parseTree := replacer tree].! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceVariableReferences | replacer | replacer := RBParseTreeRewriter new. replacer replace: variable with: 'self'. replacer executeTree: parseTree. parseTree := replacer tree! ! !MoveMethodRefactoring methodsFor: 'initialize-release' stamp: ''! selector: aSymbol class: aClass variable: aVariableName selector := aSymbol. class := self classObjectFor: aClass. variable := aVariableName! ! !MoveMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector; nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' variable: '''; nextPutAll: variable; nextPutAll: ''')'! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! transform self abstractVariables; addSelfReturn; replaceSelfReferences; replaceVariableReferences; compileNewMethods; compileDelagatorMethod! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 1/3/2010 11:48'! verifyTemporaryVariableDoesNotOverride (parseTree allDefinedVariables includes: selfVariableName) ifTrue: [ ^ false ]. ^ moveToClasses noneSatisfy: [ :each | each definesVariable: selfVariableName ]! ! MethodRefactoring subclass: #MoveVariableDefinitionRefactoring instanceVariableNames: 'selector interval name parseTree blockNodes definingNode' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !MoveVariableDefinitionRefactoring class methodsFor: 'instance creation' stamp: ''! bindTight: anInterval in: aClass selector: aSelector ^self new class: aClass selector: aSelector interval: anInterval! ! !MoveVariableDefinitionRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk bindTight: anInterval in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; class: aClass selector: aSelector interval: anInterval; yourself! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''! checkNodes: sequenceNodes (sequenceNodes detect: [:each | RBReadBeforeWrittenTester isVariable: name readBeforeWrittenIn: each] ifNone: [nil]) notNil ifTrue: [^false]. sequenceNodes do: [:each | (self usesDirectly: each body) ifTrue: [blockNodes add: each] ifFalse: [(self checkNodes: (self subblocksIn: each body)) ifFalse: [blockNodes add: each]]]. ^true! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''! checkParseTree | node | blockNodes := OrderedCollection new. node := self whichVariableNode: parseTree inInterval: interval name: name. node isNil ifTrue: [self refactoringError: 'Unable to locate node in parse tree']. definingNode := node whoDefines: name. definingNode isNil ifTrue: [self refactoringError: 'Cannot locate variable definition']. definingNode isSequence ifFalse: [self refactoringError: 'Variable is an argument']. (self usesDirectly: definingNode) ifTrue: [self refactoringError: 'Variable already bound tightly as possible']. (self checkNodes: (self subblocksIn: definingNode)) ifFalse: [self refactoringError: 'Variable is possibly read before written']! ! !MoveVariableDefinitionRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass selector: aSelector interval: anInterval interval := anInterval. class := self classObjectFor: aClass. selector := aSelector! ! !MoveVariableDefinitionRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [| methodSource | interval first <= interval last ifFalse: [self refactoringError: 'Invalid variable name']. methodSource := class sourceCodeFor: selector. methodSource size >= interval last ifFalse: [self refactoringError: 'Invalid range for variable']. name := methodSource copyFrom: interval first to: interval last. (self checkInstanceVariableName: name in: class) ifFalse: [self refactoringError: name , ' does not seem to be a valid variable name.']. parseTree := class parseTreeFor: selector. self checkParseTree. true])! ! !MoveVariableDefinitionRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' bindTight: '. interval storeOn: aStream. aStream nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector. aStream nextPut: $)! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! subblocksIn: aParseTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '[:`@blockTemps | | `@temps | `@.Statements]' do: [:aNode :answer | (aNode references: name) ifTrue: [answer add: aNode]. answer]. ^searcher executeTree: aParseTree initialAnswer: OrderedCollection new! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''! transform definingNode removeTemporaryNamed: name. blockNodes do: [:each | each body addTemporaryNamed: name]. class compileTree: parseTree! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! usesDirectly: aParseTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '[:`@args | | `@temps | `@.Statements]' do: [:aNode :answer | answer]; matches: name do: [:aNode :answer | true]. ^searcher executeTree: aParseTree initialAnswer: false! ! MethodRefactoring subclass: #PullUpMethodRefactoring instanceVariableNames: 'removeDuplicates selectors' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PullUpMethodRefactoring class methodsFor: 'instance creation' stamp: 'lr 7/17/2010 23:23'! model: aRBSmalltalk pullUp: selectorCollection from: aClass ^(self new) model: aRBSmalltalk; pullUp: selectorCollection from: aClass; yourself! ! !PullUpMethodRefactoring class methodsFor: 'instance creation' stamp: 'lr 7/17/2010 23:23'! pullUp: selectorCollection from: aClass ^self new pullUp: selectorCollection from: aClass! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 7/17/2010 22:44'! checkBackReferencesTo: aSelector | definingClass pushUpParseTree | definingClass := class superclass whoDefinesMethod: aSelector. definingClass isNil ifTrue: [^self]. pushUpParseTree := class parseTreeFor: aSelector. class superclass allSubclasses do: [:each | each selectors do: [:sel | | parseTree | parseTree := each parseTreeFor: sel. (parseTree notNil and: [(parseTree superMessages includes: aSelector) and: [definingClass == (each whoDefinesMethod: aSelector)]]) ifTrue: [removeDuplicates := true. (aSelector == sel and: [parseTree equalTo: pushUpParseTree exceptForVariables: #()]) ifFalse: [self refactoringError: ('Cannot pull up <1s> since it would override the method defined in <2p>' expandMacrosWith: aSelector with: definingClass)]]]]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkClassVars selectors do: [:each | self checkClassVarsFor: each]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 10/26/2009 22:08'! checkClassVarsFor: aSelector class theNonMetaClass classVariableNames do: [ :each | ((class whichSelectorsReferToClassVariable: each) includes: aSelector) ifTrue: [ self refactoringError: ('<1p> refers to <2s> which is defined in <3p>' expandMacrosWith: aSelector with: each with: class) ] ]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkInstVars selectors do: [:each | self checkInstVarsFor: each]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkInstVarsFor: aSelector class instanceVariableNames do: [:each | ((class whichSelectorsReferToInstanceVariable: each) includes: aSelector) ifTrue: [self refactoringError: ('<1p> refers to <2s> which is defined in <3p>' expandMacrosWith: aSelector with: each with: class)]]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 7/17/2010 22:44'! checkSiblingSuperSendsFrom: aRBClass aRBClass selectors do: [:each | | tree | tree := aRBClass parseTreeFor: each. tree notNil ifTrue: [tree superMessages do: [:aSelector | (selectors includes: aSelector) ifTrue: [| definer | definer := aRBClass superclass whoDefinesMethod: aSelector. (definer notNil and: [class includesClass: definer]) ifTrue: [self refactoringError: ('Cannot pull up <1s> since <2p>>><3s> sends a super message to it.' expandMacrosWith: aSelector with: aRBClass with: each)]]]]]. aRBClass allSubclasses do: [:each | self checkSiblingSuperSendsFrom: each]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperMessages self checkSuperSendsFromPushedUpMethods. self checkSuperSendsFromSiblings! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 7/17/2010 22:44'! checkSuperSendsFromPushedUpMethods selectors do: [:each | | parseTree | parseTree := class parseTreeFor: each. (parseTree superMessages detect: [:sup | class superclass directlyDefinesMethod: sup] ifNone: [nil]) notNil ifTrue: [self refactoringError: ('Cannot pull up <1s> since it sends a super message that is defined in the superclass.' expandMacrosWith: each)]]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperSendsFromSiblings | siblings | siblings := class superclass subclasses reject: [:each | each = class]. siblings do: [:aRBClass | self checkSiblingSuperSendsFrom: aRBClass]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperclass | overrideSelectors | overrideSelectors := selectors select: [:each | class superclass definesMethod: each]. overrideSelectors := overrideSelectors reject: [:each | | myTree superTree | myTree := class parseTreeFor: each. superTree := class superclass parseTreeFor: each. superTree equalTo: myTree exceptForVariables: #()]. overrideSelectors isEmpty ifTrue: [^self]. class superclass isAbstract ifFalse: [self refactoringError: ('Non-abstract class <2p> already defines <1p>' expandMacrosWith: overrideSelectors asArray first with: class superclass)]. overrideSelectors do: [:each | self checkBackReferencesTo: each]! ! !PullUpMethodRefactoring methodsFor: 'private' stamp: 'lr 7/17/2010 22:45'! copyDownMethod: aSelector | oldProtocol oldSource superclassDefiner subclasses refactoring | superclassDefiner := class superclass whoDefinesMethod: aSelector. superclassDefiner isNil ifTrue: [^self]. oldSource := superclassDefiner sourceCodeFor: aSelector. oldSource isNil ifTrue: [self refactoringError: ('Source code for <1s> superclass method not available' expandMacrosWith: aSelector)]. oldProtocol := superclassDefiner protocolsFor: aSelector. subclasses := class superclass subclasses reject: [:each | each directlyDefinesMethod: aSelector]. subclasses isEmpty ifTrue: [^self]. ((superclassDefiner parseTreeFor: aSelector) superMessages detect: [:each | superclassDefiner directlyDefinesMethod: each] ifNone: [nil]) notNil ifTrue: [self refactoringError: ('Cannot pull up <1s> since we must copy down the superclass method in <2p>to the other subclasses, and the superclass method sends a super message which is overriden.' expandMacrosWith: aSelector with: superclassDefiner)]. self refactoringWarning: 'Do you want to copy down the superclass method to the classes that don''t define ' , aSelector. refactoring := ExpandReferencedPoolsRefactoring model: self model forMethod: (superclassDefiner parseTreeFor: aSelector) fromClass: superclassDefiner toClasses: subclasses. self performComponentRefactoring: refactoring. subclasses do: [:each | each compile: oldSource classified: oldProtocol]! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: ''! copyDownMethods selectors do: [:each | self copyDownMethod: each]! ! !PullUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(selectors inject: (RBCondition hasSuperclass: class) into: [:cond :each | cond & (RBCondition definesSelector: each in: class)]) & (RBCondition withBlock: [self checkInstVars. self checkClassVars. self checkSuperclass. self checkSuperMessages. true])! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'! pullUp: aSelector | source refactoring | source := class sourceCodeFor: aSelector. source isNil ifTrue: [self refactoringError: 'Source for method not available']. refactoring := ExpandReferencedPoolsRefactoring model: self model forMethod: (class parseTreeFor: aSelector) fromClass: class toClasses: (Array with: class superclass). self performComponentRefactoring: refactoring. class superclass compile: source classified: (class protocolsFor: aSelector)! ! !PullUpMethodRefactoring methodsFor: 'initialize-release' stamp: 'lr 7/17/2010 23:23'! pullUp: selectorCollection from: aClass class := self classObjectFor: aClass. selectors := selectorCollection. removeDuplicates := false! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'! pullUpMethods selectors do: [:each | self pullUp: each]! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: ''! removeDuplicateMethods selectors do: [:each | self removeDuplicatesOf: each]! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: ''! removeDuplicatesOf: aSelector | tree | tree := class superclass parseTreeFor: aSelector. class superclass allSubclasses do: [:each | ((each directlyDefinesMethod: aSelector) and: [(tree equalTo: (each parseTreeFor: aSelector) exceptForVariables: #()) and: [(each superclass whoDefinesMethod: aSelector) == class superclass]]) ifTrue: [removeDuplicates ifFalse: [removeDuplicates := true. self refactoringWarning: 'Do you want to remove duplicate subclass methods?']. each removeMethod: aSelector]]! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'! removePulledUpMethods selectors do: [:each | class removeMethod: each]! ! !PullUpMethodRefactoring methodsFor: 'printing' stamp: 'lr 7/17/2010 23:23'! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' pullUp: '. selectors asArray storeOn: aStream. aStream nextPutAll: ' from: '. class storeOn: aStream. aStream nextPut: $)! ! !PullUpMethodRefactoring methodsFor: 'transforming' stamp: 'lr 7/17/2010 23:24'! transform self copyDownMethods; pullUpMethods; removePulledUpMethods; removeDuplicateMethods! ! MethodRefactoring subclass: #PushDownMethodRefactoring instanceVariableNames: 'selectors' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PushDownMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk pushDown: selectorCollection from: aClass ^(self new) model: aRBSmalltalk; pushDown: selectorCollection from: aClass; yourself! ! !PushDownMethodRefactoring class methodsFor: 'instance creation' stamp: ''! pushDown: selectorCollection from: aClass ^self new pushDown: selectorCollection from: aClass! ! !PushDownMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | condition | condition := selectors inject: RBCondition empty into: [:cond :each | cond & (RBCondition definesSelector: each in: class) & (RBCondition subclassesOf: class referToSelector: each) not]. ^condition & (RBCondition isAbstractClass: class)! ! !PushDownMethodRefactoring methodsFor: 'transforming' stamp: ''! pushDown: aSelector | code protocols refactoring | code := class sourceCodeFor: aSelector. protocols := class protocolsFor: aSelector. refactoring := ExpandReferencedPoolsRefactoring model: self model forMethod: (class parseTreeFor: aSelector) fromClass: class toClasses: class subclasses. self performComponentRefactoring: refactoring. class subclasses do: [:each | (each directlyDefinesMethod: aSelector) ifFalse: [each compile: code classified: protocols]]! ! !PushDownMethodRefactoring methodsFor: 'initialize-release' stamp: ''! pushDown: selectorCollection from: aClass class := self classObjectFor: aClass. selectors := selectorCollection! ! !PushDownMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' pushDown: '. selectors asArray storeOn: aStream. aStream nextPutAll: ' from: '. class storeOn: aStream. aStream nextPut: $)! ! !PushDownMethodRefactoring methodsFor: 'transforming' stamp: ''! transform selectors do: [:each | self pushDown: each]. selectors do: [:each | class removeMethod: each]! ! MethodRefactoring subclass: #RemoveMethodRefactoring instanceVariableNames: 'selectors' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk removeMethods: selectorCollection from: aClass ^(self new) model: aRBSmalltalk; removeMethods: selectorCollection from: aClass; yourself! ! !RemoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''! removeMethods: selectorCollection from: aClass ^self new removeMethods: selectorCollection from: aClass! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkReferencesToAnyOf: aSelectorCollection aSelectorCollection do: [:each | self model allReferencesTo: each do: [:aRBMethod | (aSelectorCollection includes: aRBMethod selector) ifFalse: [self refactoringError: ('Possible call to <2s> in <1p>Browse references?' expandMacrosWith: aRBMethod modelClass with: each) with: [self openBrowserOn: (BrowserEnvironment new referencesTo: each)]]]]! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkReferencesToSuperSendsToAnyOf: superMessages [superMessages isEmpty] whileFalse: [self refactoringWarning: ('Although <1s> is equivalent to a superclass method,it contains a super send so it might modify behavior.' expandMacrosWith: superMessages first). superMessages remove: superMessages first]! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperMethods | superMessages nonSupers | nonSupers := OrderedCollection new. superMessages := OrderedCollection new. (selectors reject: [:each | self justSendsSuper: each]) do: [:each | (self superclassEquivalentlyDefines: each) ifTrue: [(class parseTreeFor: each) superMessages isEmpty ifFalse: [superMessages add: each]] ifFalse: [nonSupers add: each]]. nonSupers isEmpty & superMessages isEmpty ifTrue: [^self]. self checkReferencesToAnyOf: nonSupers. self checkReferencesToSuperSendsToAnyOf: superMessages! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'! justSendsSuper: aSelector | matcher parseTree superclass | matcher := RBParseTreeSearcher justSendsSuper. parseTree := class parseTreeFor: aSelector. (matcher executeTree: parseTree initialAnswer: false) ifFalse: [^false]. parseTree lastIsReturn ifTrue: [^true]. superclass := class superclass whichClassIncludesSelector: aSelector. superclass isNil ifTrue: [^true]. "Since there isn't a superclass that implements the message, we can delete it since it would be an error anyway." parseTree := superclass parseTreeFor: aSelector. matcher := RBParseTreeSearcher new. matcher matches: '^``@object' do: [:aNode :answer | answer add: aNode value; yourself]. matcher executeTree: parseTree initialAnswer: Set new. ^(matcher answer detect: [:each | (each isVariable and: [each name = 'self']) not] ifNone: [nil]) isNil! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(selectors inject: RBCondition empty into: [:cond :each | cond & (RBCondition definesSelector: each in: class)]) & (RBCondition withBlock: [self checkSuperMethods. true])! ! !RemoveMethodRefactoring methodsFor: 'initialize-release' stamp: ''! removeMethods: selectorCollection from: aClass class := self classObjectFor: aClass. selectors := selectorCollection! ! !RemoveMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' removeMethods: '. selectors asArray storeOn: aStream. aStream nextPutAll: ' from: '. class storeOn: aStream. aStream nextPut: $)! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! superclassEquivalentlyDefines: aSelector | superTree myTree | class superclass isNil ifTrue: [^false]. superTree := class superclass parseTreeFor: aSelector. myTree := class parseTreeFor: aSelector. (superTree isNil or: [myTree isNil]) ifTrue: [^false]. ^superTree equalTo: myTree exceptForVariables: #()! ! !RemoveMethodRefactoring methodsFor: 'transforming' stamp: ''! transform selectors do: [:each | class removeMethod: each]! ! MethodRefactoring subclass: #RenameTemporaryRefactoring instanceVariableNames: 'selector interval oldName newName parseTree' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk renameTemporaryFrom: anInterval to: newName in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; class: aClass selector: aSelector interval: anInterval newName: newName; yourself! ! !RenameTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! renameTemporaryFrom: anInterval to: newName in: aClass selector: aSelector ^self new class: aClass selector: aSelector interval: anInterval newName: newName! ! !RenameTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass selector: aSelector interval: anInterval newName: aString class := self classObjectFor: aClass. selector := aSelector. interval := anInterval. newName := aString! ! !RenameTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition isValidInstanceVariableName: newName for: class) & (RBCondition definesInstanceVariable: newName in: class) not & (RBCondition definesClassVariable: newName in: class) not & (RBCondition withBlock: [| methodSource | interval first > interval last ifTrue: [self refactoringError: 'Invalid variable name']. methodSource := class sourceCodeFor: selector. methodSource size >= interval last ifFalse: [self refactoringError: 'Invalid range for variable']. oldName := methodSource copyFrom: interval first to: interval last. true])! ! !RenameTemporaryRefactoring methodsFor: 'tranforming' stamp: 'lr 11/2/2009 00:14'! renameNode: aParseTree (aParseTree whoDefines: newName) notNil ifTrue: [self refactoringError: newName , ' is already defined']. (aParseTree allDefinedVariables includes: newName) ifTrue: [self refactoringError: newName , ' is already defined']. (RBParseTreeRewriter rename: oldName to: newName) executeTree: aParseTree! ! !RenameTemporaryRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' renameTemporaryFrom: '. interval storeOn: aStream. aStream nextPutAll: ' to: '''; nextPutAll: newName; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector. aStream nextPut: $)! ! !RenameTemporaryRefactoring methodsFor: 'tranforming' stamp: ''! transform | definingNode variableNode | parseTree := class parseTreeFor: selector. variableNode := self whichVariableNode: parseTree inInterval: interval name: oldName. (variableNode isNil or: [variableNode isVariable not]) ifTrue: [self refactoringError: oldName , ' isn''t a valid variable']. variableNode name = oldName ifFalse: [self refactoringError: 'Invalid selection']. definingNode := variableNode whoDefines: oldName. definingNode isNil ifTrue: [self refactoringError: oldName , ' isn''t defined by the method']. self renameNode: definingNode. class compileTree: parseTree! ! MethodRefactoring subclass: #TemporaryToInstanceVariableRefactoring instanceVariableNames: 'selector temporaryVariableName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !TemporaryToInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! class: aClass selector: aSelector variable: aVariableName ^self new class: aClass selector: aSelector variable: aVariableName! ! !TemporaryToInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk class: aClass selector: aSelector variable: aVariableName ^(self new) model: aRBSmalltalk; class: aClass selector: aSelector variable: aVariableName; yourself! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! checkForValidTemporaryVariable | parseTree | parseTree := class parseTreeFor: selector. (parseTree allTemporaryVariables includes: temporaryVariableName) ifFalse: [self refactoringError: temporaryVariableName , ' isn''t a valid temporary variable name']. (parseTree allArgumentVariables includes: temporaryVariableName) ifTrue: [self refactoringError: temporaryVariableName , ' is a block parameter']. (RBReadBeforeWrittenTester isVariable: temporaryVariableName readBeforeWrittenIn: parseTree) ifTrue: [self refactoringWarning: ('<1s> is read before it is written.Proceed anyway?' expandMacrosWith: temporaryVariableName)]! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass selector: aSelector variable: aVariableName class := self classObjectFor: aClass. selector := aSelector. temporaryVariableName := aVariableName! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition hierarchyOf: class definesVariable: temporaryVariableName asString) not & (RBCondition withBlock: [self checkForValidTemporaryVariable. true])! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector; nextPutAll: ' variable: '''; nextPutAll: temporaryVariableName; nextPut: $'. aStream nextPut: $)! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! transform | parseTree matcher method | method := class methodFor: selector. parseTree := method parseTree. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']. class removeMethod: selector. class addInstanceVariable: temporaryVariableName. (matcher := RBParseTreeRewriter removeTemporaryNamed: temporaryVariableName) executeTree: parseTree. method compileTree: matcher tree! ! !Refactoring class methodsFor: 'initialization' stamp: 'lr 1/18/2010 21:02'! initialize self initializeRefactoringOptions! ! !Refactoring class methodsFor: 'initialization' stamp: 'lr 2/14/2009 11:20'! initializeRefactoringOptions RefactoringOptions := IdentityDictionary new. RefactoringOptions at: #implementorToInline put: [ :ref :imps | self error: #implementorToInline ]; at: #methodName put: [ :ref :methodName | self error: #methodName ]; at: #selfArgumentName put: [ :ref | self error: #selfArgumentName ]; at: #selectVariableToMoveTo put: [ :ref :class :selector | self error: #selectVariableToMoveTo ]; at: #variableTypes put: [ :ref :types :selected | self error: #variableTypes ]; at: #extractAssignment put: [ :ref :varName | self error: #extractAssignment ]; at: #inlineExpression put: [ :ref :string | self error: #inlineExpression ]; at: #alreadyDefined put: [ :ref :cls :selector | self error: #alreadyDefined ]; at: #useExistingMethod put: [ :ref :selector | self error: #useExistingMethod ]; at: #openBrowser put: [ :ref :env | self error: #openBrowser ]! ! !Refactoring class methodsFor: 'accessing signal' stamp: 'lr 10/5/2010 16:13'! preconditionSignal ^ RBRefactoringError , RBRefactoringWarning! ! !Refactoring class methodsFor: 'accessing' stamp: 'lr 1/18/2010 21:03'! refactoringOptions ^ RefactoringOptions! ! !Refactoring class methodsFor: 'accessing' stamp: ''! setDefaultOption: aSymbol to: aBlock self refactoringOptions at: aSymbol put: aBlock! ! !Refactoring methodsFor: 'utilities' stamp: ''! associationForClassVariable: aName in: aClass ifAbsent: aBlock ^aClass realClass classPool associationAt: aName asSymbol ifAbsent: [aClass realClass classPool associationAt: aName asString ifAbsent: aBlock]! ! !Refactoring methodsFor: 'testing' stamp: ''! canReferenceVariable: aString in: aClass (aClass definesVariable: aString) ifTrue: [^true]. (self model includesGlobal: aString asSymbol) ifTrue: [^true]. ^(self poolVariableNamesFor: aClass) includes: aString! ! !Refactoring methodsFor: 'accessing' stamp: ''! changes ^self model changes! ! !Refactoring methodsFor: 'support' stamp: ''! checkClass: aRBClass selector: aSelector using: aMatcher | parseTree | parseTree := aRBClass parseTreeFor: aSelector. parseTree notNil ifTrue: [aMatcher executeTree: parseTree]. ^aMatcher answer! ! !Refactoring methodsFor: 'utilities' stamp: ''! checkInstanceVariableName: aName in: aClass ^RBCondition checkInstanceVariableName: aName in: aClass! ! !Refactoring methodsFor: 'utilities' stamp: ''! checkMethodName: aName in: aClass ^RBCondition checkMethodName: aName in: aClass! ! !Refactoring methodsFor: 'preconditions' stamp: ''! checkPreconditions | conditions block | conditions := self preconditions. conditions check ifFalse: [block := conditions errorBlock. block notNil ifTrue: [self refactoringError: conditions errorString with: block] ifFalse: [self refactoringError: conditions errorString]]! ! !Refactoring methodsFor: 'private' stamp: 'dc 5/8/2007 12:05'! classObjectFor: anObject (anObject isBehavior or: [anObject isTrait]) ifTrue: [^self model classFor: anObject]. anObject isSymbol ifTrue: [^self model classNamed: anObject]. ^anObject! ! !Refactoring methodsFor: 'support' stamp: ''! convertAllReferencesTo: aSymbol using: searchReplacer self model allReferencesTo: aSymbol do: [:method | self convertMethod: method selector for: method modelClass using: searchReplacer]! ! !Refactoring methodsFor: 'support' stamp: ''! convertAllReferencesToClass: aRBClass using: searchReplacer self model allReferencesToClass: aRBClass do: [:method | self convertMethod: method selector for: method modelClass using: searchReplacer]! ! !Refactoring methodsFor: 'support' stamp: ''! convertClasses: classSet select: aBlock using: searchReplacer classSet do: [:aClass | (aBlock value: aClass) do: [:selector | self convertMethod: selector for: aClass using: searchReplacer]]! ! !Refactoring methodsFor: 'support' stamp: ''! convertMethod: selector for: aClass using: searchReplacer "Convert the parse tree for selector using the searchReplacer. If a change is made then compile it into the changeBuilder." | parseTree | parseTree := aClass parseTreeFor: selector. parseTree isNil ifTrue: [^self]. (searchReplacer executeTree: parseTree) ifTrue: [aClass compileTree: searchReplacer tree]! ! !Refactoring methodsFor: 'accessing' stamp: ''! copyOptionsFrom: aDictionary | dict | dict := self options. dict == self class refactoringOptions ifTrue: [^self options: aDictionary copy]. dict keysAndValuesDo: [:key :value | value == (self class refactoringOptions at: key) ifTrue: [dict at: key put: (aDictionary at: key)]]. self options: dict! ! !Refactoring methodsFor: 'transforming' stamp: ''! defaultEnvironment ^BrowserEnvironment new! ! !Refactoring methodsFor: 'transforming' stamp: ''! execute self primitiveExecute. RefactoringManager instance addRefactoring: self! ! !Refactoring methodsFor: 'transforming' stamp: ''! model ^model isNil ifTrue: [model := (RBNamespace onEnvironment: self defaultEnvironment) name: self printString; yourself] ifFalse: [model]! ! !Refactoring methodsFor: 'initialize-release' stamp: ''! model: aRBNamespace model := aRBNamespace! ! !Refactoring methodsFor: 'private' stamp: ''! onError: aBlock do: errorBlock ^aBlock on: self class preconditionSignal do: [:ex | errorBlock value. ex return: nil]! ! !Refactoring methodsFor: 'requests' stamp: ''! openBrowserOn: anEnvironment ^(self options at: #openBrowser) value: self value: anEnvironment! ! !Refactoring methodsFor: 'accessing' stamp: ''! options ^options isNil ifTrue: [self class refactoringOptions] ifFalse: [options]! ! !Refactoring methodsFor: 'accessing' stamp: ''! options: aDictionary options := aDictionary! ! !Refactoring methodsFor: 'transforming' stamp: ''! performComponentRefactoring: aRefactoring aRefactoring copyOptionsFrom: self options. aRefactoring primitiveExecute! ! !Refactoring methodsFor: 'utilities' stamp: 'lr 7/23/2010 08:04'! poolVariableNamesFor: aClass | pools | pools := Set new. aClass withAllSuperclasses do: [:each | each allPoolDictionaryNames do: [:pool | pools addAll: ((Smalltalk globals at: pool asSymbol) keys collect: [:name | name asString])]]. ^pools! ! !Refactoring methodsFor: 'preconditions' stamp: ''! preconditions self subclassResponsibility! ! !Refactoring methodsFor: 'private' stamp: ''! primitiveExecute self checkPreconditions. self transform! ! !Refactoring methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'! refactoringError: aString ^ RBRefactoringError signal: aString! ! !Refactoring methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'! refactoringError: aString with: aBlock ^ RBRefactoringError signal: aString with: aBlock! ! !Refactoring methodsFor: 'private' stamp: 'lr 10/5/2010 16:13'! refactoringWarning: aString ^ RBRefactoringWarning signal: aString! ! !Refactoring methodsFor: 'requests' stamp: ''! requestImplementorToInline: implementorsCollection ^(self options at: #implementorToInline) value: self value: implementorsCollection! ! !Refactoring methodsFor: 'requests' stamp: 'dvf 9/8/2001 19:32'! requestMethodNameFor: aMethodName ^(self options at: #methodName) value: self value: aMethodName! ! !Refactoring methodsFor: 'requests' stamp: ''! requestSelfArgumentName ^(self options at: #selfArgumentName) value: self! ! !Refactoring methodsFor: 'utilities' stamp: ''! safeMethodNameFor: aClass basedOn: aString "Creates an unused method name containing aString" | baseString newString hasParam i | baseString := aString copy. baseString at: 1 put: baseString first asLowercase. newString := baseString. hasParam := newString last = $:. hasParam ifTrue: [baseString := newString copyFrom: 1 to: newString size - 1]. i := 0. [aClass hierarchyDefinesMethod: newString asSymbol] whileTrue: [i := i + 1. newString := baseString , i printString , (hasParam ifTrue: [':'] ifFalse: [''])]. ^newString asSymbol! ! !Refactoring methodsFor: 'private' stamp: 'lr 1/4/2010 20:10'! safeVariableNameFor: aClass temporaries: allTempVars basedOn: aString | baseString i newString | newString := baseString := aString. i := 0. [ (allTempVars includes: newString) or: [ aClass definesInstanceVariable: newString ] ] whileTrue: [ i := i + 1. newString := baseString , i printString ]. ^ newString! ! !Refactoring methodsFor: 'requests' stamp: ''! selectVariableToMoveMethodTo: aSelector class: aClass ^(self options at: #selectVariableToMoveTo) value: self value: aClass value: aSelector! ! !Refactoring methodsFor: 'requests' stamp: 'lr 2/14/2009 11:23'! selectVariableTypesFrom: initialTypeCollection selected: selectedTypeCollection ^ (self options at: #variableTypes) value: self value: initialTypeCollection value: selectedTypeCollection ! ! !Refactoring methodsFor: 'accessing' stamp: ''! setOption: aSymbol toUse: aBlock | dict | dict := self options. dict == self class refactoringOptions ifTrue: [dict := dict copy]. dict at: aSymbol put: aBlock. self options: dict! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldExtractAssignmentTo: aString ^(self options at: #extractAssignment) value: self value: aString! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldInlineExpression: aString ^(self options at: #inlineExpression) value: self value: aString! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldOverride: aSelector in: aClass ^(self options at: #alreadyDefined) value: self value: aClass value: aSelector! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldUseExistingMethod: aSelector ^(self options at: #useExistingMethod) value: self value: aSelector! ! !Refactoring methodsFor: 'transforming' stamp: ''! transform self subclassResponsibility! ! !Refactoring methodsFor: 'private' stamp: ''! uniqueMethodNameFor: anInteger | before after index name | before := 'a'. after := ''. anInteger timesRepeat: [after := after , 'z:']. index := 0. [name := before , index printString , after. (Symbol findInterned: name) notNil] whileTrue: [index := index + 1]. ^name asSymbol! ! !Refactoring methodsFor: 'utilities' stamp: 'lr 11/2/2009 00:14'! whichVariableNode: aParseTree inInterval: anInterval name: aName | matcher block | matcher := RBParseTreeSearcher new. block := [:aNode :answer | (aNode intersectsInterval: anInterval) ifTrue: [aNode] ifFalse: [answer]]. matcher matches: aName do: block; matchesArgument: aName do: block. ^matcher executeTree: aParseTree initialAnswer: nil! ! Refactoring subclass: #RemoveClassRefactoring instanceVariableNames: 'classNames' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveClassRefactoring class methodsFor: 'instance creation' stamp: ''! classNames: aClassNameCollection ^self new classNames: aClassNameCollection! ! !RemoveClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk classNames: aClassNameCollection ^(self new) model: aRBSmalltalk; classNames: aClassNameCollection; yourself! ! !RemoveClassRefactoring methodsFor: 'initialize-release' stamp: ''! classNames: aClassNameCollection classNames := aClassNameCollection! ! !RemoveClassRefactoring methodsFor: 'preconditions' stamp: 'lr 7/23/2010 08:04'! hasReferencesTo: aSymbol | literal | literal := Smalltalk globals associationAt: aSymbol. BrowserEnvironment new classesDo: [:each | (classNames includes: (each isMeta ifTrue: [each soleInstance] ifFalse: [each]) name) ifFalse: [(each whichSelectorsReferTo: literal) isEmpty ifFalse: [^true]. (each whichSelectorsReferTo: aSymbol) isEmpty ifFalse: [^true]]]. ^false! ! !RemoveClassRefactoring methodsFor: 'preconditions' stamp: 'lr 7/23/2010 08:04'! preconditions ^classNames inject: RBCondition empty into: [:sum :each | | aClass | aClass := self model classNamed: each asSymbol. aClass isNil ifTrue: [self refactoringError: 'No such class']. sum & (((RBCondition isMetaclass: aClass) errorMacro: 'Cannot remove just the metaclass') not & ((RBCondition withBlock: [(self hasReferencesTo: each asSymbol) not]) errorMacro: each , ' is referenced.Browse references?'; errorBlock: [self openBrowserOn: (BrowserEnvironment new referencesTo: (Smalltalk globals associationAt: each ifAbsent: [each]))]; yourself) & ((RBCondition hasSubclasses: aClass) not | ((RBCondition isEmptyClass: aClass) & ((RBCondition withBlock: [aClass superclass notNil]) errorMacro: 'Cannot remove top level classwhen it has subclasses'; yourself))))]! ! !RemoveClassRefactoring methodsFor: 'transforming' stamp: ''! removeClasses classNames do: [:each | self model removeClassNamed: each]! ! !RemoveClassRefactoring methodsFor: 'transforming' stamp: ''! reparentSubclasses classNames do: [:each | | class | class := self model classNamed: each. self model reparentClasses: class subclasses copy to: class superclass]! ! !RemoveClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' classNames: '. classNames asArray storeOn: aStream. aStream nextPut: $)! ! !RemoveClassRefactoring methodsFor: 'transforming' stamp: ''! transform self reparentSubclasses; removeClasses! ! Refactoring subclass: #SplitClassRefactoring instanceVariableNames: 'class instanceVariables newClassName referenceVariableName newClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !SplitClassRefactoring class methodsFor: 'instance creation' stamp: ''! class: class instanceVariables: instVars newClassName: className referenceVariableName: newVariable ^(self new) class: class instanceVariables: instVars newClassName: className referenceVariableName: newVariable; yourself! ! !SplitClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk class: class instanceVariables: instVars newClassName: className referenceVariableName: newVariable ^(self new) model: aRBSmalltalk; class: class instanceVariables: instVars newClassName: className referenceVariableName: newVariable; yourself! ! !SplitClassRefactoring methodsFor: 'private-transforming' stamp: 'lr 11/2/2009 00:14'! abstractReferenceTo: each | setterMethod replacer accessorRef getterMethod | accessorRef := CreateAccessorsForVariableRefactoring variable: each class: newClass classVariable: false. self performComponentRefactoring: accessorRef. getterMethod := accessorRef getterMethod. setterMethod := accessorRef setterMethod. replacer := RBParseTreeRewriter variable: each getter: getterMethod setter: setterMethod receiver: referenceVariableName. self convertClasses: class withAllSubclasses select: [:aClass | aClass whichSelectorsReferToInstanceVariable: each] using: replacer. self performComponentRefactoring: (RemoveInstanceVariableRefactoring remove: each from: class)! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! abstractVariableReferences instanceVariables do: [:each | self abstractReferenceTo: each]! ! !SplitClassRefactoring methodsFor: 'private-transforming' stamp: ''! addClass self performComponentRefactoring: (AddClassRefactoring model: self model addClass: newClassName superclass: Object subclasses: #() category: class category). newClass := self model classNamed: newClassName! ! !SplitClassRefactoring methodsFor: 'private-transforming' stamp: ''! addInstanceVariables instanceVariables do: [:each | self performComponentRefactoring: (AddInstanceVariableRefactoring model: self model variable: each class: newClass)]! ! !SplitClassRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass instanceVariables: instVars newClassName: className referenceVariableName: newVariable class := self model classFor: aClass. instanceVariables := instVars. newClassName := className. referenceVariableName := newVariable! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! createNewClass self addClass; addInstanceVariables! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! createReference self performComponentRefactoring: (AddInstanceVariableRefactoring variable: referenceVariableName class: class)! ! !SplitClassRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isValidClassName: newClassName) & (RBCondition isGlobal: newClassName in: self model) not & (RBCondition isValidInstanceVariableName: referenceVariableName for: class) & (RBCondition hierarchyOf: class definesVariable: referenceVariableName) not & (RBCondition isGlobal: referenceVariableName in: self model) not & (RBCondition definesTemporaryVariable: referenceVariableName in: class) not! ! !SplitClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' instanceVariables: '. instanceVariables asArray storeOn: aStream. aStream nextPutAll: ' newClassName: #'; nextPutAll: newClassName; nextPutAll: ' referenceVariableName: '''; nextPutAll: referenceVariableName; nextPutAll: ''')'! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! transform self createNewClass; createReference; abstractVariableReferences! ! Refactoring subclass: #VariableRefactoring instanceVariableNames: 'class variableName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! VariableRefactoring subclass: #AbstractClassVariableRefactoring instanceVariableNames: 'accessorsRefactoring' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractClassReferences | replacer | replacer := RBParseTreeRewriter variable: variableName getter: self accessorsRefactoring getterMethod setter: self accessorsRefactoring setterMethod. self convertClasses: class theMetaClass withAllSubclasses select: [ :aClass | (aClass whichSelectorsReferToClassVariable: variableName) reject: [ :each | aClass == class theMetaClass and: [ each == self accessorsRefactoring getterMethod or: [ each == self accessorsRefactoring setterMethod ] ] ] ] using: replacer! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: 'TestRunner 11/3/2009 09:40'! abstractInstanceReferences | replacer | replacer := RBParseTreeRewriter variable: variableName getter: 'class ' , self accessorsRefactoring getterMethod setter: 'class ' , self accessorsRefactoring setterMethod. self convertClasses: class withAllSubclasses select: [ :aClass | aClass whichSelectorsReferToClassVariable: variableName ] using: replacer! ! !AbstractClassVariableRefactoring methodsFor: 'private-accessing' stamp: ''! accessorsRefactoring ^accessorsRefactoring isNil ifTrue: [accessorsRefactoring := CreateAccessorsForVariableRefactoring model: self model variable: variableName asString class: class classVariable: true] ifFalse: [accessorsRefactoring]! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''! createAccessors self performComponentRefactoring: self accessorsRefactoring! ! !AbstractClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not & (RBCondition directlyDefinesClassVariable: variableName asSymbol in: class) & ((RBCondition withBlock: [(#(#Object #Behavior #ClassDescription #Class) includes: class name) not]) errorMacro: 'This refactoring does not work for Object, Behavior, ClassDescription, or Class')! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self createAccessors. self abstractInstanceReferences. self abstractClassReferences! ! VariableRefactoring subclass: #AbstractInstanceVariableRefactoring instanceVariableNames: 'accessorsRefactoring' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractReferences | replacer | replacer := RBParseTreeRewriter variable: variableName getter: self accessorsRefactoring getterMethod setter: self accessorsRefactoring setterMethod. self convertClasses: class withAllSubclasses select: [:aClass | (aClass whichSelectorsReferToInstanceVariable: variableName) reject: [:each | aClass == class and: [each == self accessorsRefactoring getterMethod or: [each == self accessorsRefactoring setterMethod]]]] using: replacer! ! !AbstractInstanceVariableRefactoring methodsFor: 'private-accessing' stamp: ''! accessorsRefactoring ^accessorsRefactoring isNil ifTrue: [accessorsRefactoring := CreateAccessorsForVariableRefactoring model: self model variable: variableName class: class classVariable: false] ifFalse: [accessorsRefactoring]! ! !AbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! createAccessors self performComponentRefactoring: self accessorsRefactoring! ! !AbstractInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition directlyDefinesInstanceVariable: variableName in: class! ! !AbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self createAccessors. self abstractReferences! ! VariableRefactoring subclass: #AddClassVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: variableName for: class) & (RBCondition hierarchyOf: class definesVariable: variableName asString) not & (RBCondition isGlobal: variableName in: self model) not! ! !AddClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class addClassVariable: variableName! ! VariableRefactoring subclass: #AddInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isValidInstanceVariableName: variableName for: class) & (RBCondition hierarchyOf: class definesVariable: variableName) not & (RBCondition isGlobal: variableName in: self model) not! ! !AddInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class addInstanceVariable: variableName! ! VariableRefactoring subclass: #CreateAccessorsForVariableRefactoring instanceVariableNames: 'getterMethod setterMethod classVariable needsReturn' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !CreateAccessorsForVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk variable: aVarName class: aClass classVariable: aBoolean ^(self model: aRBSmalltalk variable: aVarName class: aClass) classVariable: aBoolean; yourself! ! !CreateAccessorsForVariableRefactoring class methodsFor: 'instance creation' stamp: ''! variable: aVarName class: aClass classVariable: aBoolean ^(self variable: aVarName class: aClass) classVariable: aBoolean; yourself! ! !CreateAccessorsForVariableRefactoring methodsFor: 'initialize-release' stamp: ''! classVariable: aBoolean classVariable := aBoolean! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''! createGetterAccessor getterMethod := self findGetterMethod. getterMethod isNil ifTrue: [getterMethod := self defineGetterMethod]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''! createSetterAccessor setterMethod := self findSetterMethod. setterMethod isNil ifTrue: [setterMethod := self defineSetterMethod]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: 'dc 4/4/2007 16:41'! defineGetterMethod | selector definingClass | definingClass := self definingClass. selector := self safeMethodNameFor: definingClass basedOn: variableName asString. definingClass compile: ('<1s>^ <2s>' expandMacrosWith: selector with: variableName) classified: #(#accessing). ^selector! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: 'dc 4/4/2007 16:41'! defineSetterMethod | selector definingClass string | definingClass := self definingClass. string := self needsReturnForSetter ifTrue: ['<1s> anObject^ <2s> := anObject'] ifFalse: ['<1s> anObject<2s> := anObject']. selector := self safeMethodNameFor: definingClass basedOn: variableName asString , ':'. definingClass compile: (string expandMacrosWith: selector with: variableName) classified: #accessing. ^selector! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 10/26/2009 22:09'! definingClass ^ classVariable ifTrue: [ class theMetaClass ] ifFalse: [ class ]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'! findGetterMethod | definingClass matcher | definingClass := self definingClass. matcher := RBParseTreeSearcher getterMethod: variableName. ^self possibleGetterSelectors detect: [:each | (self checkClass: definingClass selector: each using: matcher) notNil and: [(definingClass subclassRedefines: each) not]] ifNone: [nil]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'! findSetterMethod | definingClass matcher | definingClass := self definingClass. matcher := self needsReturnForSetter ifTrue: [RBParseTreeSearcher returnSetterMethod: variableName] ifFalse: [RBParseTreeSearcher setterMethod: variableName]. ^self possibleSetterSelectors detect: [:each | (self checkClass: definingClass selector: each using: matcher) notNil and: [(definingClass subclassRedefines: each) not]] ifNone: [nil]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! getterMethod ^getterMethod! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! methodsReferencingVariable ^classVariable ifTrue: [self definingClass whichSelectorsReferToClassVariable: variableName] ifFalse: [self definingClass whichSelectorsReferToInstanceVariable: variableName]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'testing' stamp: ''! needsReturnForSetter needsReturn isNil ifTrue: [needsReturn := self usesAssignmentOf: variableName in: class classVariable: classVariable]. ^needsReturn! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! possibleGetterSelectors ^self methodsReferencingVariable select: [:each | each numArgs == 0]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! possibleSetterSelectors ^self methodsReferencingVariable select: [:each | each numArgs == 1]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^classVariable ifTrue: [RBCondition definesClassVariable: variableName asSymbol in: class] ifFalse: [RBCondition definesInstanceVariable: variableName in: class]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! setterMethod ^setterMethod! ! !CreateAccessorsForVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' variable: '. variableName storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' classVariable: '. classVariable storeOn: aStream. aStream nextPut: $)! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self createGetterAccessor; createSetterAccessor! ! !CreateAccessorsForVariableRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! usesAssignmentOf: aString in: aClass classVariable: isClassVar | matcher definingClass | matcher := RBParseTreeSearcher new. matcher answer: false; matches: aString , ' := ``@object' do: [ :aNode :answer | answer or: [ aNode isUsed ] ]. definingClass := isClassVar ifTrue: [ aClass theNonMetaClass ] ifFalse: [ aClass ]. ^ (definingClass withAllSubclasses , (isClassVar ifTrue: [ definingClass theMetaClass withAllSubclasses ] ifFalse: [ #() ]) detect: [ :each | ((isClassVar ifTrue: [ each whichSelectorsReferToClassVariable: aString ] ifFalse: [ each whichSelectorsReferToInstanceVariable: aString ]) detect: [ :sel | self checkClass: each selector: sel using: matcher ] ifNone: [ nil ]) notNil ] ifNone: [ nil ]) notNil! ! VariableRefactoring subclass: #ProtectInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ProtectInstanceVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'! getterSetterMethods | matcher | matcher := RBParseTreeSearcher new. matcher answer: Set new; matchesAnyMethodOf: (Array with: '`method ^' , variableName with: ('`method: `arg <1s> := `arg' expandMacrosWith: variableName) with: ('`method: `arg ^<1s> := `arg' expandMacrosWith: variableName)) do: [:aNode :answer | (class subclassRedefines: aNode selector) ifFalse: [answer add: aNode selector]. answer]. (class whichSelectorsReferToInstanceVariable: variableName) do: [:each | self checkClass: class selector: each using: matcher]. ^matcher answer! ! !ProtectInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! inline: aSelector self onError: [self performComponentRefactoring: (InlineAllSendersRefactoring model: self model sendersOf: aSelector in: class)] do: []! ! !ProtectInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition definesInstanceVariable: variableName in: class! ! !ProtectInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self setOption: #inlineExpression toUse: [:ref :string | true]. self getterSetterMethods do: [:each | self inline: each]! ! VariableRefactoring subclass: #PullUpClassVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PullUpClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not! ! !PullUpClassVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 1/17/2010 14:39'! subclassDefiningVariable | subclasses | subclasses := class allSubclasses select: [ :each | each isMeta not and: [ each directlyDefinesClassVariable: variableName ] ]. subclasses isEmpty ifTrue: [ self refactoringError: 'Could not find a class defining ' , variableName ]. subclasses size > 1 ifTrue: [ self refactoringError: 'Multiple subclasses define ' , variableName ]. ^ subclasses asArray first! ! !PullUpClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform | subclass | subclass := self subclassDefiningVariable. subclass removeClassVariable: variableName. class addClassVariable: variableName! ! VariableRefactoring subclass: #PullUpInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PullUpInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition withBlock: [(class hierarchyDefinesInstanceVariable: variableName) ifFalse: [self refactoringError: 'No subclass defines ' , variableName]. (class subclasses detect: [:each | (each directlyDefinesInstanceVariable: variableName) not] ifNone: [nil]) notNil ifTrue: [self refactoringWarning: 'Not all subclasses have an instance variable named ' , variableName , '.']. true]! ! !PullUpInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class allSubclasses do: [:each | (each directlyDefinesInstanceVariable: variableName) ifTrue: [each removeInstanceVariable: variableName]]. class addInstanceVariable: variableName! ! VariableRefactoring subclass: #PushDownClassVariableRefactoring instanceVariableNames: 'destinationClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: 'TestRunner 11/3/2009 09:28'! findDestinationClass | classes | classes := class withAllSubclasses reject: [ :each | (each whichSelectorsReferToClassVariable: variableName) isEmpty and: [ (each theMetaClass whichSelectorsReferToClassVariable: variableName) isEmpty ] ]. destinationClass := classes isEmpty ifTrue: [ nil ] ifFalse: [ classes asOrderedCollection first ]. classes do: [ :each | (destinationClass includesClass: each) ifTrue: [ destinationClass := each ] ifFalse: [ (each includesClass: destinationClass) ifFalse: [ self signalMultipleReferenceError ] ] ]. destinationClass = class ifTrue: [ self signalStillReferencedError ]. ^ destinationClass! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions "Preconditions are that only one subclass refers to the class variable." ^(RBCondition definesClassVariable: variableName in: class) & (RBCondition withBlock: [self findDestinationClass. true])! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! signalMultipleReferenceError self signalReferenceError: ('Multiple subclasses reference <1s>' expandMacrosWith: variableName)! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! signalReferenceError: errorString class realClass isNil ifTrue: [self refactoringError: errorString] ifFalse: [| classVarName error | error := '<1s>Browse references?' expandMacrosWith: errorString. classVarName := variableName asSymbol. self refactoringError: error with: [self openBrowserOn: (VariableEnvironment referencesToClassVariable: classVarName in: class realClass)]]! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! signalStillReferencedError self signalReferenceError: ('<1p> has references to <2s>' expandMacrosWith: class with: variableName)! ! !PushDownClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeClassVariable: variableName. destinationClass isNil ifTrue: [^self]. destinationClass addClassVariable: variableName! ! VariableRefactoring subclass: #PushDownInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PushDownInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | references | references := RBCondition referencesInstanceVariable: variableName in: class. class realClass isNil ifTrue: [references errorMacro: ('<1s> is referenced.' expandMacrosWith: variableName)] ifFalse: [references errorMacro: ('<1s> is referenced.Browse references?' expandMacrosWith: variableName); errorBlock: [self openBrowserOn: (BrowserEnvironment new instVarRefsTo: variableName in: class realClass)]]. ^(RBCondition definesInstanceVariable: variableName in: class) & references not! ! !PushDownInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeInstanceVariable: variableName. class subclasses do: [:each | (each withAllSubclasses detect: [:aClass | (aClass whichSelectorsReferToInstanceVariable: variableName) isEmpty not] ifNone: [nil]) notNil ifTrue: [each addInstanceVariable: variableName]]! ! VariableRefactoring subclass: #RemoveClassVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveClassVariableRefactoring methodsFor: 'preconditions' stamp: 'lr 10/26/2009 22:09'! preconditions ^ (RBCondition isMetaclass: class) not & (RBCondition definesClassVariable: variableName in: class) & (RBCondition withBlock: [ | block | block := [ :each | (each whichSelectorsReferToClassVariable: variableName) isEmpty ifFalse: [ class realClass isNil ifTrue: [ self refactoringError: ('<1s> is referenced.' expandMacrosWith: variableName) ] ifFalse: [ self refactoringError: ('<1s> is referenced.Browse references?' expandMacrosWith: variableName) with: [ self openBrowserOn: (VariableEnvironment referencesToClassVariable: variableName in: class realClass) ] ] ] ]. class withAllSubclasses do: block. class theMetaClass withAllSubclasses do: block. true ])! ! !RemoveClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeClassVariable: variableName! ! VariableRefactoring subclass: #RemoveInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveInstanceVariableRefactoring class methodsFor: 'as yet unclassified' stamp: 'lr 1/20/2010 08:43'! model: aNamespace remove: variable from: class ^ self model: aNamespace variable: variable class: class! ! !RemoveInstanceVariableRefactoring class methodsFor: 'as yet unclassified' stamp: 'lr 1/20/2010 08:43'! remove: variable from: class ^ self variable: variable class: class! ! !RemoveInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | references | references := RBCondition hierarchyOf: class referencesInstanceVariable: variableName. class realClass isNil ifTrue: [references errorMacro: ('<1s> is referenced.' expandMacrosWith: variableName)] ifFalse: [references errorMacro: ('<1s> is referenced.Browse references?' expandMacrosWith: variableName); errorBlock: [self openBrowserOn: (BrowserEnvironment new instVarRefsTo: variableName in: class realClass)]]. ^(RBCondition definesInstanceVariable: variableName asString in: class) & references not! ! !RemoveInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeInstanceVariable: variableName! ! VariableRefactoring subclass: #RenameClassVariableRefactoring instanceVariableNames: 'newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameClassVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk rename: aVarName to: aName in: aClass ^(self new) model: aRBSmalltalk; rename: aVarName to: aName in: aClass; yourself! ! !RenameClassVariableRefactoring class methodsFor: 'instance creation' stamp: ''! rename: aVarName to: aName in: aClass ^self new rename: aVarName to: aName in: aClass! ! !RenameClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: newName asString for: class) & (RBCondition definesClassVariable: variableName asString in: class) & (RBCondition hierarchyOf: class definesVariable: newName asString) not & (RBCondition isGlobal: newName asString in: self model) not! ! !RenameClassVariableRefactoring methodsFor: 'initialize-release' stamp: ''! rename: aVarName to: aName in: aClass self variable: aVarName class: aClass. newName := aName! ! !RenameClassVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameReferences | replacer subclasses | replacer := RBParseTreeRewriter rename: variableName to: newName handler: [ self refactoringError: ('<1s> is already defined as a method or block temporary variable in this class or one of its subclasses' expandMacrosWith: newName) ]. subclasses := class withAllSubclasses asSet. subclasses addAll: class theMetaClass withAllSubclasses. self convertClasses: subclasses select: [ :aClass | aClass whichSelectorsReferToClassVariable: variableName ] using: replacer! ! !RenameClassVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' rename: '''; nextPutAll: variableName; nextPutAll: ''' to: '''; nextPutAll: newName; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPut: $)! ! !RenameClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class renameClassVariable: variableName to: newName around: [self renameReferences]! ! VariableRefactoring subclass: #RenameInstanceVariableRefactoring instanceVariableNames: 'newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk rename: aVarName to: aName in: aClass ^(self new) model: aRBSmalltalk; rename: aVarName to: aName in: aClass; yourself! ! !RenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! rename: aVarName to: aName in: aClass ^self new rename: aVarName to: aName in: aClass! ! !RenameInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isValidInstanceVariableName: newName for: class) & (RBCondition definesInstanceVariable: variableName in: class) & (RBCondition hierarchyOf: class definesVariable: newName) not & (RBCondition isGlobal: newName in: self model) not! ! !RenameInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: ''! rename: aVarName to: aName in: aClass self variable: aVarName class: aClass. newName := aName! ! !RenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameReferences | replacer | replacer := RBParseTreeRewriter rename: variableName to: newName handler: [self refactoringError: ('<1s> is already defined as a method or block temporary variable in this class or one of its subclasses' expandMacrosWith: newName)]. self convertClasses: class withAllSubclasses select: [:aClass | aClass whichSelectorsReferToInstanceVariable: variableName] using: replacer! ! !RenameInstanceVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' rename: '''; nextPutAll: variableName; nextPutAll: ''' to: '''; nextPutAll: newName; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPut: $)! ! !RenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class renameInstanceVariable: variableName to: newName around: [self renameReferences]! ! !VariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk variable: aVarName class: aClass ^(self new) model: aRBSmalltalk; variable: aVarName class: aClass; yourself! ! !VariableRefactoring class methodsFor: 'instance creation' stamp: ''! variable: aVarName class: aClass ^self new variable: aVarName class: aClass! ! !VariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' variable: '. variableName storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPut: $)! ! !VariableRefactoring methodsFor: 'initialize-release' stamp: ''! variable: aVarName class: aClass class := self classObjectFor: aClass. variableName := aVarName! ! Object subclass: #RefactoringManager instanceVariableNames: 'refactorings' classVariableNames: 'Instance' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RefactoringManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:31'! instance ^ Instance ifNil: [ Instance := self basicNew initialize ]! ! !RefactoringManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:31'! new ^ self shouldNotImplement! ! !RefactoringManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:32'! nuke Instance notNil ifTrue: [ Instance release ]. Instance := nil! ! !RefactoringManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:32'! unload self nuke! ! !RefactoringManager methodsFor: 'public access' stamp: ''! addRefactoring: aRefactoring RefactoryChangeManager instance performChange: aRefactoring changes. refactorings add: aRefactoring class name! ! !RefactoringManager methodsFor: 'initialize-release' stamp: ''! initialize refactorings := Bag new! ! !RefactoringManager methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: '# Refactoring'; cr; nextPutAll: '--- -----------------------------------------------'; cr. refactorings asSet asSortedCollection do: [:name | aStream nextPutAll: (refactorings occurrencesOf: name) printString; nextPutAll: ' '; nextPutAll: name; cr]! ! RBAbstractClass initialize! RBClass initialize! Refactoring initialize!