SystemOrganization addCategory: #'Refactoring-Core-Lint'! SystemOrganization addCategory: #'Refactoring-Core-Environments'! SystemOrganization addCategory: #'Refactoring-Core-Model'! SystemOrganization addCategory: #'Refactoring-Core-Conditions'! SystemOrganization addCategory: #'Refactoring-Core-Support'! SystemOrganization addCategory: #'Refactoring-Core-Refactorings'! SystemOrganization addCategory: #'Refactoring-Core-Change'! !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! ! Exception subclass: #RefactoringWarning instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RefactoringWarning methodsFor: 'private - actions' stamp: ''! defaultAction "Proceed through warnings" ^nil! ! !RefactoringWarning methodsFor: 'description' stamp: 'dvf 11/12/2002 00:47'! isResumable ^true.! ! Object subclass: #BrowserEnvironment instanceVariableNames: 'label searchStrings' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !BrowserEnvironment methodsFor: 'environments' stamp: ''! & anEnvironment "If we or anEnvironment includes everything, then just include the other environment (optimization)" self isSystem ifTrue: [^anEnvironment]. anEnvironment isSystem ifTrue: [^self]. ^AndEnvironment onEnvironment: self and: anEnvironment! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! addSearchString: aString searchStrings isNil ifTrue: [searchStrings := SortedCollection sortBlock: [:a :b | (a indexOf: $: ifAbsent: [a size]) > (b indexOf: $: ifAbsent: [b size])]]. searchStrings add: aString! ! !BrowserEnvironment methodsFor: 'private' stamp: 'lr 7/1/2008 09:54'! allClassesDo: aBlock self systemNavigation allClassesDo: [ :each | aBlock value: each; value: each class ]! ! !BrowserEnvironment methodsFor: 'accessing' stamp: 'nk 3/4/2005 12:41'! asSelectorEnvironment ^(ClassEnvironment onEnvironment: self classes: self classes) asSelectorEnvironment! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'dvf 10/9/2001 16:14'! associationAt: aKey | association class | association := Smalltalk associationAt: aKey ifAbsent: [^nil]. class := association value isBehavior ifTrue: [association value] ifFalse: [association value class]. ^((self includesClass: class) or: [self includesClass: class class]) ifTrue: [association] ifFalse: [nil]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'md 8/2/2005 23:26'! at: aKey ^self at: aKey ifAbsent: [self error:'key ',aKey printString,' was not found'.]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: ''! at: aKey ifAbsent: aBlock | assoc | assoc := self associationAt: aKey. ^assoc isNil ifTrue: [aBlock value] ifFalse: [assoc value]! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! categories ^Smalltalk organization categories select: [:each | self includesCategory: each]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: ''! classNames | names | names := Set new. self classesDo: [:each | names add: (each isMeta ifTrue: [each soleInstance] ifFalse: [each]) name]. ^names! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! classNamesFor: aCategoryName ^(Smalltalk organization listAtCategoryNamed: aCategoryName) select: [:each | | class | class := Smalltalk at: each ifAbsent: [nil]. class notNil and: [(self includesClass: class) or: [self includesClass: class class]]]! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! classVariablesFor: aClass ^aClass classVarNames! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: ''! classes | classes | classes := Set new. self classesDo: [:each | classes add: each]. ^classes! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! classesAndSelectorsDo: aBlock self classesDo: [:class | self selectorsForClass: class do: [:sel | aBlock value: class value: sel]]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'md 2/26/2006 15:11'! classesDo: aBlock self allClassesDo: [:each | (self includesClass: each) ifTrue: [aBlock value: each]]! ! !BrowserEnvironment methodsFor: 'copying' stamp: 'bh 3/16/2000 23:24'! copy ^self shallowCopy postCopy! ! !BrowserEnvironment methodsFor: 'copying' stamp: ''! copyEmpty ^self class new! ! !BrowserEnvironment methodsFor: 'private' stamp: ''! defaultLabel ^'Smalltalk'! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! definesClass: aClass ^true! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! forCategories: categoryList ^CategoryEnvironment onEnvironment: self categories: categoryList! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! forClass: aClass protocols: protocolCollection ^ProtocolEnvironment onEnvironment: self class: aClass protocols: protocolCollection! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! forClass: aClass selectors: selectorCollection ^(SelectorEnvironment onMethods: selectorCollection forClass: aClass in: self) label: aClass name , '>>' , (selectorCollection detect: [:each | true] ifNone: ['']); yourself! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! forClasses: classCollection | classes | classes := OrderedCollection new: classCollection size * 2. classCollection do: [:each | classes add: each; add: each class]. ^ClassEnvironment onEnvironment: self classes: classes! ! !BrowserEnvironment methodsFor: 'environments' stamp: 'lr 1/3/2006 12:14'! forPackage: aPackageInfo ^ PackageEnvironment onEnvironment: self package: aPackageInfo.! ! !BrowserEnvironment methodsFor: 'environments' stamp: 'lr 1/3/2006 12:14'! forPackageContainingClassCategory: aClassCategory | package | package := PackageInfo allPackages detect: [ :each | each includesSystemCategory: aClassCategory ] ifNone: [ self inform: 'no package for this category'. ^nil ]. ^ self forPackage: package.! ! !BrowserEnvironment methodsFor: 'environments' stamp: 'lr 1/3/2006 12:14'! forPackageNamed: aString ^ PackageEnvironment onEnvironment: self packageNamed: aString.! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! implementorsMatching: aString ^SelectorEnvironment implementorsMatching: aString in: self! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! implementorsOf: aSelector ^SelectorEnvironment implementorsOf: aSelector in: self! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^true! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! includesClass: aClass ^true! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^true! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! includesSelector: aSelector in: aClass ^true! ! !BrowserEnvironment methodsFor: 'initialize-release' stamp: ''! initialize! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! instVarReadersTo: instVarName in: aClass ^VariableEnvironment on: self readersOfInstanceVariable: instVarName in: aClass! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! instVarRefsTo: instVarName in: aClass ^VariableEnvironment on: self referencesToInstanceVariable: instVarName in: aClass! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! instVarWritersTo: instVarName in: aClass ^VariableEnvironment on: self writersOfInstanceVariable: instVarName in: aClass! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! instanceVariablesFor: aClass ^aClass instVarNames! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! isClassEnvironment ^false! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^false! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! isSelector ^false! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! isSystem ^true! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: ''! keys | keys | keys := Set new. Smalltalk keysAndValuesDo: [:key :value | | class | value isBehavior ifTrue: [(self includesClass: value) ifTrue: [keys add: key]]. class := value class. (self includesClass: class) ifTrue: [keys add: key]]. ^keys! ! !BrowserEnvironment methodsFor: 'private' stamp: ''! label ^label isNil ifTrue: [self defaultLabel] ifFalse: [label]! ! !BrowserEnvironment methodsFor: 'initialize-release' stamp: ''! label: aString label := aString! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! matches: aString ^SelectorEnvironment matches: aString in: self! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! not self isSystem ifTrue: [^SelectorEnvironment new]. ^NotEnvironment onEnvironment: self! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! numberClasses ^self classNames size! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! numberSelectors | total | total := 0. self allClassesDo: [:each | self selectorsForClass: each do: [:sel | total := total + 1]]. ^total! ! !BrowserEnvironment methodsFor: 'copying' stamp: 'dvf 9/12/2003 13:21'! postCopy ^self! ! !BrowserEnvironment methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self label! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! problemCount ^self numberSelectors! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! protocolsFor: aClass ^aClass organization categories select: [:each | self includesProtocol: each in: aClass]! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! referencesTo: aLiteral ^SelectorEnvironment referencesTo: aLiteral in: self! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! referencesTo: aLiteral in: aClass | classes | classes := aClass withAllSuperclasses asSet. classes addAll: aClass allSubclasses; addAll: aClass class withAllSuperclasses; addAll: aClass class allSubclasses. ^(self forClasses: classes) referencesTo: aLiteral! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! searchStrings ^searchStrings isNil ifTrue: [#()] ifFalse: [searchStrings]! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! searchStrings: aCollection searchStrings := aCollection! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! selectMethods: aBlock | env | env := SelectorEnvironment onEnvironment: self. self classesAndSelectorsDo: [:each :sel | (aBlock value: (each compiledMethodAt: sel)) ifTrue: [env addClass: each selector: sel]]. ^env! ! !BrowserEnvironment methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:02'! selectionIntervalFor: aString | interval | self searchStrings isEmpty ifTrue: [^nil]. interval := self selectionParseTreeIntervalFor: aString. interval notNil ifTrue: [^interval]. self searchStrings do: [:each | | search index | search := each isSymbol ifTrue: [each keywords first] ifFalse: [each]. index := aString indexOfSubCollection: search startingAt: 1. index > 0 ifTrue: [^index to: index + search size - 1]]. ^nil! ! !BrowserEnvironment methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:03'! selectionParseTreeIntervalFor: aString | parseTree answerBlock | parseTree := RBParser parseMethod: aString onError: [:str :pos | ^nil]. answerBlock := [:aNode :answer | ^aNode sourceInterval]. self searchStrings do: [:each | | matcher tree | matcher := ParseTreeSearcher new. each isSymbol ifTrue: [matcher matchesTree: (RBLiteralNode value: each) do: answerBlock. tree := ParseTreeSearcher buildSelectorTree: each. tree notNil ifTrue: [matcher matchesTree: tree do: answerBlock]] ifFalse: [tree := RBVariableNode named: each. matcher matchesTree: tree do: answerBlock; matchesArgumentTree: tree do: answerBlock]. matcher executeTree: parseTree]. ^nil! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! selectorsFor: aProtocol in: aClass ^(aClass organization listAtCategoryNamed: aProtocol) select: [:each | self includesSelector: each in: aClass]! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! selectorsForClass: aClass | selectors | selectors := Set new: 50. self selectorsForClass: aClass do: [:each | selectors add: each]. ^selectors! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! selectorsForClass: aClass do: aBlock aClass selectorsAndMethodsDo: [:each :meth | (self includesSelector: each in: aClass) ifTrue: [aBlock value: each]]! ! !BrowserEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPutAll: self class name; nextPutAll: ' new'! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! whichCategoryIncludes: aClassName ^Smalltalk organization categoryOfElement: aClassName! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! whichProtocolIncludes: aSelector in: aClass ^aClass organization categoryOfElement: aSelector! ! !BrowserEnvironment methodsFor: 'environments' stamp: ''! | anEnvironment "If we or anEnvironment includes everything, then return it instead of creating an or that will include everything." self isSystem ifTrue: [^self]. anEnvironment isSystem ifTrue: [^anEnvironment]. ^(self not & anEnvironment not) not! ! BrowserEnvironment subclass: #BrowserEnvironmentWrapper instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! BrowserEnvironmentWrapper subclass: #AndEnvironment instanceVariableNames: 'andedEnvironment' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !AndEnvironment class methodsFor: 'instance creation' stamp: ''! onEnvironment: anEnvironment and: anotherEnvironment ^(self onEnvironment: anEnvironment) andedEnvironment: anotherEnvironment; yourself! ! !AndEnvironment methodsFor: 'private' stamp: ''! andedEnvironment ^andedEnvironment! ! !AndEnvironment methodsFor: 'initialize-release' stamp: ''! andedEnvironment: aBrowserEnvironment andedEnvironment := aBrowserEnvironment! ! !AndEnvironment methodsFor: 'accessing' stamp: ''! classesDo: aBlock environment classesDo: [:each | (self includesClass: each) ifTrue: [aBlock value: each]]! ! !AndEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(self classNamesFor: aCategory) isEmpty not! ! !AndEnvironment methodsFor: 'testing' stamp: ''! includesClass: aClass | doesntHaveSelectors | (environment includesClass: aClass) ifFalse: [^false]. (andedEnvironment includesClass: aClass) ifFalse: [^false]. doesntHaveSelectors := true. environment selectorsForClass: aClass do: [:each | doesntHaveSelectors := false. (andedEnvironment includesSelector: each in: aClass) ifTrue: [^true]]. ^doesntHaveSelectors! ! !AndEnvironment methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^(self selectorsFor: aProtocol in: aClass) isEmpty not! ! !AndEnvironment methodsFor: 'testing' stamp: ''! includesSelector: aSelector in: aClass ^(environment includesSelector: aSelector in: aClass) and: [andedEnvironment includesSelector: aSelector in: aClass]! ! !AndEnvironment methodsFor: 'accessing' stamp: ''! numberSelectors | total | total := 0. environment classesAndSelectorsDo: [:each :sel | (andedEnvironment includesSelector: sel in: each) ifTrue: [total := total + 1]]. ^total! ! !AndEnvironment methodsFor: 'accessing' stamp: ''! problemCount ^environment isClassEnvironment ifTrue: [self numberClasses] ifFalse: [super problemCount]! ! !AndEnvironment methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:01'! selectionIntervalFor: aString | interval | interval := super selectionIntervalFor: aString. interval notNil ifTrue: [^interval]. ^andedEnvironment selectionIntervalFor: aString ! ! !AndEnvironment methodsFor: 'accessing' stamp: ''! selectorsForClass: aClass do: aBlock environment selectorsForClass: aClass do: [:each | (andedEnvironment includesSelector: each in: aClass) ifTrue: [aBlock value: each]]! ! !AndEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. environment storeOn: aStream. aStream nextPutAll: ' & '. andedEnvironment storeOn: aStream. aStream nextPut: $)! ! !BrowserEnvironmentWrapper class methodsFor: 'instance creation' stamp: ''! new ^self onEnvironment: BrowserEnvironment new! ! !BrowserEnvironmentWrapper class methodsFor: 'instance creation' stamp: ''! onEnvironment: anEnvironment ^(self basicNew) initialize; onEnvironment: anEnvironment; yourself! ! !BrowserEnvironmentWrapper methodsFor: 'private' stamp: ''! environment ^environment! ! !BrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^environment includesCategory: aCategory! ! !BrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''! includesClass: aClass ^environment includesClass: aClass! ! !BrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^(self includesClass: aClass) and: [environment includesProtocol: aProtocol in: aClass]! ! !BrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''! includesSelector: aSelector in: aClass ^(self includesClass: aClass) and: [environment includesSelector: aSelector in: aClass]! ! !BrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''! isEmpty self classesDo: [:each | ^false]. ^true! ! !BrowserEnvironmentWrapper methodsFor: 'testing' stamp: ''! isSystem ^false! ! !BrowserEnvironmentWrapper methodsFor: 'initialize-release' stamp: ''! onEnvironment: anEnvironment environment := anEnvironment! ! !BrowserEnvironmentWrapper methodsFor: 'accessing' stamp: 'bh 5/8/2000 21:03'! selectionIntervalFor: aString | interval | interval := super selectionIntervalFor: aString. ^interval notNil ifTrue: [interval] ifFalse: [environment selectionIntervalFor: aString]! ! !BrowserEnvironmentWrapper methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPutAll: '('; nextPutAll: self class name; nextPutAll: ' onEnvironment: '. environment storeOn: aStream. aStream nextPut: $)! ! BrowserEnvironmentWrapper subclass: #CategoryEnvironment instanceVariableNames: 'categories' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !CategoryEnvironment class methodsFor: 'instance creation' stamp: ''! onEnvironment: anEnvironment categories: aCollection ^(self onEnvironment: anEnvironment) categories: aCollection; yourself! ! !CategoryEnvironment methodsFor: 'accessing' stamp: ''! categories ^categories select: [:each | self includesCategory: each]! ! !CategoryEnvironment methodsFor: 'initialize-release' stamp: ''! categories: aCollection categories := aCollection! ! !CategoryEnvironment methodsFor: 'accessing-classes' stamp: ''! classNames ^self categories inject: OrderedCollection new into: [:col :each | col addAll: (self classNamesFor: each); yourself]! ! !CategoryEnvironment methodsFor: 'private' stamp: ''! defaultLabel | stream | stream := String new writeStream. categories do: [:each | stream nextPutAll: each; nextPut: $ ]. ^stream contents! ! !CategoryEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(categories includes: aCategory) and: [super includesCategory: aCategory]! ! !CategoryEnvironment methodsFor: 'testing' stamp: 'lr 5/14/2008 09:40'! includesClass: aClass ^ (super includesClass: aClass) and: [ | nonMetaClass | nonMetaClass := aClass isMeta ifTrue: [ aClass soleInstance ] ifFalse: [ aClass ]. categories includes: nonMetaClass category ]! ! !CategoryEnvironment methodsFor: 'initialize-release' stamp: ''! initialize super initialize. categories := Set new! ! !CategoryEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^categories isEmpty! ! !CategoryEnvironment methodsFor: 'accessing' stamp: ''! numberSelectors | total | total := 0. self classesDo: [:each | self selectorsForClass: each do: [:sel | total := total + 1]]. ^total! ! !CategoryEnvironment methodsFor: 'copying' stamp: ''! postCopy categories := categories copy. ^super postCopy! ! !CategoryEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. super storeOn: aStream. aStream nextPutAll: ' categories: '. categories asArray storeOn: aStream. aStream nextPut: $)! ! BrowserEnvironmentWrapper subclass: #ClassEnvironment instanceVariableNames: 'classes metaClasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !ClassEnvironment class methodsFor: 'instance creation' stamp: ''! onEnvironment: anEnvironment classes: aCollection ^(self onEnvironment: anEnvironment) classes: aCollection; yourself! ! !ClassEnvironment methodsFor: 'adding' stamp: ''! addClass: aClass aClass isMeta ifTrue: [metaClasses add: aClass soleInstance name] ifFalse: [classes add: aClass name]! ! !ClassEnvironment methodsFor: 'accessing' stamp: 'bh 6/10/2000 17:05'! asSelectorEnvironment ^SelectorEnvironment new searchStrings:#(); label:self label; onEnvironment: self environment; classSelectors: self classSelectorDictionary metaClassSelectors: self metaClassSelectorDictionary; yourself.! ! !ClassEnvironment methodsFor: 'accessing-classes' stamp: ''! classNames ^(Set withAll: classes) addAll: metaClasses; yourself! ! !ClassEnvironment methodsFor: 'printing' stamp: 'bh 6/10/2000 17:39'! classSelectorDictionary ^classes inject:Dictionary new into: [:answer :class | answer at:class put:(Smalltalk at:class) selectors; yourself]. ! ! !ClassEnvironment methodsFor: 'initialize-release' stamp: ''! classes: aCollection aCollection do: [:each | self addClass: each]! ! !ClassEnvironment methodsFor: 'accessing-classes' stamp: ''! classesDo: aBlock classes do: [:each | | class | class := Smalltalk at: each ifAbsent: [nil]. (class notNil and: [environment includesClass: class]) ifTrue: [aBlock value: class]]. metaClasses do: [:each | | class | class := Smalltalk at: each ifAbsent: [nil]. (class notNil and: [environment includesClass: class class]) ifTrue: [aBlock value: class class]]! ! !ClassEnvironment methodsFor: 'private' stamp: ''! defaultLabel | stream | stream := String new writeStream. classes do: [:each | stream nextPutAll: each; nextPut: $ ]. ^stream contents! ! !ClassEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(super includesCategory: aCategory) and: [(environment classNamesFor: aCategory) inject: false into: [:bool :each | bool or: [| class | class := Smalltalk at: each ifAbsent: [nil]. class notNil and: [(self includesClass: class) or: [self includesClass: class class]]]]]! ! !ClassEnvironment methodsFor: 'testing' stamp: ''! includesClass: aClass ^(aClass isMeta ifTrue: [metaClasses includes: aClass soleInstance name] ifFalse: [classes includes: aClass name]) and: [super includesClass: aClass]! ! !ClassEnvironment methodsFor: 'initialize-release' stamp: ''! initialize super initialize. classes := Set new. metaClasses := Set new! ! !ClassEnvironment methodsFor: 'testing' stamp: ''! isClassEnvironment ^true! ! !ClassEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^classes isEmpty and: [metaClasses isEmpty]! ! !ClassEnvironment methodsFor: 'printing' stamp: 'bh 4/29/2000 17:53'! logOrInspect Transcript cr; cr; show:self name. (classes asArray, metaClasses asArray) asSet do: [:class | Transcript cr; show: ' ',class asString]. ! ! !ClassEnvironment methodsFor: 'printing' stamp: 'bh 6/10/2000 17:39'! metaClassSelectorDictionary ^metaClasses inject:Dictionary new into: [:answer :class | answer at:class put:(Smalltalk at:class) class selectors; yourself]. ! ! !ClassEnvironment methodsFor: 'copying' stamp: ''! postCopy classes := classes copy. metaClasses := metaClasses copy. ^super postCopy! ! !ClassEnvironment methodsFor: 'accessing' stamp: ''! problemCount ^self numberClasses! ! !ClassEnvironment methodsFor: 'removing' stamp: ''! removeClass: aClass aClass isMeta ifTrue: [metaClasses remove: aClass soleInstance name ifAbsent: []] ifFalse: [classes remove: aClass name ifAbsent: []]! ! !ClassEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. super storeOn: aStream. aStream nextPutAll: ' classes: (('. classes asArray storeOn: aStream. aStream nextPutAll: ' inject: OrderedCollection new into: [:sum :each | | class | class := Smalltalk at: each ifAbsent: [nil]. class notNil ifTrue: [sum add: class]. sum]) , ('. metaClasses asArray storeOn: aStream. aStream nextPutAll: ' inject: OrderedCollection new into: [:sum :each | | class | class := Smalltalk at: each ifAbsent: [nil]. class notNil ifTrue: [sum add: class class]. sum])))'! ! BrowserEnvironmentWrapper subclass: #MultiEnvironment instanceVariableNames: 'environmentDictionaries' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !MultiEnvironment methodsFor: 'adding' stamp: ''! addClass: aClass into: aValue (environmentDictionaries at: aValue ifAbsentPut: [SelectorEnvironment new]) addClass: aClass! ! !MultiEnvironment methodsFor: 'adding' stamp: ''! addClass: aClass selector: aSymbol into: aValue (environmentDictionaries at: aValue ifAbsentPut: [SelectorEnvironment new]) addClass: aClass selector: aSymbol! ! !MultiEnvironment methodsFor: 'accessing' stamp: 'rr 4/19/2004 16:04'! asSelectorEnvironment | s | s := SelectorEnvironment new. s label: self label. environmentDictionaries do: [:each | | env | env := each asSelectorEnvironment. env classesDo: [:cls | env selectorsForClass: cls do: [:sel | s addClass: cls selector: sel]]]. ^ s ! ! !MultiEnvironment methodsFor: 'accessing' stamp: ''! environments ^environmentDictionaries keys! ! !MultiEnvironment methodsFor: 'initialize-release' stamp: ''! initialize super initialize. environmentDictionaries := Dictionary new. environment := SelectorEnvironment new! ! !MultiEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^environmentDictionaries isEmpty! ! !MultiEnvironment methodsFor: 'accessing' stamp: ''! problemCount ^environmentDictionaries size! ! !MultiEnvironment methodsFor: 'removing' stamp: ''! removeClass: aClass into: aValue (environmentDictionaries at: aValue ifAbsent: [SelectorEnvironment new]) removeClass: aClass! ! !MultiEnvironment methodsFor: 'removing' stamp: ''! removeClass: aClass selector: aSelector into: aValue (environmentDictionaries at: aValue ifAbsentPut: [SelectorEnvironment new]) removeClass: aClass selector: aSelector! ! !MultiEnvironment methodsFor: 'accessing' stamp: ''! selectEnvironment: aValue environment := environmentDictionaries at: aValue ifAbsent: [SelectorEnvironment new]! ! BrowserEnvironmentWrapper subclass: #NotEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !NotEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(self classNamesFor: aCategory) isEmpty not! ! !NotEnvironment methodsFor: 'testing' stamp: ''! includesClass: aClass (environment includesClass: aClass) ifFalse: [^true]. aClass selectorsAndMethodsDo: [:each :meth | (environment includesSelector: each in: aClass) ifFalse: [^true]]. ^false! ! !NotEnvironment methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^(self selectorsFor: aProtocol in: aClass) isEmpty not! ! !NotEnvironment methodsFor: 'testing' stamp: ''! includesSelector: aSelector in: aClass ^(environment includesSelector: aSelector in: aClass) not! ! !NotEnvironment methodsFor: 'environments' stamp: ''! not ^environment! ! !NotEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream environment storeOn: aStream. aStream nextPutAll: ' not'! ! BrowserEnvironmentWrapper subclass: #PackageEnvironment instanceVariableNames: 'package' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !PackageEnvironment class methodsFor: 'instance creation' stamp: 'lr 1/3/2006 12:14'! onEnvironment: anEnvironment package: aPackageInfo ^ (self onEnvironment: anEnvironment) package: aPackageInfo; yourself.! ! !PackageEnvironment class methodsFor: 'instance creation' stamp: 'lr 1/3/2006 12:14'! onEnvironment: anEnvironment packageNamed: aString ^ self onEnvironment: anEnvironment package: (PackageInfo named: aString).! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 1/3/2006 12:05'! asSelectorEnvironment | result | result := SelectorEnvironment onEnvironment: self. self classesAndSelectorsDo: [ :class :selector | result addClass: class selector: selector ]. ^ result.! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 1/3/2006 12:05'! classesAndSelectorsDo: aBlock self package coreMethods do: [ :method | (self includesSelector: method methodSymbol in: method actualClass) ifTrue: [ aBlock value: method actualClass value: method methodSymbol ] ]. self package extensionMethods do: [ :method | (self includesSelector: method methodSymbol in: method actualClass) ifTrue: [ aBlock value: method actualClass value: method methodSymbol ] ].! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 1/3/2006 12:05'! classesDo: aBlock self package classesAndMetaClasses do: [ :each | (self includesClass: each) ifTrue: [ aBlock value: each ] ]. self package extensionClasses do: [ :each | (self environment includesClass: each) ifTrue: [ aBlock value: each ]. (self environment includesClass: each class) ifTrue: [ aBlock value: each class ] ].! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2006 12:06'! includesCategory: aCategory ^ (super includesCategory: aCategory) and: [ self package includesSystemCategory: aCategory ].! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2006 12:06'! includesClass: aClass ^ (super includesClass: aClass) and: [ self package includesClass: aClass ].! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2006 12:12'! includesProtocol: aProtocol in: aClass ^ (self environment includesProtocol: aProtocol in: aClass) and: [ self package includesMethodCategory: aProtocol ofClass: aClass ].! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2006 12:12'! includesSelector: aSelector in: aClass ^ (self environment includesSelector: aSelector in: aClass) and: [ self package includesMethod: aSelector ofClass: aClass ].! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 1/3/2006 12:05'! package ^ package! ! !PackageEnvironment methodsFor: 'private' stamp: 'lr 1/3/2006 12:12'! package: aPackageInfo package := aPackageInfo! ! !PackageEnvironment methodsFor: 'printing' stamp: 'lr 1/3/2006 12:06'! storeOn: aStream aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' onEnvironment: '. environment storeOn: aStream. aStream nextPutAll: ' packageNamed: '; print: self package packageName; nextPut: $).! ! BrowserEnvironmentWrapper subclass: #ProtocolEnvironment instanceVariableNames: 'class protocols' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !ProtocolEnvironment class methodsFor: 'instance creation' stamp: ''! onEnvironment: anEnvironment class: aClass protocols: aCollection ^(self onEnvironment: anEnvironment) class: aClass protocols: aCollection; yourself! ! !ProtocolEnvironment methodsFor: 'initialize-release' stamp: ''! class: aClass protocols: aCollection class := aClass. protocols := aCollection! ! !ProtocolEnvironment methodsFor: 'private' stamp: ''! defaultLabel | stream | stream := String new writeStream. stream nextPutAll: class name; nextPut: $>. protocols do: [:each | stream nextPutAll: each; nextPut: $ ]. ^stream contents! ! !ProtocolEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(super includesCategory: aCategory) and: [(environment classNamesFor: aCategory) inject: false into: [:bool :each | bool or: [| aClass | aClass := Smalltalk at: each ifAbsent: [nil]. aClass == class or: [aClass class == class]]]]! ! !ProtocolEnvironment methodsFor: 'testing' stamp: ''! includesClass: aClass ^aClass == class and: [super includesClass: aClass]! ! !ProtocolEnvironment methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^aClass == class and: [(super includesProtocol: aProtocol in: aClass) and: [protocols includes: aProtocol]]! ! !ProtocolEnvironment methodsFor: 'testing' stamp: ''! includesSelector: aSelector in: aClass ^(super includesSelector: aSelector in: aClass) and: [protocols includes: (environment whichProtocolIncludes: aSelector in: aClass)]! ! !ProtocolEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^protocols isEmpty! ! !ProtocolEnvironment methodsFor: 'copying' stamp: ''! postCopy protocols := protocols copy. ^super postCopy! ! !ProtocolEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. super storeOn: aStream. aStream nextPutAll: ' class: '; nextPutAll: class name; nextPutAll: ' protocols: '. protocols asArray storeOn: aStream. aStream nextPut: $)! ! BrowserEnvironmentWrapper subclass: #SelectorEnvironment instanceVariableNames: 'classSelectors metaClassSelectors' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! SelectorEnvironment subclass: #ParseTreeEnvironment instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !ParseTreeEnvironment methodsFor: 'initialize-release' stamp: ''! matcher: aParseTreeSearcher matcher := aParseTreeSearcher! ! !ParseTreeEnvironment methodsFor: 'accessing' stamp: 'bh 5/9/2000 00:19'! selectionIntervalFor: aString | parseTree node | matcher isNil ifTrue: [^super selectionIntervalFor: aString]. parseTree := RBParser parseMethod: aString onError: [:error :position | ^super selectionIntervalFor: aString]. node := matcher executeTree: parseTree initialAnswer: nil. ^node isNil ifTrue: [super selectionIntervalFor: aString] ifFalse: [node sourceInterval]! ! !SelectorEnvironment class methodsFor: 'instance creation' stamp: ''! implementorsMatching: aString in: anEnvironment | classDict metaDict | classDict := IdentityDictionary new. metaDict := IdentityDictionary new. anEnvironment classesDo: [:class | | selectors | selectors := Set new. anEnvironment selectorsForClass: class do: [:each | (aString match: each) ifTrue: [selectors add: each]]. selectors isEmpty ifFalse: [class isMeta ifTrue: [metaDict at: class soleInstance name put: selectors] ifFalse: [classDict at: class name put: selectors]]]. ^(self onEnvironment: anEnvironment) classSelectors: classDict metaClassSelectors: metaDict; label: 'Implementors of ' , aString; yourself! ! !SelectorEnvironment class methodsFor: 'instance creation' stamp: ''! implementorsOf: aSelector in: anEnvironment | classDict metaDict selectors | classDict := IdentityDictionary new. metaDict := IdentityDictionary new. selectors := Array with: aSelector. anEnvironment classesDo: [:class | ((class includesSelector: aSelector) and: [anEnvironment includesSelector: aSelector in: class]) ifTrue: [class isMeta ifTrue: [metaDict at: class soleInstance name put: selectors] ifFalse: [classDict at: class name put: selectors]]]. ^(self onEnvironment: anEnvironment) classSelectors: classDict metaClassSelectors: metaDict; label: 'Implementors of ' , aSelector; yourself! ! !SelectorEnvironment class methodsFor: 'instance creation' stamp: ''! matches: aString in: anEnvironment | newEnvironment | newEnvironment := (self onEnvironment: anEnvironment) label: 'Matching: ' , aString; searchStrings: (Array with: aString); yourself. anEnvironment classesAndSelectorsDo: [:each :sel | | method | method := each compiledMethodAt: sel. method allLiterals do: [:lit | lit isString ifTrue: [(aString match: lit) ifTrue: [newEnvironment addClass: each selector: sel]]]]. ^newEnvironment! ! !SelectorEnvironment class methodsFor: 'instance creation' stamp: ''! onMethods: selectorCollection forClass: aClass in: anEnvironment | env | env := self onEnvironment: anEnvironment. selectorCollection do: [:each | env addClass: aClass selector: each]. ^env! ! !SelectorEnvironment class methodsFor: 'instance creation' stamp: ''! referencesTo: aLiteral in: anEnvironment | classDict literalPrintString | literalPrintString := aLiteral isVariableBinding ifTrue: [aLiteral key asString] ifFalse: [aLiteral isString ifTrue: [aLiteral] ifFalse: [aLiteral printString]]. classDict := Dictionary new. anEnvironment classesDo: [:class | | selectors | selectors := (class whichSelectorsReferTo: aLiteral) select: [:aSelector | anEnvironment includesSelector: aSelector in: class]. selectors isEmpty ifFalse: [classDict at: class put: selectors]]. ^(self onEnvironment: anEnvironment) on: classDict; label: 'References to: ' , literalPrintString; searchStrings: (Array with: literalPrintString); yourself! ! !SelectorEnvironment methodsFor: 'adding' stamp: ''! addClass: aClass aClass isMeta ifTrue: [metaClassSelectors at: aClass soleInstance name put: aClass selectors] ifFalse: [classSelectors at: aClass name put: aClass selectors]! ! !SelectorEnvironment methodsFor: 'adding' stamp: ''! addClass: aClass selector: aSymbol (aClass isMeta ifTrue: [metaClassSelectors at: aClass soleInstance name ifAbsentPut: [Set new]] ifFalse: [classSelectors at: aClass name ifAbsentPut: [Set new]]) add: aSymbol! ! !SelectorEnvironment methodsFor: 'accessing' stamp: 'rr 4/19/2004 16:06'! asSelectorEnvironment ^ self! ! !SelectorEnvironment methodsFor: 'accessing-classes' stamp: ''! classNames | names | names := Set new: classSelectors size + metaClassSelectors size. names addAll: classSelectors keys; addAll: metaClassSelectors keys. ^names asOrderedCollection! ! !SelectorEnvironment methodsFor: 'initialize-release' stamp: ''! classSelectors: classSelectorDictionary metaClassSelectors: metaClassSelectorDictionary classSelectors := classSelectorDictionary. metaClassSelectors := metaClassSelectorDictionary! ! !SelectorEnvironment methodsFor: 'initialize-release' stamp: ''! classes: classArray metaClasses: metaArray "Used to recreate an environment from its storeString" classSelectors := Dictionary new. metaClassSelectors := Dictionary new. classArray do: [:each | classSelectors at: each first put: each last asSet]. metaArray do: [:each | metaClassSelectors at: each first put: each last asSet]! ! !SelectorEnvironment methodsFor: 'accessing-classes' stamp: ''! classesDo: aBlock classSelectors keysDo: [:each | | class | class := Smalltalk at: each ifAbsent: [nil]. class notNil ifTrue: [(self includesClass: class) ifTrue: [aBlock value: class]]]. metaClassSelectors keysDo: [:each | | class | class := Smalltalk at: each ifAbsent: [nil]. class notNil ifTrue: [(self includesClass: class class) ifTrue: [aBlock value: class class]]]! ! !SelectorEnvironment methodsFor: 'private' stamp: ''! defaultLabel ^'some methods'! ! !SelectorEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(super includesCategory: aCategory) and: [(self classNamesFor: aCategory) contains: [:className | (classSelectors includesKey: className) or: [metaClassSelectors includesKey: className]]]! ! !SelectorEnvironment methodsFor: 'testing' stamp: ''! includesClass: aClass ^(self privateSelectorsForClass: aClass) isEmpty not and: [super includesClass: aClass]! ! !SelectorEnvironment methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^(super includesProtocol: aProtocol in: aClass) and: [(environment selectorsFor: aProtocol in: aClass) contains: [:aSelector | self privateIncludesSelector: aSelector inClass: aClass]]! ! !SelectorEnvironment methodsFor: 'testing' stamp: ''! includesSelector: aSelector in: aClass ^(environment includesSelector: aSelector in: aClass) and: [self privateIncludesSelector: aSelector inClass: aClass]! ! !SelectorEnvironment methodsFor: 'initialize-release' stamp: ''! initialize super initialize. classSelectors := IdentityDictionary new. metaClassSelectors := IdentityDictionary new! ! !SelectorEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^classSelectors isEmpty and: [metaClassSelectors isEmpty]! ! !SelectorEnvironment methodsFor: 'testing' stamp: ''! isSelector ^true! ! !SelectorEnvironment methodsFor: 'adding' stamp: 'bh 4/29/2000 18:09'! logOrInspect Transcript cr; cr; show:self name. searchStrings ifNotNil: [Transcript cr;show:' ( '. searchStrings do:[:string| Transcript show:string asString,' ']. Transcript show:')'.]. self logOrInspectDictionary:classSelectors. self logOrInspectDictionary:metaClassSelectors.! ! !SelectorEnvironment methodsFor: 'adding' stamp: 'bh 4/29/2000 18:09'! logOrInspectDictionary:aDictionary aDictionary keysAndValuesDo: [:class :selectors | selectors do: [:sel | Transcript cr; show: ' ',class name asString , '>>' , sel asString]].! ! !SelectorEnvironment methodsFor: 'accessing' stamp: ''! numberSelectors "This doesn't compute the correct result when a method that is included in our method list is not in the environment we are wrapping. It is implemented this way for efficiency." ^(classSelectors inject: 0 into: [:sum :each | sum + each size]) + (metaClassSelectors inject: 0 into: [:sum :each | sum + each size])! ! !SelectorEnvironment methodsFor: 'initialize-release' stamp: ''! on: aDict aDict keysAndValuesDo: [:class :selectors | class isMeta ifTrue: [metaClassSelectors at: class soleInstance name put: selectors] ifFalse: [classSelectors at: class name put: selectors]]! ! !SelectorEnvironment methodsFor: 'copying' stamp: ''! postCopy | newDict | newDict := classSelectors copy. newDict keysAndValuesDo: [:key :value | newDict at: key put: value copy]. classSelectors := newDict. newDict := metaClassSelectors copy. newDict keysAndValuesDo: [:key :value | newDict at: key put: value copy]. metaClassSelectors := newDict. ^super postCopy! ! !SelectorEnvironment methodsFor: 'private' stamp: ''! privateIncludesSelector: aSelector inClass: aClass ^(self privateSelectorsForClass: aClass) includes: aSelector! ! !SelectorEnvironment methodsFor: 'private' stamp: ''! privateSelectorsForClass: aClass ^aClass isMeta ifTrue: [metaClassSelectors at: aClass soleInstance name ifAbsent: [#()]] ifFalse: [classSelectors at: aClass name ifAbsent: [#()]]! ! !SelectorEnvironment methodsFor: 'removing' stamp: ''! removeClass: aClass aClass isMeta ifTrue: [metaClassSelectors removeKey: aClass soleInstance name ifAbsent: []] ifFalse: [classSelectors removeKey: aClass name ifAbsent: []]! ! !SelectorEnvironment methodsFor: 'removing' stamp: ''! removeClass: aClass selector: aSelector (aClass isMeta ifTrue: [metaClassSelectors at: aClass soleInstance name ifAbsent: [^self]] ifFalse: [classSelectors at: aClass name ifAbsent: [^self]]) remove: aSelector ifAbsent: []! ! !SelectorEnvironment methodsFor: 'accessing' stamp: ''! selectorsForClass: aClass do: aBlock ^(self privateSelectorsForClass: aClass) do: [:each | (aClass includesSelector: each) ifTrue: [aBlock value: each]]! ! !SelectorEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream | classBlock | aStream nextPutAll: '(('; nextPutAll: self class name; nextPutAll: ' onEnvironment: '. environment storeOn: aStream. aStream nextPut: $); nextPutAll: ' classes: #('. classBlock := [:key :value | aStream nextPutAll: '#('; nextPutAll: key; nextPutAll: ' #('. value do: [:each | aStream nextPutAll: each; nextPut: $ ]. aStream nextPutAll: '))'; cr]. classSelectors keysAndValuesDo: classBlock. aStream nextPutAll: ') metaClasses: #('. metaClassSelectors keysAndValuesDo: classBlock. aStream nextPutAll: '))'! ! BrowserEnvironmentWrapper subclass: #VariableEnvironment instanceVariableNames: 'instanceVariables instanceVariableReaders instanceVariableWriters classVariables selectorCache' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !VariableEnvironment class methodsFor: 'instance creation' stamp: 'nk 3/4/2005 13:20'! on: anEnvironment readersOfInstanceVariable: aString in: aClass | newEnv | newEnv := (self onEnvironment: anEnvironment) label: 'Readers of ''' , aString , ''' in ' , aClass name; yourself. (aClass whichClassDefinesInstVar: aString) withAllSubclassesDo: [:cls | (cls whichSelectorsRead: aString) isEmpty ifFalse: [newEnv addClass: cls instanceVariableReader: aString]]. ^newEnv! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: 'md 1/17/2006 14:17'! on: anEnvironment referencesToClassVariable: aSymbol in: aClass | newEnv definingClass assoc | newEnv := (self onEnvironment: anEnvironment) label: 'References to ''' , aSymbol , ''' in ' , aClass name; yourself. definingClass := aClass whichClassDefinesClassVar: aSymbol. assoc := definingClass bindingOf: aSymbol. definingClass withAllSubclassesDo: [:cls | (cls whichSelectorsReferTo: assoc) isEmpty ifFalse: [newEnv addClass: cls classVariable: aSymbol]]. ^newEnv! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: 'nk 3/4/2005 13:23'! on: anEnvironment referencesToInstanceVariable: aString in: aClass | newEnv | newEnv := (self onEnvironment: anEnvironment) label: 'References to ''' , aString , ''' in ' , aClass name; yourself. (aClass whichClassDefinesInstVar: aString) withAllSubclassesDo: [:cls | ((cls whichSelectorsRead: aString) isEmpty not or: [(cls whichSelectorsAssign: aString) isEmpty not]) ifTrue: [newEnv addClass: cls instanceVariable: aString]]. ^newEnv! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: 'nk 3/4/2005 13:17'! on: anEnvironment writersOfInstanceVariable: aString in: aClass | newEnv | newEnv := (self onEnvironment: anEnvironment) label: 'Writers of ''' , aString , ''' in ' , aClass name; yourself. (aClass whichClassDefinesInstVar: aString) withAllSubclassesDo: [:cls | (cls whichSelectorsAssign: aString) isEmpty ifFalse: [newEnv addClass: cls instanceVariableWriter: aString]]. ^newEnv! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: ''! readersOfInstanceVariable: aString in: aClass ^self on: BrowserEnvironment new readersOfInstanceVariable: aString in: aClass! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: ''! referencesToClassVariable: aSymbol in: aClass ^self on: BrowserEnvironment new referencesToClassVariable: aSymbol in: aClass! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: ''! referencesToInstanceVariable: aString in: aClass ^self on: BrowserEnvironment new referencesToInstanceVariable: aString in: aClass! ! !VariableEnvironment class methodsFor: 'instance creation' stamp: ''! writersOfInstanceVariable: aString in: aClass ^self on: BrowserEnvironment new writersOfInstanceVariable: aString in: aClass! ! !VariableEnvironment methodsFor: 'private' stamp: ''! accessorMethods ^#(#instanceVariables #instanceVariableReaders #instanceVariableWriters #classVariables)! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! addClass: aClass classVariable: aSymbol (classVariables at: aClass name ifAbsentPut: [Set new]) add: aSymbol. self flushCachesFor: aClass. self addSearchString: aSymbol! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! addClass: aClass instanceVariable: aString (instanceVariables at: aClass name ifAbsentPut: [Set new]) add: aString. self flushCachesFor: aClass. self addSearchString: aString! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! addClass: aClass instanceVariableReader: aString (instanceVariableReaders at: aClass name ifAbsentPut: [Set new]) add: aString. self flushCachesFor: aClass. self addSearchString: aString! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! addClass: aClass instanceVariableWriter: aString (instanceVariableWriters at: aClass name ifAbsentPut: [Set new]) add: aString. self flushCachesFor: aClass. self addSearchString: aString! ! !VariableEnvironment methodsFor: 'private' stamp: ''! allClassesDo: aBlock | classes instVarBlock | classes := Set new. instVarBlock := [:each | | class | class := self classForName: each. classes addAll: class withAllSubclasses]. instanceVariables keysDo: instVarBlock. instanceVariableReaders keysDo: instVarBlock. instanceVariableWriters keysDo: instVarBlock. classVariables keysDo: [:each | | class | class := self classForName: each. class notNil ifTrue: [classes addAll: class withAllSubclasses; addAll: class class withAllSubclasses]]. classes do: aBlock! ! !VariableEnvironment methodsFor: 'private' stamp: ''! classForName: aString | name isMeta class | isMeta := aString includes: $ . name := (isMeta ifTrue: [aString copyFrom: 1 to: (aString size - 6 max: 1)] ifFalse: [aString]) asSymbol. class := Smalltalk at: name ifAbsent: [nil]. ^class notNil & isMeta ifTrue: [class class] ifFalse: [class]! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! classNamesWithVariables | classNames | classNames := Set new. classNames addAll: instanceVariables keys; addAll: instanceVariableReaders keys; addAll: instanceVariableWriters keys; addAll: classVariables keys. ^classNames! ! !VariableEnvironment methodsFor: 'private' stamp: 'md 1/17/2006 14:17'! classVariableSelectorsFor: aClass | selectors classVars nonMetaClass | nonMetaClass := aClass isMeta ifTrue: [aClass soleInstance] ifFalse: [aClass]. selectors := Set new. classVars := Set new. classVariables keysDo: [:each | | cls | cls := self classForName: each. (cls notNil and: [nonMetaClass includesBehavior: cls]) ifTrue: [classVars addAll: (classVariables at: each)]]. classVars do: [:each | | binding | binding := aClass bindingOf: each. binding notNil ifTrue: [selectors addAll: (aClass whichSelectorsReferTo: binding)]]. ^selectors! ! !VariableEnvironment methodsFor: 'private' stamp: ''! classVariables ^classVariables! ! !VariableEnvironment methodsFor: 'private' stamp: ''! classVariables: anObject classVariables := anObject! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! classVariablesFor: aClass ^classVariables at: aClass name ifAbsent: [#()]! ! !VariableEnvironment methodsFor: 'private' stamp: ''! computeSelectorCacheFor: aClass ^(self instanceVariableSelectorsFor: aClass) addAll: (self classVariableSelectorsFor: aClass); yourself! ! !VariableEnvironment methodsFor: 'copying' stamp: ''! copyDictionary: aDictionary | copy | copy := Dictionary new: aDictionary size. aDictionary keysAndValuesDo: [:key :value | copy at: key put: value]. ^copy! ! !VariableEnvironment methodsFor: 'accessing' stamp: 'md 1/17/2006 14:17'! environmentForClassVariable: aSymbol in: aClass | selectorEnvironment assoc block | selectorEnvironment := SelectorEnvironment onEnvironment: self. selectorEnvironment addSearchString: aSymbol. ((classVariables at: aClass name ifAbsent: [#()]) includes: aSymbol) ifFalse: [^selectorEnvironment]. assoc := aClass bindingOf: aSymbol. block := [:each | (each whichSelectorsReferTo: assoc) do: [:sel | selectorEnvironment addClass: each selector: sel]]. aClass withAllSubAndSuperclassesDo: [:each | block value: each; value: each class]. ^selectorEnvironment! ! !VariableEnvironment methodsFor: 'accessing' stamp: 'nk 2/26/2005 07:24'! environmentForInstanceVariable: aString in: aClass | selectorEnvironment isReader isWriter | selectorEnvironment := SelectorEnvironment onEnvironment: self. selectorEnvironment addSearchString: aString. isReader := isWriter := false. ((instanceVariables at: aClass name ifAbsent: [#()]) includes: aString) ifTrue: [isReader := true. isWriter := true]. ((instanceVariableWriters at: aClass name ifAbsent: [#()]) includes: aString) ifTrue: [isWriter := true]. ((instanceVariableReaders at: aClass name ifAbsent: [#()]) includes: aString) ifTrue: [isReader := true]. aClass withAllSubAndSuperclassesDo: [:each | isWriter ifTrue: [(each whichSelectorsAssign: aString) do: [:sel | selectorEnvironment addClass: each selector: sel]]. isReader ifTrue: [(each whichSelectorsRead: aString) do: [:sel | selectorEnvironment addClass: each selector: sel]]]. ^selectorEnvironment! ! !VariableEnvironment methodsFor: 'private' stamp: ''! flushCachesFor: aClass | nonMetaClass | selectorCache isNil ifTrue: [^self]. nonMetaClass := aClass isMeta ifTrue: [aClass soleInstance] ifFalse: [aClass]. nonMetaClass withAllSubclasses do: [:each | selectorCache removeKey: each ifAbsent: []; removeKey: each class ifAbsent: []]! ! !VariableEnvironment methodsFor: 'testing' stamp: ''! includesCategory: aCategory ^(self classNamesFor: aCategory) isEmpty not! ! !VariableEnvironment methodsFor: 'testing' stamp: 'lr 2/9/2008 10:51'! includesClass: aClass (super includesClass: aClass) ifFalse: [^false]. (instanceVariables includesKey: aClass name) ifTrue: [^true]. (classVariables includesKey: aClass name) ifTrue: [^true]. ^((self selectorCacheFor: aClass) detect: [:each | self includesSelector: each in: aClass] ifNone: [nil]) notNil! ! !VariableEnvironment methodsFor: 'testing' stamp: ''! includesProtocol: aProtocol in: aClass ^(self selectorsFor: aProtocol in: aClass) isEmpty not! ! !VariableEnvironment methodsFor: 'testing' stamp: ''! includesSelector: aSymbol in: aClass ^(environment includesSelector: aSymbol in: aClass) and: [(self selectorCacheFor: aClass) includes: aSymbol]! ! !VariableEnvironment methodsFor: 'initialize-release' stamp: ''! initialize super initialize. instanceVariables := Dictionary new. classVariables := Dictionary new. instanceVariableReaders := Dictionary new. instanceVariableWriters := Dictionary new! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariableReaders ^instanceVariableReaders! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariableReaders: anObject instanceVariableReaders := anObject! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariableSelectorsFor: aClass | selectors | selectors := Set new. #(#instanceVariables #instanceVariableReaders #instanceVariableWriters) with: #(#whichSelectorsAccess: #whichSelectorsRead: #whichSelectorsAssign:) do: [:var :sel | | instVars | instVars := Set new. (self perform: var) keysDo: [:each | | cls | cls := self classForName: each. (cls notNil and: [aClass includesBehavior: cls]) ifTrue: [instVars addAll: ((self perform: var) at: each)]]. instVars do: [:each | selectors addAll: (aClass perform: sel with: each)]]. ^selectors! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariableWriters ^instanceVariableWriters! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariableWriters: anObject instanceVariableWriters := anObject! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariables ^instanceVariables! ! !VariableEnvironment methodsFor: 'private' stamp: ''! instanceVariables: anObject instanceVariables := anObject! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! instanceVariablesFor: aClass | vars name | vars := Set new. name := aClass name. vars addAll: (instanceVariables at: name ifAbsent: [#()]); addAll: (instanceVariableReaders at: name ifAbsent: [#()]); addAll: (instanceVariableWriters at: name ifAbsent: [#()]). ^vars! ! !VariableEnvironment methodsFor: 'testing' stamp: ''! isEmpty self accessorMethods do: [:each | (self perform: each) isEmpty ifFalse: [^false]]. ^true! ! !VariableEnvironment methodsFor: 'printing' stamp: 'bh 4/29/2000 18:10'! logOrInspect Transcript cr; cr; show:self name. instanceVariables keysAndValuesDo: [:class :variables | variables do: [:variable | Transcript cr; show: ' ',class name asString , '->' , variable asString]]. classVariables keysAndValuesDo: [:class :variables | variables do: [:variable | Transcript cr; show: ' ',class name asString , ' (cvar) ' , variable asString]]. ! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! numberVariables ^self accessorMethods inject: 0 into: [:sum :each | sum + ((self perform: each) inject: 0 into: [:s :e | s + e size])]! ! !VariableEnvironment methodsFor: 'copying' stamp: ''! postCopy super postCopy. instanceVariables := self copyDictionary: instanceVariables. instanceVariableReaders := self copyDictionary: instanceVariableReaders. instanceVariableWriters := self copyDictionary: instanceVariableWriters. classVariables := self copyDictionary: classVariables. selectorCache := nil! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! problemCount ^self numberVariables! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! removeClass: aClass classVariable: aSymbol | vars | vars := classVariables at: aClass name ifAbsent: [Set new]. vars remove: aSymbol ifAbsent: []. vars isEmpty ifTrue: [classVariables removeKey: aClass name ifAbsent: []]. self flushCachesFor: aClass! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! removeClass: aClass instanceVariable: aString | vars | vars := instanceVariables at: aClass name ifAbsent: [Set new]. vars remove: aString ifAbsent: []. vars isEmpty ifTrue: [instanceVariables removeKey: aClass name ifAbsent: []]. self flushCachesFor: aClass! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! removeClass: aClass instanceVariableReader: aString | vars | vars := instanceVariableReaders at: aClass name ifAbsent: [Set new]. vars remove: aString ifAbsent: []. vars isEmpty ifTrue: [instanceVariableReaders removeKey: aClass name ifAbsent: []]. self flushCachesFor: aClass! ! !VariableEnvironment methodsFor: 'accessing' stamp: ''! removeClass: aClass instanceVariableWriter: aString | vars | vars := instanceVariableWriters at: aClass name ifAbsent: [Set new]. vars remove: aString ifAbsent: []. vars isEmpty ifTrue: [instanceVariableWriters removeKey: aClass name ifAbsent: []]. self flushCachesFor: aClass! ! !VariableEnvironment methodsFor: 'private' stamp: ''! selectorCache ^selectorCache isNil ifTrue: [selectorCache := Dictionary new] ifFalse: [selectorCache]! ! !VariableEnvironment methodsFor: 'private' stamp: ''! selectorCacheFor: aClass ^self selectorCache at: aClass ifAbsentPut: [self computeSelectorCacheFor: aClass]! ! !VariableEnvironment methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' new '. #(#instanceVariables #instanceVariableReaders #instanceVariableWriters #classVariables) do: [:each | aStream nextPutAll: each; nextPutAll: ': '. (self perform: each) storeOn: aStream. aStream nextPutAll: '; ']. aStream nextPutAll: ' yourself)'! ! Object subclass: #LintRule instanceVariableNames: 'name rationale' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! LintRule subclass: #BasicLintRule instanceVariableNames: 'result openSymbol' classVariableNames: 'FilterDictionary' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !BasicLintRule class methodsFor: 'accessing' stamp: ''! addFilter: anEnvironment for: aString self filterDictionary at: aString put: anEnvironment copy! ! !BasicLintRule class methodsFor: 'accessing' stamp: ''! filterDictionary ^FilterDictionary isNil ifTrue: [FilterDictionary := Dictionary new] ifFalse: [FilterDictionary]! ! !BasicLintRule class methodsFor: 'accessing' stamp: ''! filterDictionary: aDictionary FilterDictionary := aDictionary! ! !BasicLintRule class methodsFor: 'accessing' stamp: ''! filterFor: aName ^self filterDictionary at: aName ifAbsentPut: [SelectorEnvironment new]! ! !BasicLintRule class methodsFor: 'accessing' stamp: ''! protocols ^#('bugs' 'possible bugs' 'unnecessary code' 'intention revealing' 'miscellaneous')! ! !BasicLintRule class methodsFor: 'storing' stamp: ''! storeFiltersOn: aStream aStream nextPut: $(; nextPutAll: self name; nextPutAll: ' filterDictionary: (Dictionary new'. self filterDictionary keysAndValuesDo: [:key :value | aStream nextPutAll: ' at: '. key storeOn: aStream. aStream nextPutAll: ' put: '. value storeOn: aStream. aStream nextPutAll: ';'; cr]. aStream tab; nextPutAll: 'yourself))'! ! !BasicLintRule methodsFor: 'private' stamp: ''! defaultResultClass ^SelectorEnvironment! ! !BasicLintRule methodsFor: 'accessing' stamp: ''! filteredResult ^(result & (self class filterDictionary at: self name ifAbsent: [result copyEmpty]) copy not) label: result label; yourself! ! !BasicLintRule methodsFor: 'initialize-release' stamp: ''! initialize super initialize. openSymbol := #openWithFilters. self resultClass: self defaultResultClass! ! !BasicLintRule methodsFor: 'testing' stamp: ''! isEmpty ^self result isEmpty! ! !BasicLintRule methodsFor: 'initialize-release' stamp: ''! openUsing: aSymbol openSymbol := aSymbol! ! !BasicLintRule methodsFor: 'private' stamp: 'md 3/26/2007 12:18'! openWithFilters | | self needsWork. "browser := self filteredResult openEditor. navigator := browser navigator. filter := navigator environment andedEnvironment environment. (filter isClassEnvironment or: [filter isSelector]) ifTrue: [menuItem := MenuItem labeled: 'add filter for class'. menuItem value: [(BasicLintRule filterFor: self name) addClass: navigator selectedClass. filter addClass: navigator selectedClass. navigator updateCategoryList]. navigator classMenu value addItemGroup: (Array with: menuItem). navigator updateClassMenu]. filter isSelector ifTrue: [menuItem := MenuItem labeled: 'add filter for selector'. menuItem value: [(BasicLintRule filterFor: self name) addClass: navigator selectedClass selector: navigator selector. filter addClass: navigator selectedClass selector: navigator selector. navigator updateCategoryList]. navigator selectorMenu value addItemGroup: (Array with: menuItem). navigator updateSelectorMenu]. ^browser"! ! !BasicLintRule methodsFor: 'private' stamp: 'bh 5/9/2000 00:16'! openWithoutFilters ^self result openEditor! ! !BasicLintRule methodsFor: 'accessing' stamp: ''! problemCount ^self result problemCount! ! !BasicLintRule methodsFor: 'initialize-release' stamp: ''! resetResult result := result copyEmpty. result label: name! ! !BasicLintRule methodsFor: 'accessing' stamp: ''! result ^(self class filterDictionary includesKey: self name) ifTrue: [self filteredResult] ifFalse: [result]! ! !BasicLintRule methodsFor: 'initialize-release' stamp: ''! result: aResult result := aResult copyEmpty! ! !BasicLintRule methodsFor: 'initialize-release' stamp: ''! resultClass: aClass result := aClass new! ! !BasicLintRule methodsFor: 'private' stamp: 'bh 5/9/2000 00:16'! viewResults ^self perform: openSymbol! ! BasicLintRule subclass: #BlockLintRule instanceVariableNames: 'classBlock methodBlock' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !BlockLintRule class methodsFor: 'possible bugs' stamp: ''! abstractClass | detector subclassResponsibilitySymbol | detector := self new. detector name: 'References an abstract class'. detector resultClass: ClassEnvironment. subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol. detector classBlock: [:context :result | (context selectedClass whichSelectorsReferTo: subclassResponsibilitySymbol) isEmpty ifFalse: [(context uses: (Smalltalk associationAt: context selectedClass name ifAbsent: [nil])) ifTrue: [result addClass: context selectedClass]]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: ''! addRemoveDependents | detector | detector := self new. detector resultClass: ClassEnvironment. detector name: 'Number of addDependent: messages > removeDependent:'. detector classBlock: [:context :result | | count | count := 0. ((Set withAll: (context selectedClass whichSelectorsReferTo: #addDependent:)) addAll: (context selectedClass whichSelectorsReferTo: #removeDependent:); yourself) do: [:sel | (context selectedClass compiledMethodAt: sel) messagesDo: [:each | each == #addDependent: ifTrue: [count := count + 1]. each == #removeDependent: ifTrue: [count := count - 1]]]. count > 0 ifTrue: [result addClass: context selectedClass]]. ^detector! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: ''! badMessage | detector badMessages | detector := self new. detector name: 'Sends "questionable" message'. badMessages := self badSelectors. detector classBlock: [:context :result | | selectors | selectors := badMessages inject: Set new into: [:set :each | set addAll: (context selectedClass whichSelectorsReferTo: each); yourself]. selectors do: [:each | result addClass: context selectedClass selector: each]. selectors isEmpty ifFalse: [result searchStrings: badMessages]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! badSelectors ^#(#become: #isKindOf: #changeClassToThatOf: #respondsTo: #isMemberOf: #performMethod: #performMethod:arguments: #performMethod:with: #performMethod:with:with: #performMethod:with:with:with: #allOwners #allOwnersWeakly: #firstOwner #instVarAt: #instVarAt:put: #nextInstance #nextObject #ownerAfter: #primBecome: #halt)! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: ''! classInstVarNotInitialized | detector | detector := self new. detector name: 'Has class instance variables but no initialize method'. detector resultClass: ClassEnvironment. detector classBlock: [:context :result | | definesVar class | context selectedClass isMeta ifTrue: [class := context selectedClass. definesVar := false. [definesVar or: [class isNil or: [class isMeta not]]] whileFalse: [definesVar := class instVarNames isEmpty not. class := class superclass]. (definesVar and: [(context selectedClass includesSelector: #initialize) not]) ifTrue: [result addClass: context selectedClass]]]. ^detector! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: ''! classNameInSelector | detector | detector := self new. detector name: 'Redundant class name in selector'. detector methodBlock: [:context :result | (context selectedClass isMeta and: [(context selector indexOfSubCollection: context selectedClass soleInstance name startingAt: 1) > 0]) ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! classNotReferenced | detector | detector := self new. detector name: 'Class not referenced'. detector resultClass: ClassEnvironment. detector classBlock: [:context :result | (context selectedClass isMeta or: [context selectedClass subclasses isEmpty not]) ifFalse: [| assoc | assoc := Smalltalk associationAt: context selectedClass name. ((context uses: assoc) or: [context uses: context selectedClass name]) ifFalse: [result addClass: context selectedClass; addClass: context selectedClass class]]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! classShouldNotOverride ^#(#== #class)! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: ''! collectionCopyEmpty | detector | detector := self new. detector name: 'Subclass of collection that has instance variable but doesn''t define copyEmpty'. detector resultClass: ClassEnvironment. detector classBlock: [:context :result | (context selectedClass isVariable and: [(context selectedClass includesSelector: #copyEmpty:) not and: [context selectedClass instVarNames isEmpty not and: [context selectedClass inheritsFrom: Collection]]]) ifTrue: [result addClass: context selectedClass]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'nk 2/25/2005 11:37'! definesEqualNotHash | detector | detector := self new. detector name: 'Defines = but not hash'. detector rationale: 'If objects of a class redefine equality, then to work properly in hashed collections like Sets or Dictionaries they must also have a hash method that returns equal hashes for each pair of objects for which = returns true.'. detector resultClass: ClassEnvironment. detector classBlock: [:context :result | ((context selectedClass includesSelector: #=) and: [(context selectedClass includesSelector: #hash) not]) ifTrue: [result addClass: context selectedClass]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! doesLiteralArrayContainComma: aLiteral aLiteral class == Array ifFalse: [^false]. (aLiteral includes: #,) ifTrue: [^true]. ^aLiteral inject: false into: [:sum :each | sum or: [self doesLiteralArrayContainComma: each]]! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! equivalentSuperclassMethods | detector | detector := self new. detector name: 'Methods equivalently defined in superclass'. detector methodBlock: [:context :result | context selectedClass superclass notNil ifTrue: [(context selectedClass superclass canUnderstand: context selector) ifTrue: [(((context selectedClass superclass whichClassIncludesSelector: context selector) compiledMethodAt: context selector) equivalentTo: context compiledMethod) ifTrue: [result addClass: context selectedClass selector: context selector]]]]. ^detector! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! implementedNotSent | detector | detector := self new. detector name: 'Methods implemented but not sent'. detector methodBlock: [:context :result | (context uses: context selector) ifFalse: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: ''! instVarInSubclasses | detector | detector := self new. detector name: 'Instance variables defined in all subclasses'; resultClass: VariableEnvironment; openUsing: #openWithoutFilters. detector classBlock: [:context :result | | subs | subs := context selectedClass subclasses. subs size > 1 ifTrue: [| sels | sels := Bag new. subs do: [:each | sels addAll: each instVarNames]. sels asSet do: [:val | | count | count := sels occurrencesOf: val. count == subs size ifTrue: [result addClass: context selectedClass instanceVariable: val]]]]. ^detector! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! justSendsSuper | detector matcher | detector := self new. detector name: 'Method just sends super message'. matcher := ParseTreeSearcher justSendsSuper. detector methodBlock: [:context :result | (context parseTree isPrimitive not and: [matcher executeMethod: context parseTree initialAnswer: false]) ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'md 8/2/2005 23:20'! literalArrayContainsComma | detector | detector := self new. detector name: 'Literal array contains a #,'. detector methodBlock: [:context :result | (context compiledMethod allLiterals inject: false into: [:sum :each | sum or: [self doesLiteralArrayContainComma: each]]) ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'md 8/2/2005 23:20'! literalArrayContainsSuspiciousTrueFalseOrNil | detector searcher | detector := self new. detector name: 'Literal array contains a #true, #false, or #nil but the source doesn''t.'. detector rationale: 'With ANSI changes, #(true false nil) now is equal to {true. false. nil} not {#true. #false. #nil} as it used to be. This may be a bug.'. searcher := ParseTreeSearcher new. searcher matches: '`{ :n | n isLiteral and: [ n token realValue isKindOf: Array ] }' do: [:aNode :answer | answer addAll: (self literalTrueFalseOrNilSymbolsIn: aNode token realValue); yourself]. detector methodBlock: [:context :result | | compiledLits parsedLits | compiledLits := self literalTrueFalseOrNilSymbolsIn: context compiledMethod allLiterals. compiledLits size > 0 ifTrue: [parsedLits := OrderedCollection new. searcher executeTree: context parseTree initialAnswer: parsedLits. compiledLits size ~= parsedLits size ifTrue: [ result addClass: context selectedClass selector: context selector]]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: 'nk 3/4/2005 16:32'! literalTrueFalseOrNilSymbolsIn: aLiteral | retval | aLiteral class == Array ifFalse: [^#()]. retval := OrderedCollection withAll: (aLiteral select: [:ea | ea isSymbol and: [#(#true #false #nil ) includes: ea]]). aLiteral do: [ :each | retval addAll: (self literalTrueFalseOrNilSymbolsIn: each) ]. ^retval.! ! !BlockLintRule class methodsFor: 'private' stamp: ''! longMethodSize ^10! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: 'bh 3/16/2000 12:06'! longMethods | detector matcher | detector := self new. detector name: 'Long methods'. matcher := ParseTreeSearcher new. matcher matches: '`.Stmt' do: [:aNode :answer | (aNode children inject: answer into: [:sum :each | matcher executeTree: each initialAnswer: sum]) + 1]. detector methodBlock: [:context :result | (matcher executeTree: context parseTree initialAnswer: 0) >= self longMethodSize ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! metaclassShouldNotOverride ^#(#name #comment)! ! !BlockLintRule class methodsFor: 'squeak bugs' stamp: 'nk 2/26/2005 10:05'! methodHasNoTimeStamp | detector | detector := self new. detector name: 'Method has no timeStamp'. detector rationale: 'For proper versioning, every method should have a timestamp.'. detector methodBlock: [:context :result | context compiledMethod timeStamp isEmpty ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'squeak bugs' stamp: 'nk 2/26/2005 10:19'! methodSourceContainsLinefeeds | detector | detector := self new. detector name: 'Method source contains linefeeds'. detector rationale: 'Squeak code should not contain linefeed characters.'. detector methodBlock: [:context :result | (context sourceCode includes: Character lf) ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'intention revealing' stamp: ''! missingSubclassResponsibility | detector | detector := self new. detector name: 'Method defined in all subclasses, but not in superclass'; resultClass: MultiEnvironment; openUsing: #openWithoutFilters. detector classBlock: [:context :result | | subs | subs := context selectedClass subclasses. subs size > 1 & context selectedClass isMeta not ifTrue: [| sels | sels := Bag new. subs do: [:each | sels addAll: each selectors]. sels asSet do: [:each | ((sels occurrencesOf: each) == subs size and: [(context selectedClass canUnderstand: each) not]) ifTrue: [| envName | envName := context selectedClass name , '>>' , each. subs do: [:subClass | result addClass: subClass selector: each into: envName]]]]]. ^detector! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! onlyReadOrWritten | detector | detector := self new. detector name: 'Instance variables not read AND written'; resultClass: VariableEnvironment; openUsing: #openWithoutFilters. detector classBlock: [:context :result | | allSubclasses | allSubclasses := context selectedClass withAllSubclasses. context selectedClass instVarNames do: [:each | | isRead isWritten | isRead := false. isWritten := false. allSubclasses detect: [:class | isRead ifFalse: [isRead := (class whichSelectorsRead: each) isEmpty not]. isWritten ifFalse: [isWritten := (class whichSelectorsAssign: each) isEmpty not]. isRead & isWritten] ifNone: [result addClass: context selectedClass instanceVariable: each]]]. ^detector! ! !BlockLintRule class methodsFor: 'bugs' stamp: ''! overridesSpecialMessage | detector | detector := self new. detector name: 'Overrides a "special" message'. detector resultClass: ClassEnvironment. detector classBlock: [:context :result | ((context selectedClass isMeta ifTrue: [self metaclassShouldNotOverride] ifFalse: [self classShouldNotOverride]) detect: [:each | context selectedClass superclass notNil and: [(context selectedClass superclass canUnderstand: each) and: [context selectedClass includesSelector: each]]] ifNone: [nil]) notNil ifTrue: [result addClass: context selectedClass]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'nk 7/30/2004 12:18'! overridesSuper | detector definer superMethod | detector := self new. detector name: 'Overrides super method without calling it'. detector methodBlock: [:context :result | (context selectedClass isMeta not and: [true "self superMessages includes: context selector"]) ifTrue: [ definer := context selectedClass superclass ifNotNilDo: [ :sc | sc whichClassIncludesSelector: context selector ]. definer ifNotNil: [ "super defines same method" (context superMessages includes: context selector) ifFalse: [ "but I don't call it" superMethod := (definer compiledMethodAt: context selector ifAbsent: []). (superMethod isReturnSelf or: [ superMethod sendsSelector: #subclassResponsibility ]) ifFalse: [result addClass: context selectedClass selector: context selector] ]]]]. ^detector ! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: ''! refersToClass | detector | detector := self new. detector name: 'Refers to class name instead of "self class"'. detector classBlock: [:context :result | | sels className | className := (context selectedClass isMeta ifTrue: [context selectedClass soleInstance] ifFalse: [context selectedClass]) name. sels := context selectedClass whichSelectorsReferTo: (Smalltalk associationAt: className). sels do: [:each | result addClass: context selectedClass selector: each]. sels isEmpty ifFalse: [result addSearchString: className]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'bh 4/2/2000 22:09'! returnsBooleanAndOther | detector matcher | detector := self new. detector name: 'Returns a boolean and non boolean'. matcher := ParseTreeSearcher new. matcher matches: '^``@xObject' do: [:aNode :answer | answer add: aNode value; yourself]. detector methodBlock: [:context :result | | hasBool hasSelf | hasBool := false. hasSelf := context parseTree lastIsReturn not. (matcher executeTree: context parseTree initialAnswer: Set new) do: [:each | hasBool := hasBool or: [(each isLiteral and: [{true. false} includes: each value]) or: [each isMessage and: [#(#and: #or:) includes: each selector]]]. hasSelf := hasSelf or: [(each isVariable and: [each name = 'self']) or: [each isLiteral and: [({true. false} includes: each value) not]]]]. hasSelf & hasBool ifTrue: [result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: ''! sendsDifferentSuper | detector | detector := self new. detector name: 'Sends different super message'. detector methodBlock: [:context :result | | message | (message := context superMessages detect: [:each | each ~= context selector] ifNone: [nil]) notNil ifTrue: [result addSearchString: message. result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'bugs' stamp: ''! sentNotImplemented | detector | detector := self new. detector name: 'Messages sent but not implemented'. detector methodBlock: [:context :result | | message | message := context messages detect: [:each | (context implements: each) not] ifNone: [nil]. message isNil ifTrue: [message := context superMessages detect: [:each | context selectedClass superclass isNil or: [(context selectedClass superclass canUnderstand: each) not]] ifNone: [nil]. message isNil ifTrue: [message := context selfMessages detect: [:each | (context selectedClass canUnderstand: each) not] ifNone: [nil]]]. message notNil ifTrue: [result addSearchString: message. result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! subclassOf: aClass overrides: aSelector ^(aClass subclasses detect: [:each | (each includesSelector: aSelector) or: [self subclassOf: each overrides: aSelector]] ifNone: [nil]) notNil! ! !BlockLintRule class methodsFor: 'bugs' stamp: ''! subclassResponsibilityNotDefined | detector subclassResponsibilitySymbol | detector := self new. detector name: 'Subclass responsibility not defined'. subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol. detector classBlock: [:context :result | (context selectedClass whichSelectorsReferTo: subclassResponsibilitySymbol) do: [:each | (context selectedClass withAllSubclasses detect: [:class | class subclasses isEmpty and: [(class whichClassIncludesSelector: each) == context selectedClass]] ifNone: [nil]) notNil ifTrue: [result addClass: context selectedClass selector: each]]]. ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! superMessages ^#(#release #postCopy #postBuildWith: #preBuildWith: #postOpenWith: #noticeOfWindowClose: #initialize)! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'nk 7/30/2004 12:20'! superSends | detector definer superMethod | detector := self new. detector name: 'Missing super sends in selected methods.'. detector methodBlock: [:context :result | (context selectedClass isMeta not and: [ self superMessages includes: context selector ]) ifTrue: [ definer := context selectedClass superclass ifNotNilDo: [ :sc | sc whichClassIncludesSelector: context selector ]. definer ifNotNil: [ "super defines same method" (context superMessages includes: context selector) ifFalse: [ "but I don't call it" superMethod := (definer compiledMethodAt: context selector ifAbsent: []). (superMethod isReturnSelf or: [ superMethod sendsSelector: #subclassResponsibility ]) ifFalse: [result addClass: context selectedClass selector: context selector] ]]]]. ^detector ! ! !BlockLintRule class methodsFor: 'squeak bugs' stamp: 'nk 7/30/2004 11:44'! superSendsNew | detector matcher | detector := self new. detector name: 'Sends super new initialize'. matcher := ParseTreeSearcher new. matcher matchesAnyOf: #('super new initialize' '(super new: `@expr) initialize' 'self new initialize' '(self new: `@expr) initialize') do: [ :aNode :answer | answer + 1 ]. detector methodBlock: [:context :result | context selectedClass isMeta ifTrue: [ (matcher executeTree: context parseTree initialAnswer: 0) > 0 ifTrue: [ result addClass: context selectedClass selector: context selector]]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: ''! tempVarOverridesInstVar | detector matcher vars varName | detector := self new. detector name: 'Instance variable overridden by temporary variable'. matcher := (ParseTreeSearcher new) matchesArgument: '`xxxvar' do: [:aNode :answer | answer or: [varName := aNode name. vars includes: varName]]; yourself. detector methodBlock: [:context :result | vars := context instVarNames. (matcher executeTree: context parseTree initialAnswer: false) ifTrue: [result addClass: context selectedClass selector: context selector. result addSearchString: varName]]. ^detector! ! !BlockLintRule class methodsFor: 'possible bugs' stamp: 'bh 3/16/2000 12:07'! tempsReadBeforeWritten | detector | detector := self new. detector name: 'Temporaries read before written'. detector methodBlock: [:context :result | (RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: context parseTree) do: [:each | result addClass: context selectedClass selector: context selector. result addSearchString: each]]. ^detector! ! !BlockLintRule class methodsFor: 'bugs' stamp: ''! undeclaredReference | detector | detector := self new. detector name: 'References an undeclared variable'. detector methodBlock: [:context :result | | undeclared | undeclared := Undeclared associations detect: [:each | (context uses: each) and: [context compiledMethod refersToLiteral: each]] ifNone: [nil]. undeclared notNil ifTrue: [result addSearchString: undeclared key. result addClass: context selectedClass selector: context selector]]. ^detector! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! unreferencedVariables | detector | detector := self new. detector name: 'Variables not referenced'; resultClass: VariableEnvironment; openUsing: #openWithoutFilters. detector classBlock: [:context :result | | allSubclasses | allSubclasses := context selectedClass withAllSubclasses. context selectedClass instVarNames do: [:each | allSubclasses detect: [:class | (class whichSelectorsAccess: each) isEmpty not] ifNone: [result addClass: context selectedClass instanceVariable: each]]. context selectedClass isMeta ifFalse: [context selectedClass classPool associationsDo: [:each | (context uses: each) ifFalse: [result addClass: context selectedClass classVariable: each key]]]]. ^detector! ! !BlockLintRule class methodsFor: 'bugs' stamp: ''! usesTrue | detector trueBinding falseBinding | detector := self new. trueBinding := Smalltalk associationAt: #True. falseBinding := Smalltalk associationAt: #False. detector name: 'Uses True/False instead of true/false'. detector methodBlock: [:context :result | | method | method := context compiledMethod. ((method refersToLiteral: trueBinding) or: [method refersToLiteral: falseBinding]) ifTrue: [result addClass: context selectedClass selector: context selector. result searchStrings: #('True' 'False')]]. ^detector! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: 'bh 4/29/2000 23:31'! utilityMethods | detector | detector := self new. detector name: 'Utility methods'. self needsWork. " detector methodBlock: [:context :result | (context selectedClass isMeta | (context selector numArgs == 0) or: [(context protocols detect: [:each | (self utilityProtocols detect: [:protocol | protocol match: each] ifNone: [nil]) notNil] ifNone: [nil]) notNil]) ifFalse: [(self subclassOf: context selectedClass overrides: context selector) ifFalse: [(context superMessages isEmpty and: [context selfMessages isEmpty]) ifTrue: [(context selectedClass allInstVarNames , context selectedClass allClassVarNames asArray , #('self') detect: [:each | context parseTree references: each] ifNone: [nil]) isNil ifTrue: [result addClass: context selectedClass selector: context selector]]]]]." ^detector! ! !BlockLintRule class methodsFor: 'private' stamp: ''! utilityProtocols "If a method is defined in one of these protocols, then don't check if its a utility method." ^#('*utilit*')! ! !BlockLintRule class methodsFor: 'miscellaneous' stamp: ''! variableAssignedLiteral | detector | detector := self new. detector name: 'Variable is only assigned a single literal value'; resultClass: VariableEnvironment; openUsing: #openWithoutFilters. detector classBlock: [:context :result | | allSubclasses | allSubclasses := context selectedClass withAllSubclasses. context selectedClass instVarNames do: [:each | | defClass selector | (allSubclasses inject: 0 into: [:sum :class | | sels | sels := class whichSelectorsAssign: each. sels size == 1 ifTrue: [selector := sels asArray first. defClass := class]. sum + sels size]) == 1 ifTrue: [| tree searcher | searcher := ParseTreeSearcher new. searcher matches: each , ' := ``@object' do: [:aNode :answer | answer isNil and: [aNode value isLiteral]]. tree := defClass parseTreeFor: selector. tree notNil ifTrue: [(searcher executeTree: tree initialAnswer: nil) == true ifTrue: [result addClass: context selectedClass instanceVariable: each]]]]]. ^detector! ! !BlockLintRule class methodsFor: 'bugs' stamp: 'bh 5/1/2000 16:56'! variableNotDefined | detector | detector := self new. detector name: 'Variable used, but not defined anywhere'. self needsWork. " detector methodBlock: [:context :result | context compiledMethod withAllBlockMethodsDo: [:each | each literalsDo: [:lit | lit isVariableBinding ifTrue: [((Smalltalk associationAt: lit key ifAbsent: []) == lit or: [(Undeclared associationAt: lit key ifAbsent: []) == lit]) ifFalse: [(context selectedClass fullBindingFor: lit key) == lit ifFalse: [result addClass: context selectedClass selector: context selector. result addSearchString: lit key]]]]]]." ^ detector ! ! !BlockLintRule class methodsFor: 'unnecessary code' stamp: ''! variableReferencedOnce | detector | detector := self new. detector name: 'Variable referenced in only one method and always assigned first'. detector classBlock: [:context :result | | allSubclasses | allSubclasses := context selectedClass withAllSubclasses. context selectedClass instVarNames do: [:each | | defClass selector | (allSubclasses inject: 0 into: [:sum :class | | sels | sels := class whichSelectorsAccess: each. sels size == 1 ifTrue: [selector := sels asArray first. defClass := class]. sum + sels size]) == 1 ifTrue: [| tree | tree := defClass parseTreeFor: selector. tree notNil ifTrue: [(RBReadBeforeWrittenTester isVariable: each writtenBeforeReadIn: tree) ifTrue: [result addClass: defClass selector: selector. result addSearchString: each]]]]]. ^detector! ! !BlockLintRule methodsFor: 'accessing' stamp: ''! checkClass: aSmalllintContext ^classBlock value: aSmalllintContext value: result! ! !BlockLintRule methodsFor: 'accessing' stamp: ''! checkMethod: aSmalllintContext ^methodBlock value: aSmalllintContext value: result! ! !BlockLintRule methodsFor: 'initialize-release' stamp: ''! classBlock: aBlock classBlock := aBlock! ! !BlockLintRule methodsFor: 'initialize-release' stamp: ''! initialize super initialize. classBlock := [:context :aResult | ]. methodBlock := [:context :aResult | ]! ! !BlockLintRule methodsFor: 'initialize-release' stamp: ''! methodBlock: aBlock methodBlock := aBlock! ! BasicLintRule subclass: #ParseTreeLintRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! asOrderedCollectionNotNeeded ^self createParseTreeRule: #('`@node addAll: `{:node | node isMessage and: [#(asOrderedCollection asArray) includes: node selector]}') name: '#asOrderedCollection/#asArray not needed'! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! assignmentInBlock ^self createParseTreeRule: #( '`@cursor showWhile: [| `@temps | `@.Statements1. `var := `@object]' '`@cursor showWhile: [| `@temps | `@.Statements1. ^`@object]' '[| `@temps | `@.Statements. `var := `@object] valueNowOrOnUnwindDo: `@block' '[| `@temps | `@.Statements. ^`@object] valueNowOrOnUnwindDo: `@block' '[| `@temps | `@.Statements. `var := `@object] valueOnUnwindDo: `@block' '[| `@temps | `@.Statements. ^`@object] valueOnUnwindDo: `@block' '[| `@temps | `@.Statements. `var := `@object] ensure: `@block' '[| `@temps | `@.Statements. ^`@object] ensure: `@block' '[| `@temps | `@.Statements. `var := `@object] ifCurtailed: `@block' '[| `@temps | `@.Statements. ^`@object] ifCurtailed: `@block' ) name: 'Unnecessary assignment or return in block'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! assignmentInIfTrue ^self createParseTreeRule: #('`@boolean ifTrue: [| `@temps1 | `@.Statements1. `var := `@object1] ifFalse: [| `@temps2 | `@.Statements2. `var := `@object2]' '`@boolean ifFalse: [| `@temps1 | `@.Statements1. `var := `@object1] ifTrue: [| `@temps2 | `@.Statements2. `var := `@object2]') name: 'Assignment to same variable and end of ifTrue:ifFalse: blocks'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! atIfAbsent ^self createParseTreeRule: #('`@object at: `@atArg ifAbsent: [| `@temps | `@.Statements. `@object at: `@atArg put: `@putArg]' '`@object at: `@atArg ifAbsent: [| `@temps | `@.Statements. `@object at: `@atArg put: `@putArg. `@.xStatements1. `@putArg]') name: 'Uses at:ifAbsent: instead of at:ifAbsentPut:'! ! !ParseTreeLintRule class methodsFor: 'bugs' stamp: ''! booleanPrecedence ^self createParseTreeRule: #('`@object1 | `@object2 = `@object3' '`@object1 | `@object2 == `@object3' '`@object1 & `@object2 = `@object3' '`@object1 & `@object2 == `@object3' '`@object1 | `@object2 ~= `@object3' '`@object1 | `@object2 ~~ `@object3' '`@object1 & `@object2 ~= `@object3' '`@object1 & `@object2 ~~ `@object3') name: 'Uses A | B = C instead of A | (B = C)'! ! !ParseTreeLintRule class methodsFor: 'squeak bugs' stamp: 'nk 3/4/2005 17:20'! codeCruftLeftInMethods ^(self createParseTreeRule: { '`@whatever doOnlyOnce: `@stuff'. 'Transcript `@msg: `@args'. '`@any halt'. 'true ifTrue: `@stuff'. '`@any flag: `#lit'. '`@any needsWork'. } name: 'Debugging code left in methods') rationale: 'Halts, Transcript writes, doOnlyOnce:, etc. should not be left in production code.'; yourself! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! collectSelectNotUsed ^self createParseTreeRule: #('`{:node | node isMessage and: [(#(#select: #collect: #reject:) includes: node selector) and: [node isUsed not]]}') name: 'Doesn''t use the result of a collect:/select:'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! collectionMessagesToExternalObject | detector matcher | detector := self new. detector name: 'Sends add:/remove: to external collection'. matcher := ParseTreeSearcher new. matcher matchesAnyOf: (#(#add: #remove: #addAll: #removeAll:) collect: [:each | ('(`@Object `@message: `@args) <1s> `@Arg' expandMacrosWith: each) asString]) do: [:aNode :answer | answer isNil ifTrue: [((aNode receiver selector copyFrom: 1 to: (aNode receiver selector size min: 2)) ~= 'as' and: [| receiver | receiver := aNode receiver receiver. receiver isVariable not or: [((#('self' 'super') includes: receiver name) or: [Smalltalk includesKey: receiver name asSymbol]) not]]) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! collectionProtocol ^self createParseTreeRule: #('`@collection do: [:`each | | `@temps | `@.Statements1. `@object add: `@arg. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@blockTemps | `@.BlockStatements1. `@object add: `each. `@.BlockStatements2]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@blockTemps | `@.BlockStatements1. `@object add: `each. `@.BlockStatements2]. `@.Statements2]') name: 'Uses do: instead of collect: or select:''s'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! consistencyCheck ^self createParseTreeRule: #('`@object size == 0' '`@object size = 0' '`@object size > 0' '`@object size >= 1' '`@object == nil' '`@object = nil' '`@collection at: 1' '`@collection at: `@collection size') name: 'Uses "size = 0", "= nil", or "at: 1" instead of "isEmpty", "isNil", or "first"'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! contains ^self createParseTreeRule: #('(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) isNil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) notNil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) = nil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) == nil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) ~= nil' '(`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [nil]) ~~ nil' '`@object detect: [:`each | | `@temps| `@.Statements] ifNone: [| `@temps1 | `@.Statements2. ^`@anything]') name: 'Uses detect:ifNone: instead of contains:'! ! !ParseTreeLintRule class methodsFor: 'private' stamp: ''! createMatcherFor: codeStrings method: aBoolean | matcher | matcher := ParseTreeSearcher new. aBoolean ifTrue: [matcher matchesAnyMethodOf: codeStrings do: [:aNode :answer | aNode]] ifFalse: [matcher matchesAnyOf: codeStrings do: [:aNode :answer | aNode]]. ^matcher! ! !ParseTreeLintRule class methodsFor: 'instance creation' stamp: ''! createParseTreeRule: codeStrings method: aBoolean name: aName ^(self new) name: aName; matcher: (self createMatcherFor: codeStrings method: aBoolean); yourself! ! !ParseTreeLintRule class methodsFor: 'instance creation' stamp: ''! createParseTreeRule: codeStrings name: aName ^self createParseTreeRule: codeStrings method: false name: aName! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! detectContains ^self createParseTreeRule: #('`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^`each]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1. ^`each]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^true]. `@.Statements2]' '`@Collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1. ^true]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifFalse: [| `@BlockTemps | `@.BlockStatements1. ^false]. `@.Statements2]' '`@collection do: [:`each | | `@temps | `@.Statements1. `@condition ifTrue: [| `@BlockTemps | `@.BlockStatements1. ^false]. `@.Statements2]') name: 'Uses do: instead of contains: or detect:''s'! ! !ParseTreeLintRule class methodsFor: 'unnecessary code' stamp: ''! endTrueFalse | detector matcher | detector := self new. detector name: 'Check for same statements at end of ifTrue:ifFalse: blocks'. matcher := (ParseTreeSearcher new) matchesAnyOf: #('`@object ifTrue: [| `@temps1 | `@.Statements1. `.Statement] ifFalse: [| `@temps2 | `@.Statements2. `.Statement]' '`@object ifTrue: [| `@temps1 | `.Statement. `@.Statements1] ifFalse: [| `@temps2 | `.Statement. `@.Statements2]' '`@object ifFalse: [| `@temps1 | `@.Statements1. `.Statement] ifTrue: [| `@temps2 | `@.Statements2. `.Statement]' '`@object ifFalse: [| `@temps1 | `.Statement. `@.Statements1] ifTrue: [| `@temps2 | `.Statement. `@.Statement2]') do: [:aNode :answer | answer isNil ifTrue: [| node | node := aNode arguments first body statements last. (node isVariable and: [node = aNode arguments last body statements last]) ifTrue: [nil] ifFalse: [aNode]] ifFalse: [answer]]; yourself. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! equalNotUsed ^self createParseTreeRule: #('`{:node | node isMessage and: [node isUsed not and: [#(#= #== #~= #~~ #< #> #<= #>=) includes: node selector]]}') name: 'Doesn''t use the result of a =, ~=, etc.'! ! !ParseTreeLintRule class methodsFor: 'unnecessary code' stamp: ''! equalsTrue | detector matcher | detector := self new. detector name: 'Unnecessary "= true"'. matcher := (ParseTreeSearcher new) matchesAnyOf: #('true' 'false') do: [:aNode :answer | answer isNil ifTrue: [(aNode parent isMessage and: [#(#= #== #~= #~~) includes: aNode parent selector]) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]; yourself. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'unnecessary code' stamp: ''! extraBlock ^self createParseTreeRule: #('`{:node | node isMessage and: [node receiver isBlock and: [node parent isCascade not and: [#(#value #value: #value:value: #value:value:value: #valueWithArguments) includes: node selector]]]}') name: 'Block immediately evaluated'! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! fileBlocks ^self createParseTreeRule: #('[| `@temps | `var := `@object. `@.statements] valueNowOrOnUnwindDo: [`var `@messages: `@args]' '[| `@temps | `var := `@object. `@.statements] valueOnUnwindDo: [`var `@messages: `@args]' '[| `@temps | `var := `@object. `@.statements] ensure: [`var `@messages: `@args]' '[| `@temps | `var := `@object. `@.statements] ifCurtailed: [`var `@messages: `@args]') name: 'Assignment inside unwind blocks should be outside.'! ! !ParseTreeLintRule class methodsFor: 'private' stamp: 'nk 7/30/2004 09:55'! genericPatternForSelector: sel " ParseTreeLintRule genericPatternForSelector: #a ParseTreeLintRule genericPatternForSelector: #a:b:c: " ^String streamContents: [ :s | sel keywords withIndexDo: [ :k :i | s space; nextPutAll: k. (k last = $:) ifTrue: [ s space; nextPutAll: '`@object'; print: i ]]]! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! guardingClause | detector matcher | detector := self new. detector name: 'Guarding clauses'. matcher := ParseTreeSearcher new. matcher matchesAnyMethodOf: #('`@MethodName: `@args | `@temps | `@.Statements. `@condition ifTrue: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' '`@MethodName: `@args | `@temps | `@.Statements. `@condition ifFalse: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]') do: [:aNode :answer | answer isNil ifTrue: [aNode body statements last] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! ifTrueBlocks ^self createParseTreeRule: #( '`@condition ifTrue: `{:node | node isBlock not} ifFalse: `@block' '`@condition ifTrue: `@block ifFalse: `{:node | node isBlock not}' '`@condition ifFalse: `{:node | node isBlock not} ifTrue: `@block' '`@condition ifFalse: `@block ifTrue: `{:node | node isBlock not}' '`@condition ifTrue: `{:node | node isBlock not}' '`@condition ifFalse: `{:node | node isBlock not}') name: 'Non-blocks in ifTrue:/ifFalse: messages'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: 'bh 4/2/2000 22:14'! ifTrueReturns | detector matcher | detector := self new. detector name: 'ifTrue:/ifFalse: returns instead of and:/or:''s'. matcher := ParseTreeSearcher new. matcher matchesAnyOf: #('| `@temps | ``@.Statements. ``@object ifTrue: [^``@value1]. ^``@value2' '| `@temps | ``@.Statements. ``@object ifFalse: [^``@value1]. ^``@value2') do: [:aNode :answer | answer isNil ifTrue: [| node | node := (aNode statements at: aNode statements size - 1) arguments first body statements last value. "``@value1" ((node isLiteral and: [{true. false} includes: node value]) or: [node := aNode statements last value. node isLiteral and: [{true. false} includes: node value]]) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'private' stamp: ''! isArrayOfCharacters: anArray anArray isEmpty ifTrue: [^false]. 1 to: anArray size do: [:each | (anArray at: each) class == Character ifFalse: [^false]]. ^true! ! !ParseTreeLintRule class methodsFor: 'private' stamp: ''! isSearchingLiteralExpression: aMessageNode | equalNode expressionNode | equalNode := aMessageNode selector = #| ifTrue: [aMessageNode arguments first] ifFalse: [aMessageNode receiver]. expressionNode := equalNode receiver isLiteral ifTrue: [equalNode arguments first] ifFalse: [equalNode receiver]. ^self isSearchingLiteralExpression: aMessageNode for: expressionNode! ! !ParseTreeLintRule class methodsFor: 'private' stamp: ''! isSearchingLiteralExpression: aSearchingNode for: anObjectNode | argument arguments | aSearchingNode isMessage ifFalse: [^false]. arguments := aSearchingNode arguments. arguments size = 1 ifFalse: [^false]. argument := arguments first. (#(#= #==) includes: aSearchingNode selector) ifTrue: [^(aSearchingNode receiver = anObjectNode and: [aSearchingNode arguments first isLiteral]) or: [aSearchingNode arguments first = anObjectNode and: [aSearchingNode receiver isLiteral]]]. aSearchingNode selector = #| ifTrue: [^(self isSearchingLiteralExpression: aSearchingNode receiver for: anObjectNode) and: [self isSearchingLiteralExpression: argument for: anObjectNode]]. aSearchingNode selector = #or: ifFalse: [^false]. argument isBlock ifFalse: [^false]. argument body statements size = 1 ifFalse: [^false]. ^(self isSearchingLiteralExpression: aSearchingNode receiver for: anObjectNode) and: [self isSearchingLiteralExpression: argument body statements first for: anObjectNode]! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! literalArrayCharacters | detector matcher | detector := self new. detector name: 'Literal array contains only characters'. matcher := ParseTreeSearcher new. matcher matches: '`#literal' do: [:aNode :answer | answer isNil ifTrue: [(aNode value class == Array and: [self isArrayOfCharacters: aNode value]) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! minMax | detector matcher | detector := self new. detector name: 'Uses ifTrue:/ifFalse: instead of min: or max:'. matcher := ParseTreeSearcher new. matcher matchesAnyOf: #('(`x `message: `@y) `ifTrue: [`x := `@y]' '(`@x `message: `@y) `ifTrue: [`@x] `ifFalse: [`@y]' '(`@x `message: `@y) `ifTrue: [`v := `@x] `ifFalse: [`v := `@y]') do: [:aNode :answer | answer isNil ifTrue: [((#(#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:) includes: aNode selector) and: [#(#< #<= #> #>=) includes: aNode receiver selector]) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'squeak bugs' stamp: 'nk 3/4/2005 17:46'! missingTranslationsInMenus ^(self createParseTreeRule: { '`@menu add: `#label action: `#sym'. '`@menu add: `#label selector: `#sym arguments: `@stuff'. '`@menu add: `#label subMenu: `@stuff'. '`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args'. '`@menu add: `#label target: `@targ action: `#sel'. '`@menu add: `#label target: `@targ selector `#sel'. '`@menu add: `#label target: `@targ selector `#sel argument: `@arg'. '`@menu add: `#label target: `@targ selector `#sel arguments: `@arg'. '`@menu addList: `{ :n | n isLiteral and: [ n token realValue anySatisfy: [ :row | (row isKindOf: Array) and: [ row first isLiteral ]]] }'. '`@menu addTitle: `#label'. '`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ'. '`@menu addWithLabel: `#label enablement: `#esel action: `#sel'. '`@menu addWithLabel: `#label enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args'. '`@menu balloonTextForLastItem: `#label'. '`@menu labels: `#lit lines: `@lines selections: `@sels'. '`@menu title: `#title' } name: 'Menus missing translations') rationale: 'Literal strings shown to users in menus should be translated.'; yourself! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: 'bh 4/2/2000 22:17'! missingYourself ^self createParseTreeRule: #('`{:node | node isMessage and: [node parent isCascade and: [node isDirectlyUsed and: [node selector ~~ #yourself]]]}') name: 'Possible missing "; yourself"'! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! modifiesCollection | detector matcher | detector := self new. detector name: 'Modifies collection while iterating over it'. matcher := (ParseTreeSearcher new) matchesAnyOf: #('`@object do: [:`each | | `@temps | ``@.Statements]' '`@object collect: [:`each | | `@temps | ``@.Statements]' '`@object select: [:`each | | `@temps | ``@.Statements]' '`@object reject: [:`each | | `@temps | ``@.Statements]' '`@object inject: `@value into: [:`sum :`each | | `@temps | ``@.Statements]') do: [:aNode :answer | answer isNil ifTrue: [(self modifiesTree: aNode receiver in: aNode arguments last) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]; yourself. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'private' stamp: ''! modifiesTree: aCollectionTree in: aParseTree | notifier args | notifier := ParseTreeSearcher new. args := Array with: (RBVariableNode named: '`@object'). notifier matchesAnyTreeOf: (#(#add: #addAll: #remove: #removeAll:) collect: [:each | RBMessageNode receiver: aCollectionTree selector: each arguments: args]) do: [:aNode :answer | true]. ^notifier executeTree: aParseTree initialAnswer: false! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! precedence ^self createParseTreeRule: #('`{:node | node isMessage and: [node hasParentheses not and: [#(#+ #-) includes: node selector]]} * `@C') name: 'Inspect instances of "A + B * C" might be "A + (B * C)"'! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! returnInEnsure | detector matcher returnMatcher | detector := self new. detector name: 'Contains a return in an ensure: block'. returnMatcher := ParseTreeSearcher new. returnMatcher matches: '^`@object' do: [:aNode :answer | true]. matcher := ParseTreeSearcher new. matcher matchesAnyOf: #('``@rcv ensure: [| `@temps | ``@.Stmts]' '``@rcv valueNowOrOnUnwindDo: [| `@temps | ``@.Stmts]' '``@rcv ifCurtailed: [| `@temps | ``@.Stmts]' '``@rcv valueOnUnwindDo: [| `@temps | ``@.Stmts]') do: [:aNode :answer | answer isNil ifTrue: [(returnMatcher executeTree: aNode arguments first initialAnswer: false) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! returnsIfTrue ^self createParseTreeRule: #('^`@condition ifTrue: [| `@temps | `@.statements]' '^`@condition ifFalse: [| `@temps | `@.statements]') name: 'Returns value of ifTrue:/ifFalse: without ifFalse:/ifTrue: block'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! searchingLiteral | detector matcher | detector := self new. detector name: 'Uses or''s instead of a searching literal'. matcher := ParseTreeSearcher new. matcher matchesAnyOf: #('``@object = `#literal or: [``@expression]' '``@object == `#literal or: [``@expression]' '`#literal = ``@object or: [``@expression]' '`#literal == ``@object or: [``@expression]' '``@expression | (``@object = `#literal)' '``@expression | (``@object == `#literal)' '``@expression | (`#literal = ``@object)' '``@expression | (`#literal == ``@object)') do: [:aNode :answer | answer isNil ifTrue: [(self isSearchingLiteralExpression: aNode) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'squeak bugs' stamp: 'nk 7/30/2004 19:09'! sendsDeprecatedMethodToGlobal | nav patterns pattern wellKnownGlobals | nav := SystemNavigation default. patterns := OrderedCollection new. wellKnownGlobals := IdentityDictionary new. Smalltalk keysAndValuesDo: [:k :v | v isBehavior ifFalse: [(wellKnownGlobals at: v class ifAbsentPut: [Set new]) add: k]]. #(#deprecated: 'deprecated:explanation:' 'deprecated:block:' ) do: [:sym | (nav allCallsOn: sym) do: [:mr | mr classIsMeta ifTrue: [mr actualClass withAllSubclassesDo: [:cls | patterns add: (String streamContents: [:s | s nextPutAll: cls theNonMetaClass name; nextPutAll: (self genericPatternForSelector: mr methodSymbol)])]] ifFalse: [wellKnownGlobals keysAndValuesDo: [:gcls :gnames | (gcls includesBehavior: mr actualClass) ifTrue: [gnames do: [:gname | pattern := String streamContents: [:s | s nextPutAll: gname. s nextPutAll: (self genericPatternForSelector: mr methodSymbol)]]. patterns add: pattern]]]]]. patterns add: 'self beep: `@object1'; add: 'self beep'. ^ self createParseTreeRule: patterns name: 'Sends a deprecated message to a known global'! ! !ParseTreeLintRule class methodsFor: 'bugs' stamp: 'nk 2/24/2005 15:04'! sendsUnknownMessageToGlobal | detector matcher | detector := self new. detector name: 'Sends unknown message to global'. matcher := ParseTreeSearcher new. matcher matches: '`{:node :context | node isVariable and: [ Smalltalk includesKey: node name asSymbol ] } `@message: `@args' do: [:aNode :answer | answer isNil ifTrue: [| what | what := Smalltalk at: aNode receiver name asSymbol. (what notNil and: [what ~~ Preferences and: [(what respondsTo: aNode selector) not]]) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! sizeCheck ^self createParseTreeRule: (#(#do: #collect: #reject: #select:) collect: [:each | '`@object size > 0 ifTrue: [`@object ' , each , ' [:`each | | `@temps | `@.Statements1]. `@.Statements2]']) , (#(#do: #collect: #reject: #select:) collect: [:each | '`@object isEmpty ifFalse: [`@object ' , each , ' [:`each | | `@temps | `@.Statements1]. `@.Statements2]']) name: 'Unnecessary size check'! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! stringConcatenation | detector matcher concatenationMatcher | detector := self new. detector name: 'String concatenation instead of streams'. matcher := ParseTreeSearcher new. concatenationMatcher := ParseTreeSearcher new. concatenationMatcher matches: '`@receiver , `@argument' do: [:aNode :answer | true]. matcher matchesAnyOf: #('``@collection do: [:`each | | `@temps | ``@.Statements]' '``@collection do: [:`each | | `@temps | ``@.Statements] separatedBy: [| `@temps1 | ``@.Statements1]' '``@number to: ``@endNumber do: [:`i | | `@temps | ``@.Statements]' '``@collection detect: [:`each | | `@temps | ``@.Statements]' '``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [| `@temps1 | ``@.Statements1]' '``@collection select: [:`each | | `@temps | ``@.Statements]' '``@collection inject: ``@value into: [:`each | | `@temps | ``@.Statements]') do: [:aNode :answer | answer isNil ifTrue: [(aNode arguments detect: [:each | each isBlock and: [concatenationMatcher executeTree: each initialAnswer: false]] ifNone: [nil]) notNil ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! threeElementPoint | detector matcher | detector := self new. detector name: 'Possible three element point (e.g., x @ y + q @ r)'. matcher := (ParseTreeSearcher new) matches: '``@x @ ``@y' do: [:aNode :answer | answer isNil ifTrue: [| current | current := aNode parent. [current isNil or: [current isMessage and: [current selector == #@ or: [current selector isInfix not]]]] whileFalse: [current := current parent]. (current isNil or: [current isMessage and: [current selector isInfix not]]) ifTrue: [nil] ifFalse: [aNode]] ifFalse: [answer]]; yourself. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! toDo | detector matcher | detector := self new. detector name: 'Uses to:do: instead of do:, with:do: or timesRepeat:'. matcher := ParseTreeSearcher new. matcher matches: '1 to: ``@object size do: [:`each | | `@temps | `@.Statements]' do: [:aNode :answer | answer isNil ifTrue: [| varName variableMatcher | varName := aNode arguments last arguments first. "`each" variableMatcher := ParseTreeSearcher new. variableMatcher matchesTree: varName do: [:node :ans | ans and: [node parent isMessage and: [node parent selector == #at:]]]. (variableMatcher executeTree: aNode arguments last body initialAnswer: true) ifTrue: [aNode] ifFalse: [nil]] ifFalse: [answer]]. detector matcher: matcher. ^detector! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! toDoCollect ^self createParseTreeRule: #( '| `@temps1 | `@.Stmts1. `collection := Array new: `@size. `@.Stmts2. 1 to: `@size do: [:`i | | `@Btemps2 | `@.BStmts1. `collection at: `i put: `@obj. `@.BStmt2]. `@.Stmts3' "-------------" '| `@temps1 | `@.Stmts1. `collection := Array new: `@size. `@.Stmts2. 1 to: `collection size do: [:`i | | `@Btemps2 | `@.BStmts1. `collection at: `i put: `@obj. `@.BStmt2]. `@.Stmts3') name: 'to:do: doesn''t use collect:'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! toDoWithIncrement ^self createParseTreeRule: #( '`@i to: `@j do: [:`e | | `@temps | `@.Stmts. `x := `x + 1. `@.Stmts2]' '`@i to: `@j by: `@k do: [:`e | | `@temps | `@.Stmts. `x := `x + `@k. `@.Stmts2]') name: 'to:do: loop also increments a counter'! ! !ParseTreeLintRule class methodsFor: 'unnecessary code' stamp: ''! unnecessaryAssignment ^self createParseTreeRule: #('^`{:aNode | aNode isAssignment and: [(aNode whoDefines: aNode variable name) notNil]}') name: 'Unnecessary assignment to a temporary variable'! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! unoptimizedAndOr ^self createParseTreeRule: #('(`@a and: `@b) and: `@c' '(`@a or: `@b) or: `@c') name: 'Uses "(a and: [b]) and: [c]" instead of "a and: [b and: [c]]"'! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! unoptimizedToDo ^self createParseTreeRule: #('(`@a to: `@b) do: `@c') name: 'Uses (to:)do: instead of to:do:'! ! !ParseTreeLintRule class methodsFor: 'possible bugs' stamp: ''! usesAdd ^self createParseTreeRule: #('`{:node | node isMessage and: [(node selector == #add: or: [node selector == #addAll:]) and: [node isDirectlyUsed]]}') name: 'Uses the result of an add: message'! ! !ParseTreeLintRule class methodsFor: 'intention revealing' stamp: ''! whileTrue ^self createParseTreeRule: #('| `@temps | `@.Statements1. [`index <= `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index + 1]. `@.Statements2' '| `@temps | `@.Statements1. [`index < `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index + 1]. `@.Statements2' '| `@temps | `@.Statements1. [`index >= `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index - 1]. `@.Statements2' '| `@temps | `@.Statements1. [`index > `@stop] whileTrue: [| `@blockTemps | `@.BlockStmts1. `index := `index - 1]. `@.Statements2') name: 'Uses whileTrue: instead of to:do:'! ! !ParseTreeLintRule class methodsFor: 'miscellaneous' stamp: ''! yourselfNotUsed ^self createParseTreeRule: #('`{:node | node parent isUsed not} yourself') name: 'Doesn''t use the result of a yourself message'! ! !ParseTreeLintRule methodsFor: 'accessing' stamp: ''! checkMethod: aSmalllintContext (matcher canMatchMethod: aSmalllintContext compiledMethod) ifFalse: [^self]. (matcher executeTree: aSmalllintContext parseTree initialAnswer: nil) notNil ifTrue: [result addClass: aSmalllintContext selectedClass selector: aSmalllintContext selector]! ! !ParseTreeLintRule methodsFor: 'private' stamp: ''! defaultResultClass ^ParseTreeEnvironment! ! !ParseTreeLintRule methodsFor: 'initialize-release' stamp: ''! matcher: aParseTreeMatcher matcher := aParseTreeMatcher! ! !ParseTreeLintRule methodsFor: 'initialize-release' stamp: ''! resetResult result := ParseTreeEnvironment new. result label: self name; matcher: matcher! ! LintRule subclass: #CompositeLintRule instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !CompositeLintRule class methodsFor: 'instance creation' stamp: ''! allRules ^self ruleFor: self protocol: 'all checks'! ! !CompositeLintRule class methodsFor: 'all checks' stamp: ''! lintChecks ^self rules: (BasicLintRule protocols collect: [:each | self ruleFor: BasicLintRule protocol: each]) name: 'Lint checks'! ! !CompositeLintRule class methodsFor: 'instance creation' stamp: ''! ruleFor: aClass protocol: aProtocol | allRules | allRules := aClass withAllSubclasses inject: OrderedCollection new into: [:sum :each | sum addAll: ((BrowserEnvironment new selectorsFor: aProtocol asSymbol in: each class) collect: [:selector | each perform: selector]); yourself]. ^self rules: (allRules asSortedCollection: [:a :b | a name < b name]) name: ((aProtocol asString copy) at: 1 put: aProtocol first asUppercase; yourself)! ! !CompositeLintRule class methodsFor: 'instance creation' stamp: ''! rules: aCollection ^self new rules: aCollection! ! !CompositeLintRule class methodsFor: 'instance creation' stamp: ''! rules: aCollection name: aString ^(self new) rules: aCollection; name: aString; yourself! ! !CompositeLintRule class methodsFor: 'all checks' stamp: ''! transformations ^self ruleFor: TransformationRule protocol: 'transformations'! ! !CompositeLintRule methodsFor: 'accessing' stamp: 'nk 3/5/2005 15:16'! changes ^rules gather: [ :r | r changes ]! ! !CompositeLintRule methodsFor: 'accessing' stamp: ''! checkClass: aSmalllintContext rules do: [:each | each checkClass: aSmalllintContext. Processor yield]! ! !CompositeLintRule methodsFor: 'accessing' stamp: ''! checkMethod: aSmalllintContext rules do: [:each | each checkMethod: aSmalllintContext. Processor yield]! ! !CompositeLintRule methodsFor: 'accessing' stamp: ''! failedRules ^rules inject: OrderedCollection new into: [:oc :each | oc addAll: each failedRules; yourself]! ! !CompositeLintRule methodsFor: 'testing' stamp: ''! hasConflicts ^(rules detect: [:each | each hasConflicts] ifNone: [nil]) notNil! ! !CompositeLintRule methodsFor: 'testing' stamp: ''! isComposite ^true! ! !CompositeLintRule methodsFor: 'testing' stamp: ''! isEmpty ^(rules detect: [:each | each isEmpty not] ifNone: [nil]) isNil! ! !CompositeLintRule methodsFor: 'accessing' stamp: ''! problemCount ^rules inject: 0 into: [:count :each | count + each problemCount]! ! !CompositeLintRule methodsFor: 'initialize-release' stamp: ''! resetResult rules do: [:each | each resetResult]! ! !CompositeLintRule methodsFor: 'accessing' stamp: ''! rules ^rules! ! !CompositeLintRule methodsFor: 'initialize-release' stamp: ''! rules: aCollection rules := aCollection! ! !CompositeLintRule methodsFor: 'private' stamp: 'bh 5/9/2000 00:17'! viewResults rules do: [:each | each viewResults]! ! !LintRule methodsFor: 'accessing' stamp: 'nk 3/5/2005 15:16'! changes ^#()! ! !LintRule methodsFor: 'accessing' stamp: ''! checkClass: aSmalllintContext! ! !LintRule methodsFor: 'accessing' stamp: ''! checkMethod: aSmalllintContext! ! !LintRule methodsFor: 'printing' stamp: ''! displayName | nameStream | nameStream := WriteStream on: (String new: 64). nameStream nextPutAll: self name; nextPutAll: ' ['. self problemCount printOn: nameStream. nameStream nextPut: $]. ^nameStream contents! ! !LintRule methodsFor: 'private' stamp: ''! failedRules ^self isEmpty ifTrue: [#()] ifFalse: [Array with: self]! ! !LintRule methodsFor: 'testing' stamp: ''! hasConflicts ^false! ! !LintRule methodsFor: 'initialize-release' stamp: ''! initialize! ! !LintRule methodsFor: 'testing' stamp: ''! isComposite ^false! ! !LintRule methodsFor: 'testing' stamp: ''! isEmpty self subclassResponsibility! ! !LintRule methodsFor: 'accessing' stamp: ''! name ^name! ! !LintRule methodsFor: 'accessing' stamp: ''! name: aString name := aString! ! !LintRule methodsFor: 'printing' stamp: ''! printOn: aStream name isNil ifTrue: [super printOn: aStream] ifFalse: [aStream nextPutAll: name]! ! !LintRule methodsFor: 'accessing' stamp: ''! problemCount ^self subclassResponsibility! ! !LintRule methodsFor: 'accessing' stamp: 'nk 2/25/2005 11:35'! rationale "Answer the rationale for this rule." ^rationale ifNil: [ ^'' ]! ! !LintRule methodsFor: 'accessing' stamp: 'nk 2/25/2005 11:35'! rationale: anObject rationale := anObject! ! !LintRule methodsFor: 'initialize-release' stamp: ''! resetResult! ! !LintRule methodsFor: 'accessing' stamp: 'nk 11/12/2002 13:11'! run ^SmalllintChecker runRule: self! ! !LintRule methodsFor: 'accessing' stamp: 'nk 11/12/2002 13:11'! runOnEnvironment: anEnvironment ^SmalllintChecker runRule: self onEnvironment: anEnvironment! ! !LintRule methodsFor: 'private' stamp: 'bh 5/9/2000 00:17'! viewResults self subclassResponsibility! ! LintRule subclass: #TransformationRule instanceVariableNames: 'rewriteRule builder class' classVariableNames: 'RecursiveSelfRule' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !TransformationRule class methodsFor: 'transformations' stamp: ''! assignmentInIfTrue ^self rewrite: #( #('``@Boolean ifTrue: [`variable := ``@true] ifFalse: [`variable := ``@false]' "->" '`variable := ``@Boolean ifTrue: [``@true] ifFalse: [``@false]') #('``@Boolean ifFalse: [`variable := ``@true] ifTrue: [`variable := ``@false]' "->" '`variable := ``@Boolean ifFalse: [``@true] ifTrue: [``@false]')) methods: false name: 'Move variable assignment outside of single statement ifTrue:ifFalse: blocks'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! atIfAbsent ^self rewrite: #( #('``@dictionary at: ``@key ifAbsent: [| `@temps | ``@.Statements1. ``@dictionary at: ``@key put: ``@object. ``@.Statements2. ``@object]' "->" '``@dictionary at: ``@key ifAbsentPut: [| `@temps | ``@.Statements1. ``@.Statements2. ``@object]') #('``@dictionary at: ``@key ifAbsent: [| `@temps | ``@.Statements. ``@dictionary at: ``@key put: ``@object]' "->" '``@dictionary at: ``@key ifAbsentPut: [| `@temps | ``@.Statements. ``@object]')) methods: false name: 'at:ifAbsent: -> at:ifAbsentPut:'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! betweenAnd ^self rewrite: #( #('``@a >= ``@b and: [``@a <= ``@c]' "->" '``@a between: ``@b and: ``@c') #('``@a >= ``@b & (``@a <= ``@c)' "->" '``@a between: ``@b and: ``@c') #('``@b <= ``@a and: [``@a <= ``@c]' "->" '``@a between: ``@b and: ``@c') #('``@b <= ``@a & (``@a <= ``@c)' "->" '``@a between: ``@b and: ``@c') #('``@a <= ``@c and: [``@a >= ``@b]' "->" '``@a between: ``@b and: ``@c') #('``@a <= ``@c & (``@a >= ``@b)' "->" '``@a between: ``@b and: ``@c') #('``@c >= ``@a and: [``@a >= ``@b]' "->" '``@a between: ``@b and: ``@c') #('``@c >= ``@a & (``@a >= ``@b)' "->" '``@a between: ``@b and: ``@c') #('``@a >= ``@b and: [``@c >= ``@a]' "->" '``@a between: ``@b and: ``@c') #('``@a >= ``@b & (``@c >= ``@a)' "->" '``@a between: ``@b and: ``@c') #('``@b <= ``@a and: [``@c >= ``@a]' "->" '``@a between: ``@b and: ``@c') #('``@b <= ``@a & (``@c >= ``@a)' "->" '``@a between: ``@b and: ``@c') #('``@a <= ``@c and: [``@b <= ``@a]' "->" '``@a between: ``@b and: ``@c') #('``@a <= ``@c & (``@b <= ``@a)' "->" '``@a between: ``@b and: ``@c') #('``@c >= ``@a and: [``@b <= ``@a]' "->" '``@a between: ``@b and: ``@c') #('``@c >= ``@a & (``@b <= ``@a)' "->" '``@a between: ``@b and: ``@c')) methods: false name: '"a >= b and: [a <= c]" -> "a between: b and: c"'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! cascadedNextPutAlls ^self rewrite: #( #('``@rcvr nextPutAll: ``@object1 , ``@object2' "->" '``@rcvr nextPutAll: ``@object1; nextPutAll: ``@object2') #('``@rcvr show: ``@object1 , ``@object2' "->" '``@rcvr show: ``@object1; show: ``@object2')) methods: false name: 'Use cascaded nextPutAll:''s instead of #, in #nextPutAll:'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! detectIfNone ^self rewrite: #( #('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) isNil' "->" '(``@collection contains: [:`each | | `@temps | ``@.Statements]) not') #('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) = nil' "->" '(``@collection contains: [:`each | | `@temps | ``@.Statements]) not') #('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) == nil' "->" '(``@collection contains: [:`each | | `@temps | ``@.Statements]) not') #('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) notNil' "->" '``@collection contains: [:`each | | `@temps | ``@.Statements]') #('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~= nil' "->" '``@collection contains: [:`each | | `@temps | ``@.Statements]') #('(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~~ nil' "->" '``@collection contains: [:`each | | `@temps | ``@.Statements]')) methods: false name: 'detect:ifNone: -> contains:'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! equalNil ^self rewrite: #( #('``@object = nil' "->" '``@object isNil') #('``@object == nil' "->" '``@object isNil') #('``@object ~= nil' "->" '``@object notNil') #('``@object ~~ nil' "->" '``@object notNil')) methods: false name: '= nil -> isNil AND ~= nil -> notNil'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! guardClause ^self rewrite: #( #('`@methodName: `@args | `@temps | `@.Statements. `@condition ifTrue: [| `@trueTemps | `.Statement1. `.Statement2. `@.Statements1]' "->" '`@methodName: `@args | `@temps `@trueTemps | `@.Statements. `@condition ifFalse: [^self]. `.Statement1. `.Statement2. `@.Statements1') #('`@methodName: `@args | `@temps | `@.Statements. `@condition ifFalse: [| `@falseTemps | `.Statement1. `.Statement2. `@.Statements1]' "->" '`@methodName: `@args | `@temps `@falseTemps | `@.Statements. `@condition ifTrue: [^self]. `.Statement1. `.Statement2. `@.Statements1')) methods: true name: 'Eliminate guarding clauses'! ! !TransformationRule class methodsFor: 'accessing' stamp: ''! initializeRecursiveSelfRule RecursiveSelfRule := ParseTreeSearcher new. RecursiveSelfRule matchesAnyMethodOf: #('`@methodName: `@args | `@temps | self `@methodName: `@args1' '`@methodName: `@args | `@temps | ^self `@methodName: `@args1') do: [:aNode :answer | true]. ^RecursiveSelfRule! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! minMax ^self rewrite: #( #('``@a < ``@b ifTrue: [``@a] ifFalse: [``@b]' "->" '``@a min: ``@b') #('``@a <= ``@b ifTrue: [``@a] ifFalse: [``@b]' "->" '``@a min: ``@b') #('``@a > ``@b ifTrue: [``@a] ifFalse: [``@b]' "->" '``@a max: ``@b') #('``@a >= ``@b ifTrue: [``@a] ifFalse: [``@b]' "->" '``@a max: ``@b') #('``@a < ``@b ifTrue: [``@b] ifFalse: [``@a]' "->" '``@a max: ``@b') #('``@a <= ``@b ifTrue: [``@b] ifFalse: [``@a]' "->" '``@a max: ``@b') #('``@a > ``@b ifTrue: [``@b] ifFalse: [``@a]' "->" '``@a min: ``@b') #('``@a >= ``@b ifTrue: [``@b] ifFalse: [``@a]' "->" '``@a min: ``@b') #('`a < ``@b ifTrue: [`a := ``@b]' "->" '`a := `a max: ``@b') #('`a <= ``@b ifTrue: [`a := ``@b]' "->" '`a := `a max: ``@b') #('`a < ``@b ifFalse: [`a := ``@b]' "->" '`a := `a min: ``@b') #('`a <= ``@b ifFalse: [`a := ``@b]' "->" '`a := `a min: ``@b') #('`a > ``@b ifTrue: [`a := ``@b]' "->" '`a := `a min: ``@b') #('`a >= ``@b ifTrue: [`a := ``@b]' "->" '`a := `a min: ``@b') #('`a > ``@b ifFalse: [`a := ``@b]' "->" '`a := `a max: ``@b') #('`a >= ``@b ifFalse: [`a := ``@b]' "->" '`a := `a max: ``@b') #('``@b < `a ifTrue: [`a := ``@b]' "->" '`a := `a min: ``@b') #('``@b <= `a ifTrue: [`a := ``@b]' "->" '`a := `a min: ``@b') #('``@b < `a ifFalse: [`a := ``@b]' "->" '`a := `a max: ``@b') #('``@b <= `a ifFalse: [`a := ``@b]' "->" '`a := `a max: ``@b') #('``@b > `a ifTrue: [`a := ``@b]' "->" '`a := `a max: ``@b') #('``@b >= `a ifTrue: [`a := ``@b]' "->" '`a := `a max: ``@b') #('``@b > `a ifFalse: [`a := ``@b]' "->" '`a := `a min: ``@b') #('``@b >= `a ifFalse: [`a := ``@b]' "->" '`a := `a min: ``@b')) methods: false name: 'Rewrite ifTrue:ifFalse: using min:/max:'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! notElimination ^self rewrite: #( #('``@object not not' "->" '``@object') #('``@object not ifTrue: ``@block' "->" '``@object ifFalse: ``@block') #('``@object not ifFalse: ``@block' "->" '``@object ifTrue: ``@block') #('``@collection select: [:`each | | `@temps | ``@.Statements. ``@object not]' "->" '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object]') #('``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object not]' "->" '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object]') #('[| `@temps | ``@.Statements. ``@object not] whileTrue: ``@block' "->" '[| `@temps | ``@.Statements. ``@object] whileFalse: ``@block') #('[| `@temps | ``@.Statements. ``@object not] whileFalse: ``@block' "->" '[| `@temps | ``@.Statements. ``@object] whileTrue: ``@block') #('[| `@temps | ``@.Statements. ``@object not] whileTrue' "->" '[| `@temps | ``@.Statements. ``@object] whileFalse') #('[| `@temps | ``@.Statements. ``@object not] whileFalse' "->" '[| `@temps | ``@.Statements. ``@object] whileTrue') #('(``@a <= ``@b) not' "->" '``@a > ``@b') #('(``@a < ``@b) not' "->" '``@a >= ``@b') #('(``@a = ``@b) not' "->" '``@a ~= ``@b') #('(``@a == ``@b) not' "->" '``@a ~~ ``@b') #('(``@a ~= ``@b) not' "->" '``@a = ``@b') #('(``@a ~~ ``@b) not' "->" '``@a == ``@b') #('(``@a >= ``@b) not' "->" '``@a < ``@b') #('(``@a > ``@b) not' "->" '``@a <= ``@b')) methods: false name: 'Eliminate unnecessary not''s'! ! !TransformationRule class methodsFor: 'accessing' stamp: ''! recursiveSelfRule ^RecursiveSelfRule isNil ifTrue: [self initializeRecursiveSelfRule] ifFalse: [RecursiveSelfRule]! ! !TransformationRule class methodsFor: 'instance creation' stamp: ''! rewrite: stringArrays methods: aBoolean name: aName | rewriteRule | rewriteRule := ParseTreeRewriter new. stringArrays do: [:each | aBoolean ifTrue: [rewriteRule replaceMethod: each first with: each last] ifFalse: [rewriteRule replace: each first with: each last]]. ^(self new) name: aName; rewriteUsing: rewriteRule; yourself! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! showWhileBlocks ^self rewrite: #( #('``@cursor showWhile: [| `@temps | ``@.Statements. `var := ``@object]' "->" '`var := ``@cursor showWhile: [| `@temps | ``@.Statements. ``@object]') #('``@cursor showWhile: [| `@temps | ``@.Statements. ^``@object]' "->" '^``@cursor showWhile: [| `@temps | ``@.Statements. ``@object]')) methods: false name: 'Move assignment out of showWhile: blocks'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! superSends ^(self new) name: 'Rewrite super messages to self messages when both refer to same method'; superSends; yourself! ! !TransformationRule class methodsFor: 'transformations' stamp: 'lr 3/25/2008 21:24'! translateLiteralsInMenus ^self rewrite: { { '`@menu add: `#label action: `#sym'. '`@menu add: `#label translated action: `#sym' }. { '`@menu add: `#label selector: `#sym arguments: `@stuff'. '`@menu add: `#label translated selector: `#sym arguments: `@stuff' }. { '`@menu add: `#label subMenu: `@stuff'. '`@menu add: `#label translated subMenu: `@stuff' }. { '`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args'. '`@menu add: `#label translated subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args' }. { '`@menu add: `#label target: `@targ action: `#sel'. '`@menu add: `#label translated target: `@targ action: `#sel' }. { '`@menu add: `#label target: `@targ selector `#sel'. '`@menu add: `#label translated target: `@targ selector `#sel' }. { '`@menu add: `#label target: `@targ selector `#sel argument: `@arg'. '`@menu add: `#label translated target: `@targ selector `#sel argument: `@arg' }. { '`@menu add: `#label target: `@targ selector `#sel arguments: `@arg'. '`@menu add: `#label translated target: `@targ selector `#sel arguments: `@arg' }. { '`@menu addTitle: `#label'. '`@menu addTitle: `#label translated' }. { '`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ'. '`@menu addTitle: `#label translated updatingSelector: `#sel updateTarget: `@targ' }. { '`@menu addWithLabel: `#label enablement: `#esel action: `#sel'. '`@menu addWithLabel: `#label translated enablement: `#esel action: `#sel' }. { '`@menu addWithLabel: `#label enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args'. '`@menu addWithLabel: `#label translated enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args' }. { '`@menu balloonTextForLastItem: `#label'. '`@menu balloonTextForLastItem: `#label translated' }. { '`@menu labels: `#lit lines: `@lines selections: `@sels'. '`@menu labels: (`#lit collect: [ :l | l translated ]) lines: `@lines selections: `@sels' }. { '`@menu title: `#title'. '`@menu title: `#title translated' } } methods: false name: 'add translations to strings in menus'! ! !TransformationRule class methodsFor: 'transformations' stamp: ''! unwindBlocks ^self rewrite: #( #('[| `@temps | ``@.Statements. `var := ``@object] valueNowOrOnUnwindDo: ``@block' "->" '`var := [| `@temps | ``@.Statements. ``@object] valueNowOrOnUnwindDo: ``@block') #('[| `@temps | ``@.Statements. ^``@object] valueNowOrOnUnwindDo: ``@block' "->" '^[| `@temps | ``@.Statements. ``@object] valueNowOrOnUnwindDo: ``@block') #('[| `@temps | ``@.Statements. `var := ``@object] valueOnUnwindDo: ``@block' "->" '`var := [| `@temps | ``@.Statements. ``@object] valueOnUnwindDo: ``@block') #('[| `@temps | ``@.Statements. ^``@object] valueOnUnwindDo: ``@block' "->" '^[| `@temps | ``@.Statements. ``@object] valueOnUnwindDo: ``@block')) methods: false name: 'Move assignment out of valueNowOrUnwindDo: blocks'! ! !TransformationRule methodsFor: 'accessing' stamp: 'nk 3/5/2005 15:10'! changes ^builder changes! ! !TransformationRule methodsFor: 'accessing' stamp: ''! checkMethod: aSmalllintContext (rewriteRule canMatchMethod: aSmalllintContext compiledMethod) ifFalse: [^self]. class := aSmalllintContext selectedClass. (rewriteRule executeTree: aSmalllintContext parseTree) ifTrue: [(self class recursiveSelfRule executeTree: rewriteRule tree initialAnswer: false) ifFalse: [builder compile: rewriteRule tree printString in: class classified: aSmalllintContext protocol]]! ! !TransformationRule methodsFor: 'testing' stamp: ''! hasConflicts ^true! ! !TransformationRule methodsFor: 'testing' stamp: ''! isEmpty ^builder changes isEmpty! ! !TransformationRule methodsFor: 'accessing' stamp: ''! problemCount ^builder problemCount! ! !TransformationRule methodsFor: 'accessing' stamp: ''! resetResult builder := CompositeRefactoryChange named: 'Some transformations'! ! !TransformationRule methodsFor: 'initialize-release' stamp: ''! rewriteUsing: searchReplacer rewriteRule := searchReplacer. self resetResult! ! !TransformationRule methodsFor: 'rules' stamp: ''! superSends | rule | rule := ParseTreeRewriter new. rule replace: 'super `@message: ``@args' with: 'self `@message: ``@args' when: [:aNode | (class withAllSubclasses detect: [:each | each includesSelector: aNode selector] ifNone: [nil]) isNil]. self rewriteUsing: rule! ! !TransformationRule methodsFor: 'private' stamp: ''! viewResults "I reset the result so that we don't fill up memory with methods to compile in the builder." builder inspect. self resetResult! ! 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: ''! classBinding ^Smalltalk associationAt: self name! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! compile: aString ^self compile: aString classified: (self protocolsFor: (RBParser parseMethodPattern: aString))! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! 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! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! compileTree: aBRMethodNode ^self compileTree: aBRMethodNode classified: (self protocolsFor: aBRMethodNode selector)! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! compileTree: aBRMethodNode classified: aSymbolCollection | method source | source := aBRMethodNode formattedCode. model compile: source in: self classified: aSymbolCollection. method := RBMethod for: self source: source selector: aBRMethodNode selector. " method parseTree: aBRMethodNode." self addMethod: method! ! !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: 'bh 4/8/2000 18:58'! existingMethodsThatReferTo: aSymbol | existingMethods | existingMethods := self realClass thoroughWhichSelectorsReferTo: aSymbol special:false byte:0. (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: 'accessing' stamp: ''! metaclass ^model metaclassNamed: self name! ! !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: 'accessing' stamp: ''! nonMetaclass ^model classNamed: self name! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! parseTreeFor: aSelector | class | class := self whoDefinesMethod: aSelector. class isNil ifTrue: [^nil]. ^(class methodFor: aSelector) parseTree! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! primaryInstance ^self nonMetaclass! ! !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: ''! soleInstance ^self nonMetaclass! ! !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: ''! subclassRedefines: aSelector "Return true, if one of your subclasses redefines the method with name, aMethod" self allSubclasses do: [:each | (each directlyDefinesMethod: aSelector) ifTrue: [^true]]. ^false! ! !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: 'variable accessing' stamp: ''! typeOfClassVariable: aSymbol ^model classNamed: #Object! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! whichSelectorsReferToClass: aRBClass | selectors | selectors := Set new. self 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: 'md 1/17/2006 14:17'! whichSelectorsReferToClassVariable: aString | selectors | selectors := Set new. self newMethods do: [:each | (each refersToVariable: aString) ifTrue: [selectors add: each selector]]. self isDefined ifTrue: [| binding | binding := self bindingOf: aString. binding isNil ifTrue: [^selectors]. selectors addAll: ((self realClass whichSelectorsReferTo: binding) reject: [:each | self hasRemoved: each])]. ^selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! whichSelectorsReferToInstanceVariable: aString | selectors | selectors := Set new. self newMethods do: [:each | (each refersToVariable: aString) ifTrue: [selectors add: each selector]]. self isDefined ifTrue: [selectors addAll: ((self realClass whichSelectorsAccess: aString) reject: [:each | self hasRemoved: each])]. ^selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! whichSelectorsReferToSymbol: aSymbol | selectors | selectors := Set new. self 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' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBClass class methodsFor: 'instance creation' stamp: ''! existingNamed: aSymbol ^(self named: aSymbol) realName: aSymbol; yourself! ! !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: '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: 'testing' stamp: ''! isMeta ^false! ! !RBClass methodsFor: 'accessing' stamp: ''! nonMetaclass ^self! ! !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: ''! privatePoolDictionaryNames (self isDefined and: [poolDictionaryNames isNil]) ifTrue: [self poolDictionaryNames: (self realClass sharedPools collect: [:each | Smalltalk keyAtValue: each])]. ^poolDictionaryNames! ! !RBClass methodsFor: 'initialize-release' stamp: ''! realName: aSymbol self realClass: (Smalltalk 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: ''! sharedPools ^self allPoolDictionaryNames collect: [:each | Smalltalk at: each asSymbol ifAbsent: [Dictionary new]]! ! 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: ''! allClassVariableNames ^self nonMetaclass allClassVariableNames! ! !RBMetaclass methodsFor: 'accessing' stamp: ''! allPoolDictionaryNames ^self nonMetaclass allPoolDictionaryNames! ! !RBMetaclass methodsFor: 'testing' stamp: ''! directlyDefinesClassVariable: aString ^self nonMetaclass directlyDefinesClassVariable: aString! ! !RBMetaclass methodsFor: 'testing' stamp: ''! directlyDefinesPoolDictionary: aString ^self nonMetaclass directlyDefinesPoolDictionary: aString! ! !RBMetaclass methodsFor: 'testing' stamp: ''! isMeta ^true! ! !RBMetaclass methodsFor: 'accessing' stamp: ''! metaclass ^self! ! !RBMetaclass methodsFor: 'printing' stamp: ''! printOn: aStream super printOn: aStream. aStream nextPutAll: ' class'! ! !RBMetaclass methodsFor: 'initialize-release' stamp: 'dc 5/8/2007 12:29'! realName: aSymbol self realClass: (Smalltalk at: aSymbol) classSide! ! !RBMetaclass methodsFor: 'printing' stamp: ''! storeOn: aStream super storeOn: aStream. aStream nextPutAll: ' class'! ! 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: ''! methodDefiningTemporary: aString in: aClass ignore: aBlock | searcher method | searcher := ParseTreeSearcher 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: 'dvf 11/24/2001 13:14'! type: aSymbol block: aBlock errorString: aString self needsWork. "replaced value with fixTemps. This should simulate closures well enough, we hope." type := aSymbol. block := aBlock fixTemps. 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: ''! 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: 'private' stamp: ''! literal: anObject containsReferenceTo: aSymbol anObject = aSymbol ifTrue: [^true]. anObject class = Array ifFalse: [^false]. anObject do: [:each | (self literal: each containsReferenceTo: aSymbol) ifTrue: [^true]]. ^false! ! !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: 'testing' stamp: ''! refersToClassNamed: aSymbol | searcher | searcher := ParseTreeSearcher new. searcher matches: aSymbol asString do: [:node :answer | true]. ^(searcher executeTree: self parseTree initialAnswer: false) or: [self refersToSymbol: aSymbol]! ! !RBMethod methodsFor: 'testing' stamp: 'dvf 9/17/2001 00:46'! refersToSymbol: aSymbol | searcher | searcher := ParseTreeSearcher 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 ' , (ParseTreeSearcher buildSelectorString: aSymbol) do: [:node :answer | true]]. ^searcher executeTree: self parseTree initialAnswer: false! ! !RBMethod methodsFor: 'testing' stamp: ''! refersToVariable: aString | searcher tree | tree := self parseTree. ((tree defines: aString) or: [tree body defines: aString]) ifTrue: [^false]. searcher := ParseTreeSearcher 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: 'dvf 11/8/2003 15:02'! source ^source isNil ifTrue: [source := (class realClass sourceCodeAt: selector) string] ifFalse: [source]! ! !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: ''! isValid ^(RBCondition checkMethodName: self selector in: self class) and: [self selector numArgs == self arguments size]! ! !RBMethodName methodsFor: 'accessing' stamp: ''! moveArgument: aName before: anotherName arguments remove: aName ifAbsent: [^self]. arguments add: aName before: anotherName. self changed: #arguments! ! !RBMethodName methodsFor: 'accessing' stamp: ''! selector ^selector! ! !RBMethodName methodsFor: 'accessing' stamp: ''! selector: aSymbol selector := aSymbol. 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: ''! addChangeToClass: aRBClass ^changedClasses at: aRBClass name put: (Array with: aRBClass nonMetaclass with: aRBClass metaclass)! ! !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 10/15/2007 08:39'! 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 isMeta or: [each isObsolete]) ifFalse: [((seen includes: each name) or: [self hasRemoved: (self classNameFor: each)]) ifFalse: [| class | class := self classFor: each. class isNil ifFalse: [aBlock value: class; value: class metaclass]]]]! ! !RBNamespace methodsFor: 'accessing' stamp: ''! allImplementorsOf: aSelector ^implementorsCache at: aSelector ifAbsentPut: [self privateImplementorsOf: aSelector]! ! !RBNamespace methodsFor: 'accessing' stamp: ''! allReferencesTo: aSymbol do: aBlock (sendersCache at: aSymbol ifAbsentPut: [| refs | refs := OrderedCollection new. self allClassesDo: [:each | (each whichSelectorsReferToSymbol: aSymbol) do: [:sel | refs add: (each methodFor: sel)]]. refs]) 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: ''! changeClass: aRBClass changedClasses at: aRBClass name put: (Array with: aRBClass nonMetaclass with: aRBClass metaclass). self flushCaches! ! !RBNamespace methodsFor: 'accessing' stamp: ''! changes ^changes! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/15/2007 08:37'! classFor: aBehavior | nonMetaclass class | aBehavior isNil ifTrue: [^ nil]. nonMetaclass := aBehavior isMeta ifTrue: [aBehavior soleInstance] ifFalse: [aBehavior]. class := aBehavior isMeta ifTrue: [self metaclassNamed: nonMetaclass name] ifFalse: [self classNamed: nonMetaclass name]. ^ class! ! !RBNamespace methodsFor: 'private' stamp: ''! classNameFor: aBehavior ^(aBehavior isMeta ifTrue: [aBehavior soleInstance] ifFalse: [aBehavior]) name! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 3/9/2008 08:35'! classNamed: aSymbol | class index classes | 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 metaclass]! ! !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: ''! createNewClassFor: aBehavior | nonMeta meta className | className := (aBehavior isMeta ifTrue: [aBehavior soleInstance] ifFalse: [aBehavior]) 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: ''! 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 metaclass superclass: (self classFor: Object class superclass)] ifFalse: [newClass metaclass superclass: newClass superclass metaclass]. newClass instanceVariableNames: change instanceVariableNames. newClass classVariableNames: change classVariableNames. newClass poolDictionaryNames: change poolDictionaryNames. newClass category: change category. ^change! ! !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: ''! privateImplementorsOf: aSelector | classes | classes := Set new. self allClassesDo: [:each | (each directlyDefinesMethod: aSelector) ifTrue: [classes add: each]]. ^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: ''! 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: aSymbol) 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: 'bh 4/3/2000 15:47'! rootClasses rootClasses isNil ifTrue: [rootClasses := OrderedCollection new. Class rootsOfTheWorld do: [:each | | class | class := self classFor: each. (class notNil "and: [class superclass isNil] <- it's protoObject, not nil.") ifTrue: [rootClasses add: class]]]. ^rootClasses! ! !RBNamespace methodsFor: 'accessing-classes' stamp: ''! whichCategoryIncludes: aSymbol ^self environment whichCategoryIncludes: aSymbol! ! Object subclass: #ReceiverAndSelector instanceVariableNames: 'receiver selector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ReceiverAndSelector class methodsFor: 'as yet unclassified' stamp: 'bh 11/4/2000 23:59'! forReceiver:anObject andSelector:aSymbol ^self new initializeReceiver:anObject andSelector:aSymbol.! ! !ReceiverAndSelector methodsFor: 'as yet unclassified' stamp: 'bh 11/5/2000 00:00'! initializeReceiver:anObject andSelector:aSymbol receiver := anObject. selector := aSymbol.! ! !ReceiverAndSelector methodsFor: 'as yet unclassified' stamp: 'bh 11/5/2000 00:01'! value ^receiver perform: selector.! ! !ReceiverAndSelector methodsFor: 'as yet unclassified' stamp: 'bh 11/5/2000 00:01'! value: firstArgument ^receiver perform: selector with: firstArgument.! ! !ReceiverAndSelector methodsFor: 'as yet unclassified' stamp: 'bh 11/5/2000 00:01'! value: firstArgument value: secondArgument ^receiver perform: selector with: firstArgument with: secondArgument.! ! 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: ''! abstractClassVariable: aString | refactoring rewriter nonMetaClass | nonMetaClass := fromClass nonMetaclass. refactoring := CreateAccessorsForVariableRefactoring model: self model variable: aString class: nonMetaClass classVariable: true. self performComponentRefactoring: refactoring. rewriter := ParseTreeRewriter 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: ''! abstractClassVariables | variables | classVarReaders isEmpty & classVarWriters isEmpty ifTrue: [^self]. variables := Set new. variables addAll: classVarReaders; addAll: classVarWriters. variables do: [:each | self abstractClassVariable: each]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! abstractInstanceVariable: aString | refactoring rewriter | refactoring := CreateAccessorsForVariableRefactoring model: self model variable: aString class: fromClass classVariable: false. self performComponentRefactoring: refactoring. rewriter := ParseTreeRewriter 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: ''! abstractInstanceVariables | variables | instVarReaders isEmpty & 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: ''! classVariableNames | nonMetaClass | nonMetaClass := fromClass nonMetaclass. ^(nonMetaClass allClassVariableNames collect: [:each | each asString]) asSet! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! computeVariablesToAbstract | searcher | instVarReaders := Set new. instVarWriters := Set new. classVarReaders := Set new. classVarWriters := Set new. searcher := ParseTreeSearcher 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: ''! hasVariablesToAbstract ^(instVarReaders isEmpty & instVarWriters isEmpty & classVarReaders isEmpty & classVarWriters isEmpty) not! ! !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: ''! removeDefinedClassVariables | selectionBlock nonMetaClass | nonMetaClass := fromClass nonMetaclass. selectionBlock := [:varName | (toClasses detect: [:each | ((each nonMetaclass) 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: ''! changeIsKindOfReferences | replacer | replacer := ParseTreeRewriter 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: ''! pullUpClassInstanceVariables | newSuperclass | newSuperclass := self abstractSuperclass metaclass. parent metaclass 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: '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: 'transforming' stamp: ''! pushUpMethods self pushUpMethodsFrom: parent. self pushUpMethodsFrom: parent metaclass! ! !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: ''! shouldPushUp: aSelector from: aClass ^((aClass isMeta ifTrue: [subclasses collect: [:each | each metaclass]] 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: ''! transform self addSuperclass; pushUpVariables; pushUpMethods; 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: ''! renameReferences | replacer | replacer := (ParseTreeRewriter 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: ''! computePoolsToMove | poolVariables searcher | poolVariables := self poolVariableNamesFor: fromClass. pools := Set new. searcher := ParseTreeSearcher 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: ''! movePool: aSymbol toClass: aClass | nonMetaClass | nonMetaClass := aClass nonMetaclass. (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: ''! poolVariableNamesIn: poolName ^(Smalltalk 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: ''! checkVariableReferencesIn: aParseTree | searcher | searcher := ParseTreeSearcher 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: ''! modifyImplementorParseTree: parseTree in: aClass | name newArg allTempVars | allTempVars := parseTree allDefinedVariables. name := self safeVariableNameFor: aClass temporaries: allTempVars. newArg := RBVariableNode named: name. parseTree arguments: parseTree arguments , (Array with: newArg). super modifyImplementorParseTree: parseTree in: aClass! ! !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: ''! parseTreeRewriter | rewriteRule oldString newString | rewriteRule := ParseTreeRewriter 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: ''! modifyImplementorParseTree: parseTree in: aClass | oldArgs | oldArgs := parseTree arguments. parseTree arguments: (permutation collect: [:each | oldArgs at: each]). parseTree selector: newSelector! ! !ChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^self subclassResponsibility! ! !ChangeMethodNameRefactoring methodsFor: 'accessing' stamp: ''! newSelector ^newSelector! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: ''! parseTreeRewriter | rewriteRule oldString newString | rewriteRule := ParseTreeRewriter 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: ''! removeRenamedImplementors self implementors do: [:each | each removeMethod: oldSelector]! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: ''! 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 compileTree: parseTree classified: (each protocolsFor: oldSelector)]! ! !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: ''! transform self renameImplementors. self renameMessageSends. oldSelector == newSelector ifTrue: [^self]. 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: ''! expressionsToInlineFrom: aTree | searcher | searcher := ParseTreeSearcher 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: ''! 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 atleast 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: ''! parseTreeRewriter | rewriteRule oldString newString | oldString := self buildSelectorString: oldSelector. newString := self buildSelectorString: newSelector withPermuteMap: permutation. rewriteRule := self hasPermutedArguments ifTrue: [ParseTreeRewriter new] ifFalse: [ParseTreeRewriter 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: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' renameMethod: #'; nextPutAll: oldSelector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' to: #'; nextPutAll: newSelector; nextPutAll: ' permuation: '. 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: ''! checkSelfReturns | searcher | searcher := ParseTreeSearcher 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: ''! 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 := ParseTreeRewriter 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: 'dvf 9/29/2001 17:58'! 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: [ParseTreeSearcher treeMatchingStatements: extractedParseTree body formattedCode in: parseTree] ifFalse: [ParseTreeSearcher 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: [ParseTreeRewriter replaceStatements: subtree formattedCode with: newCode in: parseTree onInterval: extractionInterval] ifFalse: [ParseTreeRewriter 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: ''! nameNewMethod: aSymbol | args newSend | args := parameters collect: [:parm | RBVariableNode named: parm]. extractedParseTree arguments: args asArray. extractedParseTree selector: aSymbol. aSymbol numArgs = 0 ifTrue: [modifiedParseTree := ParseTreeRewriter 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 := ParseTreeRewriter replace: self methodDelimiter with: 'self ' , newSend contents in: modifiedParseTree! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! placeholderNode | node | node := ParseTreeSearcher 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: 'bh 5/10/2000 21:56'! transform | existingSelector | existingSelector := self existingSelector. self nameNewMethod: (existingSelector isNil ifTrue: [self getNewMethodName] ifFalse: [existingSelector]). existingSelector isNil ifTrue: [class compileTree: extractedParseTree classified: (class protocolsFor: 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: ''! numberOfSelfSendsIn: aParseTree | search | search := ParseTreeSearcher 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: ''! selfSendIn: aTree | searcher | searcher := ParseTreeSearcher 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: ''! addSelfReferenceToInlineParseTree | variableName rewriter newArguments | variableName := self newNameForSelf. rewriter := ParseTreeRewriter rename: 'self' to: variableName. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]. newArguments := inlineParseTree arguments asOrderedCollection. newArguments addFirst: (RBVariableNode named: variableName). inlineParseTree arguments: newArguments; selector: (self addArgumentToSelector: inlineParseTree selector). sourceMessage receiver replaceWith: (RBVariableNode named: variableName)! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! addSelfReferenceToSourceMessage | newArguments | newArguments := sourceMessage arguments asOrderedCollection. newArguments addFirst: sourceMessage receiver copy. sourceMessage arguments: newArguments; selector: (self addArgumentToSelector: sourceMessage selector)! ! !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: ''! newNameForSelf | variableName index originalName nonMetaClass | nonMetaClass := inlineClass nonMetaclass. 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: ''! hasMultipleReturns "Do we have multiple returns? If the last statement isn't a return, then we have an implicit return of self." | searcher | searcher := ParseTreeSearcher 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: ''! normalizeIfTrues | rewriter | rewriter := ParseTreeRewriter 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: ''! normalizeReturns | rewriter | rewriter := ParseTreeRewriter 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: ''! removeEmptyIfTrues | rewriter | rewriter := ParseTreeRewriter 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: ''! removeImmediateBlocks | rewriter | rewriter := ParseTreeRewriter 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: ''! removeReturns | rewriter | rewriter := ParseTreeRewriter 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: ''! renameTemporary: oldName to: newName | rewriter | rewriter := ParseTreeRewriter new. rewriter replace: oldName with: newName; replaceArgument: oldName with: newName. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! replaceArgument: sourceNode with: replacementNode | rewriter | rewriter := ParseTreeRewriter new. rewriter replaceTree: sourceNode withTree: replacementNode. (rewriter executeTree: inlineParseTree body) ifTrue: [inlineParseTree body: rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! replaceArguments sourceMessage arguments reverse with: inlineParseTree arguments reverse do: [:replacement :source | (replacement isImmediate or: [self shouldInlineExpression: replacement formattedCode]) 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: ''! writeGuardClauses | rewriter | rewriter := ParseTreeRewriter 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: ''! hasOnlyOneAssignment | searcher | searcher := ParseTreeSearcher 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: ''! replaceReferences | rewriter | rewriter := ParseTreeRewriter 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: ''! checkAssignmentsToVariable | searcher | searcher := ParseTreeSearcher 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: ''! checkForSuperReferences | searcher | searcher := ParseTreeSearcher 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: ''! compileNewMethods moveToClasses do: [:each | each compileTree: parseTree classified: (class protocolsFor: 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: ''! getClassesForInstanceVariable | definingClass typer types | definingClass := class whoDefinesInstanceVariable: variable. typer := RefactoryTyper 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: ''! getClassesForTemporaryVariable | types | types := RefactoryTyper 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: 'rr 3/16/2004 15:14'! 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 arguments: (parameters collect: [:each | RBVariableNode named: each]) asArray; selector: newSelector! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! hasOnlySelfReturns ^hasOnlySelfReturns isNil ifTrue: [| searcher | searcher := ParseTreeSearcher 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: ''! hasSelfReferences | searcher | searcher := ParseTreeSearcher 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: 'dvf 10/13/2001 23:19'! replaceSelfReferences | replacer | self needsToReplaceSelfReferences ifTrue: [ replacer := ParseTreeRewriter new. replacer replace: 'self' with: selfVariableName. self hasOnlySelfReturns ifTrue: [replacer replace: '^self' with: '^self']. replacer executeTree: parseTree. parseTree := replacer tree].! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! replaceVariableReferences | replacer | replacer := ParseTreeRewriter 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: ''! verifyTemporaryVariableDoesNotOverride (parseTree allDefinedVariables includes: selfVariableName) ifTrue: [^false]. moveToClasses do: [:each | (each definesVariable: selfVariableName) ifTrue: [^false]]. ^true! ! 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: ''! subblocksIn: aParseTree | searcher | searcher := ParseTreeSearcher 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: ''! usesDirectly: aParseTree | searcher | searcher := ParseTreeSearcher new. searcher matches: '[:`@args | | `@temps | `@.Statements]' do: [:aNode :answer | answer]; matches: name do: [:aNode :answer | true]. ^searcher executeTree: aParseTree initialAnswer: false! ! 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: #PushUpMethodRefactoring instanceVariableNames: 'removeDuplicates selectors' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PushUpMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk pushUp: selectorCollection from: aClass ^(self new) model: aRBSmalltalk; pushUp: selectorCollection from: aClass; yourself! ! !PushUpMethodRefactoring class methodsFor: 'instance creation' stamp: ''! pushUp: selectorCollection from: aClass ^self new pushUp: selectorCollection from: aClass! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! 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 push up <1s> since it would override the method defined in <2p>' expandMacrosWith: aSelector with: definingClass)]]]]! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkClassVars selectors do: [:each | self checkClassVarsFor: each]! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkClassVarsFor: aSelector class nonMetaclass 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)]]! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkInstVars selectors do: [:each | self checkInstVarsFor: each]! ! !PushUpMethodRefactoring 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)]]! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! 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 push up <1s> since <2p>>><3s> sends a super message to it.' expandMacrosWith: aSelector with: aRBClass with: each)]]]]]. aRBClass allSubclasses do: [:each | self checkSiblingSuperSendsFrom: each]! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperMessages self checkSuperSendsFromPushedUpMethods. self checkSuperSendsFromSiblings! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperSendsFromPushedUpMethods selectors do: [:each | | parseTree | parseTree := class parseTreeFor: each. (parseTree superMessages detect: [:sup | class superclass directlyDefinesMethod: sup] ifNone: [nil]) notNil ifTrue: [self refactoringError: ('Cannot push up <1s> since it sends a super message that is defined in the superclass.' expandMacrosWith: each)]]! ! !PushUpMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkSuperSendsFromSiblings | siblings | siblings := class superclass subclasses reject: [:each | each = class]. siblings do: [:aRBClass | self checkSiblingSuperSendsFrom: aRBClass]! ! !PushUpMethodRefactoring 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]! ! !PushUpMethodRefactoring methodsFor: 'private' stamp: ''! 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 push 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]! ! !PushUpMethodRefactoring methodsFor: 'transforming' stamp: ''! copyDownMethods selectors do: [:each | self copyDownMethod: each]! ! !PushUpMethodRefactoring 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])! ! !PushUpMethodRefactoring methodsFor: 'transforming' stamp: ''! pushUp: 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)! ! !PushUpMethodRefactoring methodsFor: 'initialize-release' stamp: ''! pushUp: selectorCollection from: aClass class := self classObjectFor: aClass. selectors := selectorCollection. removeDuplicates := false! ! !PushUpMethodRefactoring methodsFor: 'transforming' stamp: ''! pushUpMethods selectors do: [:each | self pushUp: each]! ! !PushUpMethodRefactoring methodsFor: 'transforming' stamp: ''! removeDuplicateMethods selectors do: [:each | self removeDuplicatesOf: each]! ! !PushUpMethodRefactoring 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]]! ! !PushUpMethodRefactoring methodsFor: 'transforming' stamp: ''! removePushedUpMethods selectors do: [:each | class removeMethod: each]! ! !PushUpMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' pushUp: '. selectors asArray storeOn: aStream. aStream nextPutAll: ' from: '. class storeOn: aStream. aStream nextPut: $)! ! !PushUpMethodRefactoring methodsFor: 'transforming' stamp: ''! transform self copyDownMethods; pushUpMethods; removePushedUpMethods; removeDuplicateMethods! ! 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: ''! justSendsSuper: aSelector | matcher parseTree superclass | matcher := ParseTreeSearcher 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 := ParseTreeSearcher 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: ''! renameNode: aParseTree (aParseTree whoDefines: newName) notNil ifTrue: [self refactoringError: newName , ' is already defined']. (aParseTree allDefinedVariables includes: newName) ifTrue: [self refactoringError: newName , ' is already defined']. (ParseTreeRewriter 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: ''! transform | parseTree matcher protocols | parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']. protocols := class protocolsFor: selector. class removeMethod: selector. class addInstanceVariable: temporaryVariableName. (matcher := ParseTreeRewriter removeTemporaryNamed: temporaryVariableName) executeTree: parseTree. class compileTree: matcher tree classified: protocols! ! !Refactoring class methodsFor: '-- all --' stamp: 'nk 2/23/2005 14:34'! initializeRefactoringOptions "self initializeRefactoringOptions" RefactoringOptions := IdentityDictionary new. RefactoringOptions at: #implementorToInline put: [:ref :imps | ChooserMorph choose: 'Which implementation should be inlined?' multipleSelect: false fromList: imps values: imps cancel: []]; at: #methodName put: [:ref :methodName | MethodNameEditor modalEditorForMethodName: methodName]; at: #selfArgumentName put: [:ref | ref request: 'Enter name for argument to refer to "self" in extracted method']; at: #selectVariableToMoveTo put: [:ref :class :selector | | parseTree nameList ignoreList | parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [parseTree := RBMethodNode selector: #value body: (RBSequenceNode statements: #())]. nameList := OrderedCollection new. nameList add: '---- Arguments ----'; addAll: parseTree argumentNames asSortedCollection; add: '---- Instance Variables ----'. ignoreList := OrderedCollection with: 1 with: nameList size. nameList addAll: class allInstanceVariableNames asSortedCollection. nameList at: (PopUpMenu labelArray: nameList lines: #()) startUp]; at: #variableTypes put: [:ref :types :selected | ChooserMorph choose: 'Choose types' multipleSelect: true fromList: types values: types cancel: [] initialSelections: selected]; at: #extractAssignment put: [:ref :varName | ref confirm: ('Do you want to extract the assignment of <1s>at the end of selection?' expandMacrosWith: varName)]; at: #inlineExpression put: [:ref :string | ref confirm: ('Do you want to inline "<1s>"? If not, it will be assigned as a temporary.' expandMacrosWith: string)]; at: #alreadyDefined put: [:ref :cls :selector | ref confirm: ('<1s> is already defined in the <2p> hierarchy.Extracting it to an existing selector may change behavior.Do you wish to use <1s> anyway?' expandMacrosWith: selector with: cls)]; at: #useExistingMethod put: [:ref :selector | ref confirm: 'Use existing method ' , selector , ' instead of creating new method?']; at: #openBrowser put: [:ref :env | env openEditor]! ! !Refactoring class methodsFor: 'accessing signal' stamp: ''! preconditionSignal ^RefactoringError , RefactoringWarning! ! !Refactoring class methodsFor: 'accessing' stamp: ''! refactoringOptions RefactoringOptions isNil ifTrue: [self initializeRefactoringOptions]. ^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: 'initialize-release' stamp: ''! initialize! ! !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: ''! poolVariableNamesFor: aClass | pools | pools := Set new. aClass withAllSuperclasses do: [:each | each allPoolDictionaryNames do: [:pool | pools addAll: ((Smalltalk 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: 'md 8/2/2005 23:35'! refactoringError: aString RefactoringError signal: aString! ! !Refactoring methodsFor: 'private' stamp: ''! refactoringError: aString with: aBlock RefactoringError raiseSignal: aString with: aBlock! ! !Refactoring methodsFor: 'private' stamp: 'md 8/2/2005 23:35'! refactoringWarning: aString RefactoringWarning signal: aString! ! !Refactoring methodsFor: 'requests' stamp: 'rr 3/26/2004 10:16'! request: aString ^FillInTheBlank request: 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: 'requests' stamp: ''! selectVariableToMoveMethodTo: aSelector class: aClass ^(self options at: #selectVariableToMoveTo) value: self value: aClass value: aSelector! ! !Refactoring methodsFor: 'requests' stamp: 'rr 3/15/2004 11:48'! selectVariableTypesFrom: initialTypeCollection selected: selectedTypeCollection "Temporary workaround to get something usable here, which will avoid entering the emergency evaluator too..." "^(self options at: #variableTypes) value: self value: initialTypeCollection value: selectedTypeCollection" | init classes | init := ''. initialTypeCollection do: [:each | init := init, each asString, Character space asString]. classes := FillInTheBlank request: 'Here are the types found by the RefactoryTyper. Since you are smarter than it, you can edit the list to add or remove relevant classes at your will' initialAnswer: init. ^ (classes findTokens: Character space asString) collect: [:each | self model classFor: (Smalltalk at: each withBlanksTrimmed asSymbol)]. ! ! !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: ''! whichVariableNode: aParseTree inInterval: anInterval name: aName | matcher block | matcher := ParseTreeSearcher 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: ''! hasReferencesTo: aSymbol | literal | literal := Smalltalk 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: ''! 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 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: ''! abstractReferenceTo: each | setterMethod replacer accessorRef getterMethod | accessorRef := CreateAccessorsForVariableRefactoring variable: each class: newClass classVariable: false. self performComponentRefactoring: accessorRef. getterMethod := accessorRef getterMethod. setterMethod := accessorRef setterMethod. replacer := ParseTreeRewriter 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: ''! abstractClassReferences | replacer | replacer := ParseTreeRewriter variable: variableName getter: self accessorsRefactoring getterMethod setter: self accessorsRefactoring setterMethod. self convertClasses: class metaclass withAllSubclasses select: [:aClass | (aClass whichSelectorsReferToClassVariable: variableName) reject: [:each | aClass == class metaclass and: [each == self accessorsRefactoring getterMethod or: [each == self accessorsRefactoring setterMethod]]]] using: replacer! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''! abstractInstanceReferences | replacer | replacer := ParseTreeRewriter classVariable: variableName getter: self accessorsRefactoring getterMethod setter: 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: ''! abstractReferences | replacer | replacer := ParseTreeRewriter 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: ''! definingClass ^classVariable ifTrue: [class metaclass] ifFalse: [class]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! findGetterMethod | definingClass matcher | definingClass := self definingClass. matcher := ParseTreeSearcher 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: ''! findSetterMethod | definingClass matcher | definingClass := self definingClass. matcher := self needsReturnForSetter ifTrue: [ParseTreeSearcher returnSetterMethod: variableName] ifFalse: [ParseTreeSearcher 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: ''! usesAssignmentOf: aString in: aClass classVariable: isClassVar | matcher definingClass | matcher := ParseTreeSearcher new. matcher answer: false; matches: aString , ' := ``@object' do: [:aNode :answer | answer or: [aNode isUsed]]. definingClass := isClassVar ifTrue: [aClass nonMetaclass] ifFalse: [aClass]. ^(definingClass withAllSubclasses , (isClassVar ifTrue: [definingClass metaclass 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: ''! getterSetterMethods | matcher | matcher := ParseTreeSearcher 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: ''! subclassDefiningVariable | subclasses | subclasses := class allSubclasses select: [:each | 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: 'rr 3/11/2004 22:03'! findDestinationClass | classVarName classes classVar cond | classVarName := variableName asSymbol. classVar := class realClass classPool associationAt: classVarName. cond := [:eachClass | ((eachClass allCallsOn: classVar) select: [:eachRef | eachRef actualClass = eachClass]) isEmpty]. classes := class withAllSubclasses reject: [:each | (cond value: each realClass) and: [cond value: each realClass class]]. 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: ''! 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 metaclass 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: 'rr 3/11/2004 11:06'! 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: ''! renameReferences | replacer subclasses | replacer := ParseTreeRewriter 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 metaclass 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: ''! renameReferences | replacer | replacer := ParseTreeRewriter 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: ''! instance Instance isNil ifTrue: [Instance := self basicNew. Instance initialize]. ^Instance! ! !RefactoringManager class methodsFor: 'instance creation' stamp: ''! new ^self shouldNotImplement! ! !RefactoringManager class methodsFor: 'public access' stamp: ''! nuke Instance notNil ifTrue: [Instance release]. Instance := nil! ! !RefactoringManager class methodsFor: 'parcel load/unload/save' stamp: ''! preUnloadActionFor: aParcel ^RefactoringManager 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]! ! Object subclass: #RefactoryChange instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! RefactoryChange subclass: #CompositeRefactoryChange instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !CompositeRefactoryChange class methodsFor: 'instance creation' stamp: ''! named: aString ^(self new) name: aString; yourself! ! !CompositeRefactoryChange methodsFor: 'comparing' stamp: ''! = aRefactoryBuilder self class = aRefactoryBuilder class ifFalse: [^false]. changes size = aRefactoryBuilder changes size ifFalse: [^false]. changes with: aRefactoryBuilder changes do: [:each :change | each = change ifFalse: [^false]]. ^true! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! addChange: aRefactoryChange changes add: aRefactoryChange. ^aRefactoryChange! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! addChangeFirst: aRefactoryChange changes addFirst: aRefactoryChange. ^aRefactoryChange! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! addClassVariable: variableName to: aClass ^self addChange: (AddClassVariableChange add: variableName to: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! addInstanceVariable: variableName to: aClass ^self addChange: (AddInstanceVariableChange add: variableName to: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! addPool: aPoolVariable to: aClass ^self addChange: (AddPoolVariableChange add: aPoolVariable to: aClass)! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! changeForClass: aRBClass selector: aSelector changes reverseDo: [:each | | change | change := each changeForClass: aRBClass selector: aSelector. change notNil ifTrue: [^change]]. ^nil! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! changeForMetaclass: aSymbol selector: aSelector changes reverseDo: [:each | | change | change := each changeForMetaclass: aSymbol selector: aSelector. change notNil ifTrue: [^change]]. ^nil! ! !CompositeRefactoryChange methodsFor: 'private-inspector accessing' stamp: ''! changes ^changes! ! !CompositeRefactoryChange methodsFor: 'private-inspector accessing' stamp: ''! changes: aCollection changes := aCollection! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! changesSize ^changes inject: 0 into: [:sum :each | sum + each changesSize]! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! compile: source in: class ^self addChange: (AddMethodChange compile: source in: class)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! compile: source in: class classified: aProtocol ^self addChange: (AddMethodChange compile: source in: class classified: aProtocol)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! defineClass: aString ^self addChange: (AddClassChange definition: aString)! ! !CompositeRefactoryChange methodsFor: 'printing' stamp: ''! displayString ^super displayString asText allBold! ! !CompositeRefactoryChange methodsFor: 'private' stamp: ''! executeNotifying: aBlock | undos undo | undos := changes collect: [:each | each executeNotifying: aBlock]. undo := self copy. undo changes: undos reverse. ^undo! ! !CompositeRefactoryChange methodsFor: 'private' stamp: ''! flattenOnto: aCollection changes do: [:each | each flattenOnto: aCollection]! ! !CompositeRefactoryChange methodsFor: 'comparing' stamp: ''! hash ^changes size! ! !CompositeRefactoryChange methodsFor: 'initialize-release' stamp: ''! initialize super initialize. changes := OrderedCollection new! ! !CompositeRefactoryChange methodsFor: 'user interface' stamp: 'bh 11/8/2000 13:45'! inspect "CompositeRefactoryChangeInspector openOn: self" self needsWork. ^super inspect.! ! !CompositeRefactoryChange methodsFor: 'copying' stamp: ''! postCopy super postCopy. changes := changes collect: [:each | each copy]! ! !CompositeRefactoryChange methodsFor: 'printing' stamp: 'dvf 9/16/2001 00:56'! printOn: aStream name ifNotNil: [aStream nextPutAll: name] ifNil: [aStream nextPutAll: 'a CompositeRefactoringChange']! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! problemCount ^self changesSize! ! !CompositeRefactoryChange methodsFor: 'private-inspector accessing' stamp: ''! removeChange: aChange changes remove: aChange ifAbsent: []! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! removeClass: aClass ^self addChange: (RemoveClassChange removeClassName: aClass name)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! removeClassNamed: aSymbol self addChange: (RemoveClassChange removeClassName: aSymbol)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! removeClassVariable: variableName from: aClass ^self addChange: (RemoveClassVariableChange remove: variableName from: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! removeInstanceVariable: variableName from: aClass ^self addChange: (RemoveInstanceVariableChange remove: variableName from: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! removeMethod: aSelector from: aClass ^self addChange: (RemoveMethodChange remove: aSelector from: aClass)! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: ''! renameChangesForClass: aClassName to: newClassName ^(self copy) changes: (self changes collect: [:each | each renameChangesForClass: aClassName to: newClassName]); yourself! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: ''! renameClass: class to: newName ^self addChange: (RenameClassChange rename: class name to: newName)! ! CompositeRefactoryChange subclass: #RenameClassChange instanceVariableNames: 'oldName newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RenameClassChange class methodsFor: 'instance creation' stamp: ''! rename: oldString to: newString ^(self new) rename: oldString to: newString; yourself! ! !RenameClassChange methodsFor: 'comparing' stamp: ''! = aRenameClassChange super = aRenameClassChange ifFalse: [^false]. ^oldName = aRenameClassChange oldName and: [newName = aRenameClassChange newName]! ! !RenameClassChange methodsFor: 'accessing' stamp: ''! changeClass ^Smalltalk at: oldName asSymbol ifAbsent: [Smalltalk at: newName asSymbol]! ! !RenameClassChange methodsFor: 'private' stamp: ''! executeNotifying: aBlock | undos | self changeClass rename: newName. undos := changes collect: [:each | (each renameChangesForClass: oldName asSymbol to: newName asSymbol) executeNotifying: aBlock]. ^(self copy) changes: undos reverse; rename: newName to: oldName; yourself! ! !RenameClassChange methodsFor: 'private' stamp: ''! flattenOnto: aCollection aCollection add: (self copy changes: (changes inject: OrderedCollection new into: [:sum :each | each flattenOnto: sum. sum]))! ! !RenameClassChange methodsFor: 'private' stamp: ''! newName ^newName! ! !RenameClassChange methodsFor: 'private' stamp: ''! oldName ^oldName! ! !RenameClassChange methodsFor: 'printing' stamp: 'lr 2/7/2008 22:18'! printOn: aStream aStream nextPutAll: self oldName; nextPutAll: ' rename: '; print: self newName; nextPut: $!!! ! !RenameClassChange methodsFor: 'initialize-release' stamp: ''! rename: oldString to: newString oldName := oldString. newName := newString! ! !RenameClassChange methodsFor: 'accessing' stamp: ''! renameChangesForClass: aClassName to: newClassName | change | change := super renameChangesForClass: aClassName to: newClassName. oldName asSymbol == aClassName ifTrue: [change rename: newClassName to: newName]. ^change! ! CompositeRefactoryChange subclass: #RenameVariableChange instanceVariableNames: 'className isMeta oldName newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! RenameVariableChange subclass: #RenameClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RenameClassVariableChange methodsFor: 'private' stamp: ''! addNewVariable (AddClassVariableChange add: newName to: self changeClass) execute! ! !RenameClassVariableChange methodsFor: 'private' stamp: ''! copyOldValuesToNewVariable | oldValue | oldValue := self changeClass classPool at: oldName ifAbsent: []. self changeClass classPool at: newName asSymbol put: oldValue! ! !RenameClassVariableChange methodsFor: 'printing' stamp: 'lr 2/7/2008 21:38'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeClassVarNamed: '; print: self oldName; nextPut: $!!; cr. aStream nextPutAll: self displayClassName; nextPutAll: ' addClassVarNamed: '; print: self newName; nextPut: $!!! ! !RenameClassVariableChange methodsFor: 'private' stamp: ''! removeOldVariable (RemoveClassVariableChange remove: oldName from: self changeClass) execute! ! RenameVariableChange subclass: #RenameInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RenameInstanceVariableChange methodsFor: 'private' stamp: ''! addNewVariable (AddInstanceVariableChange add: newName to: self changeClass) execute! ! !RenameInstanceVariableChange methodsFor: 'private' stamp: ''! copyOldValuesToNewVariable | newIndex oldIndex | oldIndex := self changeClass allInstVarNames indexOf: oldName asString. newIndex := self changeClass allInstVarNames indexOf: newName asString. self changeClass withAllSubclasses do: [:each | each allInstances do: [:inst | inst instVarAt: newIndex put: (inst instVarAt: oldIndex)]]! ! !RenameInstanceVariableChange methodsFor: 'printing' stamp: 'lr 2/7/2008 21:38'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeInstVarNamed: '; print: self oldName; nextPut: $!!; cr. aStream nextPutAll: self displayClassName; nextPutAll: ' addInstVarNamed: '; print: self newName; nextPut: $!!! ! !RenameInstanceVariableChange methodsFor: 'private' stamp: ''! removeOldVariable (RemoveInstanceVariableChange remove: oldName from: self changeClass) execute! ! !RenameVariableChange class methodsFor: 'instance creation' stamp: ''! rename: oldName to: newName in: aClass ^(self new) oldName: oldName; newName: newName; changeClass: aClass; yourself! ! !RenameVariableChange methodsFor: 'comparing' stamp: ''! = aRenameVariableChange self class = aRenameVariableChange class ifFalse: [^false]. ^className = aRenameVariableChange changeClassName and: [isMeta = aRenameVariableChange isMeta and: [oldName = aRenameVariableChange oldName and: [newName = aRenameVariableChange newName]]]! ! !RenameVariableChange methodsFor: 'private' stamp: ''! addNewVariable self subclassResponsibility! ! !RenameVariableChange methodsFor: 'accessing' stamp: ''! changeClass | class | class := Smalltalk at: self changeClassName ifAbsent: [^nil]. ^isMeta ifTrue: [class class] ifFalse: [class]! ! !RenameVariableChange methodsFor: 'accessing' stamp: ''! changeClass: aBehavior isMeta := aBehavior isMeta. className := isMeta ifTrue: [aBehavior soleInstance name] ifFalse: [aBehavior name]! ! !RenameVariableChange methodsFor: 'accessing' stamp: ''! changeClassName ^className! ! !RenameVariableChange methodsFor: 'accessing' stamp: ''! changeClassName: aSymbol className := aSymbol. isMeta isNil ifTrue: [isMeta := false]! ! !RenameVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Rename ' , oldName , ' to ' , newName! ! !RenameVariableChange methodsFor: 'private' stamp: ''! copyOldValuesToNewVariable self subclassResponsibility! ! !RenameVariableChange methodsFor: 'printing' stamp: ''! displayClassName ^isMeta ifTrue: [self changeClassName , ' class'] ifFalse: [self changeClassName asString]! ! !RenameVariableChange methodsFor: 'private' stamp: ''! executeNotifying: aBlock | undo | self addNewVariable. self copyOldValuesToNewVariable. undo := super executeNotifying: aBlock. undo oldName: newName; newName: oldName. self removeOldVariable. ^undo! ! !RenameVariableChange methodsFor: 'comparing' stamp: ''! hash ^(self changeClassName hash bitXor: self oldName hash) bitXor: self newName hash! ! !RenameVariableChange methodsFor: 'private' stamp: ''! isMeta ^isMeta! ! !RenameVariableChange methodsFor: 'accessing' stamp: ''! newName ^newName! ! !RenameVariableChange methodsFor: 'private' stamp: ''! newName: aString newName := aString! ! !RenameVariableChange methodsFor: 'accessing' stamp: ''! oldName ^oldName! ! !RenameVariableChange methodsFor: 'private' stamp: ''! oldName: aString oldName := aString! ! !RenameVariableChange methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self displayString! ! !RenameVariableChange methodsFor: 'private' stamp: ''! removeOldVariable self subclassResponsibility! ! !RefactoryChange methodsFor: 'accessing' stamp: ''! changeForClass: aRBClass selector: aSelector ^nil! ! !RefactoryChange methodsFor: 'accessing' stamp: ''! changeForMetaclass: aSymbol selector: aSelector ^nil! ! !RefactoryChange methodsFor: 'printing' stamp: ''! changeString ^self class name! ! !RefactoryChange methodsFor: 'accessing' stamp: ''! changes ^Array with: self! ! !RefactoryChange methodsFor: 'accessing' stamp: ''! changesSize ^1! ! !RefactoryChange methodsFor: 'copying' stamp: 'bh 3/16/2000 23:27'! copy ^(super copy) postCopy; yourself! ! !RefactoryChange methodsFor: 'printing' stamp: ''! displayString ^name isNil ifTrue: [self changeString] ifFalse: [name]! ! !RefactoryChange methodsFor: 'performing-changes' stamp: ''! execute ^self executeNotifying: []! ! !RefactoryChange methodsFor: 'private' stamp: ''! executeNotifying: aBlock self subclassResponsibility! ! !RefactoryChange methodsFor: 'private' stamp: 'dvf 9/21/2003 16:35'! flattenOnto: aCollection aCollection add: self! ! !RefactoryChange methodsFor: 'private' stamp: ''! flattenedChanges | changes | changes := OrderedCollection new. self flattenOnto: changes. ^changes! ! !RefactoryChange methodsFor: 'initialize-release' stamp: ''! initialize! ! !RefactoryChange methodsFor: 'user interface' stamp: 'bh 5/8/2000 21:13'! inspect ^((CompositeRefactoryChange new) changes: (Array with: self); yourself) inspect! ! !RefactoryChange methodsFor: 'accessing' stamp: ''! name ^name isNil ifTrue: [self changeString] ifFalse: [name]! ! !RefactoryChange methodsFor: 'initialize-release' stamp: ''! name: aString name := aString! ! !RefactoryChange methodsFor: 'copying' stamp: 'dvf 9/21/2003 16:35'! postCopy ^self! ! !RefactoryChange methodsFor: 'accessing' stamp: ''! renameChangesForClass: aClassName to: newClassName "We're in the middle of performing a rename operation. If we stored the class name, we need to change the class name to the new name to perform the compiles." self subclassResponsibility! ! RefactoryChange subclass: #RefactoryClassChange instanceVariableNames: 'className isMeta' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! RefactoryClassChange subclass: #AddClassChange instanceVariableNames: 'definition superclassName instanceVariableNames classVariableNames poolDictionaryNames category' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !AddClassChange class methodsFor: 'instance creation' stamp: 'bh 11/8/2000 13:51'! definition: aString ^self new definition: aString! ! !AddClassChange methodsFor: 'comparing' stamp: ''! = anAddClassChange self class = anAddClassChange class ifFalse: [^false]. ^definition = anAddClassChange definition! ! !AddClassChange methodsFor: 'converting' stamp: ''! asUndoOperation | class | class := Smalltalk at: self changeClassName ifAbsent: [nil]. ^class isBehavior ifTrue: [AddClassChange definition: class definition] ifFalse: [RemoveClassChange removeClassName: self changeClassName]! ! !AddClassChange methodsFor: 'accessing' stamp: ''! category category isNil ifTrue: [self fillOutDefinition]. ^category! ! !AddClassChange methodsFor: 'accessing' stamp: ''! changeClassName className isNil ifTrue: [self fillOutDefinition]. ^className! ! !AddClassChange methodsFor: 'printing' stamp: ''! changeString ^'Define ' , self displayClassName! ! !AddClassChange methodsFor: 'accessing' stamp: ''! classVariableNames classVariableNames isNil ifTrue: [self fillOutDefinition]. ^classVariableNames! ! !AddClassChange methodsFor: 'private' stamp: ''! controller ^nil! ! !AddClassChange methodsFor: 'private' stamp: ''! definingSuperclass ^self class! ! !AddClassChange methodsFor: 'private' stamp: ''! definition ^definition! ! !AddClassChange methodsFor: 'initialize-release' stamp: ''! definition: aString definition := aString! ! !AddClassChange methodsFor: 'private' stamp: ''! fillOutDefinition | parseTree | parseTree := RBParser parseExpression: definition onError: [:str :pos | ^self parseDefinitionError]. parseTree isMessage ifFalse: [^self parseDefinitionError]. (self isValidSubclassCreationMessage: parseTree) ifFalse: [^self parseDefinitionError]. superclassName := parseTree receiver isVariable ifTrue: [parseTree receiver name asSymbol] ifFalse: [parseTree receiver value]. className := parseTree arguments first value. instanceVariableNames := self namesIn: (parseTree arguments at: 2) value. classVariableNames := self namesIn: (parseTree arguments at: 3) value. poolDictionaryNames := self namesIn: (parseTree arguments at: 4) value. category := parseTree arguments size < 5 ifTrue: [#Unknown] ifFalse: [(parseTree arguments at: 5) value asSymbol]! ! !AddClassChange methodsFor: 'comparing' stamp: ''! hash ^definition hash! ! !AddClassChange methodsFor: 'initialize-release' stamp: ''! initialize super initialize. isMeta := false! ! !AddClassChange methodsFor: 'accessing' stamp: ''! instanceVariableNames instanceVariableNames isNil ifTrue: [self fillOutDefinition]. ^instanceVariableNames! ! !AddClassChange methodsFor: 'testing' stamp: 'bh 11/8/2000 12:29'! isValidMessageName: aMessageNode ^#("#subclass:instanceVariableNames:classVariableNames:poolDictionaries:" #subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: "#variableByteSubclass:classVariableNames:poolDictionaries:" #variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: "#variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:" #variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:) includes: aMessageNode selector! ! !AddClassChange methodsFor: 'testing' stamp: ''! isValidSubclassCreationMessage: aMessageNode (aMessageNode receiver isVariable or: [aMessageNode receiver isLiteral]) ifFalse: [^false]. (self isValidMessageName: aMessageNode) ifFalse: [^false]. ^(aMessageNode arguments detect: [:each | each isLiteral not] ifNone: [nil]) isNil! ! !AddClassChange methodsFor: 'private' stamp: ''! namesIn: aString | names stream nameStream | names := OrderedCollection new. stream := ReadStream on: aString. [stream skipSeparators. stream atEnd] whileFalse: [nameStream := WriteStream on: (String new: 10). [stream atEnd or: [stream peek isSeparator]] whileFalse: [nameStream nextPut: stream next]. names add: nameStream contents]. ^names! ! !AddClassChange methodsFor: 'private' stamp: ''! parseDefinitionError className := #'Unknown Class'. instanceVariableNames := #(). classVariableNames := #(). poolDictionaryNames := #()! ! !AddClassChange methodsFor: 'accessing' stamp: ''! poolDictionaryNames poolDictionaryNames isNil ifTrue: [self fillOutDefinition]. ^poolDictionaryNames! ! !AddClassChange methodsFor: 'private' stamp: ''! primitiveExecute ^self definingSuperclass subclassDefinerClass evaluate: definition notifying: self controller logged: true! ! !AddClassChange methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: definition; nextPut: $!!! ! !AddClassChange methodsFor: 'accessing' stamp: ''! superclassName className isNil ifTrue: [self fillOutDefinition]. ^superclassName! ! AddClassChange subclass: #InteractiveAddClassChange instanceVariableNames: 'controller definedClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !InteractiveAddClassChange class methodsFor: 'instance creation' stamp: ''! definition: aString for: aController ^(self definition: aString) controller: aController; yourself! ! !InteractiveAddClassChange methodsFor: 'private' stamp: ''! controller ^controller! ! !InteractiveAddClassChange methodsFor: 'private' stamp: ''! controller: aController controller := aController! ! !InteractiveAddClassChange methodsFor: 'accessing' stamp: ''! definedClass ^definedClass! ! !InteractiveAddClassChange methodsFor: 'private' stamp: ''! primitiveExecute definedClass := super primitiveExecute! ! RefactoryClassChange subclass: #AddMethodChange instanceVariableNames: 'source selector protocols' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !AddMethodChange class methodsFor: 'instance creation' stamp: ''! compile: aString in: aClass ^self new class: aClass source: aString! ! !AddMethodChange class methodsFor: 'instance creation' stamp: ''! compile: aString in: aBehavior classified: aProtocol ^self new class: aBehavior protocol: aProtocol source: aString! ! !AddMethodChange methodsFor: 'comparing' stamp: ''! = anAddMethodChange super = anAddMethodChange ifFalse: [^false]. ^self parseTree = anAddMethodChange parseTree! ! !AddMethodChange methodsFor: 'converting' stamp: ''! asUndoOperation ^(self changeClass includesSelector: self selector) ifTrue: [| oldProtocol | oldProtocol := BrowserEnvironment new whichProtocolIncludes: self selector in: self changeClass. oldProtocol isNil ifTrue: [oldProtocol := #accessing]. AddMethodChange compile: (self methodSourceFor: self selector) in: self changeClass classified: oldProtocol] ifFalse: [RemoveMethodChange remove: selector from: self changeClass]! ! !AddMethodChange methodsFor: 'accessing' stamp: ''! changeForClass: aSymbol selector: aSelector ^(isMeta not and: [self selector = aSelector and: [className = aSymbol]]) ifTrue: [self] ifFalse: [nil]! ! !AddMethodChange methodsFor: 'accessing' stamp: ''! changeForMetaclass: aSymbol selector: aSelector ^(isMeta and: [self selector = aSelector and: [className = aSymbol]]) ifTrue: [self] ifFalse: [nil]! ! !AddMethodChange methodsFor: 'printing' stamp: ''! changeString ^self displayClassName , '>>' , self selector! ! !AddMethodChange methodsFor: 'initialize-release' stamp: ''! class: aClass protocol: aProtocol source: aString self changeClass: aClass. self protocols: aProtocol. source := aString! ! !AddMethodChange methodsFor: 'initialize-release' stamp: ''! class: aClass source: aString self changeClass: aClass. source := aString. self protocols: (BrowserEnvironment new whichProtocolIncludes: self selector in: aClass)! ! !AddMethodChange methodsFor: 'private' stamp: ''! controller ^nil! ! !AddMethodChange methodsFor: 'comparing' stamp: ''! hash ^self parseTree hash! ! !AddMethodChange methodsFor: 'private' stamp: ''! parseTree ^RBParser parseMethod: source onError: [:str :pos | ^nil]! ! !AddMethodChange methodsFor: 'private' stamp: ''! primitiveExecute ^self changeClass compile: source classified: self protocol notifying: self controller! ! !AddMethodChange methodsFor: 'printing' stamp: 'nk 3/5/2005 15:51'! printOn: aStream aStream nextPut: $!!; nextPutAll: self displayClassName; nextPutAll: ' methodsFor: '''; nextPutAll: self protocol; nextPutAll: ''' stamp: '; print: Utilities changeStamp; nextPut: $!!; cr; nextPutAll: (source copyReplaceAll: '!!' with: '!!!!'); nextPutAll: '!! !!'! ! !AddMethodChange methodsFor: 'accessing' stamp: ''! protocol ^self protocols first! ! !AddMethodChange methodsFor: 'accessing' stamp: ''! protocols ^protocols! ! !AddMethodChange methodsFor: 'initialize-release' stamp: ''! protocols: aCollection protocols := aCollection isString ifTrue: [Array with: aCollection] ifFalse: [aCollection]. protocols isNil ifTrue: [protocols := #(#accessing)]! ! !AddMethodChange methodsFor: 'accessing' stamp: ''! selector selector isNil ifTrue: [selector := RBParser parseMethodPattern: source. selector isNil ifTrue: [selector := #unknown]]. ^selector! ! AddMethodChange subclass: #InteractiveAddMethodChange instanceVariableNames: 'controller definedSelector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !InteractiveAddMethodChange class methodsFor: 'instance creation' stamp: ''! compile: aString in: aBehavior classified: aProtocol for: aController ^(self compile: aString in: aBehavior classified: aProtocol) controller: aController; yourself! ! !InteractiveAddMethodChange class methodsFor: 'instance creation' stamp: ''! compile: aString in: aClass for: aController ^(self compile: aString in: aClass) controller: aController; yourself! ! !InteractiveAddMethodChange methodsFor: 'private' stamp: ''! controller ^controller! ! !InteractiveAddMethodChange methodsFor: 'private' stamp: ''! controller: aController controller := aController! ! !InteractiveAddMethodChange methodsFor: 'accessing' stamp: ''! definedSelector ^definedSelector! ! !InteractiveAddMethodChange methodsFor: 'private' stamp: ''! primitiveExecute ^definedSelector := super primitiveExecute! ! !RefactoryClassChange methodsFor: 'comparing' stamp: ''! = aRefactoryClassChange self class = aRefactoryClassChange class ifFalse: [^false]. ^className = aRefactoryClassChange changeClassName and: [isMeta = aRefactoryClassChange isMeta]! ! !RefactoryClassChange methodsFor: 'converting' stamp: ''! asUndoOperation ^self subclassResponsibility! ! !RefactoryClassChange methodsFor: 'accessing' stamp: 'dc 5/8/2007 13:19'! changeClass | class | class := Smalltalk at: self changeClassName ifAbsent: [^nil]. ^isMeta ifTrue: [class classSide] ifFalse: [class]! ! !RefactoryClassChange methodsFor: 'accessing' stamp: ''! changeClass: aBehavior isMeta := aBehavior isMeta. className := isMeta ifTrue: [aBehavior soleInstance name] ifFalse: [aBehavior name]! ! !RefactoryClassChange methodsFor: 'accessing' stamp: ''! changeClassName ^className! ! !RefactoryClassChange methodsFor: 'accessing' stamp: ''! changeClassName: aSymbol className := aSymbol. isMeta isNil ifTrue: [isMeta := false]! ! !RefactoryClassChange methodsFor: 'printing' stamp: ''! changeString ^self displayClassName! ! !RefactoryClassChange methodsFor: 'printing' stamp: ''! displayClassName ^isMeta ifTrue: [self changeClassName , ' class'] ifFalse: [self changeClassName asString]! ! !RefactoryClassChange methodsFor: 'private' stamp: ''! executeNotifying: aBlock | undo | undo := self asUndoOperation. undo name: self name. self primitiveExecute. aBlock value. ^undo! ! !RefactoryClassChange methodsFor: 'comparing' stamp: ''! hash ^self changeClassName hash! ! !RefactoryClassChange methodsFor: 'private' stamp: ''! isMeta ^isMeta! ! !RefactoryClassChange methodsFor: 'accessing' stamp: ''! methodSourceFor: aSymbol (self changeClass includesSelector: aSymbol) ifFalse: [^nil]. ^self changeClass sourceCodeAt: aSymbol! ! !RefactoryClassChange methodsFor: 'private' stamp: ''! primitiveExecute ^self subclassResponsibility! ! !RefactoryClassChange methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self displayString! ! !RefactoryClassChange methodsFor: 'accessing' stamp: ''! renameChangesForClass: aClassName to: newClassName self changeClassName == aClassName ifTrue: [^(self copy) changeClassName: newClassName; yourself]. ^self! ! RefactoryClassChange subclass: #RefactoryVariableChange instanceVariableNames: 'variable' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! RefactoryVariableChange subclass: #AddClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !AddClassVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^RemoveClassVariableChange remove: variable from: self changeClass! ! !AddClassVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Add class variable named, <1s>, from <2s>' expandMacrosWith: variable with: self displayClassName! ! !AddClassVariableChange methodsFor: 'private' stamp: ''! changeSymbol ^#addClassVarName:! ! !AddClassVariableChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:28'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' addClassVarNamed: '; print: self variable; nextPut: $!!! ! !AddClassVariableChange methodsFor: 'private' stamp: ''! variable ^variable asSymbol! ! RefactoryVariableChange subclass: #AddInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !AddInstanceVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^RemoveInstanceVariableChange remove: variable from: self changeClass! ! !AddInstanceVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Add instance variable named, <1s>, from <2s>' expandMacrosWith: variable with: self displayClassName! ! !AddInstanceVariableChange methodsFor: 'private' stamp: ''! changeSymbol ^#addInstVarName:! ! !AddInstanceVariableChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:28'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' addInstVarNamed: '; print: self variable; nextPut: $!!! ! RefactoryVariableChange subclass: #AddPoolVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !AddPoolVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^RemovePoolVariableChange remove: variable from: self changeClass! ! !AddPoolVariableChange methodsFor: 'private' stamp: 'nk 7/31/2004 09:22'! changeObject | dictionary | dictionary := variable isString ifTrue: [Smalltalk classNamed: variable] ifFalse: [variable]. ^dictionary! ! !AddPoolVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Add pool variable named, <1s>, from <2s>' expandMacrosWith: self variable with: self displayClassName! ! !AddPoolVariableChange methodsFor: 'private' stamp: ''! changeSymbol ^#addSharedPool:! ! !AddPoolVariableChange methodsFor: 'private' stamp: ''! changesFileTemplate ^'<1p> <2s> <3s>'! ! !AddPoolVariableChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:29'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' addSharedPool: '; print: self variable; nextPut: $!!! ! !AddPoolVariableChange methodsFor: 'private' stamp: ''! variable ^variable isString ifTrue: [variable] ifFalse: [Smalltalk keyAtValue: variable ifAbsent: [self error: 'Cannot find value']]! ! !RefactoryVariableChange class methodsFor: 'instance creation' stamp: ''! add: aVariable to: aBehavior "This should only be called on the Add*Change subclasses, but is here so we don't need to copy it to all subclasses" ^self new class: aBehavior variable: aVariable! ! !RefactoryVariableChange class methodsFor: 'instance creation' stamp: ''! remove: aVariable from: aBehavior "This should only be called on the Remove*Change subclasses, but is here so we don't need to copy it to all subclasses" ^self new class: aBehavior variable: aVariable! ! !RefactoryVariableChange methodsFor: 'comparing' stamp: ''! = aRefactoryVariableChange ^super = aRefactoryVariableChange and: [variable = aRefactoryVariableChange variable]! ! !RefactoryVariableChange methodsFor: 'private' stamp: ''! changeObject ^self variable! ! !RefactoryVariableChange methodsFor: 'private' stamp: ''! changeSymbol self subclassResponsibility! ! !RefactoryVariableChange methodsFor: 'private' stamp: ''! changesFileTemplate ^'<1p> <2s> <3p>'! ! !RefactoryVariableChange methodsFor: 'initialize-release' stamp: ''! class: aBehavior variable: aString self changeClass: aBehavior. variable := aString! ! !RefactoryVariableChange methodsFor: 'comparing' stamp: ''! hash ^self class hash bitXor: variable hash! ! !RefactoryVariableChange methodsFor: 'private' stamp: 'bh 4/29/2000 18:16'! primitiveExecute | changeSymbol | changeSymbol := self changeSymbol. self changeClass perform: changeSymbol with: self changeObject. self needsWork. "the following is to handle a VW bug. Is it also a problem for Squeak?" "ChangeSet current changeClass: self changeClass. SourceFileManager default logChange: (self changesFileTemplate expandMacrosWith: self changeClass with: changeSymbol with: self variable)"! ! !RefactoryVariableChange methodsFor: 'private' stamp: ''! variable ^variable! ! RefactoryVariableChange subclass: #RemoveClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RemoveClassVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddClassVariableChange add: variable to: self changeClass! ! !RemoveClassVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Remove class variable named, <1s>, from <2s>' expandMacrosWith: variable with: self displayClassName! ! !RemoveClassVariableChange methodsFor: 'private' stamp: ''! changeSymbol ^#removeClassVarName:! ! !RemoveClassVariableChange methodsFor: 'private' stamp: 'md 8/2/2005 23:36'! primitiveExecute [super primitiveExecute] on: Notification do: [:ex | ex resume] ! ! !RemoveClassVariableChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:29'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeClassVarNamed: '; print: self variable; nextPut: $!!! ! !RemoveClassVariableChange methodsFor: 'private' stamp: ''! variable ^variable asSymbol! ! RefactoryVariableChange subclass: #RemoveInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RemoveInstanceVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddInstanceVariableChange add: variable to: self changeClass! ! !RemoveInstanceVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Remove instance variable named, <1s>, from <2s>' expandMacrosWith: variable with: self displayClassName! ! !RemoveInstanceVariableChange methodsFor: 'private' stamp: ''! changeSymbol ^#removeInstVarName:! ! !RemoveInstanceVariableChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:29'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeInstVarNamed: '; print: self variable; nextPut: $!!! ! RefactoryVariableChange subclass: #RemovePoolVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RemovePoolVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddPoolVariableChange add: variable to: self changeClass! ! !RemovePoolVariableChange methodsFor: 'private' stamp: ''! changeObject | dictionary | dictionary := variable isString ifTrue: [Smalltalk at: variable asSymbol] ifFalse: [variable]. ^dictionary! ! !RemovePoolVariableChange methodsFor: 'printing' stamp: ''! changeString ^'Remove pool variable named, <1s>, from <2s>' expandMacrosWith: self variable with: self displayClassName! ! !RemovePoolVariableChange methodsFor: 'private' stamp: ''! changeSymbol ^#removeSharedPool:! ! !RemovePoolVariableChange methodsFor: 'private' stamp: ''! changesFileTemplate ^'<1p> <2s> <3s>'! ! !RemovePoolVariableChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:29'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeSharedPool: '; print: self variable; nextPut: $!!! ! !RemovePoolVariableChange methodsFor: 'private' stamp: ''! variable ^variable isString ifTrue: [variable] ifFalse: [Smalltalk keyAtValue: variable ifAbsent: [self error: 'Cannot find value']]! ! RefactoryClassChange subclass: #RemoveClassChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RemoveClassChange class methodsFor: 'instance creation' stamp: ''! remove: aClass ^self new changeClass: aClass! ! !RemoveClassChange class methodsFor: 'instance creation' stamp: ''! removeClassName: aSymbol ^self new changeClassName: aSymbol! ! !RemoveClassChange methodsFor: 'converting' stamp: ''! asUndoOperation | classChanges | classChanges := CompositeRefactoryChange new. self changeClass withAllSubclasses do: [:each | classChanges defineClass: each definition. each class instVarNames do: [:varName | classChanges addInstanceVariable: varName to: each class]. each selectors do: [:selector | classChanges compile: (each sourceCodeAt: selector) in: each]. each class selectors do: [:selector | classChanges compile: (each class sourceCodeAt: selector) in: each class]]. ^classChanges! ! !RemoveClassChange methodsFor: 'printing' stamp: ''! changeString ^'Remove class ', self displayClassName! ! !RemoveClassChange methodsFor: 'private' stamp: ''! primitiveExecute self changeClass removeFromSystem! ! !RemoveClassChange methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeFromSystem'; nextPut: $!!! ! RefactoryClassChange subclass: #RemoveMethodChange instanceVariableNames: 'selector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RemoveMethodChange class methodsFor: 'instance creation' stamp: ''! remove: aSymbol from: aClass ^(self new) changeClass: aClass; selector: aSymbol; yourself! ! !RemoveMethodChange methodsFor: 'comparing' stamp: ''! = aRemoveMethodChange super = aRemoveMethodChange ifFalse: [^false]. ^selector = aRemoveMethodChange selector! ! !RemoveMethodChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddMethodChange compile: (self methodSourceFor: selector) in: self changeClass! ! !RemoveMethodChange methodsFor: 'printing' stamp: ''! changeString ^'Remove method, #<1s>, from: <2s>' expandMacrosWith: selector with: self displayClassName! ! !RemoveMethodChange methodsFor: 'comparing' stamp: ''! hash ^selector hash! ! !RemoveMethodChange methodsFor: 'private' stamp: ''! primitiveExecute ^self changeClass removeSelector: selector! ! !RemoveMethodChange methodsFor: 'printing' stamp: 'lr 2/8/2008 09:29'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeSelector: '; print: self selector; nextPut: $!!! ! !RemoveMethodChange methodsFor: 'private' stamp: ''! selector ^selector! ! !RemoveMethodChange methodsFor: 'initialize-release' stamp: ''! selector: aSymbol selector := aSymbol! ! Object subclass: #RefactoryChangeManager instanceVariableNames: 'undo redo isPerformingRefactoring' classVariableNames: 'Instance UndoSize' poolDictionaries: '' category: 'Refactoring-Core-Change'! !RefactoryChangeManager class methodsFor: 'class initialization' stamp: ''! initialize self nuke. UndoSize := 5! ! !RefactoryChangeManager class methodsFor: 'instance creation' stamp: ''! instance Instance isNil ifTrue: [Instance := self basicNew. Instance initialize]. ^Instance! ! !RefactoryChangeManager class methodsFor: 'instance creation' stamp: ''! new ^self shouldNotImplement! ! !RefactoryChangeManager class methodsFor: 'public access' stamp: ''! nuke Instance notNil ifTrue: [Instance release]. Instance := nil! ! !RefactoryChangeManager class methodsFor: 'class initialization' stamp: ''! undoSize ^UndoSize! ! !RefactoryChangeManager class methodsFor: 'class initialization' stamp: ''! undoSize: anInteger UndoSize := anInteger max: 0! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! addUndo: aRefactoringChange undo addLast: aRefactoringChange. undo size > UndoSize ifTrue: [undo removeFirst]. redo := OrderedCollection new! ! !RefactoryChangeManager methodsFor: 'private' stamp: ''! clearUndoRedoList undo := OrderedCollection new. redo := OrderedCollection new! ! !RefactoryChangeManager methodsFor: 'initialize-release' stamp: ''! connectToChanges ChangeSet addDependent: self! ! !RefactoryChangeManager methodsFor: 'initialize-release' stamp: ''! disconnectFromChanges ChangeSet removeDependent: self! ! !RefactoryChangeManager methodsFor: 'testing' stamp: ''! hasRedoableOperations ^redo isEmpty not! ! !RefactoryChangeManager methodsFor: 'testing' stamp: ''! hasUndoableOperations ^undo isEmpty not! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! ignoreChangesWhile: aBlock isPerformingRefactoring ifTrue: [^aBlock value]. isPerformingRefactoring := true. aBlock ensure: [isPerformingRefactoring := false]! ! !RefactoryChangeManager methodsFor: 'initialize-release' stamp: ''! initialize undo := OrderedCollection new. redo := OrderedCollection new. isPerformingRefactoring := false. self connectToChanges! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! performChange: aRefactoringChange self ignoreChangesWhile: [self addUndo: aRefactoringChange execute]! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! redoChange ^redo last! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! redoOperation redo isEmpty ifTrue: [^self]. self ignoreChangesWhile: [| change | change := redo removeLast. undo add: change execute]! ! !RefactoryChangeManager methodsFor: 'initialize-release' stamp: ''! release super release. self disconnectFromChanges! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! undoChange ^undo last! ! !RefactoryChangeManager methodsFor: 'public access' stamp: ''! undoOperation undo isEmpty ifTrue: [^self]. self ignoreChangesWhile: [| change | change := undo removeLast. redo add: change execute]! ! !RefactoryChangeManager methodsFor: 'updating' stamp: ''! update: anAspectSymbol with: aParameter from: aSender | changeType | (aSender == ChangeSet and: [isPerformingRefactoring not]) ifFalse: [^self]. anAspectSymbol == #reorganizeClass: ifTrue: [^self]. changeType := (anAspectSymbol isString ifTrue: [anAspectSymbol asString] ifFalse: ['class']) asLowercase. (changeType indexOfSubCollection: 'class' startingAt: 1) + (changeType indexOfSubCollection: 'selector' startingAt: 1) > 0 ifTrue: [self clearUndoRedoList]! ! Object subclass: #RefactoryTyper instanceVariableNames: 'model class variableTypes bestGuesses variableMessages bindings backpointers methodName selectorLookup' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RefactoryTyper class methodsFor: 'instance creation' stamp: ''! newFor: aRBNamespace ^(self new) model: aRBNamespace; yourself! ! !RefactoryTyper class methodsFor: 'accessing' stamp: ''! typesFor: variableName in: aParseTree model: aRBSmalltalk | searcher messages | searcher := ParseTreeSearcher 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! ! !RefactoryTyper methodsFor: 'printing' stamp: ''! collectionNameFor: aString ^'-<1s>-' expandMacrosWith: aString! ! !RefactoryTyper methodsFor: 'equivalence classes' stamp: ''! computeEquivalenceClassesForMethodsAndVars | searcher | bindings := Set new. backpointers := Dictionary new. class instanceVariableNames do: [:each | backpointers at: each put: (bindings add: (Set with: each))]. class withAllSubclasses do: [:sub | sub selectors do: [:each | backpointers at: each put: (bindings add: (Set with: each))]]. searcher := ParseTreeSearcher new. searcher matches: '^``@object' do: [:aNode :answer | self processNode: aNode value]. self executeSearch: searcher! ! !RefactoryTyper methodsFor: 'selectors' stamp: ''! computeMessagesSentToVariables | searcher | variableMessages := Dictionary new. class instanceVariableNames do: [:each | variableMessages at: each put: Set new]. searcher := ParseTreeSearcher 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: (ParseTreeSearcher buildSelectorString: sel)) asString do: block]]]. searcher answer: variableMessages. self executeSearch: searcher! ! !RefactoryTyper methodsFor: 'computing types' stamp: ''! computeTypes variableMessages keysAndValuesDo: [:key :value | variableTypes at: key put: (self findTypeFor: value)]! ! !RefactoryTyper 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]]]! ! !RefactoryTyper methodsFor: 'computing types' stamp: ''! findTypeFor: selectorCollection ^selectorCollection inject: model rootClasses into: [:classes :each | self refineTypes: classes with: (selectorLookup at: each ifAbsentPut: [self implementorsOf: each])]! ! !RefactoryTyper methodsFor: 'assignments' stamp: ''! 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]. newType = (model classFor: Object) ifTrue: [newType := type]. (bestGuesses at: aNode variable name ifAbsentPut: [Set new]) add: newType! ! !RefactoryTyper methodsFor: 'accessing' stamp: ''! guessTypesFor: anInstVarName ^bestGuesses at: anInstVarName ifAbsent: [self typesFor: anInstVarName]! ! !RefactoryTyper methodsFor: 'accessing' stamp: ''! guessTypesFor: anInstVarName in: aClass class = aClass ifFalse: [self runOn: aClass]. ^bestGuesses at: anInstVarName ifAbsent: [self typesFor: anInstVarName in: aClass]! ! !RefactoryTyper methodsFor: 'computing types' stamp: ''! implementorsOf: aSelector | classes | classes := OrderedCollection new. model rootClasses do: [:each | self implementorsOf: aSelector in: each storeIn: classes]. ^classes! ! !RefactoryTyper 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]! ! !RefactoryTyper methodsFor: 'initialize-release' stamp: ''! initialize model := RBNamespace new. class := model classFor: Object. variableTypes := Dictionary new. variableMessages := Dictionary new. selectorLookup := IdentityDictionary new. bestGuesses := Dictionary new! ! !RefactoryTyper methodsFor: 'equivalence classes' stamp: 'rr 3/15/2004 14:06'! 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]. bindings remove: set2 ifAbsent: [] ! ! !RefactoryTyper methodsFor: 'private' stamp: ''! model ^model! ! !RefactoryTyper methodsFor: 'private' stamp: ''! model: aRBSmalltalk model := aRBSmalltalk! ! !RefactoryTyper 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]! ! !RefactoryTyper 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: $)]! ! !RefactoryTyper 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]! ! !RefactoryTyper methodsFor: 'selectors-collections' stamp: ''! processCollectionFor: key messagesTo: aName in: aBlock | searcher | searcher := ParseTreeSearcher 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])! ! !RefactoryTyper methodsFor: 'selectors-collections' stamp: ''! processCollectionMessagesFor: variableName in: aParseTree | parent block | aParseTree isMessage ifFalse: [^self]. (#(#first #at: #last) 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]. (#(#do: #do:separatedBy: #collect: #reject: #select: #detect: #detect:ifNone:) includes: aParseTree selector) ifTrue: [block := aParseTree arguments first. block isBlock ifFalse: [^self]. self processCollectionFor: variableName messagesTo: block arguments first 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]! ! !RefactoryTyper 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]]]]! ! !RefactoryTyper 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! ! !RefactoryTyper methodsFor: 'assignments' stamp: 'lr 7/1/2008 10:28'! refineTypesByLookingAtAssignments | searcher needsSearch | needsSearch := false. searcher := ParseTreeSearcher 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]! ! !RefactoryTyper methodsFor: 'private' stamp: ''! rootClasses ^Class rootsOfTheWorld! ! !RefactoryTyper 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! ! !RefactoryTyper methodsFor: 'accessing' stamp: ''! selectedClass: aClass class := model classFor: aClass! ! !RefactoryTyper 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 ]! ! !RefactoryTyper methodsFor: 'accessing' stamp: ''! typesFor: anInstVarName ^variableTypes at: anInstVarName ifAbsent: [Set new]! ! !RefactoryTyper methodsFor: 'accessing' stamp: ''! typesFor: anInstVarName in: aClass class = aClass ifFalse: [self runOn: aClass]. ^variableTypes at: anInstVarName ifAbsent: [Set new]! ! Object subclass: #SmalllintChecker instanceVariableNames: 'rule environment context methodBlock' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !SmalllintChecker class methodsFor: 'instance creation' stamp: ''! newWithContext ^(self new) context: SmalllintContext new; yourself! ! !SmalllintChecker class methodsFor: 'instance creation' stamp: 'nk 11/12/2002 13:12'! runRule: aLintRule (self new) rule: aLintRule; run. ^aLintRule! ! !SmalllintChecker class methodsFor: 'instance creation' stamp: ''! runRule: aLintRule onEnvironment: aBrowserEnvironment (self new) rule: aLintRule; environment: aBrowserEnvironment; run. ^aLintRule! ! !SmalllintChecker methodsFor: 'private' stamp: ''! checkClass: aClass context selectedClass: aClass. (environment definesClass: aClass) ifTrue: [rule checkClass: context]! ! !SmalllintChecker methodsFor: 'private' stamp: ''! checkMethodsForClass: aClass ^environment selectorsForClass: aClass do: [:each | context selector: each. rule checkMethod: context. methodBlock value]! ! !SmalllintChecker methodsFor: 'accessing' stamp: ''! context: aSmalllintContext context := aSmalllintContext! ! !SmalllintChecker methodsFor: 'accessing' stamp: ''! environment: aBrowserEnvironment environment := aBrowserEnvironment! ! !SmalllintChecker methodsFor: 'initialize-release' stamp: ''! initialize methodBlock := []. environment := SelectorEnvironment new. context := SmalllintContext newNoCache! ! !SmalllintChecker methodsFor: 'accessing' stamp: ''! methodBlock: aBlock methodBlock := aBlock! ! !SmalllintChecker methodsFor: 'initialize-release' stamp: ''! release context release. super release! ! !SmalllintChecker methodsFor: 'accessing' stamp: ''! rule: aLintRule rule := aLintRule! ! !SmalllintChecker methodsFor: 'actions' stamp: ''! run rule resetResult. environment classesDo: [:aClass | self checkClass: aClass. self checkMethodsForClass: aClass]! ! Object subclass: #SmalllintContext instanceVariableNames: 'class selector parseTree literals literalSemaphore literalProcess selectors compiledMethod selfMessages superMessages messages' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !SmalllintContext class methodsFor: 'instance creation' stamp: ''! newNoCache ^self basicNew! ! !SmalllintContext methodsFor: 'private' stamp: 'md 8/2/2005 23:19'! addLiteralsFor: aCompiledMethod aCompiledMethod literalsDo: [:literal | self checkLiteral: literal]! ! !SmalllintContext methodsFor: 'private' stamp: ''! buildParseTree | tree | tree := self selectedClass parseTreeFor: self selector. tree isNil ifTrue: [^RBParser parseMethod: 'method']. ^tree! ! !SmalllintContext methodsFor: 'private' stamp: ''! checkLiteral: aLiteral (aLiteral isSymbol or: [aLiteral isVariableBinding]) ifTrue: [literals add: aLiteral] ifFalse: [aLiteral class == Array ifTrue: [aLiteral do: [:each | self checkLiteral: each]]]! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! compiledMethod ^compiledMethod notNil ifTrue: [compiledMethod] ifFalse: [compiledMethod := class compiledMethodAt: selector]! ! !SmalllintContext methodsFor: 'private' stamp: ''! computeLiterals literalSemaphore := Semaphore new. literalProcess := [self primitiveComputeLiterals] fork! ! !SmalllintContext methodsFor: 'private' stamp: ''! computeLiteralsForClass: aClass (selectors addAll: aClass selectors) do: [:sel | self computeLiteralsForSelector: sel in: aClass. Processor yield]! ! !SmalllintContext methodsFor: 'private' stamp: ''! computeLiteralsForSelector: aSelector in: aClass | method | method := aClass compiledMethodAt: aSelector ifAbsent: [nil]. method isNil ifTrue: [^self]. self addLiteralsFor: method! ! !SmalllintContext methodsFor: 'private' stamp: ''! computeMessages | searcher | selfMessages := Set new. superMessages := Set new. messages := Set new. searcher := ParseTreeSearcher new. searcher matches: 'self `@message: ``@args' do: [:aNode :answer | selfMessages add: aNode selector]; matches: 'super `@message: ``@args' do: [:aNode :answer | superMessages add: aNode selector]; matches: '``@receiver `@message: ``@args' do: [:aNode :answer | messages add: aNode selector]. searcher executeTree: self parseTree initialAnswer: nil! ! !SmalllintContext methodsFor: 'testing' stamp: ''! implements: aSelector ^self selectors includes: aSelector! ! !SmalllintContext methodsFor: 'initialize-release' stamp: ''! initialize self computeLiterals! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! instVarNames ^self selectedClass allInstVarNames! ! !SmalllintContext methodsFor: 'testing' stamp: ''! isAbstract: aClass ^(aClass isMeta or: [(self literals includes: aClass name) or: [self literals includes: (Smalltalk associationAt: aClass name)]]) not! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! literals literalSemaphore isNil ifTrue: [literals isNil ifTrue: [self computeLiterals. literalSemaphore wait]] ifFalse: [literalSemaphore wait]. ^literals! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! messages messages isNil ifTrue: [self computeMessages]. ^messages! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! parseTree ^parseTree isNil ifTrue: [parseTree := self buildParseTree] ifFalse: [parseTree]! ! !SmalllintContext methodsFor: 'private' stamp: 'dvf 8/27/2003 14:35'! primitiveComputeLiterals | semaphore | literals := IdentitySet new: 25000. literals addAll: self specialSelectors keys. selectors := IdentitySet new. SystemNavigation new allBehaviorsDo: [:aClass | self computeLiteralsForClass: aClass]. semaphore := literalSemaphore. literalSemaphore := nil. self signalProcesses: semaphore. ^literalProcess := nil! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! protocol ^self selectedClass whichCategoryIncludesSelector: self selector! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! protocols ^Array with: self protocol! ! !SmalllintContext methodsFor: 'initialize-release' stamp: ''! release literalProcess notNil ifTrue: [literalProcess terminate]. super release! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! selectedClass ^class! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! selectedClass: anObject class := anObject. self selector: nil! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! selector ^selector! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! selector: anObject selector := anObject. parseTree := compiledMethod := selfMessages := superMessages := messages := nil! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! selectors literalSemaphore isNil ifTrue: [selectors isNil ifTrue: [self computeLiterals. literalSemaphore wait]] ifFalse: [literalSemaphore wait]. ^selectors! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! selfMessages selfMessages isNil ifTrue: [self computeMessages]. ^selfMessages! ! !SmalllintContext methodsFor: 'private' stamp: ''! signalProcesses: aSemaphore aSemaphore isNil ifTrue: [^self]. [aSemaphore isEmpty] whileFalse: [aSemaphore signal]! ! !SmalllintContext methodsFor: 'accessing' stamp: 'nk 2/26/2005 10:19'! sourceCode ^self selectedClass sourceCodeAt: self selector ifAbsent: [ '' ].! ! !SmalllintContext methodsFor: 'private' stamp: 'dvf 9/15/2001 17:39'! specialSelectors | answer | answer := IdentityDictionary new. (Smalltalk specialSelectors select: [:sel | sel isSymbol]) do: [:sel | answer at: sel put: nil.]. ^answer.! ! !SmalllintContext methodsFor: 'accessing' stamp: ''! superMessages superMessages isNil ifTrue: [self computeMessages]. ^superMessages! ! !SmalllintContext methodsFor: 'testing' stamp: ''! uses: anObject ^self literals includes: anObject! ! !Trait methodsFor: '*refactoring-core' stamp: 'md 3/14/2006 16:44'! includesBehavior: aClass ^false! ! !SharedPool class methodsFor: '*refactoring-core' stamp: 'dvf 9/17/2003 03:10'! keys ^self classPool keys! ! Error subclass: #RefactoringError instanceVariableNames: 'parameter' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RefactoringError class methodsFor: 'signalling' stamp: 'md 8/2/2005 23:35'! raiseSignal: aString with: anObject "Raise an an exception." ^(self new) searchFrom: thisContext sender; messageText: aString; parameter: anObject; signal.! ! !RefactoringError methodsFor: 'as yet unclassified' stamp: 'dvf 9/15/2001 16:28'! parameter self needsWork."what should we do?" ^parameter. ! ! !RefactoringError methodsFor: 'as yet unclassified' stamp: 'dvf 9/15/2001 16:28'! parameter: anObject self needsWork."what should we do?" parameter := anObject. ! ! RBAbstractClass initialize! RefactoryChangeManager initialize!