SystemOrganization addCategory: #'Refactoring-Core-Model'! SystemOrganization addCategory: #'Refactoring-Core-Support'! SystemOrganization addCategory: #'Refactoring-Core-Changes'! SystemOrganization addCategory: #'Refactoring-Core-Environments'! SystemOrganization addCategory: #'Refactoring-Core-Conditions'! SystemOrganization addCategory: #'Refactoring-Core-Refactorings'! SystemOrganization addCategory: #'Refactoring-Core-Lint'! SystemOrganization addCategory: #'Refactoring-Core-Lint-BlockRules'! SystemOrganization addCategory: #'Refactoring-Core-Lint-ParseTreeRules'! SystemOrganization addCategory: #'Refactoring-Core-Lint-TransformationRules'! !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! ! 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: 'lr 2/8/2009 12:28'! addSearchString: aString searchStrings isNil ifTrue: [ searchStrings := SortedCollection sortBlock: [ :a :b | (a indexOf: $: ifAbsent: [ a size ]) > (b indexOf: $: ifAbsent: [ b size ]) ] ]. (searchStrings includes: aString) ifFalse: [ 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: 'lr 1/23/2010 17:10'! associationAt: aKey ^ self associationAt: aKey ifAbsent: [ self error: aKey printString , ' not found' ]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 1/23/2010 17:10'! associationAt: aKey ifAbsent: aBlock | association class | association := Smalltalk associationAt: aKey ifAbsent: [ ^ aBlock value ]. 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: 'lr 2/26/2009 14:46'! at: aKey ^ self at: aKey ifAbsent: [ self error: aKey printString , ' not found' ]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 1/23/2010 17:15'! at: aKey ifAbsent: aBlock | association | association := self associationAt: aKey ifAbsent: [ nil ]. ^ association isNil ifTrue: [ aBlock value ] ifFalse: [ association value ]! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! categories ^Smalltalk organization categories select: [:each | self includesCategory: each]! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 11/25/2009 08:31'! classNames | names | names := IdentitySet new: 4096. self classesDo: [ :each | names add: each theNonMetaClass 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: 'environments' stamp: 'lr 3/8/2009 19:07'! classVarRefsTo: instVarName in: aClass ^ VariableEnvironment on: self referencesToClassVariable: instVarName in: aClass! ! !BrowserEnvironment methodsFor: 'accessing' stamp: ''! classVariablesFor: aClass ^aClass classVarNames! ! !BrowserEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:45'! classes | classes | classes := IdentitySet new: 4096. 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: 'lr 2/26/2009 14:45'! classesDo: aBlock self allClassesDo: [ :each | (self includesClass: each) ifTrue: [ aBlock value: each ] ]! ! !BrowserEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:23'! copyEmpty ^ self class new! ! !BrowserEnvironment methodsFor: 'private' stamp: ''! defaultLabel ^'Smalltalk'! ! !BrowserEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:37'! 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 11/25/2009 08:56'! forPackageNames: aCollection ^ PackageEnvironment onEnvironment: self packageNames: aCollection! ! !BrowserEnvironment methodsFor: 'environments' stamp: 'lr 11/25/2009 08:55'! forPackages: aCollection ^ PackageEnvironment onEnvironment: self packages: aCollection! ! !BrowserEnvironment methodsFor: 'environments' stamp: 'lr 7/21/2008 10:38'! forPragmas: aKeywordCollection ^ PragmaEnvironment onEnvironment: self keywords: aKeywordCollection! ! !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: '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: 'lr 1/3/2010 11:11'! isClassEnvironment ^ false! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^false! ! !BrowserEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 13:00'! isSelectorEnvironment ^ false! ! !BrowserEnvironment methodsFor: 'testing' stamp: ''! isSystem ^true! ! !BrowserEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:11'! isVariableEnvironment ^ false! ! !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: '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: 'lr 11/2/2009 00:14'! selectionParseTreeIntervalFor: aString | parseTree answerBlock | parseTree := RBParser parseMethod: aString onError: [:str :pos | ^nil]. answerBlock := [:aNode :answer | ^aNode sourceInterval]. self searchStrings do: [:each | | matcher tree | matcher := RBParseTreeSearcher new. each isSymbol ifTrue: [matcher matchesTree: (RBLiteralNode value: each) do: answerBlock. tree := RBParseTreeSearcher 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: 'lr 2/26/2009 14:29'! selectorsForClass: aClass | selectors | selectors := IdentitySet new. 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: 'lr 11/25/2009 00:50'! | 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]. ^ OrEnvironment onEnvironment: self or: anEnvironment! ! 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: 'testing' stamp: 'lr 11/25/2009 08:38'! definesClass: aClass ^ environment definesClass: aClass! ! !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: 'adding' stamp: 'lr 2/8/2009 10:46'! addCategory: aSymbol categories add: aSymbol! ! !CategoryEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/26/2009 14:25'! categories: aCollection categories addAll: aCollection! ! !CategoryEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 14:32'! classNames ^ self categories inject: IdentitySet new into: [ :answer :each | answer 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 11/25/2009 08:31'! includesClass: aClass ^ (super includesClass: aClass) and: [ categories includes: aClass theNonMetaClass category ]! ! !CategoryEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/26/2009 14:25'! initialize super initialize. categories := IdentitySet 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: 'lr 2/26/2009 14:21'! postCopy super postCopy. categories := categories copy! ! !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: 'lr 2/26/2009 14:24'! classNames ^ IdentitySet new addAll: classes; addAll: metaClasses; yourself! ! !ClassEnvironment methodsFor: 'printing' stamp: 'lr 2/26/2009 14:24'! classSelectorDictionary ^ classes inject: (IdentityDictionary new: classes size) 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: 'lr 2/26/2009 13:35'! initialize super initialize. classes := IdentitySet new. metaClasses := IdentitySet new! ! !ClassEnvironment methodsFor: 'testing' stamp: ''! isClassEnvironment ^true! ! !ClassEnvironment methodsFor: 'testing' stamp: ''! isEmpty ^classes isEmpty and: [metaClasses isEmpty]! ! !ClassEnvironment methodsFor: 'printing' stamp: 'lr 2/26/2009 14:24'! metaClassSelectorDictionary ^ metaClasses inject: (IdentityDictionary new: metaClasses size) into: [ :answer :class | answer at: class put: (Smalltalk at: class) class selectors; yourself ]! ! !ClassEnvironment methodsFor: 'copying' stamp: 'lr 2/26/2009 14:24'! postCopy super postCopy. classes := classes copy. metaClasses := metaClasses copy! ! !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: 'testing' stamp: 'lr 3/13/2009 11:53'! includesCategory: aCategory ^ (super includesCategory: aCategory) and: [ environmentDictionaries anySatisfy: [ :env | env includesCategory: aCategory ] ]! ! !MultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:52'! includesClass: aClass ^ (super includesClass: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesClass: aClass ] ]! ! !MultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:54'! includesProtocol: aProtocol in: aClass ^ (super includesProtocol: aProtocol in: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesProtocol: aProtocol in: aClass ] ]! ! !MultiEnvironment methodsFor: 'testing' stamp: 'lr 3/13/2009 11:53'! includesSelector: aSelector in: aClass ^ (super includesSelector: aSelector in: aClass) and: [ environmentDictionaries anySatisfy: [ :env | env includesSelector: aSelector in: aClass ] ]! ! !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: #OrEnvironment instanceVariableNames: 'orEnvironment' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !OrEnvironment class methodsFor: 'as yet unclassified' stamp: 'lr 11/25/2009 00:51'! onEnvironment: anEnvironment or: anotherEnvironment ^ (self onEnvironment: anEnvironment) orEnvironment: anotherEnvironment; yourself! ! !OrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:25'! classesDo: aBlock | enumerated | enumerated := IdentitySet new. environment classesDo: [ :each | aBlock value: each. enumerated add: each]. orEnvironment classesDo: [ :each | (enumerated includes: each) ifFalse: [ aBlock value: each ] ]! ! !OrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:26'! includesCategory: aCategory ^ (environment includesCategory: aCategory) or: [ orEnvironment includesCategory: aCategory ]! ! !OrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 00:53'! includesClass: aClass (environment includesClass: aClass) ifTrue: [ ^ true ]. (orEnvironment includesClass: aClass) ifTrue: [ ^ true ]. (environment selectorsForClass: aClass) isEmpty ifFalse: [ ^ true ]. (orEnvironment selectorsForClass: aClass) isEmpty ifFalse: [ ^ true ]. ^ false! ! !OrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 00:53'! includesProtocol: aProtocol in: aClass ^ (environment includesProtocol: aProtocol in: aClass) or: [ orEnvironment includesProtocol: aProtocol in: aClass ]! ! !OrEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 00:53'! includesSelector: aSelector in: aClass ^ (environment includesSelector: aSelector in: aClass) or: [ orEnvironment includesSelector: aSelector in: aClass ]! ! !OrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:25'! numberSelectors | total | total := 0. self classesDo: [ :each | self selectorsForClass: each do: [ :selector | total := total + 1 ] ]. ^ total! ! !OrEnvironment methodsFor: 'initialization' stamp: 'lr 11/25/2009 00:49'! orEnvironment: aBrowserEnvironment orEnvironment := aBrowserEnvironment! ! !OrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 00:54'! selectionIntervalFor: aString ^ (environment selectionIntervalFor: aString) ifNil: [ orEnvironment selectionIntervalFor: aString ]! ! !OrEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:26'! selectorsForClass: aClass do: aBlock | enumerated | enumerated := IdentitySet new. environment selectorsForClass: aClass do: [ :each | enumerated add: each. aBlock value: each ]. orEnvironment selectorsForClass: aClass do: [:each | (enumerated includes: each) ifFalse: [ aBlock value: each ] ]! ! !OrEnvironment methodsFor: 'printing' stamp: 'lr 11/25/2009 00:51'! storeOn: aStream aStream nextPut: $(. environment storeOn: aStream. aStream nextPutAll: ' | '. orEnvironment storeOn: aStream. aStream nextPut: $)! ! BrowserEnvironmentWrapper subclass: #PackageEnvironment instanceVariableNames: 'packages' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !PackageEnvironment class methodsFor: 'instance creation' stamp: 'lr 11/25/2009 08:54'! onEnvironment: anEnvironment packageNames: aCollection ^ self onEnvironment: anEnvironment packages: (aCollection collect: [ :each | PackageInfo named: each ])! ! !PackageEnvironment class methodsFor: 'instance creation' stamp: 'lr 11/25/2009 08:54'! onEnvironment: anEnvironment packages: aCollection ^ (self onEnvironment: anEnvironment) packages: aCollection; yourself! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:48'! asSelectorEnvironment | result | result := SelectorEnvironment onEnvironment: environment. self classesAndSelectorsDo: [ :class :selector | result addClass: class selector: selector ]. ^ result! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:48'! classesAndSelectorsDo: aBlock packages do: [ :package | package methods do: [ :method | (environment includesSelector: method methodSymbol in: method actualClass) ifTrue: [ aBlock value: method actualClass value: method methodSymbol ] ] ]! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 12/3/2009 10:16'! classesDo: aBlock | enumerated enumerator | enumerated := IdentitySet new. enumerator := [ :each | (enumerated includes: each) ifFalse: [ (environment includesClass: each) ifTrue: [ aBlock value: each ]. (environment includesClass: each class) ifTrue: [ aBlock value: each class ]. enumerated add: each ] ]. packages do: [ :package | package classes do: enumerator. package extensionClasses do: enumerator ]! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:50'! definesClass: aClass ^ packages anySatisfy: [ :package | package includesClass: aClass ]! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 08:51'! includesCategory: aCategory ^ (super includesCategory: aCategory) and: [ self packages anySatisfy: [ :package | package includesSystemCategory: aCategory ] ]! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 09:06'! includesClass: aClass ^ (super includesClass: aClass) and: [ self packages anySatisfy: [ :package | (package includesClass: aClass) or: [ (package extensionCategoriesForClass: aClass) notEmpty ] ] ]! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 12/3/2009 10:13'! includesProtocol: aProtocol in: aClass ^ (environment includesProtocol: aProtocol in: aClass) and: [ self packages anySatisfy: [ :package | package includesMethodCategory: aProtocol ofClass: aClass ] ]! ! !PackageEnvironment methodsFor: 'testing' stamp: 'lr 11/25/2009 10:33'! includesSelector: aSelector in: aClass ^ (environment includesSelector: aSelector in: aClass) and: [ self packages anySatisfy: [ :package | package includesMethod: aSelector ofClass: aClass ] ]! ! !PackageEnvironment methodsFor: 'initialize-release' stamp: 'lr 12/20/2009 09:29'! initialize super initialize. packages := OrderedCollection new! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 12/3/2009 13:30'! numberSelectors ^ packages inject: 0 into: [ :result :package | result + package methods size ]! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:49'! packageNames ^ packages collect: [ :each | each packageName ]! ! !PackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 08:46'! packages ^ packages! ! !PackageEnvironment methodsFor: 'initialize-release' stamp: 'lr 12/20/2009 09:29'! packages: aCollection packages addAll: aCollection! ! !PackageEnvironment methodsFor: 'printing' stamp: 'TestRunner 12/23/2009 21:22'! storeOn: aStream aStream nextPut: $(; nextPutAll: self class name; nextPutAll: ' onEnvironment: '. environment storeOn: aStream. aStream nextPutAll: ' packageNames: '. self packageNames asArray storeOn: aStream. aStream nextPut: $)! ! BrowserEnvironmentWrapper subclass: #PragmaEnvironment instanceVariableNames: 'keywords condition' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Environments'! !PragmaEnvironment class methodsFor: 'instance creation' stamp: 'lr 7/21/2008 10:38'! onEnvironment: anEnvironment keywords: aKeywordCollection ^ (self onEnvironment: anEnvironment) keywords: aKeywordCollection; yourself! ! !PragmaEnvironment methodsFor: 'adding' stamp: 'lr 7/21/2008 10:20'! addKeyword: aSymbol keywords add: aSymbol! ! !PragmaEnvironment methodsFor: 'initialize-release' stamp: 'lr 7/21/2008 10:34'! condition: aBlock condition := aBlock! ! !PragmaEnvironment methodsFor: 'private' stamp: 'lr 7/21/2008 10:40'! defaultLabel | stream | stream := String new writeStream. keywords do: [ :each | stream nextPut: $<; nextPutAll: each; nextPut: $>; nextPut: $ ]. ^ stream contents! ! !PragmaEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 12:42'! includesCategory: aCategory ^ (environment includesCategory: aCategory) and: [ (self classNamesFor: aCategory) notEmpty ]! ! !PragmaEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 10:43'! includesClass: aClass ^ (environment includesClass: aClass) and: [ aClass selectors anySatisfy: [ :each | self includesSelector: each in: aClass ] ]! ! !PragmaEnvironment methodsFor: 'testing' stamp: 'lr 7/21/2008 10:34'! includesPragma: aPragma ^ (keywords includes: aPragma keyword) and: [ condition value: aPragma ]! ! !PragmaEnvironment methodsFor: 'testing' stamp: 'lr 8/7/2009 12:42'! includesProtocol: aProtocol in: aClass ^ (environment includesProtocol: aProtocol in: aClass) and: [ (self selectorsFor: aProtocol in: aClass) notEmpty ]! ! !PragmaEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:48'! includesSelector: aSelector in: aClass (environment includesSelector: aSelector in: aClass) ifFalse: [ ^ false ]. ^ (aClass compiledMethodAt: aSelector) pragmas anySatisfy: [ :each | self includesPragma: each ]! ! !PragmaEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/26/2009 13:35'! initialize super initialize. keywords := IdentitySet new. condition := [ :pragma | true ]! ! !PragmaEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/24/2009 19:38'! keywords: aCollection keywords addAll: aCollection! ! !PragmaEnvironment methodsFor: 'copying' stamp: 'lr 7/21/2008 10:37'! postCopy super postCopy. keywords := keywords copy! ! !PragmaEnvironment methodsFor: 'printing' stamp: 'lr 7/21/2008 10:37'! storeOn: aStream aStream nextPut: $(. super storeOn: aStream. aStream nextPutAll: ' keywords: '. keywords asArray storeOn: aStream. aStream 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: 'lr 2/26/2009 14:29'! postCopy super postCopy. protocols := protocols copy! ! !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: 'lr 12/3/2009 18:40'! 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: 'lr 11/2/2009 08:58'! referencesTo: aLiteral in: anEnvironment | classDict literalPrintString specialFlag specialByte | literalPrintString := aLiteral isVariableBinding ifTrue: [aLiteral key asString] ifFalse: [aLiteral isString ifTrue: [aLiteral] ifFalse: [aLiteral printString]]. classDict := Dictionary new. specialFlag := self environment hasSpecialSelector: aLiteral ifTrueSetByte: [ :byte | specialByte := byte ]. anEnvironment classesDo: [:class | | selectors | selectors := (class thoroughWhichSelectorsReferTo: aLiteral special: specialFlag byte: specialByte) 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: 'lr 2/26/2009 14:26'! 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: 'lr 2/26/2009 13:36'! addClass: aClass selector: aSymbol (aClass isMeta ifTrue: [ metaClassSelectors at: aClass soleInstance name ifAbsentPut: [ IdentitySet new ] ] ifFalse: [ classSelectors at: aClass name ifAbsentPut: [ IdentitySet new ] ]) add: aSymbol! ! !SelectorEnvironment methodsFor: 'accessing' stamp: 'rr 4/19/2004 16:06'! asSelectorEnvironment ^ self! ! !SelectorEnvironment methodsFor: 'accessing-classes' stamp: 'lr 2/26/2009 13:35'! classNames ^ IdentitySet new addAll: classSelectors keys; addAll: metaClassSelectors keys; yourself! ! !SelectorEnvironment methodsFor: 'initialize-release' stamp: ''! classSelectors: classSelectorDictionary metaClassSelectors: metaClassSelectorDictionary classSelectors := classSelectorDictionary. metaClassSelectors := metaClassSelectorDictionary! ! !SelectorEnvironment methodsFor: 'initialize-release' stamp: 'lr 2/26/2009 13:36'! classes: classArray metaClasses: metaArray "Used to recreate an environment from its storeString" classSelectors := IdentityDictionary new. metaClassSelectors := IdentityDictionary new. classArray do: [ :each | classSelectors at: each first put: each last asIdentitySet ]. metaArray do: [ :each | metaClassSelectors at: each first put: each last asIdentitySet ]! ! !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: 'TestRunner 1/3/2010 12:36'! includesCategory: aCategory ^(super includesCategory: aCategory) and: [(self classNamesFor: aCategory) anySatisfy: [: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: 'TestRunner 1/3/2010 12:36'! includesProtocol: aProtocol in: aClass ^(super includesProtocol: aProtocol in: aClass) and: [(environment selectorsFor: aProtocol in: aClass) anySatisfy: [: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: 'lr 8/7/2009 13:00'! isSelectorEnvironment ^ true! ! !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: 'lr 2/26/2009 14:29'! postCopy | newDict | super postCopy. 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! ! !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: 'lr 11/25/2009 08:32'! classVariableSelectorsFor: aClass | selectors classVars | selectors := Set new. classVars := Set new. classVariables keysDo: [:each | | cls | cls := self classForName: each. (cls notNil and: [aClass theNonMetaClass 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: 'lr 11/25/2009 00:40'! flushCachesFor: aClass selectorCache isNil ifTrue: [ ^ self] . aClass theNonMetaClass 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: 'TestRunner 1/3/2010 11:29'! isEmpty ^ self accessorMethods allSatisfy: [ :each | (self perform: each) isEmpty ]! ! !VariableEnvironment methodsFor: 'testing' stamp: 'lr 1/3/2010 11:11'! isVariableEnvironment ^ true! ! !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: 'lr 11/25/2009 00:42'! selectorCacheFor: aClass ^self selectorCache at: aClass name 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: #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: 'lr 11/1/2009 23:47'! compile: aString ^ self compile: aString withAttributesFrom: (self methodFor: (RBParser parseMethodPattern: aString))! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:47'! compile: aString classified: aSymbolCollection | change method | change := model compile: aString in: self classified: aSymbolCollection. method := RBMethod for: self source: aString selector: change selector. self addMethod: method. ^ change! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:16'! compile: aString withAttributesFrom: aRBMethod | change method | change := model compile: aString in: self classified: aRBMethod protocols. method := RBMethod for: self source: aString selector: change selector. self addMethod: method. ^ change! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 11/1/2009 23:48'! compileTree: aRBMethodNode ^ (self methodFor: aRBMethodNode selector) compileTree: aRBMethodNode! ! !RBAbstractClass methodsFor: 'testing' stamp: 'dc 5/18/2007 14:53'! definesClassVariable: aSymbol self realClass isTrait ifTrue: [^false]. (self directlyDefinesClassVariable: aSymbol) ifTrue: [^true]. ^self superclass notNil and: [self superclass definesClassVariable: aSymbol]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesInstanceVariable: aString (self directlyDefinesInstanceVariable: aString) ifTrue: [^true]. ^self superclass notNil and: [self superclass definesInstanceVariable: aString]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesMethod: aSelector (self directlyDefinesMethod: aSelector) ifTrue: [^true]. ^self superclass notNil and: [self superclass definesMethod: aSelector]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesPoolDictionary: aSymbol (self directlyDefinesPoolDictionary: aSymbol) ifTrue: [^true]. ^self inheritsPoolDictionaries and: [self superclass notNil and: [self superclass definesPoolDictionary: aSymbol]]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! definesVariable: aVariableName ^(self definesClassVariable: aVariableName) or: [self definesInstanceVariable: aVariableName]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesClassVariable: aString self subclassResponsibility! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesInstanceVariable: aString ^self instanceVariableNames includes: aString! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesMethod: aSelector self isDefined ifTrue: [(self hasRemoved: aSelector) ifTrue: [^false]. (self realClass includesSelector: aSelector) ifTrue: [^true]]. ^newMethods notNil and: [newMethods includesKey: aSelector]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesPoolDictionary: aString self subclassResponsibility! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! directlyDefinesVariable: aVariableName ^(self directlyDefinesClassVariable: aVariableName) or: [self directlyDefinesInstanceVariable: aVariableName]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 19:16'! existingMethodsThatReferTo: aSymbol | existingMethods special byte | special := self realClass environment hasSpecialSelector: aSymbol ifTrueSetByte: [ :value | byte := value ]. existingMethods := self realClass thoroughWhichSelectorsReferTo: aSymbol special: special byte: byte. (newMethods isNil and: [ removedMethods isNil ]) ifTrue: [ ^ existingMethods ]. ^ existingMethods reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 1/18/2010 19:39'! existingMethodsThatReferToClassVariable: aString | binding existingMethods | binding := (self bindingOf: aString) ifNil: [ ^ #() ]. existingMethods := self realClass whichSelectorsReferTo: binding. (newMethods isNil and: [ removedMethods isNil ]) ifTrue: [ ^ existingMethods ]. ^ existingMethods reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 1/18/2010 19:40'! existingMethodsThatReferToInstanceVariable: aString | existingMethods | existingMethods := self realClass whichSelectorsAccess: aString. (newMethods isNil and: [ removedMethods isNil ]) ifTrue: [ ^ existingMethods ]. ^ existingMethods reject: [ :each | (self hasRemoved: each) or: [ self newMethods includesKey: each ] ]! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hasRemoved: aSelector ^removedMethods notNil and: [removedMethods includes: aSelector]! ! !RBAbstractClass methodsFor: 'comparing' stamp: ''! hash ^self name hash bitXor: self class hash! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesClassVariable: aString (self definesClassVariable: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesClassVariable: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesInstanceVariable: aString (self definesInstanceVariable: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesInstanceVariable: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesMethod: aSelector (self definesMethod: aSelector) ifTrue: [^true]. ^self subclassRedefines: aSelector! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesPoolDictionary: aString (self definesPoolDictionary: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesPoolDictionary: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! hierarchyDefinesVariable: aString (self definesVariable: aString) ifTrue: [^true]. ^(self allSubclasses detect: [:each | each directlyDefinesVariable: aString] ifNone: [nil]) notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! includesClass: aRBClass | currentClass | currentClass := self. [currentClass notNil and: [currentClass ~= aRBClass]] whileTrue: [currentClass := currentClass superclass]. ^currentClass = aRBClass! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! inheritsPoolDictionaries ^false! ! !RBAbstractClass methodsFor: 'initialize-release' stamp: ''! initialize name := #'Unknown Class'! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! instanceVariableNames ^self privateInstanceVariableNames copy! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! instanceVariableNames: aCollectionOfStrings instanceVariableNames := aCollectionOfStrings asOrderedCollection! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! isAbstract (self whichSelectorsReferToSymbol: #subclassResponsibility) isEmpty ifFalse: [^true]. model allReferencesToClass: self do: [:each | ^false]. ^true! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! isDefined ^self realClass notNil! ! !RBAbstractClass methodsFor: 'testing' stamp: ''! isMeta self subclassResponsibility! ! !RBAbstractClass methodsFor: 'deprecated' stamp: 'lr 10/31/2009 17:32'! metaclass self deprecated: 'Use aClass>>#theMetaClass instead'. ^ self theMetaClass! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 4/7/2010 19:03'! methodFor: aSelector ^ self newMethods at: aSelector ifAbsent: [ | class compiledMethod | (self hasRemoved: aSelector) ifTrue: [ ^ nil ]. class := self realClass ifNil: [ ^ nil ]. (model environment includesSelector: aSelector in: class) ifFalse: [ ^ nil ]. compiledMethod := class compiledMethodAt: aSelector ifAbsent: [ nil ]. compiledMethod isNil ifTrue: [ nil ] ifFalse: [ RBMethod for: self fromMethod: compiledMethod andSelector: aSelector ] ]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! model ^model! ! !RBAbstractClass methodsFor: 'initialize-release' stamp: ''! model: aRBSmalltalk model := aRBSmalltalk! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! name ^name! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! name: aSymbol name := aSymbol! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! newMethods ^newMethods isNil ifTrue: [newMethods := IdentityDictionary new] ifFalse: [newMethods]! ! !RBAbstractClass methodsFor: 'deprecated' stamp: 'lr 10/31/2009 17:32'! nonMetaclass self deprecated: 'Use aClass>>#theNonMetaClass instead'. ^ self theNonMetaClass! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! parseTreeFor: aSelector | class | class := self whoDefinesMethod: aSelector. class isNil ifTrue: [^nil]. ^(class methodFor: aSelector) parseTree! ! !RBAbstractClass methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: self name! ! !RBAbstractClass methodsFor: 'private' stamp: ''! privateInstanceVariableNames instanceVariableNames isNil ifTrue: [self isDefined ifTrue: [self instanceVariableNames: self realClass instVarNames] ifFalse: [instanceVariableNames := OrderedCollection new]]. ^instanceVariableNames! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'jmb 1/23/2003 15:50'! protocolsFor: aSelector | change | change := self isMeta ifTrue: [model changes changeForMetaclass: name selector: aSelector] ifFalse: [model changes changeForClass: name selector: aSelector]. ^change isNil ifTrue: [self isDefined ifTrue: [Array with: (BrowserEnvironment new whichProtocolIncludes: aSelector in: self realClass)] ifFalse: [#(#accessing)]] ifFalse: [change protocols]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! realClass ^realClass! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! realClass: aClass realClass := aClass. superclass isNil ifTrue: [superclass := LookupSuperclass]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! removeInstanceVariable: aString self privateInstanceVariableNames remove: aString. model removeInstanceVariable: aString from: self! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! removeMethod: aSelector self newMethods removeKey: aSelector ifAbsent: []. model removeMethod: aSelector from: self. self removedMethods add: aSelector! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! removeSubclass: aRBClass self subclasses remove: aRBClass ifAbsent: []! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! removedMethods ^removedMethods isNil ifTrue: [removedMethods := Set new] ifFalse: [removedMethods]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! renameInstanceVariable: oldName to: newName around: aBlock self privateInstanceVariableNames at: (self privateInstanceVariableNames indexOf: oldName asString) put: newName asString. model renameInstanceVariable: oldName to: newName in: self around: aBlock! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! selectors | selectors | selectors := Set new. selectors addAll: self newMethods keys. self isDefined ifTrue: [selectors addAll: self realClass selectors. removedMethods notNil ifTrue: [removedMethods do: [:each | selectors remove: each ifAbsent: []]]]. ^selectors! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! soleInstance ^ self theNonMetaClass! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! sourceCodeFor: aSelector | class | class := self whoDefinesMethod: aSelector. class isNil ifTrue: [^nil]. ^(class methodFor: aSelector) source! ! !RBAbstractClass methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPutAll: self name! ! !RBAbstractClass methodsFor: 'testing' stamp: 'lr 1/3/2010 11:47'! subclassRedefines: aSelector "Return true, if one of your subclasses redefines the method with name, aMethod" ^ self allSubclasses anySatisfy: [ :each | each directlyDefinesMethod: aSelector ]! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 2/3/2008 13:33'! subclasses ^subclasses isNil ifTrue: [subclasses := self isDefined ifTrue: [((self realClass subclasses collect: [:each | model classFor: each]) reject: [ :each | each isNil ]) asOrderedCollection] ifFalse: [OrderedCollection new]] ifFalse: [subclasses]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! superclass ^superclass == LookupSuperclass ifTrue: [model classFor: self realClass superclass] ifFalse: [superclass]! ! !RBAbstractClass methodsFor: 'private' stamp: ''! superclass: aRBClass self superclass notNil ifTrue: [self superclass removeSubclass: self]. superclass := aRBClass. superclass notNil ifTrue: [superclass addSubclass: self].! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:09'! theMetaClass ^ model metaclassNamed: self name! ! !RBAbstractClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! theNonMetaClass ^ model classNamed: self name! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! typeOfClassVariable: aSymbol ^model classNamed: #Object! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:43'! whichSelectorsReferToClass: aRBClass | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToClassNamed: aRBClass name) ifTrue: [ selectors add: each selector ] ] ]. (self isDefined and: [ aRBClass isDefined ]) ifTrue: [ selectors addAll: (self existingMethodsThatReferTo: aRBClass classBinding). selectors addAll: (self existingMethodsThatReferTo: aRBClass name) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'! whichSelectorsReferToClassVariable: aString | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToVariable: aString) ifTrue: [ selectors add: each selector ] ] ]. self isDefined ifTrue: [ selectors addAll: (self existingMethodsThatReferToClassVariable: aString) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'! whichSelectorsReferToInstanceVariable: aString | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToVariable: aString) ifTrue: [ selectors add: each selector ] ] ]. self isDefined ifTrue: [ selectors addAll: (self existingMethodsThatReferToInstanceVariable: aString) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'method accessing' stamp: 'lr 3/17/2010 18:42'! whichSelectorsReferToSymbol: aSymbol | selectors | selectors := Set new. newMethods isNil ifFalse: [ newMethods do: [ :each | (each refersToSymbol: aSymbol) ifTrue: [ selectors add: each selector ] ] ]. self isDefined ifTrue: [ selectors addAll: (self existingMethodsThatReferTo: aSymbol) ]. ^ selectors! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! whoDefinesClassVariable: aString | sprClass | (self directlyDefinesClassVariable: aString) ifTrue: [^self]. sprClass := self superclass. ^sprClass isNil ifTrue: [nil] ifFalse: [sprClass whoDefinesClassVariable: aString]! ! !RBAbstractClass methodsFor: 'variable accessing' stamp: ''! whoDefinesInstanceVariable: aString | sprClass | (self directlyDefinesInstanceVariable: aString) ifTrue: [^self]. sprClass := self superclass. ^sprClass isNil ifTrue: [nil] ifFalse: [sprClass whoDefinesInstanceVariable: aString]! ! !RBAbstractClass methodsFor: 'method accessing' stamp: ''! whoDefinesMethod: aSelector | sprClass | (self directlyDefinesMethod: aSelector) ifTrue: [^self]. sprClass := self superclass. ^sprClass isNil ifTrue: [nil] ifFalse: [sprClass whoDefinesMethod: aSelector]! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! withAllSubclasses ^(self allSubclasses) add: self; yourself! ! !RBAbstractClass methodsFor: 'accessing' stamp: ''! withAllSuperclasses ^(self allSuperclasses) add: self; yourself! ! RBAbstractClass subclass: #RBClass instanceVariableNames: 'classVariableNames poolDictionaryNames category comment' classVariableNames: 'LookupComment' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBClass class methodsFor: 'instance creation' stamp: ''! existingNamed: aSymbol ^(self named: aSymbol) realName: aSymbol; yourself! ! !RBClass class methodsFor: 'class initialization' stamp: 'lr 7/1/2008 10:57'! initialize LookupComment := Object new! ! !RBClass class methodsFor: 'instance creation' stamp: ''! named: aSymbol ^(self new) name: aSymbol; yourself! ! !RBClass methodsFor: 'variable accessing' stamp: ''! addClassVariable: aString self privateClassVariableNames add: aString asSymbol. model addClassVariable: aString to: self! ! !RBClass methodsFor: 'variable accessing' stamp: ''! addPoolDictionary: aString self privatePoolDictionaryNames add: aString asSymbol. model addPool: aString to: self! ! !RBClass methodsFor: 'accessing' stamp: ''! allClassVariableNames | sprClass | sprClass := self superclass. ^sprClass isNil ifTrue: [self classVariableNames] ifFalse: [sprClass allClassVariableNames , self classVariableNames]! ! !RBClass methodsFor: 'accessing' stamp: ''! allPoolDictionaryNames | sprClass | sprClass := self superclass. ^sprClass isNil ifTrue: [self poolDictionaryNames] ifFalse: [sprClass allPoolDictionaryNames , self poolDictionaryNames]! ! !RBClass methodsFor: 'accessing' stamp: 'bh 11/8/2000 15:22'! category ^category isNil ifTrue: [self isDefined ifTrue: [category := self realClass category] ifFalse: [model environment whichCategoryIncludes: self name]] ifFalse: [category] ! ! !RBClass methodsFor: 'accessing' stamp: ''! category: aSymbol category := aSymbol! ! !RBClass methodsFor: 'accessing' stamp: ''! classVariableNames ^self privateClassVariableNames copy! ! !RBClass methodsFor: 'accessing' stamp: ''! classVariableNames: aCollectionOfStrings classVariableNames := (aCollectionOfStrings collect: [:each | each asSymbol]) asOrderedCollection! ! !RBClass methodsFor: 'accessing' stamp: 'lr 7/1/2008 11:09'! comment ^ comment = LookupComment ifTrue: [ comment := self isDefined ifTrue: [ self realClass comment ] ifFalse: [ nil ] ] ifFalse: [ comment ]! ! !RBClass methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:55'! comment: aString model comment: (comment := aString) in: self! ! !RBClass methodsFor: 'accessing' stamp: 'bh 11/8/2000 14:38'! definitionString | definitionStream | definitionStream := WriteStream on: ''. definitionStream nextPutAll: self superclass printString; nextPutAll: ' subclass: #'; nextPutAll: self name; nextPutAll: ' instanceVariableNames: '''. self instanceVariableNames do: [:each | definitionStream nextPutAll: each; nextPut: $ ]. definitionStream nextPutAll: ''' classVariableNames: '''. self classVariableNames do: [:each | definitionStream nextPutAll: each; nextPut: $ ]. definitionStream nextPutAll: ''' poolDictionaries: '''. self poolDictionaryNames do: [:each | definitionStream nextPutAll: each; nextPut: $ ]. definitionStream nextPutAll: ''' category: #'''. definitionStream nextPutAll: self category asString. definitionStream nextPut: $'. ^definitionStream contents! ! !RBClass methodsFor: 'testing' stamp: ''! directlyDefinesClassVariable: aString ^self classVariableNames includes: aString asSymbol! ! !RBClass methodsFor: 'testing' stamp: ''! directlyDefinesPoolDictionary: aString ^self poolDictionaryNames includes: aString asSymbol! ! !RBClass methodsFor: 'initialize-release' stamp: 'lr 7/1/2008 10:58'! initialize super initialize. comment := LookupComment! ! !RBClass methodsFor: 'testing' stamp: ''! isMeta ^false! ! !RBClass methodsFor: 'accessing' stamp: ''! poolDictionaryNames ^self privatePoolDictionaryNames copy! ! !RBClass methodsFor: 'accessing' stamp: ''! poolDictionaryNames: aCollectionOfStrings poolDictionaryNames := (aCollectionOfStrings collect: [:each | each asSymbol]) asOrderedCollection! ! !RBClass methodsFor: 'private' stamp: ''! privateClassVariableNames (self isDefined and: [classVariableNames isNil]) ifTrue: [self classVariableNames: self realClass classVarNames]. ^classVariableNames! ! !RBClass methodsFor: 'private' stamp: 'djr 3/31/2010 14:00'! privatePoolDictionaryNames (self isDefined and: [poolDictionaryNames isNil]) ifTrue: [self poolDictionaryNames: (self realClass sharedPools collect: [:each | self realClass environment keyAtValue: each])]. ^poolDictionaryNames! ! !RBClass methodsFor: 'initialize-release' stamp: ''! 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]]! ! !RBClass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! theNonMetaClass ^ self! ! RBAbstractClass subclass: #RBMetaclass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBMetaclass class methodsFor: 'instance creation' stamp: ''! existingNamed: aSymbol ^(self named: aSymbol) realName: aSymbol; yourself! ! !RBMetaclass class methodsFor: 'instance creation' stamp: ''! named: aSymbol ^(self new) name: aSymbol; yourself! ! !RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! allClassVariableNames ^ self theNonMetaClass allClassVariableNames! ! !RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:08'! allPoolDictionaryNames ^ self theNonMetaClass allPoolDictionaryNames! ! !RBMetaclass methodsFor: 'testing' stamp: 'lr 10/26/2009 22:08'! directlyDefinesClassVariable: aString ^ self theNonMetaClass directlyDefinesClassVariable: aString! ! !RBMetaclass methodsFor: 'testing' stamp: 'lr 10/26/2009 22:08'! directlyDefinesPoolDictionary: aString ^ self theNonMetaClass directlyDefinesPoolDictionary: aString! ! !RBMetaclass methodsFor: 'testing' stamp: ''! isMeta ^true! ! !RBMetaclass methodsFor: 'printing' stamp: ''! printOn: aStream super printOn: aStream. aStream nextPutAll: ' class'! ! !RBMetaclass methodsFor: 'initialize-release' stamp: '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'! ! !RBMetaclass methodsFor: 'accessing' stamp: 'lr 10/26/2009 22:09'! theMetaClass ^ self! ! Object subclass: #RBAbstractCondition instanceVariableNames: 'errorMacro' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBAbstractCondition methodsFor: 'logical operations' stamp: ''! & aCondition ^RBConjunctiveCondition new left: self right: aCondition! ! !RBAbstractCondition methodsFor: 'checking' stamp: ''! check self subclassResponsibility! ! !RBAbstractCondition methodsFor: 'accessing' stamp: ''! errorBlock ^self errorBlockFor: false! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorBlockFor: aBoolean ^nil! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorMacro ^errorMacro isNil ifTrue: ['unknown'] ifFalse: [errorMacro]! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorMacro: aString errorMacro := aString! ! !RBAbstractCondition methodsFor: 'accessing' stamp: ''! errorString ^self errorStringFor: false! ! !RBAbstractCondition methodsFor: 'private' stamp: ''! errorStringFor: aBoolean ^self errorMacro expandMacrosWith: aBoolean! ! !RBAbstractCondition methodsFor: 'logical operations' stamp: ''! not ^RBNegationCondition on: self! ! !RBAbstractCondition methodsFor: 'logical operations' stamp: ''! | aCondition "(A | B) = (A not & B not) not" ^(self not & aCondition not) not! ! RBAbstractCondition subclass: #RBCondition instanceVariableNames: 'block type errorBlock' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBCondition class methodsFor: 'instance creation' stamp: ''! canUnderstand: aSelector in: aClass ^self new type: (Array with: #understandsSelector with: aClass with: aSelector) block: [aClass definesMethod: aSelector] errorString: aClass printString , ' <1?:does not >understand<1?s:> ' , aSelector printString! ! !RBCondition class methodsFor: 'utilities' stamp: ''! checkClassVarName: aName in: aClass | string | aName isString ifFalse: [^false]. string := aName asString. (self reservedNames includes: string) ifTrue: [^false]. string isEmpty ifTrue: [^false]. string first isUppercase ifFalse: [^false]. ^RBScanner isVariable: string! ! !RBCondition class methodsFor: 'utilities' stamp: ''! checkInstanceVariableName: aName in: aClass | string | aName isString ifFalse: [^false]. string := aName asString. string isEmpty ifTrue: [^false]. (self reservedNames includes: string) ifTrue: [^false]. string first isUppercase ifTrue: [^false]. ^RBScanner isVariable: string! ! !RBCondition class methodsFor: 'utilities' stamp: ''! checkMethodName: aName in: aClass ^aName isString and: [RBScanner isSelector: aName]! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesClassVariable: aString in: aClass ^self new type: (Array with: #definesClassVar with: aClass with: aString) block: [aClass definesClassVariable: aString] errorString: aClass printString , ' <1?:does not >define<1?s:> class variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesInstanceVariable: aString in: aClass ^self new type: (Array with: #definesInstVar with: aClass with: aString) block: [aClass definesInstanceVariable: aString] errorString: aClass printString , ' <1?:does not >define<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesSelector: aSelector in: aClass ^self new type: (Array with: #definesSelector with: aClass with: aSelector) block: [aClass directlyDefinesMethod: aSelector] errorString: aClass printString , ' <1?:does not >define<1?s:> ' , aSelector printString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesTempVar: aString in: aClass ignoreClass: subclass | condition | condition := self new. condition type: (Array with: #definesTempVarIgnoring with: aClass with: aString with: subclass) block: [| method | method := self methodDefiningTemporary: aString in: aClass ignore: [:class :aSelector | class includesClass: subclass]. method notNil ifTrue: [condition errorMacro: method printString , ' defines variable ' , aString]. method notNil] errorString: aClass printString , ' <1?:does not >define<1?s:> temporary variable ' , aString. ^condition! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! definesTemporaryVariable: aString in: aClass | condition | condition := self new. condition type: (Array with: #definesTempVar with: aClass with: aString) block: [| method | method := self methodDefiningTemporary: aString in: aClass ignore: [:class :selector | false]. method notNil ifTrue: [condition errorMacro: method printString , ' defines variable ' , aString]. method notNil] errorString: aClass printString , ' <1?:does not >define<1?s:> temporary variable ' , aString. ^condition! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! directlyDefinesClassVariable: aString in: aClass ^self new type: (Array with: #directlyDefinesClassVar with: aClass with: aString) block: [aClass directlyDefinesClassVariable: aString] errorString: aClass printString , ' <1?:does not >directly define<1?s:> class variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! directlyDefinesInstanceVariable: aString in: aClass ^self new type: (Array with: #directlyDefinesInstanceVariable with: aClass with: aString) block: [aClass directlyDefinesInstanceVariable: aString] errorString: aClass printString , ' <1?:does not >directly define<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! empty "Returns an empty condition" ^self new type: (Array with: #empty) block: [true] errorString: 'Empty'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hasSubclasses: aClass ^self new type: (Array with: #hasSubclasses with: aClass) block: [aClass subclasses isEmpty not] errorString: aClass printString , ' has <1?:no >subclasses'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hasSuperclass: aClass ^self new type: (Array with: #hasSuperclass with: aClass) block: [aClass superclass isNil not] errorString: aClass printString , ' has <1?a:no> superclass'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hierarchyOf: aClass canUnderstand: aSelector ^self new type: (Array with: #hierarchyUnderstandsSelector with: aClass with: aSelector) block: [aClass hierarchyDefinesMethod: aSelector] errorString: aClass printString , ' <1?or a subclass:and all subclasses do not> understand<1?s:> ' , aSelector printString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hierarchyOf: aClass definesVariable: aString ^self new type: (Array with: #hierarchyDefinesInstVar with: aClass with: aString) block: [aClass hierarchyDefinesVariable: aString] errorString: aClass printString , ' or one of its subclasses <1?:does not >define<1?s:> variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! hierarchyOf: aClass referencesInstanceVariable: aString ^self new type: (Array with: #hierarchyReferencesInstVar with: aClass with: aString) block: [(aClass withAllSubclasses detect: [:each | (each whichSelectorsReferToInstanceVariable: aString) isEmpty not] ifNone: [nil]) notNil] errorString: aClass printString , ' or subclass <1?:does not >reference<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isAbstractClass: aClass ^self new type: (Array with: #IsAbstractClass with: aClass) block: [aClass isAbstract] errorString: aClass printString , ' is <1?:not >an abstract class'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isClass: anObject ^self new type: (Array with: #IsClass with: anObject) block: [anObject isBehavior] errorString: anObject printString , ' is <1?:not >a behavior'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isEmptyClass: anObject ^self new type: (Array with: #IsEmptyClass with: anObject) block: [anObject classVariableNames isEmpty and: [anObject instanceVariableNames isEmpty and: [anObject selectors isEmpty]]] errorString: anObject printString , ' is <1?:not > empty'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isGlobal: aString in: aRBSmalltalk ^self new type: (Array with: #isGlobal with: aString) block: [aRBSmalltalk includesGlobal: aString asSymbol] errorString: aString , ' is <1?:not >a class or global variable'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isImmediateSubclass: subclass of: superClass ^self new type: (Array with: #immediateSubclass with: superClass with: subclass) block: [subclass superclass = superClass] errorString: subclass printString , ' is <1?:not >an immediate subclass of ' , superClass printString! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isMetaclass: anObject ^self new type: (Array with: #IsMetaclass with: anObject) block: [anObject isMeta] errorString: anObject printString , ' is <1?:not >a metaclass'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isSymbol: aString ^self new type: (Array with: #isSymbol with: aString) block: [aString isSymbol] errorString: aString , ' is <1?:not >a symbol'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidClassName: aString ^self new type: (Array with: #validClassName with: aString) block: [self validClassName: aString] errorString: aString , ' is <1?:not >a valid class name'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidClassVarName: aString for: aClass ^self new type: (Array with: #validClassVarName with: aString with: aClass) block: [self checkClassVarName: aString in: aClass] errorString: aString , ' is <1?:not >a valid class variable name'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidInstanceVariableName: aString for: aClass ^self new type: (Array with: #validInstVarName with: aString with: aClass) block: [self checkInstanceVariableName: aString in: aClass] errorString: aString , ' is <1?:not >a valid instance variable name'! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! isValidMethodName: aString for: aClass ^self new type: (Array with: #validMethodName with: aString with: aClass) block: [self checkMethodName: aString in: aClass] errorString: aString printString , ' is <1?:not >a valid method name'! ! !RBCondition class methodsFor: 'utilities' stamp: 'lr 11/2/2009 00:14'! methodDefiningTemporary: aString in: aClass ignore: aBlock | searcher method | searcher := RBParseTreeSearcher new. method := nil. "Shut-up the warning" searcher matches: aString do: [:aNode :answer | ^method]. aClass withAllSubclasses do: [:class | class selectors do: [:each | (aBlock value: class value: each) ifFalse: [| parseTree | method := class methodFor: each. parseTree := class parseTreeFor: each. parseTree notNil ifTrue: [searcher executeTree: parseTree]]]]. ^nil! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! referencesInstanceVariable: aString in: aClass ^self new type: (Array with: #referencesInstVar with: aClass with: aString) block: [(aClass whichSelectorsReferToInstanceVariable: aString) isEmpty not] errorString: aClass printString , ' <1?:does not >reference<1?s:> instance variable ' , aString! ! !RBCondition class methodsFor: 'utilities' stamp: ''! reservedNames ^#('self' 'true' 'false' 'nil' 'thisContext' 'super')! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! subclassesOf: aClass referToSelector: aSelector ^self new type: (Array with: #subclassReferences with: aClass with: aSelector) block: [(aClass subclasses detect: [:each | (each selectors detect: [:sel | | tree | tree := each parseTreeFor: sel. tree notNil and: [tree superMessages includes: aSelector]] ifNone: [nil]) notNil] ifNone: [nil]) notNil] errorString: '<1?:no:a> subclass of ' , aClass printString , ' refers to ' , aSelector printString! ! !RBCondition class methodsFor: 'utilities' stamp: ''! validClassName: aString "Class names and class variable names have the same restrictions" ^self checkClassVarName: aString in: self! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! withBlock: aBlock ^self new withBlock: aBlock! ! !RBCondition class methodsFor: 'instance creation' stamp: ''! withBlock: aBlock errorString: aString ^self new type: #unknown block: aBlock errorString: aString! ! !RBCondition methodsFor: 'checking' stamp: ''! check ^block value! ! !RBCondition methodsFor: 'initialize-release' stamp: ''! errorBlock: anObject errorBlock := anObject! ! !RBCondition methodsFor: 'accessing' stamp: ''! errorBlockFor: aBoolean ^errorBlock! ! !RBCondition methodsFor: 'printing' stamp: 'bh 4/10/2001 16:51'! printOn: aStream aStream nextPutAll: type asString! ! !RBCondition methodsFor: 'initialize-release' stamp: 'lr 11/19/2009 11:45'! type: aSymbol block: aBlock errorString: aString type := aSymbol. block := aBlock. self errorMacro: aString! ! !RBCondition methodsFor: 'initialize-release' stamp: ''! withBlock: aBlock block := aBlock. type := #(#generic)! ! RBAbstractCondition subclass: #RBConjunctiveCondition instanceVariableNames: 'left right failed' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBConjunctiveCondition methodsFor: 'checking' stamp: ''! check left check ifFalse: [failed := #leftFailed. ^false]. right check ifFalse: [failed := #rightFailed. ^false]. ^true! ! !RBConjunctiveCondition methodsFor: 'private' stamp: 'lr 11/2/2009 23:38'! errorBlockFor: aBoolean ^aBoolean ifTrue: [nil] ifFalse: [failed = #leftFailed ifTrue: [left errorBlock] ifFalse: [right errorBlock]]! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! errorMacro ^errorMacro isNil ifTrue: [self longMacro] ifFalse: [super errorMacro]! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! errorStringFor: aBoolean ^aBoolean ifTrue: [self neitherFailed] ifFalse: [self perform: failed]! ! !RBConjunctiveCondition methodsFor: 'initialize-release' stamp: ''! left: aCondition right: aCondition2 left := aCondition. right := aCondition2. failed := #unknownFailed! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! leftFailed ^left errorStringFor: false! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! longMacro ^'(' , left errorMacro , ') <1?AND:OR> (' , right errorMacro , ')'! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! neitherFailed ^(left errorStringFor: true) , ' AND ' , (right errorStringFor: true)! ! !RBConjunctiveCondition methodsFor: 'printing' stamp: 'bh 4/10/2001 16:52'! printOn: aStream aStream nextPutAll: left asString; nextPutAll: ' & '; nextPutAll: right asString ! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! rightFailed ^right errorStringFor: false! ! !RBConjunctiveCondition methodsFor: 'private' stamp: ''! unknownFailed ^(left errorStringFor: false) , ' OR ' , (right errorStringFor: false)! ! RBAbstractCondition subclass: #RBNegationCondition instanceVariableNames: 'condition' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Conditions'! !RBNegationCondition class methodsFor: 'instance creation' stamp: ''! on: aCondition ^self new condition: aCondition! ! !RBNegationCondition methodsFor: 'checking' stamp: ''! check ^condition check not! ! !RBNegationCondition methodsFor: 'initialize-release' stamp: ''! condition: aCondition condition := aCondition. self errorMacro: condition errorMacro! ! !RBNegationCondition methodsFor: 'private' stamp: ''! errorBlockFor: aBoolean ^condition errorBlockFor: aBoolean not! ! !RBNegationCondition methodsFor: 'private' stamp: ''! errorStringFor: aBoolean ^condition errorStringFor: aBoolean not! ! !RBNegationCondition methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: 'NOT '; print: condition! ! Object subclass: #RBLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! RBLintRule subclass: #RBBasicLintRule instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 1/25/2010 23:25'! filteredResult "Be very careful when filtering results not to introduce new items and not to lose the dedicated browser environments. Try the following steps in order: - If this is a selector environment use the set-operations of the refactoring browser. - If this is a class environment, remove the classes that have a filter annotation in any of its methods. - If this is a variable environment, remove the classes and all its variables that have a filter annotation in any of its methods. - Otherwise return the unfiltered environment." | filter | result isEmpty ifTrue: [ ^ result ]. filter := PragmaEnvironment onEnvironment: BrowserEnvironment new keywords: #( lint: lint:rationale: lint:rationale:author: lint:author: ignoreLintRule: ignoreLintRule:rationale: ignoreLintRule:rationale:author: ignoreLintRule:author: ). filter condition: [ :pragma | pragma arguments first = self name or: [ pragma arguments first = self group or: [ pragma arguments first = self class name ] ] ]. result isSelectorEnvironment ifTrue: [ ^ (result & filter not) label: result label ]. result isClassEnvironment ifTrue: [ filter classesDo: [ :class | result removeClass: class theMetaClass; removeClass: class theNonMetaClass ] ] ifFalse: [ result isVariableEnvironment ifTrue: [ filter classesDo: [ :class | class classVarNames do: [ :var | result removeClass: class classVariable: var ]. class instVarNames do: [ :var | result removeClass: class instanceVariable: var ] ] ] ]. ^ result! ! !RBBasicLintRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 21:39'! initialize super initialize. self resetResult ! ! !RBBasicLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:37'! isEmpty ^ self result isEmpty! ! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:40'! problemCount ^ self result problemCount! ! !RBBasicLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:39'! resetResult result := self resultClass new. result label: self name! ! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:40'! result ^ result! ! !RBBasicLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:28'! resultClass self subclassResponsibility! ! RBBasicLintRule subclass: #RBBlockLintRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! RBBlockLintRule subclass: #RBAbstractClassRule instanceVariableNames: 'subclassResponsibilitySymbol' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBAbstractClassRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:34'! checkClass: aContext (aContext selectedClass whichSelectorsReferTo: subclassResponsibilitySymbol) isEmpty ifFalse: [ (aContext uses: (Smalltalk associationAt: aContext selectedClass name ifAbsent: [ nil ])) ifTrue: [ result addClass: aContext selectedClass ] ]! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBAbstractClassRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 00:34'! initialize super initialize. subclassResponsibilitySymbol := 'subclassResponsibility' asSymbol! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'References an abstract class'! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for references to classes that have subclassResponsibility methods. Such references might be creating instances of the abstract class or more commonly being used as the argument to an isKindOf: message which is considered bad style.'! ! !RBAbstractClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBAddRemoveDependentsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBAddRemoveDependentsRule methodsFor: 'running' stamp: 'lr 11/2/2009 23:38'! checkClass: aContext | count | count := 0. ((Set withAll: (aContext selectedClass whichSelectorsReferTo: #addDependent:)) addAll: (aContext selectedClass whichSelectorsReferTo: #removeDependent:); yourself) do: [ :sel | (aContext selectedClass compiledMethodAt: sel) messagesDo: [ :each | each = #addDependent: ifTrue: [ count := count + 1 ]. each = #removeDependent: ifTrue: [ count := count - 1 ] ] ]. count > 0 ifTrue: [ result addClass: aContext selectedClass ]! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Number of addDependent: messages > removeDependent:'! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check that the number of addDependent: message sends in a class is less than or equal to the number of removeDependent: messages. If there are more addDependent: messages that may signify that some dependents are not being released, which may lead to memory leaks.'! ! !RBAddRemoveDependentsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBBadMessageRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBBadMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:09'! 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 )! ! !RBBadMessageRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:10'! checkClass: aContext | selectors | selectors := self badSelectors inject: Set new into: [ :set :each | set addAll: (aContext selectedClass whichSelectorsReferTo: each); yourself ]. selectors do: [ :each | result addClass: aContext selectedClass selector: each ]. selectors isEmpty ifFalse: [ result searchStrings: self badSelectors ]! ! !RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends "questionable" message'! ! !RBBadMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check methods that send messages that perform low level things. You might want to limit the number of such messages in your application. For example, using become: throughout your application might not be the best thing. Also, messages such as isKindOf: can signify a lack of polymorphism. You can change which methods are "questionable" by editing the BasicLintRule>>badSelectors method.'! ! !RBBlockLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'! isVisible ^ self name ~= #RBBlockLintRule! ! !RBBlockLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:28'! resultClass ^ SelectorEnvironment! ! RBBlockLintRule subclass: #RBClassInstVarNotInitializedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBClassInstVarNotInitializedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | definesVar class | aContext selectedClass isMeta ifTrue: [ class := aContext selectedClass. definesVar := false. [ definesVar or: [ class isNil or: [ class isMeta not ] ] ] whileFalse: [ definesVar := class instVarNames isEmpty not. class := class superclass ]. (definesVar and: [ (aContext selectedClass includesSelector: #initialize) not ]) ifTrue: [ result addClass: aContext selectedClass ] ]! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Has class instance variables but no initialize method'! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all classes that have class instance variables also have an initialize method. This makes sure that all class instance variables are initialized properly when the class is filed-into a new image.'! ! !RBClassInstVarNotInitializedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBClassNameInSelectorRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBClassNameInSelectorRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext selectedClass isMeta and: [ (aContext selector indexOfSubCollection: aContext selectedClass soleInstance name startingAt: 1) > 0 ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Redundant class name in selector'! ! !RBClassNameInSelectorRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for the class name in a selector. This is redundant since to call the you must already refer to the class name. For example, openHierarchyBrowserFrom: is a redundant name for HierarchyBrowser.'! ! RBBlockLintRule subclass: #RBClassNotReferencedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBClassNotReferencedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext (aContext selectedClass isMeta or: [ aContext selectedClass subclasses isEmpty not or: [ aContext selectedClass includesBehavior: TestCase ] ]) ifFalse: [ | assoc | assoc := Smalltalk associationAt: aContext selectedClass name. ((aContext uses: assoc) or: [ aContext uses: aContext selectedClass name ]) ifFalse: [ result addClass: aContext selectedClass; addClass: aContext selectedClass class ] ]! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Class not referenced'! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check if a class is referenced either directly or indirectly by a symbol. If a class is not referenced, it can be removed.'! ! !RBClassNotReferencedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBClassVariableCapitalizationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBClassVariableCapitalizationRule methodsFor: 'running' stamp: 'lr 1/21/2010 23:42'! checkClass: aContext aContext selectedClass isMeta ifTrue: [ ^ self ]. aContext selectedClass classVarNames do: [ :each | each first isUppercase ifFalse: [ result addClass: aContext selectedClass classVariable: each ] ]. aContext selectedClass poolDictionaryNames do: [ :each | each first isUppercase ifFalse: [ result addClass: aContext selectedClass classVariable: each ] ]! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Class variable capitalization'! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 20:34'! rationale ^ 'Class and pool variable names should start with an uppercase letter.'! ! !RBClassVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ VariableEnvironment! ! RBBlockLintRule subclass: #RBCollectionCopyEmptyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBCollectionCopyEmptyRule methodsFor: 'running' stamp: 'lr 10/11/2009 11:30'! checkClass: aContext (aContext selectedClass isVariable and: [ (aContext selectedClass includesSelector: #copyEmpty) not and: [ aContext selectedClass instVarNames isEmpty not and: [ aContext selectedClass inheritsFrom: Collection ] ] ]) ifTrue: [ result addClass: aContext selectedClass ]! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Subclass of collection that has instance variable but doesn''t define copyEmpty'! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all subclasses of the Collection classes that add an instance variable also redefine the copyEmpty method. This method is used when the collection grows. It copies over the necessary instance variables to the new larger collection.'! ! !RBCollectionCopyEmptyRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBDefinesEqualNotHashRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBDefinesEqualNotHashRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext ((aContext selectedClass includesSelector: #=) and: [ (aContext selectedClass includesSelector: #hash) not ]) ifTrue: [ result addClass: aContext selectedClass ]! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Defines = but not hash'! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all classes that define = also define hash. If hash is not defined then the instances of the class might not be able to be used in sets since equal element must have the same hash.'! ! !RBDefinesEqualNotHashRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBEquivalentSuperclassMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBEquivalentSuperclassMethodsRule methodsFor: 'running' stamp: 'TestRunner 11/3/2009 16:27'! checkMethod: aContext | superclass supertree | aContext selectedClass superclass notNil ifTrue: [ superclass := aContext selectedClass superclass whichClassIncludesSelector: aContext selector. superclass notNil ifTrue: [ supertree := superclass parseTreeFor: aContext selector. (supertree notNil and: [ supertree equalTo: aContext parseTree exceptForVariables: supertree allDefinedVariables ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ] ]! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Methods equivalently defined in superclass'! ! !RBEquivalentSuperclassMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that are equivalent to their superclass methods. Such methods don''t add anything to the computation and can be removed since the superclass''s method will work just fine.'! ! RBBlockLintRule subclass: #RBExcessiveArgumentsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBExcessiveArgumentsRule methodsFor: 'private' stamp: 'lr 6/15/2009 15:59'! argumentsCount ^ 5! ! !RBExcessiveArgumentsRule methodsFor: 'running' stamp: 'lr 6/15/2009 16:00'! checkMethod: aContext aContext selector numArgs >= self argumentsCount ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:52'! group ^ 'Miscellaneous'! ! !RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:00'! name ^ 'Excessive number of arguments'! ! !RBExcessiveArgumentsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:55'! rationale ^ 'Long argument lists can indicate that a new object should be created to wrap the numerous parameters.'! ! RBBlockLintRule subclass: #RBExcessiveInheritanceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBExcessiveInheritanceRule methodsFor: 'running' stamp: 'lr 1/21/2010 23:42'! checkClass: aContext | count current | aContext selectedClass isMeta ifTrue: [ ^ self ]. count := 1. current := aContext selectedClass. [ current isNil ] whileFalse: [ self inheritanceDepth < count ifTrue: [ ^ result addClass: aContext selectedClass ]. current := current superclass. count := count + 1 ]! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! group ^ 'Miscellaneous'! ! !RBExcessiveInheritanceRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:22'! inheritanceDepth ^ 10! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! name ^ 'Excessive inheritance depth'! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! rationale ^ 'Deep inheritance is usually a sign of a design flaw. Try to break it down, and reduce the inheritance to something manageable.'! ! !RBExcessiveInheritanceRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:03'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBExcessiveMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBExcessiveMethodsRule methodsFor: 'running' stamp: 'lr 6/15/2009 16:14'! checkClass: aContext aContext selectedClass selectors size >= self methodsCount ifTrue: [ result addClass: aContext selectedClass ]! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:57'! group ^ 'Miscellaneous'! ! !RBExcessiveMethodsRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:23'! methodsCount ^ 40! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:58'! name ^ 'Excessive number of methods'! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 15:58'! rationale ^ 'Large classes are indications that the class may be trying to do too much. Try to break it down, and reduce the size to something manageable.'! ! !RBExcessiveMethodsRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:01'! resultClass ^ ClassEnvironment! ! RBBlockLintRule subclass: #RBExcessiveVariablesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBExcessiveVariablesRule methodsFor: 'running' stamp: 'lr 6/15/2009 16:16'! checkClass: aContext (aContext selectedClass instVarNames size >= self variablesCount or: [ aContext selectedClass classVarNames size >= self variablesCount ]) ifTrue: [ result addClass: aContext selectedClass ]! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! group ^ 'Miscellaneous'! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! name ^ 'Excessive number of variables'! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! rationale ^ 'Classes that have too many instance variables could be redesigned to have fewer fields, possibly through some nested object grouping.'! ! !RBExcessiveVariablesRule methodsFor: 'accessing' stamp: 'lr 6/15/2009 16:09'! resultClass ^ ClassEnvironment! ! !RBExcessiveVariablesRule methodsFor: 'private' stamp: 'lr 6/15/2009 16:23'! variablesCount ^ 10! ! RBBlockLintRule subclass: #RBImplementedNotSentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBImplementedNotSentRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext ((aContext uses: aContext selector) or: [ aContext selectedClass isMeta not and: [ (aContext selector beginsWith: #test) and: [ aContext selectedClass includesBehavior: TestCase ] ] ]) ifFalse: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Methods implemented but not sent'! ! !RBImplementedNotSentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that are never sent. If a method is not sent, it can be removed.'! ! RBBlockLintRule subclass: #RBInconsistentMethodClassificationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBInconsistentMethodClassificationRule methodsFor: 'running' stamp: 'lr 3/13/2009 11:41'! checkMethod: aContext | superClass superProtocol ownerProtocol | aContext selectedClass superclass isNil ifFalse: [ superClass := aContext selectedClass superclass whichClassIncludesSelector: aContext selector. superClass isNil ifFalse: [ superProtocol := superClass whichCategoryIncludesSelector: aContext selector. ownerProtocol := aContext selectedClass whichCategoryIncludesSelector: aContext selector. (superProtocol isNil or: [ superProtocol isEmpty or: [ superProtocol first = $* or: [ ownerProtocol isNil or: [ ownerProtocol isEmpty or: [ ownerProtocol first = $* ] ] ] ] ]) ifFalse: [ superProtocol = ownerProtocol ifFalse: [ result addClass: superClass selector: aContext selector into: superProtocol; addClass: aContext selectedClass selector: aContext selector into: superProtocol ] ] ] ]! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Inconsistent method classification'! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'All methods should be put into a protocol (method category) that is equivalent to the one of the superclass.'! ! !RBInconsistentMethodClassificationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ MultiEnvironment! ! RBBlockLintRule subclass: #RBInstVarInSubclassesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBInstVarInSubclassesRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | subs | subs := aContext 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: aContext selectedClass instanceVariable: val ] ] ]! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variables defined in all subclasses'! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks classes for instance variables that are defined in all subclasses. Many times you might want to pull the instance variable up into the class so that all the subclasses do not have to define it.'! ! !RBInstVarInSubclassesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ VariableEnvironment! ! RBBlockLintRule subclass: #RBInstanceVariableCapitalizationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBInstanceVariableCapitalizationRule methodsFor: 'running' stamp: 'lr 7/3/2009 20:34'! checkClass: aContext aContext selectedClass instVarNames do: [ :each | each first isLowercase ifFalse: [ result addClass: aContext selectedClass instanceVariable: each ] ]! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variable capitalization'! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Instance variable names on the instance- and class-side should start with a lowercase letter.'! ! !RBInstanceVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ VariableEnvironment! ! RBBlockLintRule subclass: #RBJustSendsSuperRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBJustSendsSuperRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:11'! checkMethod: aContext (aContext parseTree isPrimitive not and: [ matcher executeMethod: aContext parseTree initialAnswer: false ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBJustSendsSuperRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher justSendsSuper! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method just sends super message'! ! !RBJustSendsSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that just forward the message to its superclass. These methods can be removed.'! ! RBBlockLintRule subclass: #RBLiteralArrayContainsCommaRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBLiteralArrayContainsCommaRule methodsFor: 'running' stamp: 'lr 2/6/2010 13:32'! checkMethod: aContext (aContext compiledMethod allLiterals anySatisfy: [ :each | self doesLiteralArrayContainComma: each ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBLiteralArrayContainsCommaRule methodsFor: 'private' stamp: 'lr 2/6/2010 13:32'! doesLiteralArrayContainComma: aLiteral aLiteral class = Array ifFalse: [ ^ false ]. (aLiteral includes: #,) ifTrue: [ ^ true ]. ^ aLiteral anySatisfy: [ :each | self doesLiteralArrayContainComma: each ]! ! !RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBLiteralArrayContainsCommaRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Literal array contains a #,'! ! RBBlockLintRule subclass: #RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'running' stamp: 'lr 2/16/2010 21:04'! checkMethod: aContext | compiledLits parsedLits | compiledLits := aContext compiledMethod allLiterals inject: OrderedCollection new into: [ :collection :literal | collection addAll: (self literalTrueFalseOrNilSymbolsIn: literal); yourself ]. compiledLits size > 0 ifTrue: [ parsedLits := OrderedCollection new. matcher executeTree: aContext parseTree initialAnswer: parsedLits. compiledLits size ~= parsedLits size ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ]! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'initialization' stamp: 'lr 2/6/2010 13:50'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matches: '`#array `{ :node | node isLiteralArray and: [ node isForByteArray not ] }' do: [ :node :answer | answer addAll: (self literalTrueFalseOrNilSymbolsIn: node value); yourself ]! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'private' stamp: 'lr 2/6/2010 13:21'! literalTrueFalseOrNilSymbolsIn: aLiteral | retval | aLiteral class == Array ifFalse: [ ^ #() ]. retval := OrderedCollection withAll: (aLiteral select: [ :each | each isSymbol and: [ #(#true #false #nil ) includes: each ] ]). aLiteral do: [ :each | retval addAll: (self literalTrueFalseOrNilSymbolsIn: each) ]. ^ retval! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Literal array contains a #true, #false, or #nil but the source doesn''t.'! ! !RBLiteralArrayContainsSuspiciousTrueFalseOrNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! 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.'! ! RBBlockLintRule subclass: #RBLongMethodsRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBLongMethodsRule methodsFor: 'running' stamp: 'lr 6/15/2009 15:56'! checkMethod: aContext (matcher executeTree: aContext parseTree initialAnswer: 0) >= self longMethodSize ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBLongMethodsRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matches: '`.Stmt' do: [:aNode :answer | (aNode children inject: answer into: [:sum :each | matcher executeTree: each initialAnswer: sum]) + 1].! ! !RBLongMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:12'! longMethodSize ^ 10! ! !RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Long methods'! ! !RBLongMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Returns all methods that have BasicLintRule class>>longMethodSize number of statements. This check counts statements, not lines.'! ! RBBlockLintRule subclass: #RBMethodHasNoTimeStampRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBMethodHasNoTimeStampRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext aContext compiledMethod timeStamp isEmpty ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method has no timeStamp'! ! !RBMethodHasNoTimeStampRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'For proper versioning, every method should have a timestamp.'! ! RBBlockLintRule subclass: #RBMethodSourceContainsLinefeedsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBMethodSourceContainsLinefeedsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext sourceCode includes: Character lf) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method source contains linefeeds'! ! !RBMethodSourceContainsLinefeedsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Squeak code should not contain linefeed characters.'! ! RBBlockLintRule subclass: #RBMissingSubclassResponsibilityRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBMissingSubclassResponsibilityRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | subs | subs := aContext selectedClass subclasses. (subs size > 1 and: [ aContext 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: [ (aContext selectedClass canUnderstand: each) not ]) ifTrue: [ | envName | envName := aContext selectedClass name , '>>' , each. subs do: [ :subClass | result addClass: subClass selector: each into: envName ] ] ] ]! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Method defined in all subclasses, but not in superclass'! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks classes for methods that are defined in all subclasses, but not defined in self. Such methods should most likely be defined as subclassResponsibility methods to help document the class. Furthermore, this check helps to find similar code that might be occurring in all the subclasses that should be pulled up into the superclass.'! ! !RBMissingSubclassResponsibilityRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ MultiEnvironment! ! RBBlockLintRule subclass: #RBMissingSuperSendsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBMissingSuperSendsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:52'! checkMethod: aContext | definer superMethod | (aContext selectedClass isMeta not and: [ self superMessages includes: aContext selector ]) ifTrue: [ definer := aContext selectedClass superclass ifNotNilDo: [ :sc | sc whichClassIncludesSelector: aContext selector ]. definer ifNotNil: [ "super defines same method" (aContext superMessages includes: aContext selector) ifFalse: [ "but I don't call it" superMethod := definer compiledMethodAt: aContext selector ifAbsent: [ ]. (superMethod isReturnSelf or: [ superMethod sendsSelector: #subclassResponsibility ]) ifFalse: [ result addClass: aContext selectedClass selector: aContext selector ] ] ] ]! ! !RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'! group ^ 'Possible bugs'! ! !RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'! name ^ 'Missing super sends in selected methods.'! ! !RBMissingSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:53'! rationale ^ 'Checks that some methods contain a super message send. Some methods should always contain a super message send. For example, the postCopy method should always contain a "super postCopy". The list of methods that should contain super message sends is in BasicLintRule>>superMessages.'! ! !RBMissingSuperSendsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:17'! superMessages ^#(#release #postCopy #postBuildWith: #preBuildWith: #postOpenWith: #noticeOfWindowClose: #initialize)! ! RBBlockLintRule subclass: #RBOnlyReadOrWrittenRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBOnlyReadOrWrittenRule methodsFor: 'running' stamp: 'lr 2/6/2010 13:28'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext 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 and: [ isWritten ] ] ifNone: [ result addClass: aContext selectedClass instanceVariable: each ] ]! ! !RBOnlyReadOrWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBOnlyReadOrWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variables not read AND written'! ! !RBOnlyReadOrWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all instance variables are both read and written. If an instance variable is only read, you can replace all of the reads with nil, since it couldn''t have been assigned a value. If the variable is only written, then we don''t need to store the result since we never use it. This check does not work for the data model classes since they use the instVarAt:put: messages to set instance variables.'! ! !RBOnlyReadOrWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ VariableEnvironment! ! RBBlockLintRule subclass: #RBOverridesSpecialMessageRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBOverridesSpecialMessageRule methodsFor: 'running' stamp: 'lr 1/21/2010 23:42'! checkClass: aContext | selectors | selectors := aContext selectedClass isMeta ifTrue: [ self metaclassShouldNotOverride ] ifFalse: [ self classShouldNotOverride ]. selectors do: [ :each | (aContext selectedClass superclass notNil and: [ (aContext selectedClass superclass canUnderstand: each) and: [ (aContext selectedClass includesSelector: each) ] ]) ifTrue: [ result addClass: aContext selectedClass selector: each ] ]! ! !RBOverridesSpecialMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:12'! classShouldNotOverride ^ #( #== #~~ #class #basicAt: #basicAt:put: #basicSize #identityHash )! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBOverridesSpecialMessageRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:13'! metaclassShouldNotOverride ^ #( #basicNew #basicNew #class #comment #name )! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Overrides a "special" message'! ! !RBOverridesSpecialMessageRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 20:07'! rationale ^ 'Checks that a class does not override a message that is essential to the base system. For example, if you override the #class method from object, you are likely to crash your image.'! ! RBBlockLintRule subclass: #RBRefersToClassRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBRefersToClassRule methodsFor: 'running' stamp: 'lr 10/31/2009 17:36'! checkClass: aContext | sels className | className := aContext selectedClass theNonMetaClass name. sels := aContext selectedClass whichSelectorsReferTo: (Smalltalk associationAt: className). sels do: [ :each | result addClass: aContext selectedClass selector: each ]. sels isEmpty ifFalse: [ result addSearchString: className ]! ! !RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Refers to class name instead of "self class"'! ! !RBRefersToClassRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for classes that have their class name directly in the source instead of "self class". The self class variant allows you to create subclasses without needing to redefine that method.'! ! RBBlockLintRule subclass: #RBReturnsBooleanAndOtherRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBReturnsBooleanAndOtherRule methodsFor: 'running' stamp: 'lr 8/19/2009 20:54'! checkMethod: aContext | hasBool hasSelf | hasBool := false. hasSelf := aContext parseTree lastIsReturn not. (matcher executeTree: aContext 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 and: [ hasBool ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBReturnsBooleanAndOtherRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matches: '^ ``@object' do: [ :node :answer | answer add: node value; yourself ]! ! !RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Returns a boolean and non boolean'! ! !RBReturnsBooleanAndOtherRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods that return a boolean value (true or false) and return some other value such as (nil or self). If the method is suppose to return a boolean, then this signifies that there is one path through the method that might return a non-boolean. If the method doesn''t need to return a boolean, you should probably rewrite it to return some non-boolean value since other programmers reading your method might assume that it returns a boolean.'! ! RBBlockLintRule subclass: #RBSendsDifferentSuperRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBSendsDifferentSuperRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | message | (message := aContext superMessages detect: [ :each | each ~= aContext selector ] ifNone: [ nil ]) notNil ifTrue: [ result addSearchString: message. result addClass: aContext selectedClass selector: aContext selector ]! ! !RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends different super message'! ! !RBSendsDifferentSuperRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods whose source sends a different super message.'! ! RBBlockLintRule subclass: #RBSentNotImplementedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBSentNotImplementedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | message | message := aContext messages detect: [ :each | (aContext implements: each) not ] ifNone: [ aContext superMessages detect: [ :each | aContext selectedClass superclass isNil or: [ (aContext selectedClass superclass canUnderstand: each) not ] ] ifNone: [ aContext selfMessages detect: [ :each | (aContext selectedClass canUnderstand: each) not ] ifNone: [ nil ] ] ]. message notNil ifTrue: [ result addSearchString: message. result addClass: aContext selectedClass selector: aContext selector ]! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Messages sent but not implemented'! ! !RBSentNotImplementedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for messages that are sent by a method, but no class in the system implements such a message. Further checks if messages sent to self or super exist in the hierarchy, since these can be statically typed. Reported methods will certainly cause a doesNotUnderstand: message when they are executed.'! ! RBBlockLintRule subclass: #RBSubclassResponsibilityNotDefinedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext (aContext selectedClass whichSelectorsReferTo: #subclassResponsibility) do: [ :each | (aContext selectedClass withAllSubclasses detect: [ :class | class subclasses isEmpty and: [ (class whichClassIncludesSelector: each) == aContext selectedClass ] ] ifNone: [ nil ]) notNil ifTrue: [ result addClass: aContext selectedClass selector: each ] ]! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Subclass responsibility not defined'! ! !RBSubclassResponsibilityNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all subclassResponsibility methods are defined in all leaf classes.'! ! RBBlockLintRule subclass: #RBSuperSendsNewRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBSuperSendsNewRule methodsFor: 'running' stamp: 'lr 2/26/2009 16:32'! checkMethod: aContext aContext selectedClass isMeta ifTrue: [ ^ self ]. (matcher executeTree: aContext parseTree initialAnswer: false) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBSuperSendsNewRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matchesAnyOf: #( 'super new initialize' '(super new: `@expr) initialize' 'self new initialize' '(self new: `@expr) initialize' ) do: [ :answer :node | true ].! ! !RBSuperSendsNewRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends super new initialize'! ! RBBlockLintRule subclass: #RBTempVarOverridesInstVarRule instanceVariableNames: 'matcher varName vars' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBTempVarOverridesInstVarRule methodsFor: 'running' stamp: 'lr 2/24/2009 00:14'! checkMethod: aContext vars := aContext instVarNames. (matcher executeTree: aContext parseTree initialAnswer: false) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: varName ]! ! !RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBTempVarOverridesInstVarRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new. matcher matchesArgument: '`var' do: [:aNode :answer | answer or: [varName := aNode name. vars includes: varName]]! ! !RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Instance variable overridden by temporary variable'! ! !RBTempVarOverridesInstVarRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Finds methods that have block are temporary variables that override an instance variable. This causes problems if you want to use the instance variable inside the method.'! ! RBBlockLintRule subclass: #RBTemporaryVariableCapitalizationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBTemporaryVariableCapitalizationRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext aContext parseTree allDefinedVariables do: [ :each | each first isLowercase ifFalse: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: each ] ]! ! !RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Temporary variable capitalization'! ! !RBTemporaryVariableCapitalizationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Temporary and argument variable names should start with a lowercase letter.'! ! RBBlockLintRule subclass: #RBTempsReadBeforeWrittenRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBTempsReadBeforeWrittenRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (RBReadBeforeWrittenTester variablesReadBeforeWrittenIn: aContext parseTree) do: [ :each | result addClass: aContext selectedClass selector: aContext selector. result addSearchString: each ]! ! !RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Temporaries read before written'! ! !RBTempsReadBeforeWrittenRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks that all temporaries are assigned before they are used. This can help find possible paths through the code where a variable might be unassigned when it is used.'! ! RBBlockLintRule subclass: #RBUnclassifiedMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUnclassifiedMethodsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext selectedClass organization categoryOfElement: aContext selector) = Categorizer default ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unclassified methods'! ! !RBUnclassifiedMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'All methods should be put into a protocol (method category) for better readability.'! ! RBBlockLintRule subclass: #RBUncommonMessageSendRule instanceVariableNames: 'literalNames' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUncommonMessageSendRule methodsFor: 'running' stamp: 'lr 3/28/2009 14:26'! checkMethod: aContext aContext messages do: [ :each | (each isEmpty or: [ each first isUppercase or: [ literalNames includes: each ] ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: each ] ]! ! !RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:21'! group ^ 'Possible bugs'! ! !RBUncommonMessageSendRule methodsFor: 'initialization' stamp: 'lr 3/28/2009 14:25'! initialize super initialize. literalNames := #( #self #super #thisContext #true #false #nil ) asIdentitySet! ! !RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:22'! name ^ 'Uncommon message send'! ! !RBUncommonMessageSendRule methodsFor: 'accessing' stamp: 'lr 3/28/2009 14:34'! rationale ^ 'Sending messages with a common literal with an uppercase selector name are usually bugs, introduced through missing statement separators.'! ! RBBlockLintRule subclass: #RBUndeclaredReferenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUndeclaredReferenceRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | undeclared | undeclared := Undeclared associations detect: [ :each | (aContext uses: each) and: [ aContext compiledMethod refersToLiteral: each ] ] ifNone: [ nil ]. undeclared notNil ifTrue: [ result addSearchString: undeclared key. result addClass: aContext selectedClass selector: aContext selector ]! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'References an undeclared variable'! ! !RBUndeclaredReferenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for references to a variable in the Undeclared dictionary. If you remove a variable from a class that is accessed by a method, you will create an undeclared variable reference for those methods that accessed the variable.'! ! RBBlockLintRule subclass: #RBUnpackagedCodeRule instanceVariableNames: 'packages package' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUnpackagedCodeRule methodsFor: 'running' stamp: 'lr 3/20/2009 09:14'! checkClass: aContext (aContext selectedClass isMeta not and: [ (self packageSatisfying: [ :info | info includesSystemCategory: aContext selectedClass category ]) isNil ]) ifTrue: [ self result addClass: aContext selectedClass ]! ! !RBUnpackagedCodeRule methodsFor: 'running' stamp: 'lr 3/20/2009 09:14'! checkMethod: aContext (self packageSatisfying: [ :info | info includesMethod: aContext selector ofClass: aContext selectedClass ]) isNil ifTrue: [ self result addClass: aContext selectedClass selector: aContext selector ]! ! !RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/20/2009 17:21'! group ^ 'Possible bugs'! ! !RBUnpackagedCodeRule methodsFor: 'initialization' stamp: 'lr 3/20/2009 08:21'! initialize super initialize. packages := MCWorkingCopy allManagers collect: [ :each | each packageInfo ]! ! !RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/20/2009 08:20'! name ^ 'Unpackaged code'! ! !RBUnpackagedCodeRule methodsFor: 'private' stamp: 'lr 3/20/2009 09:17'! packageSatisfying: aBlock "Answer the first package satisfying aBlock or nil. This method assumes that it is likely that the last matching package matches the given condition again and thus it tries that one first." (package notNil and: [ aBlock value: package ]) ifTrue: [ ^ package ]. packages do: [ :info | (aBlock value: info) ifTrue: [ ^ package := info ] ]. ^ nil! ! !RBUnpackagedCodeRule methodsFor: 'accessing' stamp: 'lr 3/9/2010 16:08'! rationale ^ 'Code that is not contained in a Monticello package is not versioned and cannot be brought into a different image.'! ! RBBlockLintRule subclass: #RBUnreferencedVariablesRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUnreferencedVariablesRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext selectedClass instVarNames do: [ :each | allSubclasses detect: [ :class | (class whichSelectorsAccess: each) isEmpty not ] ifNone: [ result addClass: aContext selectedClass instanceVariable: each ] ]. aContext selectedClass isMeta ifFalse: [ aContext selectedClass classPool associationsDo: [ :each | (aContext uses: each) ifFalse: [ result addClass: aContext selectedClass classVariable: each key ] ] ]! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variables not referenced'! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for variables not referenced. If a variable is not used in a class, it should be deleted.'! ! !RBUnreferencedVariablesRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ VariableEnvironment! ! RBBlockLintRule subclass: #RBUsesTrueRule instanceVariableNames: 'trueBinding falseBinding' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUsesTrueRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext | method | method := aContext compiledMethod. ((method refersToLiteral: trueBinding) or: [ method refersToLiteral: falseBinding ]) ifTrue: [ result addClass: aContext selectedClass selector: aContext selector. result searchStrings: #('True' 'False' ) ]! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBUsesTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 00:35'! initialize super initialize. trueBinding := Smalltalk associationAt: #True. falseBinding := Smalltalk associationAt: #False! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses True/False instead of true/false'! ! !RBUsesTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for uses of the classes True and False instead of the objects true and false.'! ! RBBlockLintRule subclass: #RBUtilityMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBUtilityMethodsRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext (aContext selectedClass isMeta or: [ aContext selector numArgs == 0 or: [ (aContext protocols detect: [ :each | (self utilityProtocols detect: [ :protocol | protocol match: each ] ifNone: [ ]) notNil ] ifNone: [ ]) notNil ] ]) ifFalse: [ (self subclassOf: aContext selectedClass overrides: aContext selector) ifFalse: [ (aContext superMessages isEmpty and: [ aContext selfMessages isEmpty ]) ifTrue: [ (aContext selectedClass allInstVarNames , aContext selectedClass allClassVarNames asArray , #('self' ) detect: [ :each | aContext parseTree references: each ] ifNone: [ ]) isNil ifTrue: [ result addClass: aContext selectedClass selector: aContext selector ] ] ] ]! ! !RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Utility methods'! ! !RBUtilityMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'List methods that have one or more arguments and do no refer to self or an instance variable. These methods might be better defined in some other class or as class methods.'! ! !RBUtilityMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:18'! subclassOf: aClass overrides: aSelector ^(aClass subclasses detect: [:each | (each includesSelector: aSelector) or: [self subclassOf: each overrides: aSelector]] ifNone: [nil]) notNil! ! !RBUtilityMethodsRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:18'! utilityProtocols ^ #('*utilit*')! ! RBBlockLintRule subclass: #RBVariableAssignedLiteralRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBVariableAssignedLiteralRule methodsFor: 'running' stamp: 'lr 11/2/2009 00:14'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext 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 := RBParseTreeSearcher 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: aContext selectedClass instanceVariable: each ] ] ] ]! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variable is only assigned a single literal value'! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'If a variable is only assigned a single literal value then that variable is either nil or that literal value. If the variable is always initialized with that literal value, then you could replace each variable reference with a message send to get the value. If the variable can also be nil, then you might want to replace that variable with another that stores true or false depending on whether the old variable had been assigned.'! ! !RBVariableAssignedLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! resultClass ^ VariableEnvironment! ! RBBlockLintRule subclass: #RBVariableNotDefinedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBVariableNotDefinedRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkMethod: aContext aContext compiledMethod literals do: [ :literal | (literal isVariableBinding and: [ literal key notNil ]) ifTrue: [ ((Smalltalk associationAt: literal key ifAbsent: [ ]) == literal or: [ (Undeclared associationAt: literal key ifAbsent: [ ]) == literal ]) ifFalse: [ (aContext selectedClass bindingOf: literal key) == literal ifFalse: [ result addClass: aContext selectedClass selector: aContext selector. result addSearchString: literal key ] ] ] ]! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variable used, but not defined anywhere'! ! !RBVariableNotDefinedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'This check is similar to the "References an undeclared variable" check, but it looks for variables that are not defined in the class or in the undeclared dictionary. You probably had to work hard to get your code in this state.'! ! RBBlockLintRule subclass: #RBVariableReferencedOnceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-BlockRules'! !RBVariableReferencedOnceRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:17'! checkClass: aContext | allSubclasses | allSubclasses := aContext selectedClass withAllSubclasses. aContext 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 ] ] ] ]! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Variable referenced in only one method and always assigned first'! ! !RBVariableReferencedOnceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for instance variables that might better be defined as temporary variables. If an instance variable is only used in one method and it is always assigned before it is used, then that method could define that variable as a temporary variable of the method instead (assuming that the method is not recursive).'! ! RBBasicLintRule subclass: #RBParseTreeLintRule instanceVariableNames: 'matcher' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! RBParseTreeLintRule subclass: #RBAsOrderedCollectionNotNeededRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBAsOrderedCollectionNotNeededRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:18'! initialize super initialize. self matcher matches: '`@node addAll: `{:node | node isMessage and: [#(asOrderedCollection asArray) includes: node selector]}' do: [ :node :answer | node ]! ! !RBAsOrderedCollectionNotNeededRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ '#asOrderedCollection/#asArray not needed'! ! RBParseTreeLintRule subclass: #RBAssignmentInBlockRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBAssignmentInBlockRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:47'! initialize super initialize. self matcher matchesAnyOf: #( '`@cursor showWhile: [| `@temps | `@.Statements1. `var := `@object]' '`@cursor showWhile: [| `@temps | `@.Statements1. ^`@object]' '[| `@temps | `@.Statements. `var := `@object] ensure: `@block' '[| `@temps | `@.Statements. ^`@object] ensure: `@block' '[| `@temps | `@.Statements. `var := `@object] ifCurtailed: `@block' '[| `@temps | `@.Statements. ^`@object] ifCurtailed: `@block' ) do: [ :node :answer | node ]! ! !RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unnecessary assignment or return in block'! ! !RBAssignmentInBlockRule methodsFor: 'accessing' stamp: 'lr 11/19/2009 14:47'! rationale ^ 'Checks ensure:, ifCurtailed:, and showWhile: blocks for assignments or returns that are the last statement in the block. These assignments or returns can be moved outside the block since these messages return the value of the block.'! ! RBParseTreeLintRule subclass: #RBAssignmentWithoutEffectRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! group ^ 'Unnecessary code'! ! !RBAssignmentWithoutEffectRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 13:56'! initialize super initialize. self matcher matches: '`var := `var' do: [ :node :answer | node ]! ! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! name ^ 'Assignment has no effect'! ! !RBAssignmentWithoutEffectRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! rationale ^ 'A statement such as x := x has no effect.'! ! RBParseTreeLintRule subclass: #RBBooleanPrecedenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBBooleanPrecedenceRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:18'! initialize super initialize. self matcher matchesAnyOf: #( '`@object1 | `@object2 = `@object3' '`@object1 | `@object2 == `@object3' '`@object1 & `@object2 = `@object3' '`@object1 & `@object2 == `@object3' '`@object1 | `@object2 ~= `@object3' '`@object1 | `@object2 ~~ `@object3' '`@object1 & `@object2 ~= `@object3' '`@object1 & `@object2 ~~ `@object3' ) do: [ :node :answer | node ]! ! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses A | B = C instead of A | (B = C)'! ! !RBBooleanPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks precedence ordering of & and | with equality operators. Since | and & have the same precedence as =, there are common mistakes where parenthesis are missing around the equality operators.'! ! RBParseTreeLintRule subclass: #RBCodeCruftLeftInMethodsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:19'! initialize super initialize. self matcher matchesAnyOf: #( '`@object checkHaltCountExpired' '`@object clearHaltOnce' '`@object decrementAndCheckHaltCount' '`@object decrementHaltCount' '`@object doExpiredHaltCount' '`@object doExpiredHaltCount: `@object1' '`@object doOnlyOnce: `@object1' '`@object halt' '`@object halt: `@object1 onCount: `@object2' '`@object haltOnCount: `@object1' '`@object haltOnce' '`@object haltOnce: `@object1' '`@object haltOnceEnabled' '`@object hasHaltCount' '`@object hatIf: `@object1' '`@object inspectOnCount: `@object1' '`@object inspectOnce' '`@object inspectUntilCount: `@object1' '`@object rearmOneShot' '`@object removeHaltCount' '`@object setHaltCountTo: `@object1' '`@object setHaltOnce' '`@object toggleHaltOnce' '`@object flag: `@object1' '`@object isThisEverCalled' '`@object isThisEverCalled: `@object1' '`@object logEntry' '`@object logExecution' '`@object logExit' '`@object needsWork' 'true ifTrue: `@object1' 'false ifTrue: `@object1' 'true ifTrue: `@object1 ifFalse: `@object2' 'false ifTrue: `@object1 ifFalse: `@object2' 'true ifFalse: `@object1' 'false ifFalse: `@object1' 'true ifFalse: `@object1 ifTrue: `@object2' 'false ifFalse: `@object1 ifTrue: `@object2' 'Transcript `@message: `@object1' ) do: [ :node :answer | node ]! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Debugging code left in methods'! ! !RBCodeCruftLeftInMethodsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Breakpoints, logging statements, etc. should not be left in production code.'! ! RBParseTreeLintRule subclass: #RBCollectSelectNotUsedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBCollectSelectNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:20'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [(#(#select: #collect: #reject:) includes: node selector) and: [node isUsed not]]}' do: [ :node :answer | node ]! ! !RBCollectSelectNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Doesn''t use the result of a collect:/select:'! ! RBParseTreeLintRule subclass: #RBCollectionMessagesToExternalObjectRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBCollectionMessagesToExternalObjectRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:23'! initialize | queries | super initialize. queries := #( add: remove: addAll: removeAll: ) collect: [ :each | '(`@Object `@message: `@args) <1s> `@Arg' expandMacrosWith: each ]. self matcher matchesAnyOf: queries do: [ :node :answer | answer isNil ifTrue: [ ((node receiver selector copyFrom: 1 to: (node receiver selector size min: 2)) ~= 'as' and: [ | receiver | receiver := node receiver receiver. receiver isVariable not or: [ ((#('self' 'super') includes: receiver name) or: [ Smalltalk includesKey: receiver name asSymbol ]) not ] ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends add:/remove: to external collection'! ! !RBCollectionMessagesToExternalObjectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods that appear to be modifying a collection that is owned by another object. Such modifications can cause problems especially if other variables are modified when the collection is modified. For example, CompositePart must set the container''s of all its parts when adding a new component.'! ! RBParseTreeLintRule subclass: #RBCollectionProtocolRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBCollectionProtocolRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:23'! initialize super initialize. self matcher matchesAnyOf: #( '`@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]' ) do: [ :node :answer | node ]! ! !RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses do: instead of collect: or select:''s'! ! !RBCollectionProtocolRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using the do: method instead of using the collect: or select: methods. This often occurs with new people writing code. The collect: and select: variants express the source code''s intentions better.'! ! RBParseTreeLintRule subclass: #RBConsistencyCheckRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBConsistencyCheckRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:24'! initialize super initialize. self matcher matchesAnyOf: #( '`@object size == 0' '`@object size = 0' '`@object size > 0' '`@object size >= 1' '`@object == nil' '`@object = nil' '`@collection at: 1' '`@collection at: `@collection size' ) do: [ :node :answer | node ]! ! !RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses "size = 0", "= nil", or "at: 1" instead of "isEmpty", "isNil", or "first"'! ! !RBConsistencyCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using equality tests instead of the message sends. Since the code "aCollection size = 0" works for all objects, it is more difficult for someone reading such code to determine that "aCollection" is a collection. Whereas, if you say "aCollection isEmpty" then aCollection must be a collection since isEmpty is only defined for collections.'! ! RBParseTreeLintRule subclass: #RBContainsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBContainsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:24'! initialize super initialize. self matcher matchesAnyOf: #( '(`@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]' ) do: [ :node :answer | node ]! ! !RBContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses detect:ifNone: instead of contains:'! ! !RBContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for the common code fragment: "(aCollection detect: [:each | ''some condition''] ifNone: [nil]) ~= nil". contains: can simplify this code to "aCollection contains: [:each | ''some condition'']". Not only is the contains: variant shorter, it better signifies what the code is doing.'! ! RBParseTreeLintRule subclass: #RBDetectContainsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBDetectContainsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:24'! initialize super initialize. self matcher matchesAnyOf: #( '`@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]' ) do: [ :node :answer | node ]! ! !RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses do: instead of contains: or detect:''s'! ! !RBDetectContainsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using the do: method instead of using the contains: or detect: methods.'! ! RBParseTreeLintRule subclass: #RBEmptyExceptionHandlerRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:31'! group ^ 'Possible bugs'! ! !RBEmptyExceptionHandlerRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 14:12'! initialize super initialize. self matcher matches: '`@block on: `{ :node | | class | node isVariable and: [ (class := Smalltalk classNamed: node name) notNil and: [ (class includesBehavior: Exception) and: [ (class includesBehavior: Notification) not ] ] ] } do: [ :`@err | | `@temps | ]' do: [ :node :answer | node ]! ! !RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/9/2010 16:07'! name ^ 'Empty exception handler'! ! !RBEmptyExceptionHandlerRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 14:05'! rationale ^ 'Empty exception handler blocks hide potential bugs. The situation should be handled in a more robust way.'! ! RBParseTreeLintRule subclass: #RBEndTrueFalseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBEndTrueFalseRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'! initialize super initialize. self matcher 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: [ :node :answer | answer isNil ifTrue: [ | statement | statement := node arguments first body statements last. (statement isVariable and: [ statement = node arguments last body statements last ]) ifFalse: [ node ] ifTrue: [ nil ] ] ifFalse: [ answer ] ]! ! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Check for same statements at end of ifTrue:ifFalse: blocks'! ! !RBEndTrueFalseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for ifTrue:ifFalse: blocks that have the same code at the beginning or end. While you might not originally write such code, as it is modified, it is easier to create such code. Instead of having the same code in two places, you should move it outside the blocks.'! ! RBParseTreeLintRule subclass: #RBEqualNotUsedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBEqualNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:26'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node isUsed not and: [#(#= #== #~= #~~ #< #> #<= #>=) includes: node selector]]}' do: [ :node :answer | node ]! ! !RBEqualNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Doesn''t use the result of a =, ~=, etc.'! ! RBParseTreeLintRule subclass: #RBEqualsTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBEqualsTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'! initialize super initialize. self matcher matchesAnyOf: #('true' 'false') do: [ :node :answer | answer isNil ifTrue: [ (node parent isMessage and: [ #(#= #== #~= #~~) includes: node parent selector ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unnecessary "= true"'! ! !RBEqualsTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for a =, ==, ~=, or ~~ message being sent to true/false or with true/false as the argument. Many times these can be eliminated since their receivers are already booleans. For example, "anObject isFoo == false" could be replaced with "anObject isFoo not" if isFoo always returns a boolean. Sometimes variables might refer to true, false, and something else, but this is considered bad style since the variable has multiple types.'! ! RBParseTreeLintRule subclass: #RBExtraBlockRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Unnecessary code'! ! !RBExtraBlockRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:27'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node receiver isBlock and: [node parent isCascade not and: [#(#value #value: #value:value: #value:value:value: #valueWithArguments) includes: node selector]]]}' do: [ :node :answer | node ]! ! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Block immediately evaluated'! ! !RBExtraBlockRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for blocks that are immediately evaluated. Since the block is immediately evaluated, there is no need for the statements to be in a block.'! ! RBParseTreeLintRule subclass: #RBFileBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBFileBlocksRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:46'! initialize super initialize. self matcher matchesAnyOf: #( '[| `@temps | `var := `@object. `@.statements] ensure: [`var `@messages: `@args]' '[| `@temps | `var := `@object. `@.statements] ifCurtailed: [`var `@messages: `@args]' ) do: [ :node :answer | node ]! ! !RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Assignment inside unwind blocks should be outside.'! ! !RBFileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks assignment to a variable that is the first statement inside the value block that is also used in the unwind block.'! ! RBParseTreeLintRule subclass: #RBFloatEqualityComparisonRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:57'! group ^ 'Possible bugs'! ! !RBFloatEqualityComparisonRule methodsFor: 'initialization' stamp: 'lr 3/13/2009 14:03'! initialize super initialize. self matcher matchesAnyOf: #( '`{ :node | node isLiteral and: [ node value isFloat ] } = `@expr' '`{ :node | node isLiteral and: [ node value isFloat ] } ~= `@expr' '`@expr = `{ :node | node isLiteral and: [ node value isFloat ] }' '`@expr ~= `{ :node | node isLiteral and: [ node value isFloat ] }' ) do: [ :node :answer | node ]! ! !RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:58'! name ^ 'Float equality comparison'! ! !RBFloatEqualityComparisonRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 14:03'! rationale ^ 'Floating point types are imprecise. Using the operators = or ~= might not yield the expected result due to internal rounding differences.'! ! RBParseTreeLintRule subclass: #RBGuardingClauseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBGuardingClauseRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:28'! initialize super initialize. self matcher matchesAnyMethodOf: #( '`@MethodName: `@args | `@temps | `@.Statements. `@condition ifTrue: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' '`@MethodName: `@args | `@temps | `@.Statements. `@condition ifFalse: [| `@BlockTemps | `.Statement1. `.Statement2. `@.BStatements]' ) do: [ :node :answer | answer isNil ifTrue: [ node body statements last ] ifFalse: [ answer ] ]! ! !RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Guarding clauses'! ! !RBGuardingClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for ifTrue: or ifFalse: conditions at end of methods that have two or more statements inside their blocks. Such code might better represent the true meaning of the code if they returned self instead.'! ! RBParseTreeLintRule subclass: #RBIfTrueBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBIfTrueBlocksRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:28'! initialize super initialize. self matcher matchesAnyOf: #( '`@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}' '`@condition and: `{:node | node isBlock not}' '`@condition or: `{:node | node isBlock not}' '`{:node | node isBlock not} whileTrue' '`{:node | node isBlock not} whileFalse' '`{:node | node isBlock not} whileTrue: `@block' '`@block whileTrue: `{:node | node isBlock not}' '`{:node | node isBlock not} whileFalse: `@block' '`@block whileFalse: `{:node | node isBlock not}' '`@from to: `@to do: `{:node | node isBlock not}' '`@from to: `@to by: `@by do: `{:node | node isBlock not}' '`@condition ifNil: `{:node | node isBlock not}' '`@condition ifNotNil: `{:node | node isBlock not}' '`@condition ifNil: `{:node | node isBlock not} ifNotNil: `@block' '`@condition ifNil: `@block ifNotNil: `{:node | node isBlock not}' '`@condition ifNotNil: `{:node | node isBlock not} ifNil: `@block' '`@condition ifNotNil: `@block ifNil: `{:node | node isBlock not}' ) do: [ :node :answer | node ]! ! !RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Non-blocks in special messages'! ! !RBIfTrueBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for methods that don''t use blocks in the special messages. People new to Smalltalk might write code such as: "aBoolean ifTrue: (self doSomething)" instead of the correct version: "aBoolean ifTrue: [self doSomething]". Even if these pieces of code could be correct, they cannot be optimized by the compiler.'! ! RBParseTreeLintRule subclass: #RBIfTrueReturnsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBIfTrueReturnsRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:30'! initialize super initialize. self matcher matchesAnyOf: #( '| `@temps | ``@.Statements. ``@object ifTrue: [^``@value1]. ^``@value2' '| `@temps | ``@.Statements. ``@object ifFalse: [^``@value1]. ^``@value2' ) do: [ :node :answer | answer isNil ifTrue: [ | condition | condition := (node statements at: node statements size - 1) arguments first body statements last value. "``@value1" ((condition isLiteral and: [ #(true false) includes: condition value ]) or: [ condition := node statements last value. condition isLiteral and: [ #(true false) includes: condition value ] ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'ifTrue:/ifFalse: returns instead of and:/or:''s'! ! !RBIfTrueReturnsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for common ifTrue: returns that could be simplified using a boolean expression.'! ! RBParseTreeLintRule subclass: #RBLawOfDemeterRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBLawOfDemeterRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBLawOfDemeterRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:31'! initialize super initialize. self matcher matches: '(((`@reciver `@msg1: `@arg1) `@msg2: `@arg2) `@msg3: `@arg3) `@msg4: `@arg4' do: [ :node :answer | node ]! ! !RBLawOfDemeterRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Law of demeter'! ! !RBLawOfDemeterRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'The Law of Demeter is a design guideline for developing software and can be succinctly summarized as "Only talk to your immediate friends". The fundamental notion is that a given object should assume as little as possible about the structure or properties of anything else. If long method chains are used a lot of system knowledge is hardcoded into a single method and might make reusability difficult.'! ! RBParseTreeLintRule subclass: #RBLiteralArrayCharactersRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBLiteralArrayCharactersRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:32'! initialize super initialize. self matcher matches: '`#literal' do: [ :node :answer | answer isNil ifTrue: [ (node value class == Array and: [ self isArrayOfCharacters: node value ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBLiteralArrayCharactersRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:25'! isArrayOfCharacters: anArray anArray isEmpty ifTrue: [^false]. 1 to: anArray size do: [:each | (anArray at: each) class == Character ifFalse: [^false]]. ^true! ! !RBLiteralArrayCharactersRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Literal array contains only characters'! ! RBParseTreeLintRule subclass: #RBMissingTranslationsInMenusRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBMissingTranslationsInMenusRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 22:15'! initialize super initialize. self matcher matchesAnyOf: #( '`@menu add: `#label action: `#sym' '`@menu add: `#label selector: `#sym arguments: `@stuff' '`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args' '`@menu add: `#label subMenu: `@stuff' '`@menu add: `#label target: `@targ action: `#sel' '`@menu add: `#label target: `@targ selector `#sel argument: `@arg' '`@menu add: `#label target: `@targ selector `#sel arguments: `@arg' '`@menu add: `#label target: `@targ selector `#sel' '`@menu addList: `{ :n | n isLiteral and: [ n value isArray and: [ n value anySatisfy: [ :row | (row isKindOf: Array) and: [ row first isLiteral ] ] ] ] }' '`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ' '`@menu addTitle: `#label' '`@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' ) do: [ :node :answer | node ]! ! !RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Menus missing translations'! ! !RBMissingTranslationsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Literal strings shown to users in menus should be translated.'! ! RBParseTreeLintRule subclass: #RBMissingYourselfRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBMissingYourselfRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:32'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node parent isCascade and: [node isDirectlyUsed and: [node selector ~~ #yourself]]]}' do: [ :node :answer | node ]! ! !RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Possible missing "; yourself"'! ! !RBMissingYourselfRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for missing "; yourself" cascaded message send for cascaded messages that are used. This helps locate common coding mistakes such as "anArray := (Array new: 2) at: 1 put: 1; at: 2 put: 2". In this example, anArray would be assigned to 2 not the array object.'! ! RBParseTreeLintRule subclass: #RBModifiesCollectionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBModifiesCollectionRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'! initialize super initialize. self matcher 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: [ :node :answer | answer isNil ifTrue: [ (self modifiesTree: node receiver in: node arguments last) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBModifiesCollectionRule methodsFor: 'private' stamp: 'TestRunner 11/3/2009 16:33'! modifiesTree: aCollectionTree in: aParseTree | notifier args | notifier := RBParseTreeSearcher new. args := Array with: (RBPatternVariableNode 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! ! !RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Modifies collection while iterating over it'! ! !RBModifiesCollectionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for remove:''s of elements inside of collection iteration methods such as do:. These can cause the do: method to break since it will walk of the end of the collection. The common fix for this problem is to copy the collection before iterating over it.'! ! !RBParseTreeLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'! isVisible ^ self name ~= #RBParseTreeLintRule! ! !RBParseTreeLintRule methodsFor: 'running' stamp: 'lr 2/24/2009 08:21'! checkMethod: aContext (self matcher canMatchMethod: aContext compiledMethod) ifFalse: [ ^ self ]. (self matcher executeTree: aContext parseTree initialAnswer: nil) isNil ifFalse: [ result addClass: aContext selectedClass selector: aContext selector ]! ! !RBParseTreeLintRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. matcher := RBParseTreeSearcher new! ! !RBParseTreeLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 00:01'! matcher ^ matcher! ! !RBParseTreeLintRule methodsFor: 'running' stamp: 'lr 2/24/2009 08:21'! resetResult super resetResult. self result matcher: self matcher! ! !RBParseTreeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:41'! resultClass ^ ParseTreeEnvironment! ! RBParseTreeLintRule subclass: #RBPlatformDependentUserInteractionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBPlatformDependentUserInteractionRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'! initialize super initialize. self matcher matchesAnyOf: #( 'FillInTheBlank multiLineRequest: `@object1 centerAt: `@object2 initialAnswer: `@object3 answerHeight: `@object4' 'FillInTheBlank request: `@object1 initialAnswer: `@object2 centerAt: `@object3' 'FillInTheBlank request: `@object1 initialAnswer: `@object2' 'FillInTheBlank request: `@object1' 'FillInTheBlank requestPassword: `@object1' 'PopUpMenu confirm: `@object1 orCancel: `@object2' 'PopUpMenu confirm: `@object1 trueChoice: `@object2 falseChoice: `@object3' 'PopUpMenu confirm: `@object1' 'PopUpMenu inform: `@object1' 'PopUpMenu initialize' 'PopUpMenu labelArray: `@object1 lines: `@object2' 'PopUpMenu labelArray: `@object1' 'PopUpMenu labels: `@object1 lines: `@object2' 'PopUpMenu labels: `@object1' 'PopUpMenu withCaption: `@object1 chooseFrom: `@object2' 'SelectionMenu fromArray: `@object1' 'SelectionMenu labelList: `@object1 lines: `@object2 selections: `@object3' 'SelectionMenu labelList: `@object1 lines: `@object2' 'SelectionMenu labelList: `@object1 selections: `@object2' 'SelectionMenu labelList: `@object1' 'SelectionMenu labels: `@object1 lines: `@object2 selections: `@object3' 'SelectionMenu labels: `@object1 lines: `@object2' 'SelectionMenu labels: `@object1 selections: `@object2' 'SelectionMenu selections: `@object1 lines: `@object2' 'SelectionMenu selections: `@object1' ) do: [ :node :answer | node ]! ! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Platform dependent user interaction'! ! !RBPlatformDependentUserInteractionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'The method uses platform dependent user interactions.'! ! RBParseTreeLintRule subclass: #RBPrecedenceRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBPrecedenceRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:33'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [node hasParentheses not and: [#(#+ #-) includes: node selector]]} * `@C' do: [ :node :answer | node ]! ! !RBPrecedenceRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Inspect instances of "A + B * C" might be "A + (B * C)"'! ! RBParseTreeLintRule subclass: #RBReturnInEnsureRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBReturnInEnsureRule methodsFor: 'initialization' stamp: 'lr 11/19/2009 14:48'! initialize | returnMatcher | super initialize. returnMatcher := RBParseTreeSearcher new. returnMatcher matches: '^ `@object' do: [ :node :answer | true ]. self matcher matchesAnyOf: #( '``@rcv ensure: [| `@temps | ``@.Stmts]' '``@rcv ifCurtailed: [| `@temps | ``@.Stmts]') do: [ :node :answer | answer isNil ifTrue: [ (returnMatcher executeTree: node arguments first initialAnswer: false) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBReturnInEnsureRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Contains a return in an ensure: block'! ! RBParseTreeLintRule subclass: #RBReturnsIfTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBReturnsIfTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:34'! initialize super initialize. self matcher matchesAnyOf: #( '^`@condition ifTrue: [| `@temps | `@.statements]' '^`@condition ifFalse: [| `@temps | `@.statements]' ) do: [ :node :answer | node ]! ! !RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Returns value of ifTrue:/ifFalse: without ifFalse:/ifTrue: block'! ! !RBReturnsIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods that return the value of an ifTrue: or ifFalse: message. These statements return nil when the block is not executed.'! ! RBParseTreeLintRule subclass: #RBSearchingLiteralRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBSearchingLiteralRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:35'! initialize super initialize. self 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: [ :node :answer | answer isNil ifTrue: [ (self isSearchingLiteralExpression: node) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBSearchingLiteralRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:26'! 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! ! !RBSearchingLiteralRule methodsFor: 'private' stamp: 'lr 2/24/2009 00:26'! 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]! ! !RBSearchingLiteralRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses or''s instead of a searching literal'! ! RBParseTreeLintRule subclass: #RBSendsDeprecatedMethodToGlobalRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 3/17/2010 17:54'! group ^ 'Pharo bugs'! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:36'! initialize | nav patterns pattern wellKnownGlobals | super initialize. 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 matcher matchesAnyOf: patterns do: [ :node :answer | node ]! ! !RBSendsDeprecatedMethodToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends a deprecated message to a known global'! ! RBParseTreeLintRule subclass: #RBSendsUnknownMessageToGlobalRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Bugs'! ! !RBSendsUnknownMessageToGlobalRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:37'! initialize super initialize. self matcher matches: '`{:node :context | node isVariable and: [ Smalltalk includesKey: node name asSymbol ] } `@message: `@args' do: [ :node :answer | answer isNil ifTrue: [ | what | what := Smalltalk at: node receiver name asSymbol. (what notNil and: [ what ~~ Preferences and: [ (what respondsTo: node selector) not ] ]) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBSendsUnknownMessageToGlobalRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Sends unknown message to global'! ! RBParseTreeLintRule subclass: #RBSizeCheckRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBSizeCheckRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:46'! initialize | patterns | super initialize. patterns := OrderedCollection new. patterns addAll: (self selectors collect: [ :each | '`@object size > 0 ifTrue: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). patterns addAll: (self selectors collect: [ :each | '`@object isEmpty ifFalse: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). patterns addAll: (self selectors collect: [ :each | '`@object notEmpty ifTrue: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). patterns addAll: (self selectors collect: [ :each | '`@object size = 0 ifFalse: [`@object' , (self genericPatternForSelector: each) , '. `@.Statements2]' ]). self matcher matchesAnyOf: patterns do: [ :node :answer | node ]! ! !RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unnecessary size check'! ! !RBSizeCheckRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for code that checks that a collection is non-empty before sending it an iteration message (e.g., do:, collect:, etc.). Since the collection iteration messages work for empty collections, we do not need to clutter up our method with the extra size check.'! ! !RBSizeCheckRule methodsFor: 'private' stamp: 'lr 2/24/2009 20:47'! selectors ^ #( collect: do: reject: select: )! ! RBParseTreeLintRule subclass: #RBStringConcatenationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBStringConcatenationRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize | concatenationMatcher | super initialize. concatenationMatcher := RBParseTreeSearcher new. concatenationMatcher matches: '`@receiver , `@argument' do: [ :node :answer | true ]. self 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: [ :node :answer | answer isNil ifTrue: [ (node arguments detect: [ :each | each isBlock and: [ concatenationMatcher executeTree: each initialAnswer: false ] ] ifNone: [ nil ]) notNil ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'String concatenation instead of streams'! ! !RBStringConcatenationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for people using string concatenation inside some iteration message. Since string concatenation is O(n^2), it is better to use streaming since it is O(n) - assuming that n is large enough.'! ! RBParseTreeLintRule subclass: #RBThreeElementPointRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBThreeElementPointRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:50'! initialize super initialize. self matcher matches: '``@x @ ``@y' do: [ :node :answer | answer isNil ifTrue: [ | current | current := node 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: [ node ] ] ifFalse: [ answer ] ]! ! !RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Possible three element point (e.g., x @ y + q @ r)'! ! !RBThreeElementPointRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks arithmetic statements for possible three element points (i.e., a point that has another point in its x or y part).'! ! RBParseTreeLintRule subclass: #RBToDoCollectRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBToDoCollectRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:50'! initialize super initialize. self matcher matchesAnyOf: #( '| `@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' ) do: [ :node :answer | node ]! ! !RBToDoCollectRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'to:do: doesn''t use collect:'! ! RBParseTreeLintRule subclass: #RBToDoRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBToDoRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 23:38'! initialize super initialize. self matcher matches: '1 to: ``@object size do: [:`each | | `@temps | `@.Statements]' do: [ :node :answer | answer isNil ifTrue: [ | varName variableMatcher | varName := node arguments last arguments first. "`each" variableMatcher := RBParseTreeSearcher new. variableMatcher matchesTree: varName do: [ :nod :ans | ans and: [ nod parent isMessage and: [ nod parent selector = #at: ] ] ]. (variableMatcher executeTree: node arguments last body initialAnswer: true) ifTrue: [ node ] ifFalse: [ nil ] ] ifFalse: [ answer ] ]! ! !RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses to:do: instead of do:, with:do: or timesRepeat:'! ! !RBToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using to:do: when a do:, with:do: or timesRepeat: should be used.'! ! RBParseTreeLintRule subclass: #RBToDoWithIncrementRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBToDoWithIncrementRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:52'! initialize super initialize. self matcher matchesAnyOf: #( '`@i to: `@j do: [:`e | | `@temps | `@.Stmts. `x := `x + 1. `@.Stmts2]' '`@i to: `@j by: `@k do: [:`e | | `@temps | `@.Stmts. `x := `x + `@k. `@.Stmts2]' ) do: [ :node :answer | node ]! ! !RBToDoWithIncrementRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'to:do: loop also increments a counter'! ! RBParseTreeLintRule subclass: #RBUnconditionalRecursionRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBUnconditionalRecursionRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:52'! initialize super initialize. self matcher matchesAnyMethodOf: #( '`@message: `@args | `@temps | self `@message: `@args. `@.statements' '`@message: `@args1 | `@temps | `{ :node :context | node containsReturn not }. self `@message: `@args2. `@.statements' ) do: [ :node :answer | node ]! ! !RBUnconditionalRecursionRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Unconditional recursion'! ! RBParseTreeLintRule subclass: #RBUnnecessaryAssignmentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! group ^ 'Unnecessary code'! ! !RBUnnecessaryAssignmentRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matches: '^`{:aNode | aNode isAssignment and: [(aNode whoDefines: aNode variable name) notNil]}' do: [ :node :answer | node ]! ! !RBUnnecessaryAssignmentRule methodsFor: 'accessing' stamp: 'lr 3/13/2009 13:55'! name ^ 'Unnecessary assignment to a temporary variable'! ! RBParseTreeLintRule subclass: #RBUnoptimizedAndOrRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUnoptimizedAndOrRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matchesAnyOf: #( '(`@a and: `@b) and: `@c' '(`@a or: `@b) or: `@c' ) do: [ :node :answer | node ]! ! !RBUnoptimizedAndOrRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses "(a and: [b]) and: [c]" instead of "a and: [b and: [c]]"'! ! RBParseTreeLintRule subclass: #RBUnoptimizedToDoRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBUnoptimizedToDoRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matches: '(`@a to: `@b) do: `@c' do: [ :node :answer | node ]! ! !RBUnoptimizedToDoRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses (to:)do: instead of to:do:'! ! RBParseTreeLintRule subclass: #RBUsesAddRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Possible bugs'! ! !RBUsesAddRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matches: '`{:node | node isMessage and: [(node selector == #add: or: [node selector == #addAll:]) and: [node isDirectlyUsed]]}' do: [ :node :answer | node ]! ! !RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses the result of an add: message'! ! !RBUsesAddRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for possible uses of the result returned by an add: or addAll: messages. These messages return their arguments not the receiver. As a result, may uses of the results are wrong.'! ! RBParseTreeLintRule subclass: #RBWhileTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Intention revealing'! ! !RBWhileTrueRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:53'! initialize super initialize. self matcher matchesAnyOf: #( '| `@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' ) do: [ :node :answer | node ]! ! !RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Uses whileTrue: instead of to:do:'! ! !RBWhileTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Checks for people using whileTrue: when the shorter to:do: would work.'! ! RBParseTreeLintRule subclass: #RBYourselfNotUsedRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-ParseTreeRules'! !RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Miscellaneous'! ! !RBYourselfNotUsedRule methodsFor: 'initialization' stamp: 'lr 2/24/2009 20:54'! initialize super initialize. self matcher matches: '`{:node | node parent isUsed not} yourself' do: [ :node :answer | node ]! ! !RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Doesn''t use the result of a yourself message'! ! !RBYourselfNotUsedRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! rationale ^ 'Check for methods sending the yourself message when it is not necessary.'! ! RBLintRule subclass: #RBCompositeLintRule instanceVariableNames: 'rules name' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint'! !RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:50'! allRules ^ self rules: (Array with: self lintChecks with: self transformations) name: 'All checks'! ! !RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:48'! lintChecks ^ self rules: (self rulesGroupedFor: RBBasicLintRule) name: 'Lint checks'! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 21:55'! rules: aCollection ^ self new rules: aCollection; yourself! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 21:56'! rules: aCollection name: aString ^ self new rules: aCollection; name: aString; yourself! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/24/2009 17:11'! rulesFor: aRuleClass | rules | rules := SortedCollection sortBlock: [ :a :b | a name <= b name ]. aRuleClass withAllSubclassesDo: [ :each | each isVisible ifTrue: [ rules add: each new ] ]. ^ rules asArray! ! !RBCompositeLintRule class methodsFor: 'instance creation' stamp: 'lr 2/23/2009 22:44'! rulesGroupedFor: aRuleClass | groups rules | groups := Dictionary new. (self rulesFor: aRuleClass) do: [ :each | (groups at: each group ifAbsentPut: [ OrderedCollection new ]) addLast: each ]. rules := SortedCollection sortBlock: [ :a :b | a name <= b name ]. groups keysAndValuesDo: [ :group :elements | rules addLast: (RBCompositeLintRule rules: elements asArray name: group) ]. ^ rules asArray! ! !RBCompositeLintRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:48'! transformations ^ self rules: (self rulesGroupedFor: RBTransformationRule) name: 'Transformations'! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:09'! changes ^ rules gather: [ :each | each changes ]! ! !RBCompositeLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:10'! checkClass: aContext rules do: [ :each | each checkClass: aContext ]! ! !RBCompositeLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:10'! checkMethod: aContext rules do: [ :each | each checkMethod: aContext ]! ! !RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:11'! hasConflicts ^ rules anySatisfy: [ :each | each hasConflicts ]! ! !RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:11'! isComposite ^ true! ! !RBCompositeLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:12'! isEmpty ^ rules allSatisfy: [ :each | each isEmpty ]! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'! name ^ name! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:33'! name: aString name := aString! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:11'! problemCount ^ rules inject: 0 into: [ :count :each | count + each problemCount ]! ! !RBCompositeLintRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 21:11'! resetResult rules do: [ :each | each resetResult ]! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:11'! rules ^ rules! ! !RBCompositeLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'! rules: aCollection rules := aCollection! ! !RBLintRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:08'! isVisible "Answer true if the class should be visible in the GUI." ^ false! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 08:29'! changes ^ #()! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:02'! checkClass: aContext! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:03'! checkMethod: aContext! ! !RBLintRule methodsFor: 'private' stamp: 'lr 2/24/2009 15:46'! genericPatternForSelector: aSymbol ^ String streamContents: [ :stream | aSymbol keywords keysAndValuesDo: [ :index :value | stream space; nextPutAll: value. aSymbol last = $: ifTrue: [ stream space; nextPutAll: '`@object'; print: index ] ] ]! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 22:47'! group ^ String new! ! !RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:52'! hasConflicts ^ false! ! !RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:52'! isComposite ^ false! ! !RBLintRule methodsFor: 'testing' stamp: 'lr 2/23/2009 21:51'! isEmpty self subclassResponsibility! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:32'! name self subclassResponsibility! ! !RBLintRule methodsFor: 'printing' stamp: 'lr 2/26/2009 16:06'! printOn: aStream super printOn: aStream. self name isNil ifFalse: [ aStream nextPutAll: ' name: '; print: self name ]! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:41'! problemCount self subclassResponsibility! ! !RBLintRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 21:28'! rationale ^ String new! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:35'! resetResult! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:29'! run ^ SmalllintChecker runRule: self! ! !RBLintRule methodsFor: 'running' stamp: 'lr 2/23/2009 21:29'! runOnEnvironment: anEnvironment ^ SmalllintChecker runRule: self onEnvironment: anEnvironment! ! RBLintRule subclass: #RBTransformationRule instanceVariableNames: 'rewriteRule builder class' classVariableNames: 'RecursiveSelfRule' poolDictionaries: '' category: 'Refactoring-Core-Lint'! RBTransformationRule subclass: #RBAllAnyNoneSatisfyRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:35'! group ^ 'Transformations'! ! !RBAllAnyNoneSatisfyRule methodsFor: 'initialization' stamp: 'lr 1/3/2010 12:04'! initialize super initialize. self rewriteRule " allSatisfy: " replaceMethod: '`@method: `@args | `@temps | `@.statements. `@collection do: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ifFalse: [ ^ false ] ]. ^ true' with: '`@method: `@args | `@temps | `@.statements. ^ `@collection allSatisfy: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ]'; " anySatisfy: " replaceMethod: '`@method: `@args | `@temps | `@.statements. `@collection do: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ifTrue: [ ^ true ] ]. ^ false' with: '`@method: `@args | `@temps | `@.statements. ^ `@collection anySatisfy: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ]'; " noneSatisfy: " replaceMethod: '`@method: `@args | `@temps | `@.statements. `@collection do: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ifTrue: [ ^ false ] ]. ^ true' with: '`@method: `@args | `@temps | `@.statements. ^ `@collection noneSatisfy: [ :`each | | `@blocktemps | `@.blockstatements. `@condition ]'! ! !RBAllAnyNoneSatisfyRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:53'! name ^ 'Replace with #allSatsify:, #anySatisfy: or #noneSatsify:'! ! RBTransformationRule subclass: #RBAssignmentInIfTrueRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBAssignmentInIfTrueRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:24'! initialize super initialize. self rewriteRule replace: '``@Boolean ifTrue: [`variable := ``@true] ifFalse: [`variable := ``@false]' with: '`variable := ``@Boolean ifTrue: [``@true] ifFalse: [``@false]'; replace: '``@Boolean ifFalse: [`variable := ``@true] ifTrue: [`variable := ``@false]' with: '`variable := ``@Boolean ifFalse: [``@true] ifTrue: [``@false]'! ! !RBAssignmentInIfTrueRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Move variable assignment outside of single statement ifTrue:ifFalse: blocks'! ! RBTransformationRule subclass: #RBAtIfAbsentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBAtIfAbsentRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:26'! initialize super initialize. self rewriteRule replace: '``@dictionary at: ``@key ifAbsent: [| `@temps | ``@.Statements1. ``@dictionary at: ``@key put: ``@object. ``@.Statements2. ``@object]' with: '``@dictionary at: ``@key ifAbsentPut: [| `@temps | ``@.Statements1. ``@.Statements2. ``@object]'; replace: '``@dictionary at: ``@key ifAbsent: [| `@temps | ``@.Statements. ``@dictionary at: ``@key put: ``@object]' with: '``@dictionary at: ``@key ifAbsentPut: [| `@temps | ``@.Statements. ``@object]'! ! !RBAtIfAbsentRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'at:ifAbsent: -> at:ifAbsentPut:'! ! RBTransformationRule subclass: #RBBetweenAndRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBBetweenAndRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBBetweenAndRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:29'! initialize super initialize. self rewriteRule replace: '``@a >= ``@b and: [``@a <= ``@c]' with: '``@a between: ``@b and: ``@c'; replace: '``@a >= ``@b & (``@a <= ``@c)' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a and: [``@a <= ``@c]' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a & (``@a <= ``@c)' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c and: [``@a >= ``@b]' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c & (``@a >= ``@b)' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a and: [``@a >= ``@b]' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a & (``@a >= ``@b)' with: '``@a between: ``@b and: ``@c'; replace: '``@a >= ``@b and: [``@c >= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@a >= ``@b & (``@c >= ``@a)' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a and: [``@c >= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@b <= ``@a & (``@c >= ``@a)' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c and: [``@b <= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@a <= ``@c & (``@b <= ``@a)' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a and: [``@b <= ``@a]' with: '``@a between: ``@b and: ``@c'; replace: '``@c >= ``@a & (``@b <= ``@a)' with: '``@a between: ``@b and: ``@c'! ! !RBBetweenAndRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ '"a >= b and: [a <= c]" -> "a between: b and: c"'! ! RBTransformationRule subclass: #RBCascadedNextPutAllsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBCascadedNextPutAllsRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:29'! initialize super initialize. self rewriteRule replace: '``@rcvr nextPutAll: ``@object1 , ``@object2' with: '``@rcvr nextPutAll: ``@object1; nextPutAll: ``@object2'; replace: '``@rcvr show: ``@object1 , ``@object2' with: '``@rcvr show: ``@object1; show: ``@object2'! ! !RBCascadedNextPutAllsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Use cascaded nextPutAll:''s instead of #, in #nextPutAll:'! ! RBTransformationRule subclass: #RBDetectIfNoneRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBDetectIfNoneRule methodsFor: 'initialization' stamp: 'lr 1/3/2010 11:56'! initialize super initialize. self rewriteRule replace: '``@collection contains: [:`each | | `@temps | ``@.Statements]' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) isNil' with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) = nil' with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) == nil' with: '(``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]) not'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) notNil' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~= nil' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'; replace: '(``@collection detect: [:`each | | `@temps | ``@.Statements] ifNone: [nil]) ~~ nil' with: '``@collection anySatisfy: [:`each | | `@temps | ``@.Statements]'! ! !RBDetectIfNoneRule methodsFor: 'accessing' stamp: 'lr 1/3/2010 11:55'! name ^ '#detect:ifNone: -> anySatisfy:'! ! RBTransformationRule subclass: #RBEqualNilRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBEqualNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBEqualNilRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:31'! initialize super initialize. self rewriteRule replace: '``@object = nil' with: '``@object isNil'; replace: '``@object == nil' with: '``@object isNil'; replace: '``@object ~= nil' with: '``@object notNil'; replace: '``@object ~~ nil' with: '``@object notNil'! ! !RBEqualNilRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ '= nil -> isNil AND ~= nil -> notNil'! ! RBTransformationRule subclass: #RBGuardClauseRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBGuardClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBGuardClauseRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:33'! initialize super initialize. self rewriteRule replaceMethod: '`@methodName: `@args | `@temps | `@.Statements. `@condition ifTrue: [| `@trueTemps | `.Statement1. `.Statement2. `@.Statements1]' with: '`@methodName: `@args | `@temps `@trueTemps | `@.Statements. `@condition ifFalse: [^self]. `.Statement1. `.Statement2. `@.Statements1'; replaceMethod: '`@methodName: `@args | `@temps | `@.Statements. `@condition ifFalse: [| `@falseTemps | `.Statement1. `.Statement2. `@.Statements1]' with: '`@methodName: `@args | `@temps `@falseTemps | `@.Statements. `@condition ifTrue: [^self]. `.Statement1. `.Statement2. `@.Statements1'! ! !RBGuardClauseRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Eliminate guarding clauses'! ! RBTransformationRule subclass: #RBMinMaxRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBMinMaxRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:35'! initialize super initialize. self rewriteRule replace: '``@a < ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a min: ``@b'; replace: '``@a <= ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a min: ``@b'; replace: '``@a > ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a max: ``@b'; replace: '``@a >= ``@b ifTrue: [``@a] ifFalse: [``@b]' with: '``@a max: ``@b'; replace: '``@a < ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a max: ``@b'; replace: '``@a <= ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a max: ``@b'; replace: '``@a > ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a min: ``@b'; replace: '``@a >= ``@b ifTrue: [``@b] ifFalse: [``@a]' with: '``@a min: ``@b'; replace: '`a < ``@b ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '`a <= ``@b ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '`a < ``@b ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a <= ``@b ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a > ``@b ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a >= ``@b ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '`a > ``@b ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '`a >= ``@b ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b < `a ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '``@b <= `a ifTrue: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '``@b < `a ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b <= `a ifFalse: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b > `a ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b >= `a ifTrue: [`a := ``@b]' with: '`a := `a max: ``@b'; replace: '``@b > `a ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'; replace: '``@b >= `a ifFalse: [`a := ``@b]' with: '`a := `a min: ``@b'! ! !RBMinMaxRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Rewrite ifTrue:ifFalse: using min:/max:'! ! RBTransformationRule subclass: #RBNotEliminationRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBNotEliminationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBNotEliminationRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:38'! initialize super initialize. self rewriteRule replace: '``@object not not' with: '``@object'; replace: '``@object not ifTrue: ``@block' with: '``@object ifFalse: ``@block'; replace: '``@object not ifFalse: ``@block' with: '``@object ifTrue: ``@block'; replace: '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object not]' with: '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object]'; replace: '``@collection reject: [:`each | | `@temps | ``@.Statements. ``@object not]' with: '``@collection select: [:`each | | `@temps | ``@.Statements. ``@object]'; replace: '[| `@temps | ``@.Statements. ``@object not] whileTrue: ``@block' with: '[| `@temps | ``@.Statements. ``@object] whileFalse: ``@block'; replace: '[| `@temps | ``@.Statements. ``@object not] whileFalse: ``@block' with: '[| `@temps | ``@.Statements. ``@object] whileTrue: ``@block'; replace: '[| `@temps | ``@.Statements. ``@object not] whileTrue' with: '[| `@temps | ``@.Statements. ``@object] whileFalse'; replace: '[| `@temps | ``@.Statements. ``@object not] whileFalse' with: '[| `@temps | ``@.Statements. ``@object] whileTrue'; replace: '(``@a <= ``@b) not' with: '``@a > ``@b'; replace: '(``@a < ``@b) not' with: '``@a >= ``@b'; replace: '(``@a = ``@b) not' with: '``@a ~= ``@b'; replace: '(``@a == ``@b) not' with: '``@a ~~ ``@b'; replace: '(``@a ~= ``@b) not' with: '``@a = ``@b'; replace: '(``@a ~~ ``@b) not' with: '``@a == ``@b'; replace: '(``@a >= ``@b) not' with: '``@a < ``@b'; replace: '(``@a > ``@b) not' with: '``@a <= ``@b'! ! !RBNotEliminationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Eliminate unnecessary not''s'! ! RBTransformationRule subclass: #RBShowWhileBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBShowWhileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBShowWhileBlocksRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:38'! initialize super initialize. self rewriteRule replace: '``@cursor showWhile: [| `@temps | ``@.Statements. `var := ``@object]' with: '`var := ``@cursor showWhile: [| `@temps | ``@.Statements. ``@object]'; replace: '``@cursor showWhile: [| `@temps | ``@.Statements. ^``@object]' with: '^``@cursor showWhile: [| `@temps | ``@.Statements. ``@object]'! ! !RBShowWhileBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Move assignment out of showWhile: blocks'! ! RBTransformationRule subclass: #RBSuperSendsRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBSuperSendsRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:44'! initialize super initialize. self rewriteRule replace: 'super `@message: ``@args' with: 'self `@message: ``@args' when: [ :node | (class withAllSubclasses detect: [:each | each includesSelector: node selector] ifNone: [ nil ]) isNil ]! ! !RBSuperSendsRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'Rewrite super messages to self messages when both refer to same method'! ! !RBTransformationRule class methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:48'! initialize self initializeRecursiveSelfRule! ! !RBTransformationRule class methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initializeRecursiveSelfRule RecursiveSelfRule := RBParseTreeSearcher new. RecursiveSelfRule matchesAnyMethodOf: #( '`@methodName: `@args | `@temps | self `@methodName: `@args1' '`@methodName: `@args | `@temps | ^ self `@methodName: `@args1') do: [ :node :answer | true ]. ^ RecursiveSelfRule! ! !RBTransformationRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:09'! isVisible ^ self name ~= #RBTransformationRule! ! !RBTransformationRule class methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:49'! recursiveSelfRule ^ RecursiveSelfRule! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:46'! changes ^ builder changes! ! !RBTransformationRule methodsFor: 'running' stamp: 'lr 11/1/2009 22:59'! checkMethod: aContext (self rewriteRule canMatchMethod: aContext compiledMethod) ifFalse: [ ^ self ]. class := aContext selectedClass. (self rewriteRule executeTree: aContext parseTree) ifTrue: [ (self class recursiveSelfRule executeTree: rewriteRule tree initialAnswer: false) ifFalse: [ builder compile: rewriteRule tree newSource in: class classified: aContext protocol ] ]! ! !RBTransformationRule methodsFor: 'testing' stamp: 'lr 2/23/2009 23:47'! hasConflicts ^ true! ! !RBTransformationRule methodsFor: 'initialization' stamp: 'lr 11/2/2009 00:14'! initialize super initialize. rewriteRule := RBParseTreeRewriter new! ! !RBTransformationRule methodsFor: 'testing' stamp: 'lr 2/23/2009 23:47'! isEmpty ^ builder changes isEmpty! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:46'! problemCount ^ builder problemCount! ! !RBTransformationRule methodsFor: 'running' stamp: 'lr 2/23/2009 23:46'! resetResult builder := CompositeRefactoryChange named: self name! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/26/2009 16:24'! result | environment | environment := ParseTreeEnvironment new. environment matcher: self rewriteRule. environment label: self name. self changes do: [ :change | (change isKindOf: AddMethodChange) ifTrue: [ environment addClass: change changeClass selector: change selector ] ]. ^ environment! ! !RBTransformationRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:23'! rewriteRule ^ rewriteRule! ! RBTransformationRule subclass: #RBTranslateLiteralsInMenusRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBTranslateLiteralsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBTranslateLiteralsInMenusRule methodsFor: 'initialization' stamp: 'lr 2/23/2009 23:41'! initialize super initialize. self rewriteRule replace: '`@menu add: `#label action: `#sym' with: '`@menu add: `#label translated action: `#sym'; replace: '`@menu add: `#label selector: `#sym arguments: `@stuff' with: '`@menu add: `#label translated selector: `#sym arguments: `@stuff'; replace: '`@menu add: `#label subMenu: `@stuff' with: '`@menu add: `#label translated subMenu: `@stuff'; replace: '`@menu add: `#label subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args' with: '`@menu add: `#label translated subMenu: `@stuff target: `@targ selector: `#sel argumentList: `@args'; replace: '`@menu add: `#label target: `@targ action: `#sel' with: '`@menu add: `#label translated target: `@targ action: `#sel'; replace: '`@menu add: `#label target: `@targ selector `#sel' with: '`@menu add: `#label translated target: `@targ selector `#sel'; replace: '`@menu add: `#label target: `@targ selector `#sel argument: `@arg' with: '`@menu add: `#label translated target: `@targ selector `#sel argument: `@arg'; replace: '`@menu add: `#label target: `@targ selector `#sel arguments: `@arg' with: '`@menu add: `#label translated target: `@targ selector `#sel arguments: `@arg'; replace: '`@menu addTitle: `#label' with: '`@menu addTitle: `#label translated'; replace: '`@menu addTitle: `#label updatingSelector: `#sel updateTarget: `@targ' with: '`@menu addTitle: `#label translated updatingSelector: `#sel updateTarget: `@targ'; replace: '`@menu addWithLabel: `#label enablement: `#esel action: `#sel' with: '`@menu addWithLabel: `#label translated enablement: `#esel action: `#sel'; replace: '`@menu addWithLabel: `#label enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args' with: '`@menu addWithLabel: `#label translated enablementSelector: `#esel target: `@targ selector: `#sel argumentList: `@args'; replace: '`@menu balloonTextForLastItem: `#label' with: '`@menu balloonTextForLastItem: `#label translated'; replace: '`@menu labels: `#lit lines: `@lines selections: `@sels' with: '`@menu labels: (`#lit collect: [ :l | l translated ]) lines: `@lines selections: `@sels'; replace: '`@menu title: `#title' with: '`@menu title: `#title translated'! ! !RBTranslateLiteralsInMenusRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! name ^ 'add translations to strings in menus'! ! RBTransformationRule subclass: #RBUnderscoreAssignmentRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:02'! group ^ 'Transformations'! ! !RBUnderscoreAssignmentRule methodsFor: 'initialization' stamp: 'lr 11/7/2009 18:31'! initialize super initialize. self rewriteRule replace: '`var := ``@object' with: '`var := ``@object' when: [ :node | node assignmentOperator = '_' ]! ! !RBUnderscoreAssignmentRule methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:05'! name ^ 'Underscore assignements should be avoided'! ! RBTransformationRule subclass: #RBUnwindBlocksRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Lint-TransformationRules'! !RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'lr 2/23/2009 23:17'! group ^ 'Transformations'! ! !RBUnwindBlocksRule methodsFor: 'initialization' stamp: 'lr 11/4/2009 09:26'! initialize super initialize. self rewriteRule replace: '[| `@temps | ``@.Statements. `var := ``@object] ensure: ``@block' with: '`var := [| `@temps | ``@.Statements. ``@object] ensure: ``@block'; replace: '[| `@temps | ``@.Statements. ^``@object] ensure: ``@block' with: '^[| `@temps | ``@.Statements. ``@object] ensure: ``@block'; replace:'[| `@temps | ``@.Statements. `var := ``@object] ifCurtailed: ``@block' with: '`var := [| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block'; replace:'[| `@temps | ``@.Statements. ^``@object] ifCurtailed: ``@block' with: '^[| `@temps | ``@.Statements. ``@object] ifCurtailed: ``@block'! ! !RBUnwindBlocksRule methodsFor: 'accessing' stamp: 'lr 11/19/2009 14:41'! name ^ 'Move assignment out of unwind blocks'! ! Object subclass: #RBMethod instanceVariableNames: 'class compiledMethod source selector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Model'! !RBMethod class methodsFor: 'instance creation' stamp: ''! for: aRBClass fromMethod: aCompiledMethod andSelector: aSymbol ^(self new) modelClass: aRBClass; method: aCompiledMethod; selector: aSymbol; yourself! ! !RBMethod class methodsFor: 'instance creation' stamp: ''! for: aRBClass source: aString selector: aSelector ^(self new) modelClass: aRBClass; selector: aSelector; source: aString; yourself! ! !RBMethod methodsFor: 'compiling' stamp: 'lr 11/1/2009 23:53'! compileTree: aBRMethodNode | method sourceCode change | sourceCode := aBRMethodNode newSource. change := self modelClass model compile: sourceCode in: self modelClass classified: self protocols. method := self class for: self modelClass source: sourceCode selector: aBRMethodNode selector. self modelClass addMethod: method. ^ change! ! !RBMethod methodsFor: 'private' stamp: 'lr 1/3/2010 11:47'! literal: anObject containsReferenceTo: aSymbol anObject = aSymbol ifTrue: [ ^ true ]. anObject class = Array ifFalse: [ ^ false ]. ^ anObject anySatisfy: [ :each | self literal: each containsReferenceTo: aSymbol ]! ! !RBMethod methodsFor: 'accessing' stamp: ''! method ^compiledMethod! ! !RBMethod methodsFor: 'accessing' stamp: ''! method: aCompiledMethod compiledMethod := aCompiledMethod! ! !RBMethod methodsFor: 'accessing' stamp: ''! modelClass ^class! ! !RBMethod methodsFor: 'accessing' stamp: ''! modelClass: aRBClass class := aRBClass! ! !RBMethod methodsFor: 'accessing' stamp: ''! parseTree ^RBParser parseMethod: self source onError: [:str :pos | ^nil]! ! !RBMethod methodsFor: 'printing' stamp: ''! printOn: aStream class printOn: aStream. aStream nextPutAll: '>>'; nextPutAll: self selector! ! !RBMethod methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:15'! protocols ^ self modelClass protocolsFor: self selector! ! !RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! refersToClassNamed: aSymbol | searcher | searcher := RBParseTreeSearcher new. searcher matches: aSymbol asString do: [:node :answer | true]. ^(searcher executeTree: self parseTree initialAnswer: false) or: [self refersToSymbol: aSymbol]! ! !RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! refersToSymbol: aSymbol | searcher | searcher := RBParseTreeSearcher new. searcher matches: aSymbol printString do: [:node :answer | true]; matches: '`#literal' do: [:node :answer | answer or: [self literal: node value containsReferenceTo: aSymbol]]. (RBScanner isSelector: aSymbol) ifTrue: [searcher matches: '`@object ' , (RBParseTreeSearcher buildSelectorString: aSymbol) do: [:node :answer | true]]. ^searcher executeTree: self parseTree initialAnswer: false! ! !RBMethod methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! refersToVariable: aString | searcher tree | tree := self parseTree. ((tree defines: aString) or: [tree body defines: aString]) ifTrue: [^false]. searcher := RBParseTreeSearcher new. searcher matches: aString do: [:node :answer | true]; matches: '[:`@vars | | `@temps | `@.Stmts]' do: [:node :answer | answer or: [((node defines: aString) or: [node body defines: aString]) not and: [searcher executeTree: node body initialAnswer: false]]]. ^searcher executeTree: self parseTree initialAnswer: false! ! !RBMethod methodsFor: 'accessing' stamp: ''! selector ^selector! ! !RBMethod methodsFor: 'accessing' stamp: ''! selector: aSymbol selector := aSymbol! ! !RBMethod methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:15'! source ^ source ifNil: [ source := (class realClass sourceCodeAt: selector) asString ]! ! !RBMethod methodsFor: 'accessing' stamp: ''! source: aString source := aString! ! Object subclass: #RBMethodName instanceVariableNames: 'selector arguments' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RBMethodName class methodsFor: 'instance creation' stamp: ''! selector: aSymbol arguments: stringCollection ^(self new) selector: aSymbol; arguments: stringCollection; yourself! ! !RBMethodName methodsFor: 'accessing' stamp: ''! arguments ^arguments! ! !RBMethodName methodsFor: 'accessing' stamp: ''! arguments: nameCollection arguments := nameCollection. self changed: #arguments! ! !RBMethodName methodsFor: 'testing' stamp: ''! 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: 'lr 10/26/2009 22:09'! addChangeToClass: aRBClass ^ changedClasses at: aRBClass name put: (Array with: aRBClass theNonMetaClass with: aRBClass theMetaClass)! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! addClassVariable: aString to: aRBClass ^changes addClassVariable: aString to: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! addInstanceVariable: aString to: aRBClass ^changes addInstanceVariable: aString to: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! addPool: aString to: aRBClass ^changes addPool: aString to: aRBClass! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 3/17/2010 19:11'! allClassesDo: aBlock | seen evalBlock | seen := Set new. evalBlock := [ :each | seen add: each first name. aBlock value: each first; value: each last ]. newClasses do: evalBlock. changedClasses do: evalBlock. environment classesDo: [ :each | each isObsolete ifFalse: [ | class | class := each theNonMetaClass. ((seen includes: class name) or: [ self hasRemoved: (self classNameFor: class) ]) ifFalse: [ (class := self classFor: each) isNil ifFalse: [ seen add: class name. aBlock value: class; value: class theMetaClass ] ] ] ]! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:40'! allImplementorsOf: aSelector ^ implementorsCache at: aSelector ifAbsentPut: [ self privateImplementorsOf: aSelector ]! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 18:53'! allImplementorsOf: aSelector do: aBlock (self allImplementorsOf: aSelector) do: aBlock! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:44'! allReferencesTo: aSymbol ^ sendersCache at: aSymbol ifAbsentPut: [ self privateReferencesTo: aSymbol ]! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:44'! allReferencesTo: aSymbol do: aBlock (self allReferencesTo: aSymbol) do: aBlock! ! !RBNamespace methodsFor: 'accessing' stamp: ''! allReferencesToClass: aRBClass do: aBlock self allClassesDo: [:each | (each whichSelectorsReferToClass: aRBClass) do: [:sel | aBlock value: (each methodFor: sel)]]! ! !RBNamespace methodsFor: 'private-changes' stamp: 'lr 10/26/2009 22:09'! changeClass: aRBClass changedClasses at: aRBClass name put: (Array with: aRBClass theNonMetaClass with: aRBClass theMetaClass). self flushCaches! ! !RBNamespace methodsFor: 'accessing' stamp: ''! changes ^changes! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/31/2009 17:35'! classFor: aBehavior aBehavior isNil ifTrue: [ ^ nil ]. ^ aBehavior isMeta ifTrue: [ self metaclassNamed: aBehavior theNonMetaClass name ] ifFalse: [ self classNamed: aBehavior theNonMetaClass name ]! ! !RBNamespace methodsFor: 'private' stamp: 'lr 10/31/2009 17:37'! classNameFor: aBehavior ^ aBehavior theNonMetaClass name! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/26/2009 22:09'! classNamed: aSymbol | class classes index | aSymbol isNil ifTrue: [ ^ nil ]. (self hasRemoved: aSymbol) ifTrue: [ ^ nil ]. (newClasses includesKey: aSymbol) ifTrue: [ ^ (newClasses at: aSymbol) first ]. (changedClasses includesKey: aSymbol) ifTrue: [ ^ (changedClasses at: aSymbol) first ]. class := environment at: aSymbol ifAbsent: [ nil ]. (class isBehavior or: [ class isTrait ]) ifTrue: [ classes := self createNewClassFor: class. ^ class isMeta ifTrue: [ classes last ] ifFalse: [ classes first ] ]. index := aSymbol indexOfSubCollection: ' class' startingAt: 1 ifAbsent: [ ^ nil ]. class := self classNamed: (aSymbol copyFrom: 1 to: index - 1) asSymbol. ^ class isNil ifTrue: [ nil ] ifFalse: [ class theMetaClass ]! ! !RBNamespace methodsFor: 'changes' stamp: 'lr 7/1/2008 11:06'! comment: aString in: aClass ^ changes comment: aString in: aClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! compile: aString in: aRBClass classified: aSymbol | change | change := changes compile: aString in: aRBClass classified: aSymbol. self flushCaches. ^change! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'lr 10/31/2009 17:36'! createNewClassFor: aBehavior | nonMeta meta className | className := aBehavior theNonMetaClass name. nonMeta := (RBClass existingNamed: className) model: self; yourself. meta := (RBMetaclass existingNamed: className) model: self; yourself. ^changedClasses at: className put: (Array with: nonMeta with: meta)! ! !RBNamespace methodsFor: 'changes' stamp: 'lr 10/26/2009 22:09'! defineClass: aString | change newClass newClassName | change := changes defineClass: aString. newClassName := change changeClassName. newClass := self classNamed: newClassName. newClass isNil ifTrue: [ | newMetaclass | removedClasses remove: newClassName ifAbsent: [ ]; remove: newClassName , ' class' ifAbsent: [ ]. newClass := RBClass named: newClassName. newMetaclass := RBMetaclass named: newClassName. newClass model: self. newMetaclass model: self. newClasses at: newClassName put: (Array with: newClass with: newMetaclass) ]. newClass superclass: (self classNamed: change superclassName). newClass superclass isNil ifTrue: [ self rootClasses add: newClass. newClass theMetaClass superclass: (self classFor: Object class superclass) ] ifFalse: [ newClass theMetaClass superclass: newClass superclass theMetaClass ]. newClass instanceVariableNames: change instanceVariableNames. newClass classVariableNames: change classVariableNames. newClass poolDictionaryNames: change poolDictionaryNames. newClass category: change category. ^ change! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 1/20/2010 18:08'! description ^ self changes name! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 1/20/2010 18:08'! description: aString self changes name: aString! ! !RBNamespace methodsFor: 'accessing' stamp: ''! environment ^environment! ! !RBNamespace methodsFor: 'accessing' stamp: ''! environment: aBrowserEnvironment environment := aBrowserEnvironment! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! flushCaches implementorsCache := IdentityDictionary new. sendersCache := IdentityDictionary new! ! !RBNamespace methodsFor: 'private' stamp: ''! hasCreatedClassFor: aBehavior | className | className := self classNameFor: aBehavior. ^(newClasses includesKey: className) or: [changedClasses includesKey: className]! ! !RBNamespace methodsFor: 'testing' stamp: ''! hasRemoved: aSymbol ^removedClasses includes: aSymbol! ! !RBNamespace methodsFor: 'testing' stamp: ''! includesClassNamed: aSymbol ^(self classNamed: aSymbol) notNil! ! !RBNamespace methodsFor: 'testing' stamp: ''! includesGlobal: aSymbol (self hasRemoved: aSymbol) ifTrue: [^false]. (self includesClassNamed: aSymbol) ifTrue: [^true]. environment at: aSymbol ifAbsent: [^false]. ^true! ! !RBNamespace methodsFor: 'initialize-release' stamp: ''! initialize changes := CompositeRefactoryChange new. environment := BrowserEnvironment new. newClasses := IdentityDictionary new. changedClasses := IdentityDictionary new. removedClasses := Set new. implementorsCache := IdentityDictionary new. sendersCache := IdentityDictionary new! ! !RBNamespace methodsFor: 'accessing-classes' stamp: 'dc 5/8/2007 13:44'! metaclassNamed: aSymbol | class | aSymbol isNil ifTrue: [^nil]. (self hasRemoved: aSymbol) ifTrue: [^nil]. (newClasses includesKey: aSymbol) ifTrue: [^(newClasses at: aSymbol) last]. (changedClasses includesKey: aSymbol) ifTrue: [^(changedClasses at: aSymbol) last]. class := environment at: aSymbol ifAbsent: [nil]. (class isBehavior or: [class isTrait]) ifTrue: [^ (self createNewClassFor: class) last]. ^ nil! ! !RBNamespace methodsFor: 'accessing' stamp: ''! name ^changes name! ! !RBNamespace methodsFor: 'accessing' stamp: ''! name: aString ^changes name: aString! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! performChange: aCompositeRefactoryChange around: aBlock | oldChanges | changes addChange: aCompositeRefactoryChange. oldChanges := changes. changes := aCompositeRefactoryChange. aBlock ensure: [changes := oldChanges]. ^aCompositeRefactoryChange! ! !RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'! privateImplementorsOf: aSelector | classes | classes := Set new. self allClassesDo: [ :class | (class directlyDefinesMethod: aSelector) ifTrue: [ classes add: class ] ]. ^ classes! ! !RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'! privateReferencesTo: aSelector | methods | methods := OrderedCollection new. self allClassesDo: [ :class | (class whichSelectorsReferToSymbol: aSelector) do: [ :selector | methods add: (class methodFor: selector) ] ]. ^ methods! ! !RBNamespace methodsFor: 'private' stamp: 'lr 4/7/2010 13:45'! privateRootClasses | classes | classes := OrderedCollection new. Class rootsOfTheWorld do: [ :each | | class | class := self classFor: each. (class notNil and: [ class superclass isNil ]) ifTrue: [ classes add: class ] ]. ^ classes! ! !RBNamespace methodsFor: 'changes' stamp: ''! removeClass: aRBClass self removeClassNamed: aRBClass name! ! !RBNamespace methodsFor: 'changes' stamp: ''! removeClassNamed: aSymbol (self classNamed: aSymbol) subclasses do: [:each | self removeClassNamed: each name]. removedClasses add: aSymbol; add: aSymbol , ' class'. newClasses removeKey: aSymbol ifAbsent: []. changedClasses removeKey: aSymbol ifAbsent: []. self flushCaches. ^changes removeClassNamed: aSymbol! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! removeClassVariable: aString from: aRBClass ^changes removeClassVariable: aString from: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! removeInstanceVariable: aString from: aRBClass ^changes removeInstanceVariable: aString from: aRBClass! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! removeMethod: aSelector from: aRBClass self flushCaches. ^changes removeMethod: aSelector from: aRBClass! ! !RBNamespace methodsFor: 'changes' stamp: 'lr 3/19/2010 13:24'! renameClass: aRBClass to: aSymbol around: aBlock | change value dict | change := RenameClassChange rename: aRBClass name to: aSymbol. self performChange: change around: aBlock. self flushCaches. dict := (newClasses includesKey: aRBClass name) ifTrue: [newClasses] ifFalse: [changedClasses]. removedClasses add: aRBClass name; add: aRBClass name , ' class'. value := dict at: aRBClass name. dict removeKey: aRBClass name. dict at: aSymbol put: value. value first name: aSymbol. value last name: aSymbol. value first subclasses do: [:each | each superclass: value first]. value last subclasses do: [:each | each superclass: value last]. ^change! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! renameClassVariable: oldName to: newName in: aRBClass around: aBlock ^self performChange: (RenameClassVariableChange rename: oldName to: newName in: aRBClass) around: aBlock! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! renameInstanceVariable: oldName to: newName in: aRBClass around: aBlock ^self performChange: (RenameInstanceVariableChange rename: oldName to: newName in: aRBClass) around: aBlock! ! !RBNamespace methodsFor: 'changes' stamp: ''! reparentClasses: aRBClassCollection to: newClass aRBClassCollection do: [:aClass | self defineClass: (self replaceClassNameIn: aClass definitionString to: newClass name)]! ! !RBNamespace methodsFor: 'private-changes' stamp: ''! replaceClassNameIn: definitionString to: aSymbol | parseTree | parseTree := RBParser parseExpression: definitionString. parseTree receiver: (RBVariableNode named: aSymbol). ^parseTree formattedCode! ! !RBNamespace methodsFor: 'accessing' stamp: 'lr 4/7/2010 13:38'! rootClasses ^ rootClasses ifNil: [ rootClasses := self privateRootClasses]! ! !RBNamespace methodsFor: 'accessing-classes' stamp: ''! whichCategoryIncludes: aSymbol ^self environment whichCategoryIncludes: aSymbol! ! Object subclass: #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: 'lr 11/2/2009 00:14'! abstractClassVariable: aString | refactoring rewriter nonMetaClass | nonMetaClass := fromClass theNonMetaClass. refactoring := CreateAccessorsForVariableRefactoring model: self model variable: aString class: nonMetaClass classVariable: true. self performComponentRefactoring: refactoring. rewriter := RBParseTreeRewriter new. fromClass isMeta ifTrue: [ rewriter replace: aString , ' := ``@object' with: ('self <1s> ``@object' expandMacrosWith: refactoring setterMethod); replace: aString with: 'self ' , refactoring getterMethod ] ifFalse: [ rewriter replace: aString , ' := ``@object' with: ('self class <1s> ``@object' expandMacrosWith: refactoring setterMethod); replace: aString with: 'self class ' , refactoring getterMethod ]. (rewriter executeTree: tree) ifTrue: [ tree := rewriter tree ]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 2/6/2010 13:33'! abstractClassVariables | variables | (classVarReaders isEmpty and: [ classVarWriters isEmpty ]) ifTrue: [ ^ self ]. variables := Set new. variables addAll: classVarReaders; addAll: classVarWriters. variables do: [ :each | self abstractClassVariable: each ]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractInstanceVariable: aString | refactoring rewriter | refactoring := CreateAccessorsForVariableRefactoring model: self model variable: aString class: fromClass classVariable: false. self performComponentRefactoring: refactoring. rewriter := RBParseTreeRewriter new. rewriter replace: aString , ' := ``@object' with: ('self <1s> ``@object' expandMacrosWith: refactoring setterMethod); replace: aString with: 'self ' , refactoring getterMethod. (rewriter executeTree: tree) ifTrue: [tree := rewriter tree]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 2/6/2010 13:34'! abstractInstanceVariables | variables | (instVarReaders isEmpty and: [ instVarWriters isEmpty ]) ifTrue: [ ^ self]. variables := Set new. variables addAll: instVarReaders; addAll: instVarWriters. variables do: [ :each | self abstractInstanceVariable: each ]! ! !AbstractVariablesRefactoring methodsFor: 'initialize-release' stamp: ''! abstractVariablesIn: aBRProgramNode from: fromBehavior toAll: behaviorCollection ignoring: aVariableName | poolRefactoring | tree := aBRProgramNode. fromClass := self classObjectFor: fromBehavior. toClasses := behaviorCollection collect: [:each | self classObjectFor: each]. ignore := aVariableName. poolRefactoring := ExpandReferencedPoolsRefactoring model: self model forMethod: tree fromClass: fromClass toClasses: toClasses. self performComponentRefactoring: poolRefactoring. self computeVariablesToAbstract! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! classVariableNames | nonMetaClass | nonMetaClass := fromClass theNonMetaClass. ^ (nonMetaClass allClassVariableNames collect: [ :each | each asString ]) asSet! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! computeVariablesToAbstract | searcher | instVarReaders := Set new. instVarWriters := Set new. classVarReaders := Set new. classVarWriters := Set new. searcher := RBParseTreeSearcher new. searcher matches: '`var := ``@anything' do: [:aNode :answer | self processAssignmentNode: aNode]; matches: '`var' do: [:aNode :answer | self processReferenceNode: aNode]. searcher executeTree: tree. self removeDefinedClassVariables! ! !AbstractVariablesRefactoring methodsFor: 'testing' stamp: 'lr 2/6/2010 13:34'! hasVariablesToAbstract ^ instVarReaders notEmpty or: [ instVarWriters notEmpty or: [ classVarReaders notEmpty or: [ classVarWriters notEmpty ] ] ]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! instanceVariableNames ^fromClass allInstanceVariableNames asSet! ! !AbstractVariablesRefactoring methodsFor: 'accessing' stamp: ''! parseTree ^tree! ! !AbstractVariablesRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition empty! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! processAssignmentNode: aNode | varName | varName := aNode variable name. ignore = varName ifTrue: [^self]. (aNode whoDefines: varName) notNil ifTrue: [^self]. (self instanceVariableNames includes: varName) ifTrue: [instVarWriters add: varName]. (self classVariableNames includes: varName) ifTrue: [classVarWriters add: varName]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! processReferenceNode: aNode | varName | varName := aNode name. ignore = varName ifTrue: [^self]. (aNode whoDefines: varName) notNil ifTrue: [^self]. (self instanceVariableNames includes: varName) ifTrue: [instVarReaders add: varName]. (self classVariableNames includes: varName) ifTrue: [classVarReaders add: varName]! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! removeDefinedClassVariables | selectionBlock nonMetaClass | nonMetaClass := fromClass theNonMetaClass. selectionBlock := [ :varName | (toClasses detect: [ :each | (each theNonMetaClass includesClass: (nonMetaClass whoDefinesClassVariable: varName)) not ] ifNone: [ nil ]) notNil ]. classVarReaders := classVarReaders select: selectionBlock. classVarWriters := classVarWriters select: selectionBlock! ! !AbstractVariablesRefactoring methodsFor: 'transforming' stamp: ''! transform self hasVariablesToAbstract ifTrue: [self refactoringWarning: 'This method has direct variable references whichwill need to be converted to getter/setters.' expandMacros]. self abstractInstanceVariables. self abstractClassVariables! ! Refactoring subclass: #ClassRefactoring instanceVariableNames: 'className' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! ClassRefactoring subclass: #AddClassRefactoring instanceVariableNames: 'category superclass subclasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddClassRefactoring class methodsFor: 'instance creation' stamp: ''! addClass: aName superclass: aClass subclasses: aCollection category: aSymbol ^self new addClass: aName superclass: aClass subclasses: aCollection category: aSymbol! ! !AddClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk addClass: aName superclass: aClass subclasses: aCollection category: aSymbol ^(self new) model: aRBSmalltalk; addClass: aName superclass: aClass subclasses: aCollection category: aSymbol; yourself! ! !AddClassRefactoring methodsFor: 'initialize-release' stamp: ''! addClass: aName superclass: aClass subclasses: aCollection category: aSymbol self className: aName. superclass := self classObjectFor: aClass. subclasses := aCollection collect: [:each | self classObjectFor: each]. category := aSymbol! ! !AddClassRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | cond | cond := ((RBCondition isMetaclass: superclass) errorMacro: 'Superclass must not be a metaclass') not. cond := subclasses inject: cond into: [:sub :each | sub & ((RBCondition isMetaclass: each) errorMacro: 'Subclass must <1?not :>be a metaclass') not & (RBCondition isImmediateSubclass: each of: superclass)]. ^cond & (RBCondition isValidClassName: className) & (RBCondition isGlobal: className in: self model) not & (RBCondition isSymbol: category) & ((RBCondition withBlock: [category isEmpty not]) errorMacro: 'Invalid category name')! ! !AddClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' addClass: #'; nextPutAll: className; nextPutAll: ' superclass: '. superclass storeOn: aStream. aStream nextPutAll: ' subclasses: '. subclasses asArray storeOn: aStream. aStream nextPutAll: ' category: '. category storeOn: aStream. aStream nextPut: $)! ! !AddClassRefactoring methodsFor: 'transforming' stamp: 'bh 4/10/2001 14:25'! transform (self model) defineClass: ('<1p> subclass: #<2s> instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: <3p>' expandMacrosWith: superclass with: className with: category asString); reparentClasses: subclasses to: (self model classNamed: className asSymbol)! ! ClassRefactoring subclass: #ChildrenToSiblingsRefactoring instanceVariableNames: 'parent subclasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ChildrenToSiblingsRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk name: aClassName class: aClass subclasses: subclassCollection ^(self new) model: aRBSmalltalk; name: aClassName class: aClass subclasses: subclassCollection; yourself! ! !ChildrenToSiblingsRefactoring class methodsFor: 'instance creation' stamp: ''! name: aClassName class: aClass subclasses: subclassCollection ^(self new) name: aClassName class: aClass subclasses: subclassCollection; yourself! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-accessing' stamp: ''! abstractSuperclass ^self model classNamed: className asSymbol! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! addSuperclass self performComponentRefactoring: (AddClassRefactoring model: self model addClass: className superclass: parent superclass subclasses: (Array with: parent) category: parent category)! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! changeIsKindOfReferences | replacer | replacer := RBParseTreeRewriter new. replacer replace: '``@object isKindOf: ' , parent name with: '``@object isKindOf: ' , className. self convertAllReferencesToClass: parent using: replacer! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! computeSubclassSupersOf: aClass | selectors | selectors := Set new. aClass subclasses do: [:each | each selectors do: [:sel | selectors addAll: (each parseTreeFor: sel) superMessages]]. ^selectors! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! createSubclassResponsibilityFor: aSelector in: aClass | source | (aClass superclass definesMethod: aSelector) ifTrue: [^self]. source := self subclassResponsibilityFor: aSelector in: aClass. source isNil ifTrue: [^self]. aClass superclass compile: source classified: (aClass protocolsFor: aSelector)! ! !ChildrenToSiblingsRefactoring methodsFor: 'initialize-release' stamp: ''! name: aClassName class: aClass subclasses: subclassCollection className := aClassName asSymbol. parent := self model classFor: aClass. subclasses := subclassCollection collect: [:each | self model classFor: each]! ! !ChildrenToSiblingsRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^subclasses inject: ((RBCondition isMetaclass: parent) errorMacro: 'Superclass must not be a metaclass') not & (RBCondition isValidClassName: className) & (RBCondition isGlobal: className in: self model) not into: [:sub :each | sub & ((RBCondition isMetaclass: each) errorMacro: 'Subclass must <1?not :>be a metaclass') not & (RBCondition isImmediateSubclass: each of: parent)]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: 'lr 10/26/2009 22:09'! pullUpClassInstanceVariables | newSuperclass | newSuperclass := self abstractSuperclass theMetaClass. parent theMetaClass instanceVariableNames do: [ :each | self performComponentRefactoring: (PullUpInstanceVariableRefactoring model: self model variable: each class: newSuperclass) ]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: ''! pullUpClassVariables | newSuperclass | newSuperclass := self abstractSuperclass. parent classVariableNames do: [:each | self performComponentRefactoring: (PullUpClassVariableRefactoring model: self model variable: each class: newSuperclass)]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-variables' stamp: ''! pullUpInstanceVariables | newSuperclass | newSuperclass := self abstractSuperclass. parent instanceVariableNames do: [:each | self performComponentRefactoring: (PullUpInstanceVariableRefactoring model: self model variable: each class: newSuperclass)]! ! !ChildrenToSiblingsRefactoring methodsFor: '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: 'lr 10/26/2009 22:09'! pushUpMethods self pushUpMethodsFrom: parent. self pushUpMethodsFrom: parent theMetaClass! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! pushUpMethodsFrom: aClass | selectorsToPushUp | selectorsToPushUp := self selectorsToPushUpFrom: aClass. aClass selectors do: [:each | (selectorsToPushUp includes: each) ifTrue: [self pushUp: each in: aClass] ifFalse: [self createSubclassResponsibilityFor: each in: aClass]]. selectorsToPushUp do: [:each | aClass removeMethod: each]! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! pushUpVariables self pullUpInstanceVariables. self pullUpClassInstanceVariables. self pullUpClassVariables. self pullUpPoolVariables! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! reparentSubclasses self model reparentClasses: subclasses to: self abstractSuperclass! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! selectorsToPushUpFrom: aClass | superSelectors | superSelectors := self computeSubclassSupersOf: aClass. ^aClass selectors select: [:each | (superSelectors includes: each) or: [self shouldPushUp: each from: aClass]]! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: 'lr 10/26/2009 22:09'! shouldPushUp: aSelector from: aClass ^ ((aClass isMeta ifTrue: [ subclasses collect: [ :each | each theMetaClass ] ] ifFalse: [ subclasses ]) detect: [ :each | (each directlyDefinesMethod: aSelector) not ] ifNone: [ nil ]) notNil! ! !ChildrenToSiblingsRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' name: #'; nextPutAll: className; nextPutAll: ' class: '. parent storeOn: aStream. aStream nextPutAll: ' subclasses: '. subclasses asArray storeOn: aStream. aStream nextPut: $)! ! !ChildrenToSiblingsRefactoring methodsFor: 'private-methods' stamp: ''! subclassResponsibilityFor: aSelector in: aClass | methodNode position source | source := aClass sourceCodeFor: aSelector. methodNode := RBParser parseMethod: source onError: [:err :pos | ^nil]. position := methodNode arguments isEmpty ifTrue: [methodNode selectorParts last stop] ifFalse: [methodNode arguments last stop]. ^'<1s>self subclassResponsibility' expandMacrosWith: (source copyFrom: 1 to: position)! ! !ChildrenToSiblingsRefactoring methodsFor: 'transforming' stamp: ''! 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: 'lr 11/2/2009 00:14'! renameReferences | replacer | replacer := (RBParseTreeRewriter replaceLiteral: className with: newName) replace: className with: newName; replaceArgument: newName withValueFrom: [:aNode | self refactoringError: newName , ' already exists within the reference scope']; yourself. self model allReferencesToClass: class do: [:method | (method modelClass hierarchyDefinesVariable: newName) ifTrue: [self refactoringError: newName , ' is already defined in hierarchy of ' , method modelClass printString]. self convertMethod: method selector for: method modelClass using: replacer]! ! !RenameClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' rename: '. class storeOn: aStream. aStream nextPutAll: ' to: #'; nextPutAll: newName; nextPut: $)! ! !RenameClassRefactoring methodsFor: 'transforming' stamp: ''! transform self model renameClass: class to: newName around: [self renameReferences]! ! Refactoring subclass: #ExpandReferencedPoolsRefactoring instanceVariableNames: 'pools fromClass parseTree toClasses' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExpandReferencedPoolsRefactoring class methodsFor: 'instance creation' stamp: ''! forMethod: aParseTree fromClass: aClass toClasses: classCollection ^(self new) forMethod: aParseTree fromClass: aClass toClasses: classCollection; yourself! ! !ExpandReferencedPoolsRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBNamespace forMethod: aParseTree fromClass: aClass toClasses: classCollection ^(self new) model: aRBNamespace; forMethod: aParseTree fromClass: aClass toClasses: classCollection; yourself! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! computePoolsToMove | poolVariables searcher | poolVariables := self poolVariableNamesFor: fromClass. pools := Set new. searcher := RBParseTreeSearcher new. searcher matches: '`var' do: [:aNode :answer | | varName pool | varName := aNode name. (aNode whoDefines: varName) isNil ifTrue: [(poolVariables includes: varName) ifTrue: [pool := self whichPoolDefines: varName. pool notNil ifTrue: [pools add: pool]]]]. searcher executeTree: parseTree! ! !ExpandReferencedPoolsRefactoring methodsFor: 'initialize-release' stamp: ''! forMethod: aParseTree fromClass: aClass toClasses: classCollection fromClass := self model classFor: aClass. parseTree := aParseTree. toClasses := classCollection collect: [:each | self model classFor: each]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'testing' stamp: ''! hasPoolsToMove ^pools isEmpty not! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! movePool: aSymbol toClass: aClass | nonMetaClass | nonMetaClass := aClass theNonMetaClass. (nonMetaClass definesPoolDictionary: aSymbol) ifFalse: [ nonMetaClass addPoolDictionary: aSymbol ]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''! movePoolVariables pools do: [:poolDict | toClasses do: [:each | self movePool: poolDict toClass: each]]! ! !ExpandReferencedPoolsRefactoring methodsFor: 'transforming' stamp: ''! 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: 'lr 11/2/2009 00:14'! checkVariableReferencesIn: aParseTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '`var' do: [:aNode :answer | | name | name := aNode name. (aNode whoDefines: name) isNil ifTrue: [self checkSendersAccessTo: name]]. searcher executeTree: aParseTree! ! !AddParameterRefactoring methodsFor: 'private' stamp: 'lr 2/21/2010 14:52'! modifyImplementorParseTree: parseTree in: aClass | name newArg allTempVars | allTempVars := parseTree allDefinedVariables. name := self safeVariableNameFor: aClass temporaries: allTempVars. newArg := RBVariableNode named: name. parseTree renameSelector: newSelector andArguments: parseTree arguments , (Array with: newArg)! ! !AddParameterRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^RBCondition withBlock: [oldSelector numArgs + 1 = newSelector numArgs ifFalse: [self refactoringError: newSelector printString , ' doesn''t have the proper number of arguments.']. self verifyInitializationExpression. true]! ! !AddParameterRefactoring methodsFor: 'private' stamp: ''! newSelectorString | stream keywords | stream := WriteStream on: String new. keywords := newSelector keywords. 1 to: keywords size do: [:i | stream nextPutAll: (keywords at: i). i == keywords size ifTrue: [stream nextPut: $(; nextPutAll: initializer; nextPut: $)] ifFalse: [stream nextPutAll: ' ``@arg'; nextPutAll: i printString]. stream nextPut: $ ]. ^stream contents! ! !AddParameterRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! parseTreeRewriter | rewriteRule oldString newString | rewriteRule := RBParseTreeRewriter new. oldString := self buildSelectorString: oldSelector. newString := self newSelectorString. rewriteRule replace: '``@object ' , oldString with: '``@object ' , newString. ^rewriteRule! ! !AddParameterRefactoring methodsFor: 'private' stamp: ''! safeVariableNameFor: aClass temporaries: allTempVars | baseString i newString | newString := baseString := 'anObject'. i := 0. [(allTempVars includes: newString) or: [aClass definesInstanceVariable: newString]] whileTrue: [i := i + 1. newString := baseString , i printString]. ^newString! ! !AddParameterRefactoring methodsFor: 'private' stamp: ''! senders senders isNil ifTrue: [senders := Set new. self model allReferencesTo: oldSelector do: [:each | senders add: each modelClass]]. ^senders! ! !AddParameterRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' addParameterToMethod: #'; nextPutAll: oldSelector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' newSelector: #'; nextPutAll: newSelector; nextPutAll: ' initializer: '''; nextPutAll: initializer; nextPutAll: ''')'! ! !AddParameterRefactoring methodsFor: 'preconditions' stamp: ''! verifyInitializationExpression | tree | tree := RBParser parseExpression: initializer onError: [:msg :index | self refactoringError: 'Illegal initialization code because:.' , msg]. tree isValue ifFalse: [self refactoringError: 'The initialization code cannot be a return node or a list of statements']. self checkVariableReferencesIn: tree! ! !ChangeMethodNameRefactoring methodsFor: 'testing' stamp: ''! hasPermutedArguments oldSelector numArgs = newSelector numArgs ifFalse: [^true]. 1 to: oldSelector numArgs do: [:i | (permutation at: i) = i ifFalse: [^true]]. ^false! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: ''! implementors implementors isNil ifTrue: [implementors := self model allImplementorsOf: oldSelector]. ^implementors! ! !ChangeMethodNameRefactoring methodsFor: 'testing' stamp: ''! implementorsCanBePrimitives ^false! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: 'lr 11/23/2009 10:58'! modifyImplementorParseTree: parseTree in: aClass | oldArgs | oldArgs := parseTree arguments. parseTree renameSelector: newSelector andArguments: (permutation collect: [:each | oldArgs at: each]) ! ! !ChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^self subclassResponsibility! ! !ChangeMethodNameRefactoring methodsFor: 'accessing' stamp: ''! newSelector ^newSelector! ! !ChangeMethodNameRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! parseTreeRewriter | rewriteRule oldString newString | rewriteRule := RBParseTreeRewriter new. oldString := self buildSelectorString: oldSelector. newString := self buildSelectorString: newSelector withPermuteMap: permutation. rewriteRule replace: '``@object ' , oldString with: '``@object ' , newString. ^rewriteRule! ! !ChangeMethodNameRefactoring methodsFor: 'preconditions' stamp: ''! preconditions "This refactoring only preserves behavior if all implementors are renamed." | conditions | conditions := self myConditions & (RBCondition definesSelector: oldSelector in: class) & (RBCondition isValidMethodName: newSelector for: class). conditions := self implementors inject: conditions into: [:condition :each | condition & (RBCondition hierarchyOf: each canUnderstand: newSelector) not]. ^conditions & (RBCondition withBlock: [self implementors size > 1 ifTrue: [self refactoringWarning: ('This will modify all <1p> implementors.' expandMacrosWith: self implementors size)]. true])! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 12/23/2009 19:59'! removeRenamedImplementors oldSelector = newSelector ifTrue: [ ^ self ]. self implementors do: [ :each | each removeMethod: oldSelector ]! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:58'! renameImplementors self implementors do: [:each | | parseTree | parseTree := each parseTreeFor: oldSelector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse source code.']. self implementorsCanBePrimitives ifFalse: [parseTree isPrimitive ifTrue: [self refactoringError: ('<1p>''s implementation of #<2s> is a primitive' expandMacrosWith: each with: oldSelector)]]. self modifyImplementorParseTree: parseTree in: each. (each methodFor: oldSelector) compileTree: parseTree]! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: ''! renameMessageSends self convertAllReferencesTo: oldSelector using: self parseTreeRewriter! ! !ChangeMethodNameRefactoring methodsFor: 'initialize-release' stamp: 'md 3/15/2006 17:27'! renameMethod: aSelector in: aClass to: newSel permutation: aMap oldSelector := aSelector asSymbol. newSelector := newSel asSymbol. class := self classObjectFor: aClass. permutation := aMap! ! !ChangeMethodNameRefactoring methodsFor: 'transforming' stamp: 'lr 12/23/2009 20:00'! transform self renameImplementors. self renameMessageSends. self removeRenamedImplementors! ! ChangeMethodNameRefactoring subclass: #RemoveParameterRefactoring instanceVariableNames: 'parameterIndex argument' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! RemoveParameterRefactoring subclass: #InlineParameterRefactoring instanceVariableNames: 'expressions' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineParameterRefactoring class methodsFor: 'instance creation' stamp: ''! inlineParameter: aString in: aClass selector: aSelector ^self new inlineParameter: aString in: aClass selector: aSelector! ! !InlineParameterRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk inlineParameter: aString in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; inlineParameter: aString in: aClass selector: aSelector; yourself! ! !InlineParameterRefactoring methodsFor: 'private' stamp: ''! allExpressionsToInline | coll | coll := Set new. self model allReferencesTo: oldSelector do: [:each | | tree | tree := each parseTree. tree notNil ifTrue: [coll addAll: (self expressionsToInlineFrom: tree)]]. ^coll asOrderedCollection! ! !InlineParameterRefactoring methodsFor: 'private' stamp: 'lr 11/2/2009 00:14'! expressionsToInlineFrom: aTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '``@obj ' , (self buildSelectorString: oldSelector) do: [:aNode :answer | answer add: (aNode arguments at: parameterIndex); yourself]. ^searcher executeTree: aTree initialAnswer: OrderedCollection new! ! !InlineParameterRefactoring methodsFor: 'initialize-release' stamp: ''! inlineParameter: aString in: aClass selector: aSelector oldSelector := aSelector. class := self classObjectFor: aClass. argument := aString! ! !InlineParameterRefactoring methodsFor: 'transforming' stamp: ''! modifyImplementorParseTree: parseTree in: aClass | node assignment | node := (parseTree arguments at: parameterIndex) copy. parseTree body addTemporaryNamed: node name. assignment := RBAssignmentNode variable: node copy value: expressions first. parseTree body addNodeFirst: assignment. super modifyImplementorParseTree: parseTree in: aClass! ! !InlineParameterRefactoring methodsFor: 'preconditions' stamp: ''! myConditions self getNewSelector. expressions := self allExpressionsToInline. ^(RBCondition definesSelector: oldSelector in: class) & ((RBCondition withBlock: [expressions isEmpty not]) errorMacro: 'No callers. Use Remove Method instead.') & ((RBCondition withBlock: [expressions size = 1]) errorMacro: 'All values passed as this argument must be identical.') & ((RBCondition withBlock: [expressions first isLiteral]) errorMacro: 'All values passed must be literal.')! ! !InlineParameterRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' inlineParameter: '''; nextPutAll: argument; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: oldSelector; nextPut: $)! ! !RemoveParameterRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk removeParameter: aString in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; removeParameter: aString in: aClass selector: aSelector; yourself! ! !RemoveParameterRefactoring class methodsFor: 'instance creation' stamp: ''! removeParameter: aString in: aClass selector: aSelector ^self new removeParameter: aString in: aClass selector: aSelector! ! !RemoveParameterRefactoring methodsFor: 'private' stamp: 'md 8/2/2005 22:25'! computeNewSelector | keywords stream | oldSelector numArgs == 0 ifTrue: [self refactoringError: 'This method contains no arguments']. oldSelector isInfix ifTrue: [self refactoringError: 'Cannot remove parameters of infix selectors']. keywords := oldSelector keywords asOrderedCollection. keywords size = 1 ifTrue: [^(keywords first copyWithout: $:) asSymbol]. keywords removeAt: parameterIndex. stream := WriteStream on: ''. keywords do: [:each | stream nextPutAll: each]. ^stream contents asSymbol! ! !RemoveParameterRefactoring methodsFor: 'transforming' stamp: ''! getNewSelector | tree | (class directlyDefinesMethod: oldSelector) ifFalse: [self refactoringError: 'Method doesn''t exist']. tree := class parseTreeFor: oldSelector. tree isNil ifTrue: [self refactoringError: 'Cannot parse sources']. parameterIndex := tree argumentNames indexOf: argument ifAbsent: [self refactoringError: 'Select a parameter!!!!']. permutation := (1 to: oldSelector numArgs) copyWithout: parameterIndex. newSelector := self computeNewSelector! ! !RemoveParameterRefactoring methodsFor: 'transforming' stamp: ''! hasReferencesToTemporaryIn: each | tree | tree := each parseTreeFor: oldSelector. tree isNil ifTrue: [self refactoringError: 'Cannot parse sources.']. ^tree references: (tree argumentNames at: parameterIndex)! ! !RemoveParameterRefactoring methodsFor: 'preconditions' stamp: 'lr 3/9/2010 16:08'! myConditions | imps | imps := self model allImplementorsOf: oldSelector. self getNewSelector. ^imps inject: (RBCondition definesSelector: oldSelector in: class) into: [:cond :each | cond & (RBCondition withBlock: [(self hasReferencesToTemporaryIn: each) not] errorString: 'This argument is still referenced in at least one implementor!!!!')]! ! !RemoveParameterRefactoring methodsFor: 'initialize-release' stamp: ''! removeParameter: aString in: aClass selector: aSelector oldSelector := aSelector. class := self classObjectFor: aClass. argument := aString! ! !RemoveParameterRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' removeParameter: '''; nextPutAll: argument; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: oldSelector. aStream nextPut: $)! ! ChangeMethodNameRefactoring subclass: #RenameMethodRefactoring instanceVariableNames: 'hasPermutedArguments' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameMethodRefactoring class methodsFor: 'instance creation' stamp: 'md 3/15/2006 17:29'! model: aRBSmalltalk renameMethod: aSelector in: aClass to: newSelector permutation: aMap ^(self new) model: aRBSmalltalk; renameMethod: aSelector in: aClass to: newSelector permutation: aMap; yourself! ! !RenameMethodRefactoring class methodsFor: 'instance creation' stamp: 'md 3/15/2006 17:26'! renameMethod: aSelector in: aClass to: newSelector permutation: aMap ^self new renameMethod: aSelector in: aClass to: newSelector permutation: aMap! ! !RenameMethodRefactoring methodsFor: 'testing' stamp: ''! hasPermutedArguments ^hasPermutedArguments isNil ifTrue: [hasPermutedArguments := super hasPermutedArguments] ifFalse: [hasPermutedArguments]! ! !RenameMethodRefactoring methodsFor: 'testing' stamp: ''! implementorsCanBePrimitives ^self hasPermutedArguments not! ! !RenameMethodRefactoring methodsFor: 'preconditions' stamp: ''! myConditions ^RBCondition withBlock: [oldSelector numArgs = newSelector numArgs] errorString: newSelector printString , ' doesn''t have the correct number of arguments.'! ! !RenameMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! parseTreeRewriter | rewriteRule oldString newString | oldString := self buildSelectorString: oldSelector. newString := self buildSelectorString: newSelector withPermuteMap: permutation. rewriteRule := self hasPermutedArguments ifTrue: [RBParseTreeRewriter new] ifFalse: [RBParseTreeRewriter replaceLiteral: oldSelector with: newSelector]. rewriteRule replace: '``@object ' , oldString with: '``@object ' , newString. ^rewriteRule! ! !RenameMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | newCondition | newCondition := (RBCondition withBlock: [newSelector = oldSelector] errorString: 'The selectors are <1?:not >equivalent') & (RBCondition withBlock: [permutation asArray ~= (1 to: oldSelector numArgs) asArray] errorString: 'The arguments are <1?:not >permuted'). ^newCondition | super preconditions! ! !RenameMethodRefactoring methodsFor: 'printing' stamp: 'lr 3/9/2010 16:09'! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' renameMethod: #'; nextPutAll: oldSelector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' to: #'; nextPutAll: newSelector; nextPutAll: ' permutation: '. permutation storeOn: aStream. aStream nextPut: $)! ! MethodRefactoring subclass: #ExtractMethodRefactoring instanceVariableNames: 'selector extractionInterval extractedParseTree modifiedParseTree parameters needsReturn' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExtractMethodRefactoring class methodsFor: 'instance creation' stamp: ''! extract: anInterval from: aSelector in: aClass ^self new extract: anInterval from: aSelector in: aClass! ! !ExtractMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk extract: anInterval from: aSelector in: aClass ^(self new) model: aRBSmalltalk; extract: anInterval from: aSelector in: aClass; yourself! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkAssignments: variableNames | node outsideVars removeAssigned | removeAssigned := variableNames copy. node := self placeholderNode. outsideVars := variableNames select: [:each | (node whoDefines: each) references: each]. outsideVars size == 1 ifTrue: [self checkSingleAssignment: outsideVars asArray first]. outsideVars size > 1 ifTrue: [self refactoringError: 'Cannot extract assignment without all references.']. removeAssigned removeAll: outsideVars. (RBReadBeforeWrittenTester readBeforeWritten: removeAssigned in: extractedParseTree) isEmpty ifFalse: [self refactoringError: 'Cannot extract assignment if read before written.']. removeAssigned do: [:each | (node whoDefines: each) removeTemporaryNamed: each]. self createTemporariesInExtractedMethodFor: variableNames! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkReturn needsReturn := self placeholderNode isUsed. extractedParseTree containsReturn ifFalse: [^self]. extractedParseTree lastIsReturn ifTrue: [^self]. (modifiedParseTree isLast: self placeholderNode) ifFalse: [self refactoringError: 'Couldn''t extract code since it contains a return.']. self checkSelfReturns! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! checkSelfReturns | searcher | searcher := RBParseTreeSearcher new. searcher matches: '^self' do: [:aNode :answer | answer]; matches: '^`@anything' do: [:aNode :answer | true]. (searcher executeTree: extractedParseTree initialAnswer: false) ifTrue: [self placeholderNode asReturn]! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! checkSingleAssignment: varName ((RBReadBeforeWrittenTester isVariable: varName readBeforeWrittenIn: extractedParseTree) or: [extractedParseTree containsReturn]) ifTrue: [self refactoringError: 'Cannot extract assignments to temporaries without all references']. extractedParseTree addNode: (RBReturnNode value: (RBVariableNode named: varName)). modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: varName , ' := ' , self methodDelimiter in: modifiedParseTree! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkSpecialExtractions | node | node := self placeholderNode parent. node isNil ifTrue: [^self]. (node isAssignment and: [node variable = self placeholderNode]) ifTrue: [self refactoringError: 'Cannot extract left hand side of an assignment']. node isCascade ifTrue: [self refactoringError: 'Cannot extract first message of a cascaded message']! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! checkTemporaries | temps accesses assigned | temps := self remainingTemporaries. accesses := temps select: [:each | extractedParseTree references: each]. assigned := accesses select: [:each | extractedParseTree assigns: each]. assigned isEmpty ifFalse: [self checkAssignments: assigned]. ^parameters := (accesses asOrderedCollection) removeAll: assigned; yourself! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! createTemporariesInExtractedMethodFor: assigned assigned do: [:each | extractedParseTree body addTemporaryNamed: each]! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'bh 5/10/2000 21:58'! existingSelector "Try to find an existing method instead of creating a new one" ^class allSelectors detect: [:each | self isMethodEquivalentTo: each] ifNone: [nil]! ! !ExtractMethodRefactoring methodsFor: 'initialize-release' stamp: ''! extract: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. extractionInterval := anInterval! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! extractMethod | parseTree isSequence extractCode subtree newCode | extractCode := self getExtractedSource. extractedParseTree := RBParser parseExpression: extractCode onError: [:string :pos | self refactoringError: 'Invalid source to extract - ', string]. extractedParseTree isNil ifTrue: [self refactoringError: 'Invalid source to extract']. (extractedParseTree isSequence and: [extractedParseTree statements isEmpty]) ifTrue: [self refactoringError: 'Select some code to extract']. isSequence := extractedParseTree isSequence or: [extractedParseTree isReturn]. extractedParseTree := RBMethodNode selector: #value arguments: #() body: (extractedParseTree isSequence ifTrue: [extractedParseTree] ifFalse: [RBSequenceNode temporaries: #() statements: (OrderedCollection with: extractedParseTree)]). extractedParseTree body temporaries isEmpty not ifTrue: [extractedParseTree body temporaries: #()]. extractedParseTree source: extractCode. parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse ' , selector printString]. subtree := isSequence ifTrue: [RBParseTreeSearcher treeMatchingStatements: extractedParseTree body formattedCode in: parseTree] ifFalse: [RBParseTreeSearcher treeMatching: extractCode in: parseTree]. subtree isNil ifTrue: [self refactoringError: 'Could not extract code from method']. newCode := self methodDelimiter. isSequence ifTrue: [| stmts | stmts := extractedParseTree body statements. stmts isEmpty ifFalse: [stmts last isAssignment ifTrue: [| name | name := stmts last variable name. (self shouldExtractAssignmentTo: name) ifFalse: [newCode := '<1s> := <2s>' expandMacrosWith: name with: newCode. stmts at: stmts size put: stmts last value]]]]. modifiedParseTree := isSequence ifTrue: [RBParseTreeRewriter replaceStatements: subtree formattedCode with: newCode in: parseTree onInterval: extractionInterval] ifFalse: [RBParseTreeRewriter replace: subtree formattedCode with: newCode in: parseTree onInterval: extractionInterval]! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! getExtractedSource | source | source := class sourceCodeFor: selector. ((extractionInterval first between: 1 and: source size) and: [extractionInterval last between: 1 and: source size]) ifFalse: [self refactoringError: 'Invalid interval']. ^source copyFrom: extractionInterval first to: extractionInterval last! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! getNewMethodName | newSelector methodName newMethodName | methodName := RBMethodName new. methodName arguments: parameters. [newMethodName := self requestMethodNameFor: methodName. newMethodName isNil ifTrue: [self refactoringError: 'Did not extract code']. newSelector := newMethodName selector. (self checkMethodName: newSelector in: class) ifFalse: [self refactoringWarning: newSelector , ' is not a valid selector name.'. newSelector := nil]. (class hierarchyDefinesMethod: newSelector asSymbol) ifTrue: [(self shouldOverride: newSelector in: class) ifFalse: [newSelector := nil]]. newSelector isNil] whileTrue: []. parameters := newMethodName arguments asOrderedCollection. ^newSelector asSymbol! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! isMethodEquivalentTo: aSelector selector == aSelector ifTrue: [^false]. aSelector numArgs ~~ parameters size ifTrue: [^false]. (self isParseTreeEquivalentTo: aSelector) ifFalse: [^false]. self reorderParametersToMatch: aSelector. ^true! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! isParseTreeEquivalentTo: aSelector | tree definingClass | definingClass := class whoDefinesMethod: aSelector. tree := definingClass parseTreeFor: aSelector. tree isNil ifTrue: [^false]. tree isPrimitive ifTrue: [^false]. (tree body equalTo: extractedParseTree body exceptForVariables: (tree arguments collect: [:each | each name])) ifFalse: [^false]. (definingClass = class or: [(tree superMessages detect: [:each | (class superclass whichClassIncludesSelector: aSelector) ~= (definingClass superclass whichClassIncludesSelector: each)] ifNone: [nil]) isNil]) ifFalse: [^false]. ^self shouldUseExistingMethod: aSelector! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! methodDelimiter ^'#''place.holder.for.method'''! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:00'! nameNewMethod: aSymbol | args newSend | args := parameters collect: [:parm | RBVariableNode named: parm]. extractedParseTree renameSelector: aSymbol andArguments: args asArray. aSymbol numArgs = 0 ifTrue: [modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: 'self ' , aSymbol asString in: modifiedParseTree. ^self]. newSend := WriteStream on: ''. aSymbol keywords with: parameters do: [:key :arg | newSend nextPutAll: key asString; nextPut: $ ; nextPutAll: arg asString; nextPut: $ ]. modifiedParseTree := RBParseTreeRewriter replace: self methodDelimiter with: 'self ' , newSend contents in: modifiedParseTree! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! placeholderNode | node | node := RBParseTreeSearcher treeMatching: self methodDelimiter in: modifiedParseTree. node isNil ifTrue: [self refactoringError: 'Cannot extract code']. ^node! ! !ExtractMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [self extractMethod. self checkSpecialExtractions. self checkReturn. needsReturn ifTrue: [extractedParseTree addReturn]. self checkTemporaries. true])! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! remainingTemporaries | temps | temps := modifiedParseTree allDefinedVariables asSet. extractedParseTree allDefinedVariables do: [:each | temps remove: each ifAbsent: []]. ^temps! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: ''! reorderParametersToMatch: aSelector | tree dictionary | tree := class parseTreeFor: aSelector. dictionary := Dictionary new. tree body equalTo: extractedParseTree body withMapping: dictionary. parameters := tree arguments collect: [:each | dictionary at: each name ifAbsent: [self refactoringError: 'An internal error occured, please report this error.']]! ! !ExtractMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' extract: '. extractionInterval storeOn: aStream. aStream nextPutAll: ' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !ExtractMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:04'! transform | existingSelector | existingSelector := self existingSelector. self nameNewMethod: (existingSelector isNil ifTrue: [self getNewMethodName] ifFalse: [existingSelector]). existingSelector isNil ifTrue: [class compile: extractedParseTree newSource withAttributesFrom: (class methodFor: selector)]. class compileTree: modifiedParseTree! ! MethodRefactoring subclass: #ExtractMethodToComponentRefactoring instanceVariableNames: 'selector extractionInterval extractedMethodSelector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExtractMethodToComponentRefactoring class methodsFor: 'instance creation' stamp: ''! extract: anInterval from: aSelector in: aClass ^self new extract: anInterval from: aSelector in: aClass! ! !ExtractMethodToComponentRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk extract: anInterval from: aSelector in: aClass ^(self new) model: aRBSmalltalk; extract: anInterval from: aSelector in: aClass; yourself! ! !ExtractMethodToComponentRefactoring methodsFor: 'initialize-release' stamp: ''! extract: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. extractionInterval := anInterval! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! extractMethod | refactoring | refactoring := ExtractMethodRefactoring model: self model extract: extractionInterval from: selector in: class. refactoring setOption: #methodName toUse: [:ref :methodName | extractedMethodSelector := ref uniqueMethodNameFor: methodName arguments size. methodName selector: extractedMethodSelector; yourself]. self performComponentRefactoring: refactoring! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! inlineForwarder | refactoring | refactoring := InlineAllSendersRefactoring model: self model sendersOf: extractedMethodSelector in: class. refactoring setOption: #inlineExpression toUse: [:ref :string | true]. self performComponentRefactoring: refactoring! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! moveMethod | variable refactoring | variable := self selectVariableToMoveMethodTo: extractedMethodSelector class: class. variable isNil ifTrue: [self refactoringError: 'Did not extract method']. refactoring := MoveMethodRefactoring model: self model selector: extractedMethodSelector class: class variable: variable. self performComponentRefactoring: refactoring! ! !ExtractMethodToComponentRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition empty! ! !ExtractMethodToComponentRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' extract: '. extractionInterval storeOn: aStream. aStream nextPutAll: ' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !ExtractMethodToComponentRefactoring methodsFor: 'transforming' stamp: ''! transform self extractMethod; moveMethod; inlineForwarder! ! MethodRefactoring subclass: #ExtractToTemporaryRefactoring instanceVariableNames: 'sourceInterval selector newVariableName parseTree' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ExtractToTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! extract: anInterval to: aString from: aSelector in: aClass ^self new extract: anInterval to: aString from: aSelector in: aClass! ! !ExtractToTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk extract: anInterval to: aString from: aSelector in: aClass ^(self new) model: aRBSmalltalk; extract: anInterval to: aString from: aSelector in: aClass; yourself! ! !ExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! checkVariableName (class whoDefinesInstanceVariable: newVariableName) notNil ifTrue: [self refactoringError: ('<1p> defines an instance variable named <2s>' expandMacrosWith: class with: newVariableName)]. (class whoDefinesClassVariable: newVariableName) notNil ifTrue: [self refactoringError: ('<1p> defines a class variabled named <2s>' expandMacrosWith: class with: newVariableName)]. (self parseTree allDefinedVariables includes: newVariableName) ifTrue: [self refactoringError: ('<1s> is already a temporary variable name' expandMacrosWith: newVariableName)]! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! compileNewMethod class compileTree: self parseTree! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! constructAssignmentFrom: aNode | valueNode | valueNode := RBVariableNode named: newVariableName. ^RBAssignmentNode variable: valueNode value: aNode! ! !ExtractToTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''! extract: anInterval to: aString from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. sourceInterval := anInterval. newVariableName := aString! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! insertTemporary | node statementNode | node := self parseTree whichNodeIsContainedBy: sourceInterval. (node notNil and: [node isValue]) ifFalse: [self refactoringError: 'Cannot assign to non-value nodes']. statementNode := node statementNode. node replaceWith: (RBVariableNode named: newVariableName). (statementNode parent) addNode: (self constructAssignmentFrom: node) before: (node == statementNode ifTrue: [RBVariableNode named: newVariableName] ifFalse: [statementNode]); addTemporaryNamed: newVariableName! ! !ExtractToTemporaryRefactoring methodsFor: 'private-accessing' stamp: ''! parseTree parseTree isNil ifTrue: [parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']]. ^parseTree! ! !ExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition isValidInstanceVariableName: newVariableName for: class) & (RBCondition withBlock: [self verifySelectedInterval. self checkVariableName. true])! ! !ExtractToTemporaryRefactoring methodsFor: 'private-accessing' stamp: ''! selectedSource | source | source := class sourceCodeFor: selector. source isNil ifTrue: [self refactoringError: 'Couldn''t find sources']. ((sourceInterval first between: 1 and: source size) and: [sourceInterval last between: 1 and: source size]) ifFalse: [self refactoringError: 'Invalid interval']. ^source copyFrom: sourceInterval first to: sourceInterval last! ! !ExtractToTemporaryRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' extract: '. sourceInterval storeOn: aStream. aStream nextPutAll: ' to: '''; nextPutAll: newVariableName; nextPutAll: ''' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !ExtractToTemporaryRefactoring methodsFor: 'transforming' stamp: ''! transform self insertTemporary; compileNewMethod! ! !ExtractToTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! verifySelectedInterval | selectedParseTree selectedSources | selectedSources := self selectedSource. selectedParseTree := RBParser parseExpression: selectedSources onError: [:message :position | self refactoringError: 'Invalid selection']. selectedParseTree isSequence ifTrue: [self refactoringError: 'Cannot assign temp to multiple statements']! ! MethodRefactoring subclass: #InlineAllSendersRefactoring instanceVariableNames: 'selector numberReplaced numberNotReplaced' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineAllSendersRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk sendersOf: aSelector in: aClass ^(self new) model: aRBSmalltalk; sendersOf: aSelector in: aClass; yourself! ! !InlineAllSendersRefactoring class methodsFor: 'instance creation' stamp: ''! sendersOf: aSelector in: aClass ^self new sendersOf: aSelector in: aClass! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! checkInlinedMethods numberReplaced = 0 ifTrue: [self refactoringError: 'Could not inline any senders']! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! inlineMessagesInClass: aClass andSelector: aSelector | messagesToInline previousCountOfMessages | previousCountOfMessages := 4294967295. "Some really large number > # of initial self sends." [messagesToInline := self numberOfSelfSendsIn: (aClass parseTreeFor: aSelector). messagesToInline > 0 and: [previousCountOfMessages > messagesToInline]] whileTrue: [| node | previousCountOfMessages := messagesToInline. node := self selfSendIn: (aClass parseTreeFor: aSelector). self onError: [self performComponentRefactoring: (InlineMethodRefactoring model: self model inline: node sourceInterval inMethod: aSelector forClass: aClass). numberReplaced := numberReplaced + 1] do: []]. numberNotReplaced := numberNotReplaced + messagesToInline! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! inlineSelfSends class withAllSubclasses do: [:each | | selectors | selectors := each selectors. selectors remove: selector ifAbsent: []. selectors do: [:sel | self inlineMessagesInClass: each andSelector: sel]]! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! messagePattern ^'self ' , (self buildSelectorString: selector)! ! !InlineAllSendersRefactoring methodsFor: 'accessing' stamp: ''! messagesNotReplaced ^numberNotReplaced! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! numberOfSelfSendsIn: aParseTree | search | search := RBParseTreeSearcher new. search matches: self messagePattern do: [:aNode :answer | answer + 1]. ^search executeTree: aParseTree initialAnswer: 0! ! !InlineAllSendersRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition canUnderstand: selector in: class! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! removeMethod self onError: [self performComponentRefactoring: (RemoveMethodRefactoring model: self model removeMethods: (Array with: selector) from: class)] do: []! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! selfSendIn: aTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: self messagePattern do: [:aNode :answer | ^aNode]. ^searcher executeTree: aTree initialAnswer: nil! ! !InlineAllSendersRefactoring methodsFor: 'initialize-release' stamp: ''! sendersOf: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. numberReplaced := numberNotReplaced := 0! ! !InlineAllSendersRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' sendersOf: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !InlineAllSendersRefactoring methodsFor: 'transforming' stamp: ''! transform self inlineSelfSends; removeMethod; checkInlinedMethods! ! MethodRefactoring subclass: #InlineMethodRefactoring instanceVariableNames: 'sourceInterval inlineParseTree sourceParseTree sourceSelector sourceMessage inlineClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! InlineMethodRefactoring subclass: #InlineMethodFromComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! abstractVariableReferences | refactoring | refactoring := AbstractVariablesRefactoring model: self model abstractVariablesIn: inlineParseTree from: inlineClass toAll: (Array with: class). self performComponentRefactoring: refactoring. inlineParseTree := refactoring parseTree! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! addArgumentToSelector: aSymbol ^aSymbol isInfix ifTrue: [#value:value:] ifFalse: [(aSymbol , 'value:') asSymbol]! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:03'! addSelfReferenceToInlineParseTree | variableName rewriter newArguments | variableName := self newNameForSelf. rewriter := RBParseTreeRewriter rename: 'self' to: variableName. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]. newArguments := inlineParseTree arguments asOrderedCollection. newArguments addFirst: (RBVariableNode named: variableName). inlineParseTree renameSelector: (self addArgumentToSelector: inlineParseTree selector) andArguments: newArguments. sourceMessage receiver replaceWith: (RBVariableNode named: variableName)! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 11/23/2009 11:02'! addSelfReferenceToSourceMessage | newArguments | newArguments := sourceMessage arguments asOrderedCollection. newArguments addFirst: sourceMessage receiver copy. sourceMessage renameSelector: (self addArgumentToSelector: sourceMessage selector) andArguments: newArguments! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! checkSuperMessages inlineParseTree superMessages isEmpty ifFalse: [self refactoringError: 'Cannot inline method since it sends a super message']! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! findSelectedMessage sourceParseTree := class parseTreeFor: sourceSelector. sourceParseTree isNil ifTrue: [self refactoringError: 'Could not parse sources']. sourceMessage := sourceParseTree whichNodeIsContainedBy: sourceInterval. sourceMessage isNil ifTrue: [self refactoringError: 'The selection doesn''t appear to be a message send']. sourceMessage isCascade ifTrue: [sourceMessage := sourceMessage messages last]. sourceMessage isMessage ifFalse: [self refactoringError: 'The selection doesn''t appear to be a message send']! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! inlineClass | imps | inlineClass notNil ifTrue: [^inlineClass]. imps := (self model allImplementorsOf: self inlineSelector) asOrderedCollection. imps size = 1 ifTrue: [^inlineClass := imps first]. imps isEmpty ifTrue: [self refactoringError: 'Nobody defines a method named ' , self inlineSelector]. inlineClass := self requestImplementorToInline: imps. inlineClass isNil ifTrue: [self refactoringError: 'No implementor selected']. ^inlineClass! ! !InlineMethodFromComponentRefactoring methodsFor: 'testing' stamp: ''! isOverridden ^(self inlineClass allSubclasses detect: [:each | each directlyDefinesMethod: self inlineSelector] ifNone: [nil]) notNil! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:08'! newNameForSelf | variableName index originalName nonMetaClass | nonMetaClass := inlineClass theNonMetaClass. variableName := originalName := (nonMetaClass name first isVowel ifTrue: [ 'an' ] ifFalse: [ 'a' ]) , nonMetaClass name. index := 1. [ variableName := self safeVariableNameBasedOn: variableName. inlineParseTree allDefinedVariables includes: variableName ] whileTrue: [ variableName := originalName , index printString. index := index + 1 ]. ^ variableName! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! renameSelfReferences self addSelfReferenceToSourceMessage. self addSelfReferenceToInlineParseTree.! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! safeVariableNameBasedOn: aString "Creates an unused variable name containing aString" | baseString newString i allTempVars | allTempVars := inlineParseTree allTemporaryVariables. baseString := aString copy. baseString at: 1 put: baseString first asLowercase. newString := baseString. i := 0. [(allTempVars includes: newString) or: [class definesInstanceVariable: newString]] whileTrue: [i := i + 1. newString := baseString , i printString]. ^newString! ! !InlineMethodFromComponentRefactoring methodsFor: 'transforming' stamp: ''! transform self abstractVariableReferences. self renameSelfReferences. super transform! ! !InlineMethodRefactoring class methodsFor: 'instance creation' stamp: ''! inline: anInterval inMethod: aSelector forClass: aClass ^self new inline: anInterval inMethod: aSelector forClass: aClass! ! !InlineMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk inline: anInterval inMethod: aSelector forClass: aClass ^(self new) model: aRBSmalltalk; inline: anInterval inMethod: aSelector forClass: aClass; yourself! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! addSelfReturn inlineParseTree addSelfReturn! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! addTemporary: sourceNode assignedTo: replacementNode | newName | newName := self renameConflictingTemporary: sourceNode name. (inlineParseTree body) addTemporaryNamed: newName; addNodeFirst: (RBAssignmentNode variable: (RBVariableNode named: newName) value: replacementNode)! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! checkSuperMessages self inlineClass = class ifTrue: [^self]. self inlineClass superclass isNil ifTrue: [^self]. inlineParseTree superMessages do: [:each | (self inlineClass superclass whoDefinesMethod: each) = (class superclass whoDefinesMethod: each) ifFalse: [self refactoringError: ('Cannot inline method since it sends a super message <1s> that is overriden' expandMacrosWith: each)]]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! compileMethod class compileTree: sourceParseTree! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! findSelectedMessage sourceParseTree := class parseTreeFor: sourceSelector. sourceParseTree isNil ifTrue: [self refactoringError: 'Could not parse sources']. sourceMessage := sourceParseTree whichNodeIsContainedBy: sourceInterval. sourceMessage isNil ifTrue: [self refactoringError: 'The selection doesn''t appear to be a message send']. sourceMessage isCascade ifTrue: [sourceMessage := sourceMessage messages last]. sourceMessage isMessage ifFalse: [self refactoringError: 'The selection doesn''t appear to be a message send']. (sourceMessage receiver isVariable and: [#('self' 'super') includes: sourceMessage receiver name]) ifFalse: [self refactoringError: 'Cannot inline non-self messages']! ! !InlineMethodRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! hasMultipleReturns "Do we have multiple returns? If the last statement isn't a return, then we have an implicit return of self." | searcher | searcher := RBParseTreeSearcher new. searcher matches: '^``@object' do: [:aNode :hasAReturn | hasAReturn ifTrue: [^true]. true]. searcher executeTree: inlineParseTree initialAnswer: inlineParseTree lastIsReturn not. ^false! ! !InlineMethodRefactoring methodsFor: 'initialize-release' stamp: ''! inline: anInterval inMethod: aSelector forClass: aClass sourceSelector := aSelector. class := self classObjectFor: aClass. sourceInterval := anInterval! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! inlineClass ^inlineClass isNil ifTrue: [inlineClass := (sourceMessage receiver name = 'super' ifTrue: [class superclass] ifFalse: [class]) whoDefinesMethod: self inlineSelector] ifFalse: [inlineClass]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! inlineSelector sourceMessage isNil ifTrue: [self findSelectedMessage]. ^sourceMessage selector! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! inlineSourceReplacing: aParseTree | statements nodeUnderSequence | statements := inlineParseTree body statements. (statements size > 1 and: [aParseTree isEvaluatedFirst not]) ifTrue: [self refactoringWarning: 'To inline this method, we need to move some of its statements before the original message send.This could change the order of execution, which can change the behavior.Do you want to proceed?' expandMacros]. nodeUnderSequence := aParseTree. [nodeUnderSequence parent isSequence] whileFalse: [nodeUnderSequence := nodeUnderSequence parent]. (nodeUnderSequence parent) addNodes: (statements copyFrom: 1 to: (statements size - 1 max: 0)) before: nodeUnderSequence; addTemporariesNamed: inlineParseTree body temporaryNames. aParseTree parent replaceNode: aParseTree withNode: (statements isEmpty ifTrue: [RBVariableNode named: 'self'] ifFalse: [statements last])! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! insertInlinedMethod | node | node := sourceMessage. self moveComments. node parent isCascade ifTrue: [self rewriteCascadedMessage. node := node parent]. node parent isReturn ifTrue: [node := node parent] ifFalse: [self removeReturns]. self replaceArguments. self inlineSourceReplacing: node. sourceParseTree removeDeadCode. self removeEmptyIfTrues. self removeImmediateBlocks! ! !InlineMethodRefactoring methodsFor: 'testing' stamp: ''! isOverridden ^(class allSubclasses detect: [:each | each directlyDefinesMethod: self inlineSelector] ifNone: [nil]) notNil! ! !InlineMethodRefactoring methodsFor: 'testing' stamp: ''! isPrimitive ^inlineParseTree isPrimitive! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! moveComments inlineParseTree nodesDo: [:each | each comments: (each comments collect: [:anInterval | | start stop source | source := sourceParseTree source. start := source size + 1. source := source , (inlineParseTree source copyFrom: anInterval first to: anInterval last). stop := source size. sourceParseTree source: source. start to: stop])]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! normalizeIfTrues | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2' with: '| `@temps | ``@.s1. ``@boolean ifTrue: [| `@t1 | ``@.Stmts1. ^`@r1] ifFalse: [``@.s2. ^``@r2]'; replace: '| `@temps | ``@.s1. ``@boolean ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]. ``@.s2. ^``@r2' with: '| `@temps | ``@.s1. ``@boolean ifTrue: [``@.s2. ^``@r2] ifFalse: [| `@t1 | ``@.Stmts1. ^`@r1]'. [rewriter executeTree: inlineParseTree] whileTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! normalizeReturns | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '``@boolean ifTrue: [| `@t1 | `@.Stmts1. ^``@r1] ifFalse: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifTrue: [| `@t1 | `@.Stmts1. ``@r1] ifFalse: [| `@t2 | `@.Stmts2. ``@r2]'; replace: '``@boolean ifFalse: [| `@t1 | `@.Stmts1. ^``@r1] ifTrue: [| `@t2 | `@.Stmts2. ^``@r2]' with: '^``@boolean ifFalse: [| `@t1 | `@.Stmts1. ``@r1] ifTrue: [| `@t2 | `@.Stmts2. ``@r2]'. [rewriter executeTree: inlineParseTree] whileTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! parseInlineMethod self inlineClass isNil ifTrue: [self refactoringError: ('<1p> or its superclasses don''t contain method <2s>' expandMacrosWith: class with: self inlineSelector)]. inlineParseTree := self inlineClass parseTreeFor: self inlineSelector. inlineParseTree isNil ifTrue: [self refactoringError: 'Could not parse sources']. inlineParseTree lastIsReturn ifFalse: [inlineParseTree addSelfReturn]! ! !InlineMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: sourceSelector in: class) & (RBCondition withBlock: [self findSelectedMessage. self isOverridden ifTrue: [self refactoringWarning: ('<1p>>><2s> is overriden. Do you want to inline it anyway?' expandMacrosWith: self inlineClass with: self inlineSelector)]. self parseInlineMethod. self isPrimitive ifTrue: [self refactoringError: 'Cannot inline primitives']. self checkSuperMessages. self rewriteInlinedTree. (sourceMessage parent isReturn or: [self hasMultipleReturns not]) ifFalse: [self refactoringError: 'Cannot inline method since it contains multiple returns that cannot be rewritten']. true])! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! removeEmptyIfTrues | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '``@boolean ifTrue: [] ifFalse: [| `@temps | ``@.Stmts]' with: '``@boolean ifFalse: [|`@temps | ``@.Stmts]'; replace: '``@boolean ifFalse: [] ifTrue: [| `@temps | ``@.Stmts]' with: '``@boolean ifTrue: [|`@temps | ``@.Stmts]'; replace: '``@boolean ifTrue: [| `@temps | ``@.Stmts] ifFalse: []' with: '``@boolean ifTrue: [|`@temps | ``@.Stmts]'; replace: '``@boolean ifFalse: [| `@temps | ``@.Stmts] ifTrue: []' with: '``@boolean ifFalse: [|`@temps | ``@.Stmts]'. (rewriter executeTree: sourceParseTree) ifTrue: [sourceParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! removeImmediateBlocks | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '[``.object] value' with: '``.object' when: [:aNode | aNode parent isCascade not]. rewriter replace: '| `@temps | ``@.Stmts1. [| `@bTemps | ``@.bStmts] value. ``@.Stmts2' with: '| `@temps `@bTemps | ``@.Stmts1. ``@.bStmts. ``@.Stmts2'. (rewriter executeTree: sourceParseTree) ifTrue: [sourceParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! removeReturns | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: '^``@object' with: '``@object'. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! renameConflictingTemporaries inlineParseTree allDefinedVariables do: [:each | self renameConflictingTemporary: each]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! renameConflictingTemporary: aName | allNames newName index seqNode | allNames := (Set new) addAll: inlineParseTree allDefinedVariables; yourself. allNames remove: aName ifAbsent: []. seqNode := sourceMessage. [seqNode isSequence] whileFalse: [seqNode := seqNode parent]. allNames addAll: seqNode allDefinedVariables. "Add those variables defined in blocks. This might cause a few variables to be renamed that don't need to be, but this should be safe." newName := aName. index := 0. [(sourceMessage whoDefines: newName) notNil or: [(class hierarchyDefinesVariable: newName) or: [allNames includes: newName]]] whileTrue: [index := index + 1. newName := aName , index printString]. newName = aName ifFalse: [self renameTemporary: aName to: newName]. ^newName! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameTemporary: oldName to: newName | rewriter | rewriter := RBParseTreeRewriter new. rewriter replace: oldName with: newName; replaceArgument: oldName with: newName. (rewriter executeTree: inlineParseTree) ifTrue: [inlineParseTree := rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceArgument: sourceNode with: replacementNode | rewriter | rewriter := RBParseTreeRewriter new. rewriter replaceTree: sourceNode withTree: replacementNode. (rewriter executeTree: inlineParseTree body) ifTrue: [inlineParseTree body: rewriter tree]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:01'! replaceArguments sourceMessage arguments reverse with: inlineParseTree arguments reverse do: [:replacement :source | (replacement isImmediate or: [self shouldInlineExpression: replacement newSource]) ifTrue: [self replaceArgument: source with: replacement] ifFalse: [self addTemporary: source assignedTo: replacement]]! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! rewriteCascadedMessage | index messages | messages := sourceMessage parent messages. index := (1 to: messages size) detect: [:i | sourceMessage == (messages at: i)] ifNone: [0]. inlineParseTree body addNodesFirst: (messages copyFrom: 1 to: index - 1). self removeReturns. inlineParseTree body addNodes: (messages copyFrom: index + 1 to: messages size). inlineParseTree addReturn! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! rewriteInlinedTree sourceMessage parent isReturn ifTrue: [(sourceParseTree isLast: sourceMessage parent) ifFalse: [self addSelfReturn]] ifFalse: [self writeGuardClauses; normalizeIfTrues; normalizeReturns; addSelfReturn]! ! !InlineMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' inline: '. sourceInterval storeOn: aStream. aStream nextPutAll: ' inMethod: #'; nextPutAll: sourceSelector; nextPutAll: ' forClass: '. class storeOn: aStream. aStream nextPut: $)! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: ''! transform self renameConflictingTemporaries; insertInlinedMethod; compileMethod! ! !InlineMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! writeGuardClauses | rewriter | rewriter := RBParseTreeRewriter new. rewriter replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^`@r2]'; replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2. ^`@r2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^`@r2] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]'; replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [| `@t1 | `@.Stmts1. ^`@r1] ifFalse: [`@.s2. ^self]'; replaceMethod: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]. `@.s2' with: '`@methodName: `@args | `@temps | `@.s1. `@boolean ifTrue: [`@.s2. ^self] ifFalse: [| `@t1 | `@.Stmts1. ^`@r1]'. [rewriter executeTree: inlineParseTree] whileTrue: [inlineParseTree := rewriter tree]! ! MethodRefactoring subclass: #InlineTemporaryRefactoring instanceVariableNames: 'sourceInterval selector sourceTree assignmentNode definingNode' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !InlineTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! inline: anInterval from: aSelector in: aClass ^self new inline: anInterval from: aSelector in: aClass! ! !InlineTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk inline: anInterval from: aSelector in: aClass ^(self new) model: aRBSmalltalk; inline: anInterval from: aSelector in: aClass; yourself! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''! compileMethod class compileTree: sourceTree! ! !InlineTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! hasOnlyOneAssignment | searcher | searcher := RBParseTreeSearcher new. searcher matches: assignmentNode variable name , ' := ``@object' do: [:aNode :answer | answer + 1]. ^(searcher executeTree: definingNode initialAnswer: 0) == 1! ! !InlineTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''! inline: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. sourceInterval := anInterval! ! !InlineTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [self verifySelectedInterval. true])! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''! replaceAssignment assignmentNode parent isSequence ifTrue: [assignmentNode parent removeNode: assignmentNode] ifFalse: [assignmentNode replaceWith: assignmentNode value]! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceReferences | rewriter | rewriter := RBParseTreeRewriter new. rewriter replaceTree: assignmentNode variable withTree: assignmentNode value. definingNode removeTemporaryNamed: assignmentNode variable name. rewriter executeTree: definingNode! ! !InlineTemporaryRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' inline: '. sourceInterval storeOn: aStream. aStream nextPutAll: ' from: #'; nextPutAll: selector; nextPutAll: ' in: '. class storeOn: aStream. aStream nextPut: $)! ! !InlineTemporaryRefactoring methodsFor: 'transforming' stamp: ''! transform self replaceAssignment; replaceReferences; compileMethod! ! !InlineTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! verifySelectedInterval sourceTree := class parseTreeFor: selector. sourceTree isNil ifTrue: [self refactoringError: 'Could not parse source']. assignmentNode := sourceTree whichNodeIsContainedBy: sourceInterval. assignmentNode isAssignment ifFalse: [self refactoringError: 'The selected node is not an assignment statement']. definingNode := assignmentNode whoDefines: assignmentNode variable name. self hasOnlyOneAssignment ifFalse: [self refactoringError: 'There are multiple assignments to the variable']. (RBReadBeforeWrittenTester isVariable: assignmentNode variable name writtenBeforeReadIn: definingNode) ifFalse: [self refactoringError: 'The variable is possible read before it is assigned']! ! !MethodRefactoring methodsFor: 'private' stamp: ''! buildSelectorString: aSelector aSelector numArgs = 0 ifTrue: [^aSelector]. ^self buildSelectorString: aSelector withPermuteMap: (1 to: aSelector numArgs)! ! !MethodRefactoring methodsFor: 'private' stamp: ''! buildSelectorString: aSelector withPermuteMap: anIntegerCollection | stream keywords | aSelector numArgs == 0 ifTrue: [^aSelector asString]. stream := WriteStream on: String new. keywords := aSelector keywords. keywords with: anIntegerCollection do: [:each :i | stream nextPutAll: each; nextPutAll: ' ``@arg'; nextPutAll: i printString; nextPut: $ ]. ^stream contents! ! MethodRefactoring subclass: #MoveMethodRefactoring instanceVariableNames: 'selector variable moveToClasses parseTree hasOnlySelfReturns selfVariableName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !MoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk selector: aSymbol class: aClass variable: aVariableName ^(self new) model: aRBSmalltalk; selector: aSymbol class: aClass variable: aVariableName; yourself! ! !MoveMethodRefactoring class methodsFor: 'instance creation' stamp: ''! selector: aSymbol class: aClass variable: aVariableName ^(self new) selector: aSymbol class: aClass variable: aVariableName; yourself! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! abstractVariables self performComponentRefactoring: self abstractVariablesRefactoring. parseTree := self abstractVariablesRefactoring parseTree! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! abstractVariablesRefactoring ^AbstractVariablesRefactoring model: self model abstractVariablesIn: parseTree from: class toAll: moveToClasses ignoring: variable! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! addSelfReturn self hasOnlySelfReturns ifTrue: [^self]. parseTree addSelfReturn! ! !MoveMethodRefactoring methodsFor: 'private' stamp: ''! buildParseTree parseTree := (class parseTreeFor: selector) copy. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'! checkAssignmentsToVariable | searcher | searcher := RBParseTreeSearcher new. searcher matches: variable , ' := `@object' do: [:aNode :answer | true]. (searcher executeTree: parseTree initialAnswer: false) ifTrue: [self refactoringError: ('Cannot move the method into <1s> since it is assigned' expandMacrosWith: variable)]! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkForPrimitiveMethod parseTree isPrimitive ifTrue: [self refactoringError: 'Cannot move primitive methods']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 11/2/2009 00:14'! checkForSuperReferences | searcher | searcher := RBParseTreeSearcher new. searcher matches: 'super `@message: `@args' do: [:aNode :answer | true]. (searcher executeTree: parseTree initialAnswer: false) ifTrue: [self refactoringError: 'Cannot move the method since it has a super message send.']! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! checkTemporaryVariableNames | varNames | varNames := parseTree allDefinedVariables. selfVariableName notNil ifTrue: [varNames add: selfVariableName]. varNames do: [:name | moveToClasses do: [:each | (self canReferenceVariable: name in: each) ifTrue: [self refactoringError: ('<1p> already defines a variable called <2s>' expandMacrosWith: each with: name)]]]! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! compileDelagatorMethod | statementNode delegatorNode tree | delegatorNode := RBMessageNode receiver: (RBVariableNode named: variable) selectorParts: parseTree selectorParts arguments: (parseTree argumentNames collect: [:each | RBVariableNode named: (each = selfVariableName ifTrue: ['self'] ifFalse: [each])]). self hasOnlySelfReturns ifFalse: [delegatorNode := RBReturnNode value: delegatorNode]. statementNode := RBSequenceNode temporaries: #() statements: (Array with: delegatorNode). (tree := class parseTreeFor: selector) body: statementNode. class compileTree: tree! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:05'! compileNewMethods moveToClasses do: [:each | each compile: parseTree newSource withAttributesFrom: (class methodFor: selector)]! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! getArgumentNameForSelf self needsToReplaceSelfReferences ifFalse: [^self]. [selfVariableName := self requestSelfArgumentName. (self checkInstanceVariableName: selfVariableName in: class) ifTrue: [self verifyTemporaryVariableDoesNotOverride ifFalse: [self refactoringWarning: 'The variable is already defined in one of the classes you''re moving the method to.Try another?' expandMacros. selfVariableName := nil]] ifFalse: [self refactoringWarning: 'The variable name is not a valid Smalltalk temporary variable nameTry again?' expandMacros. selfVariableName := nil]. selfVariableName isNil] whileTrue: []! ! !MoveMethodRefactoring methodsFor: 'private-accessing' stamp: ''! getClassForGlobalOrClassVariable | definingClass type | definingClass := class whoDefinesClassVariable: variable. definingClass isNil ifTrue: [type := self model classNamed: variable. type isNil ifTrue: [type := self model classNamed: #Object]] ifFalse: [type := definingClass typeOfClassVariable: variable]. moveToClasses := self selectVariableTypesFrom: (Array with: type) selected: (Array with: type). moveToClasses isNil ifTrue: [self refactoringError: 'Method not moved']! ! !MoveMethodRefactoring methodsFor: 'private-accessing' stamp: ''! 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: 'lr 11/23/2009 11:03'! getNewMethodName "rr 3/16/2004 15:12 : changed the code to really remove the variable which the extracted selector is moved to, as in the new location it is now the self pseudo-argument. The previous version was only removing it from the arguments, which was causing a bug." | newSelector parameters alreadyDefined methodName newMethodName | self removeArgument. parameters := parseTree argumentNames asOrderedCollection. "parameters remove: variable ifAbsent: []." self needsToReplaceSelfReferences ifTrue: [parameters add: selfVariableName]. methodName := RBMethodName selector: (self uniqueMethodNameFor: parameters size) arguments: parameters. [newMethodName := self requestMethodNameFor: methodName. newMethodName isNil ifTrue: [self refactoringError: 'Did not move method']. newMethodName isValid ifTrue: [newSelector := newMethodName selector] ifFalse: [self refactoringWarning: 'Invalid method name']. parameters := newMethodName arguments. (self checkMethodName: newSelector in: class) ifFalse: [self refactoringWarning: newSelector , ' is not a valid selector name.'. newSelector := nil]. alreadyDefined := moveToClasses detect: [:each | each hierarchyDefinesMethod: newSelector] ifNone: [nil]. alreadyDefined notNil ifTrue: [self refactoringWarning: ('<1s> is already defined by <2p> or a super/subclassTry another?' expandMacrosWith: newSelector with: alreadyDefined). newSelector := nil]. newSelector isNil] whileTrue: []. parseTree renameSelector: newSelector andArguments: (parameters collect: [:each | RBVariableNode named: each]) asArray! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! hasOnlySelfReturns ^hasOnlySelfReturns isNil ifTrue: [| searcher | searcher := RBParseTreeSearcher new. searcher matches: '^self' do: [:aNode :answer | answer]; matches: '^`@object' do: [:aNode :answer | false]. hasOnlySelfReturns := searcher executeTree: parseTree initialAnswer: true] ifFalse: [hasOnlySelfReturns]! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! hasSelfReferences | searcher | searcher := RBParseTreeSearcher new. searcher matches: 'self' do: [:aNode :answer | true]. self hasOnlySelfReturns ifTrue: [searcher matches: '^self' do: [:aNode :answer | answer]]. ^searcher executeTree: parseTree initialAnswer: false! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: ''! isMovingToArgument ^(parseTree arguments collect: [:each | each name]) includes: variable! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: ''! isMovingToInstVar ^self isMovingToArgument not and: [(class whoDefinesInstanceVariable: variable) notNil]! ! !MoveMethodRefactoring methodsFor: 'testing' stamp: ''! needsToReplaceSelfReferences ^self hasSelfReferences or: [self abstractVariablesRefactoring hasVariablesToAbstract]! ! !MoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [self buildParseTree. self checkForPrimitiveMethod. self checkForSuperReferences. self checkAssignmentsToVariable. self getClassesToMoveTo. self getArgumentNameForSelf. self checkTemporaryVariableNames. self getNewMethodName. true])! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'rr 3/16/2004 15:15'! removeArgument "Removes the excess argument if any. This argument is the variable which is referenced by self in the classes the method is moved to. " | removeIndex | removeIndex := parseTree argumentNames indexOf: variable. removeIndex = 0 ifFalse: [parseTree arguments: ((parseTree arguments asOrderedCollection) removeAt: removeIndex; yourself) asArray. parseTree selectorParts: ((parseTree selectorParts asOrderedCollection) removeAt: removeIndex; yourself) asArray].! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceSelfReferences | replacer | self needsToReplaceSelfReferences ifTrue: [ replacer := RBParseTreeRewriter new. replacer replace: 'self' with: selfVariableName. self hasOnlySelfReturns ifTrue: [replacer replace: '^self' with: '^self']. replacer executeTree: parseTree. parseTree := replacer tree].! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! replaceVariableReferences | replacer | replacer := RBParseTreeRewriter new. replacer replace: variable with: 'self'. replacer executeTree: parseTree. parseTree := replacer tree! ! !MoveMethodRefactoring methodsFor: 'initialize-release' stamp: ''! selector: aSymbol class: aClass variable: aVariableName selector := aSymbol. class := self classObjectFor: aClass. variable := aVariableName! ! !MoveMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector; nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' variable: '''; nextPutAll: variable; nextPutAll: ''')'! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: ''! transform self abstractVariables; addSelfReturn; replaceSelfReferences; replaceVariableReferences; compileNewMethods; compileDelagatorMethod! ! !MoveMethodRefactoring methodsFor: 'transforming' stamp: 'lr 1/3/2010 11:48'! verifyTemporaryVariableDoesNotOverride (parseTree allDefinedVariables includes: selfVariableName) ifTrue: [ ^ false ]. ^ moveToClasses noneSatisfy: [ :each | each definesVariable: selfVariableName ]! ! MethodRefactoring subclass: #MoveVariableDefinitionRefactoring instanceVariableNames: 'selector interval name parseTree blockNodes definingNode' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !MoveVariableDefinitionRefactoring class methodsFor: 'instance creation' stamp: ''! bindTight: anInterval in: aClass selector: aSelector ^self new class: aClass selector: aSelector interval: anInterval! ! !MoveVariableDefinitionRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk bindTight: anInterval in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; class: aClass selector: aSelector interval: anInterval; yourself! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''! checkNodes: sequenceNodes (sequenceNodes detect: [:each | RBReadBeforeWrittenTester isVariable: name readBeforeWrittenIn: each] ifNone: [nil]) notNil ifTrue: [^false]. sequenceNodes do: [:each | (self usesDirectly: each body) ifTrue: [blockNodes add: each] ifFalse: [(self checkNodes: (self subblocksIn: each body)) ifFalse: [blockNodes add: each]]]. ^true! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''! checkParseTree | node | blockNodes := OrderedCollection new. node := self whichVariableNode: parseTree inInterval: interval name: name. node isNil ifTrue: [self refactoringError: 'Unable to locate node in parse tree']. definingNode := node whoDefines: name. definingNode isNil ifTrue: [self refactoringError: 'Cannot locate variable definition']. definingNode isSequence ifFalse: [self refactoringError: 'Variable is an argument']. (self usesDirectly: definingNode) ifTrue: [self refactoringError: 'Variable already bound tightly as possible']. (self checkNodes: (self subblocksIn: definingNode)) ifFalse: [self refactoringError: 'Variable is possibly read before written']! ! !MoveVariableDefinitionRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass selector: aSelector interval: anInterval interval := anInterval. class := self classObjectFor: aClass. selector := aSelector! ! !MoveVariableDefinitionRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [| methodSource | interval first <= interval last ifFalse: [self refactoringError: 'Invalid variable name']. methodSource := class sourceCodeFor: selector. methodSource size >= interval last ifFalse: [self refactoringError: 'Invalid range for variable']. name := methodSource copyFrom: interval first to: interval last. (self checkInstanceVariableName: name in: class) ifFalse: [self refactoringError: name , ' does not seem to be a valid variable name.']. parseTree := class parseTreeFor: selector. self checkParseTree. true])! ! !MoveVariableDefinitionRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' bindTight: '. interval storeOn: aStream. aStream nextPutAll: ' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector. aStream nextPut: $)! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! subblocksIn: aParseTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '[:`@blockTemps | | `@temps | `@.Statements]' do: [:aNode :answer | (aNode references: name) ifTrue: [answer add: aNode]. answer]. ^searcher executeTree: aParseTree initialAnswer: OrderedCollection new! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: ''! transform definingNode removeTemporaryNamed: name. blockNodes do: [:each | each body addTemporaryNamed: name]. class compileTree: parseTree! ! !MoveVariableDefinitionRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! usesDirectly: aParseTree | searcher | searcher := RBParseTreeSearcher new. searcher matches: '[:`@args | | `@temps | `@.Statements]' do: [:aNode :answer | answer]; matches: name do: [:aNode :answer | true]. ^searcher executeTree: aParseTree initialAnswer: false! ! MethodRefactoring subclass: #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: 'lr 10/26/2009 22:08'! checkClassVarsFor: aSelector class theNonMetaClass classVariableNames do: [ :each | ((class whichSelectorsReferToClassVariable: each) includes: aSelector) ifTrue: [ self refactoringError: ('<1p> refers to <2s> which is defined in <3p>' expandMacrosWith: aSelector with: each with: class) ] ]! ! !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: 'lr 11/2/2009 00:14'! justSendsSuper: aSelector | matcher parseTree superclass | matcher := RBParseTreeSearcher justSendsSuper. parseTree := class parseTreeFor: aSelector. (matcher executeTree: parseTree initialAnswer: false) ifFalse: [^false]. parseTree lastIsReturn ifTrue: [^true]. superclass := class superclass whichClassIncludesSelector: aSelector. superclass isNil ifTrue: [^true]. "Since there isn't a superclass that implements the message, we can delete it since it would be an error anyway." parseTree := superclass parseTreeFor: aSelector. matcher := RBParseTreeSearcher new. matcher matches: '^``@object' do: [:aNode :answer | answer add: aNode value; yourself]. matcher executeTree: parseTree initialAnswer: Set new. ^(matcher answer detect: [:each | (each isVariable and: [each name = 'self']) not] ifNone: [nil]) isNil! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(selectors inject: RBCondition empty into: [:cond :each | cond & (RBCondition definesSelector: each in: class)]) & (RBCondition withBlock: [self checkSuperMethods. true])! ! !RemoveMethodRefactoring methodsFor: 'initialize-release' stamp: ''! removeMethods: selectorCollection from: aClass class := self classObjectFor: aClass. selectors := selectorCollection! ! !RemoveMethodRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' removeMethods: '. selectors asArray storeOn: aStream. aStream nextPutAll: ' from: '. class storeOn: aStream. aStream nextPut: $)! ! !RemoveMethodRefactoring methodsFor: 'preconditions' stamp: ''! superclassEquivalentlyDefines: aSelector | superTree myTree | class superclass isNil ifTrue: [^false]. superTree := class superclass parseTreeFor: aSelector. myTree := class parseTreeFor: aSelector. (superTree isNil or: [myTree isNil]) ifTrue: [^false]. ^superTree equalTo: myTree exceptForVariables: #()! ! !RemoveMethodRefactoring methodsFor: 'transforming' stamp: ''! transform selectors do: [:each | class removeMethod: each]! ! MethodRefactoring subclass: #RenameTemporaryRefactoring instanceVariableNames: 'selector interval oldName newName parseTree' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk renameTemporaryFrom: anInterval to: newName in: aClass selector: aSelector ^(self new) model: aRBSmalltalk; class: aClass selector: aSelector interval: anInterval newName: newName; yourself! ! !RenameTemporaryRefactoring class methodsFor: 'instance creation' stamp: ''! renameTemporaryFrom: anInterval to: newName in: aClass selector: aSelector ^self new class: aClass selector: aSelector interval: anInterval newName: newName! ! !RenameTemporaryRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass selector: aSelector interval: anInterval newName: aString class := self classObjectFor: aClass. selector := aSelector. interval := anInterval. newName := aString! ! !RenameTemporaryRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition isValidInstanceVariableName: newName for: class) & (RBCondition definesInstanceVariable: newName in: class) not & (RBCondition definesClassVariable: newName in: class) not & (RBCondition withBlock: [| methodSource | interval first > interval last ifTrue: [self refactoringError: 'Invalid variable name']. methodSource := class sourceCodeFor: selector. methodSource size >= interval last ifFalse: [self refactoringError: 'Invalid range for variable']. oldName := methodSource copyFrom: interval first to: interval last. true])! ! !RenameTemporaryRefactoring methodsFor: 'tranforming' stamp: 'lr 11/2/2009 00:14'! renameNode: aParseTree (aParseTree whoDefines: newName) notNil ifTrue: [self refactoringError: newName , ' is already defined']. (aParseTree allDefinedVariables includes: newName) ifTrue: [self refactoringError: newName , ' is already defined']. (RBParseTreeRewriter rename: oldName to: newName) executeTree: aParseTree! ! !RenameTemporaryRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' renameTemporaryFrom: '. interval storeOn: aStream. aStream nextPutAll: ' to: '''; nextPutAll: newName; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector. aStream nextPut: $)! ! !RenameTemporaryRefactoring methodsFor: 'tranforming' stamp: ''! transform | definingNode variableNode | parseTree := class parseTreeFor: selector. variableNode := self whichVariableNode: parseTree inInterval: interval name: oldName. (variableNode isNil or: [variableNode isVariable not]) ifTrue: [self refactoringError: oldName , ' isn''t a valid variable']. variableNode name = oldName ifFalse: [self refactoringError: 'Invalid selection']. definingNode := variableNode whoDefines: oldName. definingNode isNil ifTrue: [self refactoringError: oldName , ' isn''t defined by the method']. self renameNode: definingNode. class compileTree: parseTree! ! MethodRefactoring subclass: #TemporaryToInstanceVariableRefactoring instanceVariableNames: 'selector temporaryVariableName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !TemporaryToInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! class: aClass selector: aSelector variable: aVariableName ^self new class: aClass selector: aSelector variable: aVariableName! ! !TemporaryToInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk class: aClass selector: aSelector variable: aVariableName ^(self new) model: aRBSmalltalk; class: aClass selector: aSelector variable: aVariableName; yourself! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! checkForValidTemporaryVariable | parseTree | parseTree := class parseTreeFor: selector. (parseTree allTemporaryVariables includes: temporaryVariableName) ifFalse: [self refactoringError: temporaryVariableName , ' isn''t a valid temporary variable name']. (parseTree allArgumentVariables includes: temporaryVariableName) ifTrue: [self refactoringError: temporaryVariableName , ' is a block parameter']. (RBReadBeforeWrittenTester isVariable: temporaryVariableName readBeforeWrittenIn: parseTree) ifTrue: [self refactoringWarning: ('<1s> is read before it is written.Proceed anyway?' expandMacrosWith: temporaryVariableName)]! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass selector: aSelector variable: aVariableName class := self classObjectFor: aClass. selector := aSelector. temporaryVariableName := aVariableName! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition definesSelector: selector in: class) & (RBCondition hierarchyOf: class definesVariable: temporaryVariableName asString) not & (RBCondition withBlock: [self checkForValidTemporaryVariable. true])! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' selector: #'; nextPutAll: selector; nextPutAll: ' variable: '''; nextPutAll: temporaryVariableName; nextPut: $'. aStream nextPut: $)! ! !TemporaryToInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! transform | parseTree matcher method | method := class methodFor: selector. parseTree := method parseTree. parseTree isNil ifTrue: [self refactoringError: 'Could not parse method']. class removeMethod: selector. class addInstanceVariable: temporaryVariableName. (matcher := RBParseTreeRewriter removeTemporaryNamed: temporaryVariableName) executeTree: parseTree. method compileTree: matcher tree! ! !Refactoring class methodsFor: 'initialization' stamp: 'lr 1/18/2010 21:02'! initialize self initializeRefactoringOptions! ! !Refactoring class methodsFor: 'initialization' stamp: 'lr 2/14/2009 11:20'! initializeRefactoringOptions RefactoringOptions := IdentityDictionary new. RefactoringOptions at: #implementorToInline put: [ :ref :imps | self error: #implementorToInline ]; at: #methodName put: [ :ref :methodName | self error: #methodName ]; at: #selfArgumentName put: [ :ref | self error: #selfArgumentName ]; at: #selectVariableToMoveTo put: [ :ref :class :selector | self error: #selectVariableToMoveTo ]; at: #variableTypes put: [ :ref :types :selected | self error: #variableTypes ]; at: #extractAssignment put: [ :ref :varName | self error: #extractAssignment ]; at: #inlineExpression put: [ :ref :string | self error: #inlineExpression ]; at: #alreadyDefined put: [ :ref :cls :selector | self error: #alreadyDefined ]; at: #useExistingMethod put: [ :ref :selector | self error: #useExistingMethod ]; at: #openBrowser put: [ :ref :env | self error: #openBrowser ]! ! !Refactoring class methodsFor: 'accessing signal' stamp: 'lr 1/4/2010 20:04'! preconditionSignal ^ RefactoringError , RefactoringWarning! ! !Refactoring class methodsFor: 'accessing' stamp: 'lr 1/18/2010 21:03'! refactoringOptions ^ RefactoringOptions! ! !Refactoring class methodsFor: 'accessing' stamp: ''! setDefaultOption: aSymbol to: aBlock self refactoringOptions at: aSymbol put: aBlock! ! !Refactoring methodsFor: 'utilities' stamp: ''! associationForClassVariable: aName in: aClass ifAbsent: aBlock ^aClass realClass classPool associationAt: aName asSymbol ifAbsent: [aClass realClass classPool associationAt: aName asString ifAbsent: aBlock]! ! !Refactoring methodsFor: 'testing' stamp: ''! canReferenceVariable: aString in: aClass (aClass definesVariable: aString) ifTrue: [^true]. (self model includesGlobal: aString asSymbol) ifTrue: [^true]. ^(self poolVariableNamesFor: aClass) includes: aString! ! !Refactoring methodsFor: 'accessing' stamp: ''! changes ^self model changes! ! !Refactoring methodsFor: 'support' stamp: ''! checkClass: aRBClass selector: aSelector using: aMatcher | parseTree | parseTree := aRBClass parseTreeFor: aSelector. parseTree notNil ifTrue: [aMatcher executeTree: parseTree]. ^aMatcher answer! ! !Refactoring methodsFor: 'utilities' stamp: ''! checkInstanceVariableName: aName in: aClass ^RBCondition checkInstanceVariableName: aName in: aClass! ! !Refactoring methodsFor: 'utilities' stamp: ''! checkMethodName: aName in: aClass ^RBCondition checkMethodName: aName in: aClass! ! !Refactoring methodsFor: 'preconditions' stamp: ''! checkPreconditions | conditions block | conditions := self preconditions. conditions check ifFalse: [block := conditions errorBlock. block notNil ifTrue: [self refactoringError: conditions errorString with: block] ifFalse: [self refactoringError: conditions errorString]]! ! !Refactoring methodsFor: 'private' stamp: 'dc 5/8/2007 12:05'! classObjectFor: anObject (anObject isBehavior or: [anObject isTrait]) ifTrue: [^self model classFor: anObject]. anObject isSymbol ifTrue: [^self model classNamed: anObject]. ^anObject! ! !Refactoring methodsFor: 'support' stamp: ''! convertAllReferencesTo: aSymbol using: searchReplacer self model allReferencesTo: aSymbol do: [:method | self convertMethod: method selector for: method modelClass using: searchReplacer]! ! !Refactoring methodsFor: 'support' stamp: ''! convertAllReferencesToClass: aRBClass using: searchReplacer self model allReferencesToClass: aRBClass do: [:method | self convertMethod: method selector for: method modelClass using: searchReplacer]! ! !Refactoring methodsFor: 'support' stamp: ''! convertClasses: classSet select: aBlock using: searchReplacer classSet do: [:aClass | (aBlock value: aClass) do: [:selector | self convertMethod: selector for: aClass using: searchReplacer]]! ! !Refactoring methodsFor: 'support' stamp: ''! convertMethod: selector for: aClass using: searchReplacer "Convert the parse tree for selector using the searchReplacer. If a change is made then compile it into the changeBuilder." | parseTree | parseTree := aClass parseTreeFor: selector. parseTree isNil ifTrue: [^self]. (searchReplacer executeTree: parseTree) ifTrue: [aClass compileTree: searchReplacer tree]! ! !Refactoring methodsFor: 'accessing' stamp: ''! copyOptionsFrom: aDictionary | dict | dict := self options. dict == self class refactoringOptions ifTrue: [^self options: aDictionary copy]. dict keysAndValuesDo: [:key :value | value == (self class refactoringOptions at: key) ifTrue: [dict at: key put: (aDictionary at: key)]]. self options: dict! ! !Refactoring methodsFor: 'transforming' stamp: ''! defaultEnvironment ^BrowserEnvironment new! ! !Refactoring methodsFor: 'transforming' stamp: ''! execute self primitiveExecute. RefactoringManager instance addRefactoring: self! ! !Refactoring methodsFor: 'transforming' stamp: ''! model ^model isNil ifTrue: [model := (RBNamespace onEnvironment: self defaultEnvironment) name: self printString; yourself] ifFalse: [model]! ! !Refactoring methodsFor: 'initialize-release' stamp: ''! model: aRBNamespace model := aRBNamespace! ! !Refactoring methodsFor: 'private' stamp: ''! onError: aBlock do: errorBlock ^aBlock on: self class preconditionSignal do: [:ex | errorBlock value. ex return: nil]! ! !Refactoring methodsFor: 'requests' stamp: ''! openBrowserOn: anEnvironment ^(self options at: #openBrowser) value: self value: anEnvironment! ! !Refactoring methodsFor: 'accessing' stamp: ''! options ^options isNil ifTrue: [self class refactoringOptions] ifFalse: [options]! ! !Refactoring methodsFor: 'accessing' stamp: ''! options: aDictionary options := aDictionary! ! !Refactoring methodsFor: 'transforming' stamp: ''! performComponentRefactoring: aRefactoring aRefactoring copyOptionsFrom: self options. aRefactoring primitiveExecute! ! !Refactoring methodsFor: 'utilities' stamp: ''! 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: 'lr 1/4/2010 20:06'! refactoringError: aString ^ RefactoringError signal: aString! ! !Refactoring methodsFor: 'private' stamp: 'lr 1/4/2010 20:06'! refactoringError: aString with: aBlock ^ RefactoringError signal: aString with: aBlock! ! !Refactoring methodsFor: 'private' stamp: 'lr 1/4/2010 20:06'! refactoringWarning: aString ^ RefactoringWarning signal: aString! ! !Refactoring methodsFor: 'private' stamp: 'lr 1/4/2010 20:06'! refactoringWarning: aString with: aBlock ^ RefactoringWarning signal: aString with: aBlock ! ! !Refactoring methodsFor: 'requests' stamp: ''! requestImplementorToInline: implementorsCollection ^(self options at: #implementorToInline) value: self value: implementorsCollection! ! !Refactoring methodsFor: 'requests' stamp: 'dvf 9/8/2001 19:32'! requestMethodNameFor: aMethodName ^(self options at: #methodName) value: self value: aMethodName! ! !Refactoring methodsFor: 'requests' stamp: ''! requestSelfArgumentName ^(self options at: #selfArgumentName) value: self! ! !Refactoring methodsFor: 'utilities' stamp: ''! safeMethodNameFor: aClass basedOn: aString "Creates an unused method name containing aString" | baseString newString hasParam i | baseString := aString copy. baseString at: 1 put: baseString first asLowercase. newString := baseString. hasParam := newString last = $:. hasParam ifTrue: [baseString := newString copyFrom: 1 to: newString size - 1]. i := 0. [aClass hierarchyDefinesMethod: newString asSymbol] whileTrue: [i := i + 1. newString := baseString , i printString , (hasParam ifTrue: [':'] ifFalse: [''])]. ^newString asSymbol! ! !Refactoring methodsFor: 'private' stamp: 'lr 1/4/2010 20:10'! safeVariableNameFor: aClass temporaries: allTempVars basedOn: aString | baseString i newString | newString := baseString := aString. i := 0. [ (allTempVars includes: newString) or: [ aClass definesInstanceVariable: newString ] ] whileTrue: [ i := i + 1. newString := baseString , i printString ]. ^ newString! ! !Refactoring methodsFor: 'requests' stamp: ''! selectVariableToMoveMethodTo: aSelector class: aClass ^(self options at: #selectVariableToMoveTo) value: self value: aClass value: aSelector! ! !Refactoring methodsFor: 'requests' stamp: 'lr 2/14/2009 11:23'! selectVariableTypesFrom: initialTypeCollection selected: selectedTypeCollection ^ (self options at: #variableTypes) value: self value: initialTypeCollection value: selectedTypeCollection ! ! !Refactoring methodsFor: 'accessing' stamp: ''! setOption: aSymbol toUse: aBlock | dict | dict := self options. dict == self class refactoringOptions ifTrue: [dict := dict copy]. dict at: aSymbol put: aBlock. self options: dict! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldExtractAssignmentTo: aString ^(self options at: #extractAssignment) value: self value: aString! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldInlineExpression: aString ^(self options at: #inlineExpression) value: self value: aString! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldOverride: aSelector in: aClass ^(self options at: #alreadyDefined) value: self value: aClass value: aSelector! ! !Refactoring methodsFor: 'requests' stamp: ''! shouldUseExistingMethod: aSelector ^(self options at: #useExistingMethod) value: self value: aSelector! ! !Refactoring methodsFor: 'transforming' stamp: ''! transform self subclassResponsibility! ! !Refactoring methodsFor: 'private' stamp: ''! uniqueMethodNameFor: anInteger | before after index name | before := 'a'. after := ''. anInteger timesRepeat: [after := after , 'z:']. index := 0. [name := before , index printString , after. (Symbol findInterned: name) notNil] whileTrue: [index := index + 1]. ^name asSymbol! ! !Refactoring methodsFor: 'utilities' stamp: 'lr 11/2/2009 00:14'! whichVariableNode: aParseTree inInterval: anInterval name: aName | matcher block | matcher := RBParseTreeSearcher new. block := [:aNode :answer | (aNode intersectsInterval: anInterval) ifTrue: [aNode] ifFalse: [answer]]. matcher matches: aName do: block; matchesArgument: aName do: block. ^matcher executeTree: aParseTree initialAnswer: nil! ! Refactoring subclass: #RemoveClassRefactoring instanceVariableNames: 'classNames' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveClassRefactoring class methodsFor: 'instance creation' stamp: ''! classNames: aClassNameCollection ^self new classNames: aClassNameCollection! ! !RemoveClassRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk classNames: aClassNameCollection ^(self new) model: aRBSmalltalk; classNames: aClassNameCollection; yourself! ! !RemoveClassRefactoring methodsFor: 'initialize-release' stamp: ''! classNames: aClassNameCollection classNames := aClassNameCollection! ! !RemoveClassRefactoring methodsFor: 'preconditions' stamp: ''! 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: 'lr 11/2/2009 00:14'! abstractReferenceTo: each | setterMethod replacer accessorRef getterMethod | accessorRef := CreateAccessorsForVariableRefactoring variable: each class: newClass classVariable: false. self performComponentRefactoring: accessorRef. getterMethod := accessorRef getterMethod. setterMethod := accessorRef setterMethod. replacer := RBParseTreeRewriter variable: each getter: getterMethod setter: setterMethod receiver: referenceVariableName. self convertClasses: class withAllSubclasses select: [:aClass | aClass whichSelectorsReferToInstanceVariable: each] using: replacer. self performComponentRefactoring: (RemoveInstanceVariableRefactoring remove: each from: class)! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! abstractVariableReferences instanceVariables do: [:each | self abstractReferenceTo: each]! ! !SplitClassRefactoring methodsFor: 'private-transforming' stamp: ''! addClass self performComponentRefactoring: (AddClassRefactoring model: self model addClass: newClassName superclass: Object subclasses: #() category: class category). newClass := self model classNamed: newClassName! ! !SplitClassRefactoring methodsFor: 'private-transforming' stamp: ''! addInstanceVariables instanceVariables do: [:each | self performComponentRefactoring: (AddInstanceVariableRefactoring model: self model variable: each class: newClass)]! ! !SplitClassRefactoring methodsFor: 'initialize-release' stamp: ''! class: aClass instanceVariables: instVars newClassName: className referenceVariableName: newVariable class := self model classFor: aClass. instanceVariables := instVars. newClassName := className. referenceVariableName := newVariable! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! createNewClass self addClass; addInstanceVariables! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! createReference self performComponentRefactoring: (AddInstanceVariableRefactoring variable: referenceVariableName class: class)! ! !SplitClassRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isValidClassName: newClassName) & (RBCondition isGlobal: newClassName in: self model) not & (RBCondition isValidInstanceVariableName: referenceVariableName for: class) & (RBCondition hierarchyOf: class definesVariable: referenceVariableName) not & (RBCondition isGlobal: referenceVariableName in: self model) not & (RBCondition definesTemporaryVariable: referenceVariableName in: class) not! ! !SplitClassRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' instanceVariables: '. instanceVariables asArray storeOn: aStream. aStream nextPutAll: ' newClassName: #'; nextPutAll: newClassName; nextPutAll: ' referenceVariableName: '''; nextPutAll: referenceVariableName; nextPutAll: ''')'! ! !SplitClassRefactoring methodsFor: 'transforming' stamp: ''! transform self createNewClass; createReference; abstractVariableReferences! ! Refactoring subclass: #VariableRefactoring instanceVariableNames: 'class variableName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! VariableRefactoring subclass: #AbstractClassVariableRefactoring instanceVariableNames: 'accessorsRefactoring' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractClassReferences | replacer | replacer := RBParseTreeRewriter variable: variableName getter: self accessorsRefactoring getterMethod setter: self accessorsRefactoring setterMethod. self convertClasses: class theMetaClass withAllSubclasses select: [ :aClass | (aClass whichSelectorsReferToClassVariable: variableName) reject: [ :each | aClass == class theMetaClass and: [ each == self accessorsRefactoring getterMethod or: [ each == self accessorsRefactoring setterMethod ] ] ] ] using: replacer! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: 'TestRunner 11/3/2009 09:40'! abstractInstanceReferences | replacer | replacer := RBParseTreeRewriter variable: variableName getter: 'class ' , self accessorsRefactoring getterMethod setter: 'class ' , self accessorsRefactoring setterMethod. self convertClasses: class withAllSubclasses select: [ :aClass | aClass whichSelectorsReferToClassVariable: variableName ] using: replacer! ! !AbstractClassVariableRefactoring methodsFor: 'private-accessing' stamp: ''! accessorsRefactoring ^accessorsRefactoring isNil ifTrue: [accessorsRefactoring := CreateAccessorsForVariableRefactoring model: self model variable: variableName asString class: class classVariable: true] ifFalse: [accessorsRefactoring]! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''! createAccessors self performComponentRefactoring: self accessorsRefactoring! ! !AbstractClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not & (RBCondition directlyDefinesClassVariable: variableName asSymbol in: class) & ((RBCondition withBlock: [(#(#Object #Behavior #ClassDescription #Class) includes: class name) not]) errorMacro: 'This refactoring does not work for Object, Behavior, ClassDescription, or Class')! ! !AbstractClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self createAccessors. self abstractInstanceReferences. self abstractClassReferences! ! VariableRefactoring subclass: #AbstractInstanceVariableRefactoring instanceVariableNames: 'accessorsRefactoring' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! abstractReferences | replacer | replacer := RBParseTreeRewriter variable: variableName getter: self accessorsRefactoring getterMethod setter: self accessorsRefactoring setterMethod. self convertClasses: class withAllSubclasses select: [:aClass | (aClass whichSelectorsReferToInstanceVariable: variableName) reject: [:each | aClass == class and: [each == self accessorsRefactoring getterMethod or: [each == self accessorsRefactoring setterMethod]]]] using: replacer! ! !AbstractInstanceVariableRefactoring methodsFor: 'private-accessing' stamp: ''! accessorsRefactoring ^accessorsRefactoring isNil ifTrue: [accessorsRefactoring := CreateAccessorsForVariableRefactoring model: self model variable: variableName class: class classVariable: false] ifFalse: [accessorsRefactoring]! ! !AbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! createAccessors self performComponentRefactoring: self accessorsRefactoring! ! !AbstractInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition directlyDefinesInstanceVariable: variableName in: class! ! !AbstractInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self createAccessors. self abstractReferences! ! VariableRefactoring subclass: #AddClassVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: variableName for: class) & (RBCondition hierarchyOf: class definesVariable: variableName asString) not & (RBCondition isGlobal: variableName in: self model) not! ! !AddClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class addClassVariable: variableName! ! VariableRefactoring subclass: #AddInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !AddInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isValidInstanceVariableName: variableName for: class) & (RBCondition hierarchyOf: class definesVariable: variableName) not & (RBCondition isGlobal: variableName in: self model) not! ! !AddInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class addInstanceVariable: variableName! ! VariableRefactoring subclass: #CreateAccessorsForVariableRefactoring instanceVariableNames: 'getterMethod setterMethod classVariable needsReturn' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !CreateAccessorsForVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk variable: aVarName class: aClass classVariable: aBoolean ^(self model: aRBSmalltalk variable: aVarName class: aClass) classVariable: aBoolean; yourself! ! !CreateAccessorsForVariableRefactoring class methodsFor: 'instance creation' stamp: ''! variable: aVarName class: aClass classVariable: aBoolean ^(self variable: aVarName class: aClass) classVariable: aBoolean; yourself! ! !CreateAccessorsForVariableRefactoring methodsFor: 'initialize-release' stamp: ''! classVariable: aBoolean classVariable := aBoolean! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''! createGetterAccessor getterMethod := self findGetterMethod. getterMethod isNil ifTrue: [getterMethod := self defineGetterMethod]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''! createSetterAccessor setterMethod := self findSetterMethod. setterMethod isNil ifTrue: [setterMethod := self defineSetterMethod]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: 'dc 4/4/2007 16:41'! defineGetterMethod | selector definingClass | definingClass := self definingClass. selector := self safeMethodNameFor: definingClass basedOn: variableName asString. definingClass compile: ('<1s>^ <2s>' expandMacrosWith: selector with: variableName) classified: #(#accessing). ^selector! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: 'dc 4/4/2007 16:41'! defineSetterMethod | selector definingClass string | definingClass := self definingClass. string := self needsReturnForSetter ifTrue: ['<1s> anObject^ <2s> := anObject'] ifFalse: ['<1s> anObject<2s> := anObject']. selector := self safeMethodNameFor: definingClass basedOn: variableName asString , ':'. definingClass compile: (string expandMacrosWith: selector with: variableName) classified: #accessing. ^selector! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 10/26/2009 22:09'! definingClass ^ classVariable ifTrue: [ class theMetaClass ] ifFalse: [ class ]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'! findGetterMethod | definingClass matcher | definingClass := self definingClass. matcher := RBParseTreeSearcher getterMethod: variableName. ^self possibleGetterSelectors detect: [:each | (self checkClass: definingClass selector: each using: matcher) notNil and: [(definingClass subclassRedefines: each) not]] ifNone: [nil]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'! findSetterMethod | definingClass matcher | definingClass := self definingClass. matcher := self needsReturnForSetter ifTrue: [RBParseTreeSearcher returnSetterMethod: variableName] ifFalse: [RBParseTreeSearcher setterMethod: variableName]. ^self possibleSetterSelectors detect: [:each | (self checkClass: definingClass selector: each using: matcher) notNil and: [(definingClass subclassRedefines: each) not]] ifNone: [nil]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! getterMethod ^getterMethod! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! methodsReferencingVariable ^classVariable ifTrue: [self definingClass whichSelectorsReferToClassVariable: variableName] ifFalse: [self definingClass whichSelectorsReferToInstanceVariable: variableName]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'testing' stamp: ''! needsReturnForSetter needsReturn isNil ifTrue: [needsReturn := self usesAssignmentOf: variableName in: class classVariable: classVariable]. ^needsReturn! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! possibleGetterSelectors ^self methodsReferencingVariable select: [:each | each numArgs == 0]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! possibleSetterSelectors ^self methodsReferencingVariable select: [:each | each numArgs == 1]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^classVariable ifTrue: [RBCondition definesClassVariable: variableName asSymbol in: class] ifFalse: [RBCondition definesInstanceVariable: variableName in: class]! ! !CreateAccessorsForVariableRefactoring methodsFor: 'private-accessing' stamp: ''! setterMethod ^setterMethod! ! !CreateAccessorsForVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' variable: '. variableName storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPutAll: ' classVariable: '. classVariable storeOn: aStream. aStream nextPut: $)! ! !CreateAccessorsForVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self createGetterAccessor; createSetterAccessor! ! !CreateAccessorsForVariableRefactoring methodsFor: 'testing' stamp: 'lr 11/2/2009 00:14'! usesAssignmentOf: aString in: aClass classVariable: isClassVar | matcher definingClass | matcher := RBParseTreeSearcher new. matcher answer: false; matches: aString , ' := ``@object' do: [ :aNode :answer | answer or: [ aNode isUsed ] ]. definingClass := isClassVar ifTrue: [ aClass theNonMetaClass ] ifFalse: [ aClass ]. ^ (definingClass withAllSubclasses , (isClassVar ifTrue: [ definingClass theMetaClass withAllSubclasses ] ifFalse: [ #() ]) detect: [ :each | ((isClassVar ifTrue: [ each whichSelectorsReferToClassVariable: aString ] ifFalse: [ each whichSelectorsReferToInstanceVariable: aString ]) detect: [ :sel | self checkClass: each selector: sel using: matcher ] ifNone: [ nil ]) notNil ] ifNone: [ nil ]) notNil! ! VariableRefactoring subclass: #ProtectInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !ProtectInstanceVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 11/2/2009 00:14'! getterSetterMethods | matcher | matcher := RBParseTreeSearcher new. matcher answer: Set new; matchesAnyMethodOf: (Array with: '`method ^' , variableName with: ('`method: `arg <1s> := `arg' expandMacrosWith: variableName) with: ('`method: `arg ^<1s> := `arg' expandMacrosWith: variableName)) do: [:aNode :answer | (class subclassRedefines: aNode selector) ifFalse: [answer add: aNode selector]. answer]. (class whichSelectorsReferToInstanceVariable: variableName) do: [:each | self checkClass: class selector: each using: matcher]. ^matcher answer! ! !ProtectInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! inline: aSelector self onError: [self performComponentRefactoring: (InlineAllSendersRefactoring model: self model sendersOf: aSelector in: class)] do: []! ! !ProtectInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition definesInstanceVariable: variableName in: class! ! !ProtectInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform self setOption: #inlineExpression toUse: [:ref :string | true]. self getterSetterMethods do: [:each | self inline: each]! ! VariableRefactoring subclass: #PullUpClassVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PullUpClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not! ! !PullUpClassVariableRefactoring methodsFor: 'private-accessing' stamp: 'lr 1/17/2010 14:39'! subclassDefiningVariable | subclasses | subclasses := class allSubclasses select: [ :each | each isMeta not and: [ each directlyDefinesClassVariable: variableName ] ]. subclasses isEmpty ifTrue: [ self refactoringError: 'Could not find a class defining ' , variableName ]. subclasses size > 1 ifTrue: [ self refactoringError: 'Multiple subclasses define ' , variableName ]. ^ subclasses asArray first! ! !PullUpClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform | subclass | subclass := self subclassDefiningVariable. subclass removeClassVariable: variableName. class addClassVariable: variableName! ! VariableRefactoring subclass: #PullUpInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PullUpInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^RBCondition withBlock: [(class hierarchyDefinesInstanceVariable: variableName) ifFalse: [self refactoringError: 'No subclass defines ' , variableName]. (class subclasses detect: [:each | (each directlyDefinesInstanceVariable: variableName) not] ifNone: [nil]) notNil ifTrue: [self refactoringWarning: 'Not all subclasses have an instance variable named ' , variableName , '.']. true]! ! !PullUpInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class allSubclasses do: [:each | (each directlyDefinesInstanceVariable: variableName) ifTrue: [each removeInstanceVariable: variableName]]. class addInstanceVariable: variableName! ! VariableRefactoring subclass: #PushDownClassVariableRefactoring instanceVariableNames: 'destinationClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: 'TestRunner 11/3/2009 09:28'! findDestinationClass | classes | classes := class withAllSubclasses reject: [ :each | (each whichSelectorsReferToClassVariable: variableName) isEmpty and: [ (each theMetaClass whichSelectorsReferToClassVariable: variableName) isEmpty ] ]. destinationClass := classes isEmpty ifTrue: [ nil ] ifFalse: [ classes asOrderedCollection first ]. classes do: [ :each | (destinationClass includesClass: each) ifTrue: [ destinationClass := each ] ifFalse: [ (each includesClass: destinationClass) ifFalse: [ self signalMultipleReferenceError ] ] ]. destinationClass = class ifTrue: [ self signalStillReferencedError ]. ^ destinationClass! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions "Preconditions are that only one subclass refers to the class variable." ^(RBCondition definesClassVariable: variableName in: class) & (RBCondition withBlock: [self findDestinationClass. true])! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! signalMultipleReferenceError self signalReferenceError: ('Multiple subclasses reference <1s>' expandMacrosWith: variableName)! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! signalReferenceError: errorString class realClass isNil ifTrue: [self refactoringError: errorString] ifFalse: [| classVarName error | error := '<1s>Browse references?' expandMacrosWith: errorString. classVarName := variableName asSymbol. self refactoringError: error with: [self openBrowserOn: (VariableEnvironment referencesToClassVariable: classVarName in: class realClass)]]! ! !PushDownClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! signalStillReferencedError self signalReferenceError: ('<1p> has references to <2s>' expandMacrosWith: class with: variableName)! ! !PushDownClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeClassVariable: variableName. destinationClass isNil ifTrue: [^self]. destinationClass addClassVariable: variableName! ! VariableRefactoring subclass: #PushDownInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !PushDownInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | references | references := RBCondition referencesInstanceVariable: variableName in: class. class realClass isNil ifTrue: [references errorMacro: ('<1s> is referenced.' expandMacrosWith: variableName)] ifFalse: [references errorMacro: ('<1s> is referenced.Browse references?' expandMacrosWith: variableName); errorBlock: [self openBrowserOn: (BrowserEnvironment new instVarRefsTo: variableName in: class realClass)]]. ^(RBCondition definesInstanceVariable: variableName in: class) & references not! ! !PushDownInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeInstanceVariable: variableName. class subclasses do: [:each | (each withAllSubclasses detect: [:aClass | (aClass whichSelectorsReferToInstanceVariable: variableName) isEmpty not] ifNone: [nil]) notNil ifTrue: [each addInstanceVariable: variableName]]! ! VariableRefactoring subclass: #RemoveClassVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveClassVariableRefactoring methodsFor: 'preconditions' stamp: 'lr 10/26/2009 22:09'! preconditions ^ (RBCondition isMetaclass: class) not & (RBCondition definesClassVariable: variableName in: class) & (RBCondition withBlock: [ | block | block := [ :each | (each whichSelectorsReferToClassVariable: variableName) isEmpty ifFalse: [ class realClass isNil ifTrue: [ self refactoringError: ('<1s> is referenced.' expandMacrosWith: variableName) ] ifFalse: [ self refactoringError: ('<1s> is referenced.Browse references?' expandMacrosWith: variableName) with: [ self openBrowserOn: (VariableEnvironment referencesToClassVariable: variableName in: class realClass) ] ] ] ]. class withAllSubclasses do: block. class theMetaClass withAllSubclasses do: block. true ])! ! !RemoveClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeClassVariable: variableName! ! VariableRefactoring subclass: #RemoveInstanceVariableRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RemoveInstanceVariableRefactoring class methodsFor: 'as yet unclassified' stamp: 'lr 1/20/2010 08:43'! model: aNamespace remove: variable from: class ^ self model: aNamespace variable: variable class: class! ! !RemoveInstanceVariableRefactoring class methodsFor: 'as yet unclassified' stamp: 'lr 1/20/2010 08:43'! remove: variable from: class ^ self variable: variable class: class! ! !RemoveInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions | references | references := RBCondition hierarchyOf: class referencesInstanceVariable: variableName. class realClass isNil ifTrue: [references errorMacro: ('<1s> is referenced.' expandMacrosWith: variableName)] ifFalse: [references errorMacro: ('<1s> is referenced.Browse references?' expandMacrosWith: variableName); errorBlock: [self openBrowserOn: (BrowserEnvironment new instVarRefsTo: variableName in: class realClass)]]. ^(RBCondition definesInstanceVariable: variableName asString in: class) & references not! ! !RemoveInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class removeInstanceVariable: variableName! ! VariableRefactoring subclass: #RenameClassVariableRefactoring instanceVariableNames: 'newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameClassVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk rename: aVarName to: aName in: aClass ^(self new) model: aRBSmalltalk; rename: aVarName to: aName in: aClass; yourself! ! !RenameClassVariableRefactoring class methodsFor: 'instance creation' stamp: ''! rename: aVarName to: aName in: aClass ^self new rename: aVarName to: aName in: aClass! ! !RenameClassVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isMetaclass: class) not & (RBCondition isValidClassVarName: newName asString for: class) & (RBCondition definesClassVariable: variableName asString in: class) & (RBCondition hierarchyOf: class definesVariable: newName asString) not & (RBCondition isGlobal: newName asString in: self model) not! ! !RenameClassVariableRefactoring methodsFor: 'initialize-release' stamp: ''! rename: aVarName to: aName in: aClass self variable: aVarName class: aClass. newName := aName! ! !RenameClassVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameReferences | replacer subclasses | replacer := RBParseTreeRewriter rename: variableName to: newName handler: [ self refactoringError: ('<1s> is already defined as a method or block temporary variable in this class or one of its subclasses' expandMacrosWith: newName) ]. subclasses := class withAllSubclasses asSet. subclasses addAll: class theMetaClass withAllSubclasses. self convertClasses: subclasses select: [ :aClass | aClass whichSelectorsReferToClassVariable: variableName ] using: replacer! ! !RenameClassVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' rename: '''; nextPutAll: variableName; nextPutAll: ''' to: '''; nextPutAll: newName; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPut: $)! ! !RenameClassVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class renameClassVariable: variableName to: newName around: [self renameReferences]! ! VariableRefactoring subclass: #RenameInstanceVariableRefactoring instanceVariableNames: 'newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk rename: aVarName to: aName in: aClass ^(self new) model: aRBSmalltalk; rename: aVarName to: aName in: aClass; yourself! ! !RenameInstanceVariableRefactoring class methodsFor: 'instance creation' stamp: ''! rename: aVarName to: aName in: aClass ^self new rename: aVarName to: aName in: aClass! ! !RenameInstanceVariableRefactoring methodsFor: 'preconditions' stamp: ''! preconditions ^(RBCondition isValidInstanceVariableName: newName for: class) & (RBCondition definesInstanceVariable: variableName in: class) & (RBCondition hierarchyOf: class definesVariable: newName) not & (RBCondition isGlobal: newName in: self model) not! ! !RenameInstanceVariableRefactoring methodsFor: 'initialize-release' stamp: ''! rename: aVarName to: aName in: aClass self variable: aVarName class: aClass. newName := aName! ! !RenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: 'lr 11/2/2009 00:14'! renameReferences | replacer | replacer := RBParseTreeRewriter rename: variableName to: newName handler: [self refactoringError: ('<1s> is already defined as a method or block temporary variable in this class or one of its subclasses' expandMacrosWith: newName)]. self convertClasses: class withAllSubclasses select: [:aClass | aClass whichSelectorsReferToInstanceVariable: variableName] using: replacer! ! !RenameInstanceVariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' rename: '''; nextPutAll: variableName; nextPutAll: ''' to: '''; nextPutAll: newName; nextPutAll: ''' in: '. class storeOn: aStream. aStream nextPut: $)! ! !RenameInstanceVariableRefactoring methodsFor: 'transforming' stamp: ''! transform class renameInstanceVariable: variableName to: newName around: [self renameReferences]! ! !VariableRefactoring class methodsFor: 'instance creation' stamp: ''! model: aRBSmalltalk variable: aVarName class: aClass ^(self new) model: aRBSmalltalk; variable: aVarName class: aClass; yourself! ! !VariableRefactoring class methodsFor: 'instance creation' stamp: ''! variable: aVarName class: aClass ^self new variable: aVarName class: aClass! ! !VariableRefactoring methodsFor: 'printing' stamp: ''! storeOn: aStream aStream nextPut: $(. self class storeOn: aStream. aStream nextPutAll: ' variable: '. variableName storeOn: aStream. aStream nextPutAll: ' class: '. class storeOn: aStream. aStream nextPut: $)! ! !VariableRefactoring methodsFor: 'initialize-release' stamp: ''! variable: aVarName class: aClass class := self classObjectFor: aClass. variableName := aVarName! ! Object subclass: #RefactoringManager instanceVariableNames: 'refactorings' classVariableNames: 'Instance' poolDictionaries: '' category: 'Refactoring-Core-Refactorings'! !RefactoringManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:31'! instance ^ Instance ifNil: [ Instance := self basicNew initialize ]! ! !RefactoringManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:31'! new ^ self shouldNotImplement! ! !RefactoringManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:32'! nuke Instance notNil ifTrue: [ Instance release ]. Instance := nil! ! !RefactoringManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:32'! unload self nuke! ! !RefactoringManager methodsFor: 'public access' stamp: ''! addRefactoring: aRefactoring RefactoryChangeManager instance performChange: aRefactoring changes. refactorings add: aRefactoring class name! ! !RefactoringManager methodsFor: 'initialize-release' stamp: ''! initialize refactorings := Bag new! ! !RefactoringManager methodsFor: 'printing' stamp: ''! printOn: aStream aStream nextPutAll: '# Refactoring'; cr; nextPutAll: '--- -----------------------------------------------'; cr. refactorings asSet asSortedCollection do: [:name | aStream nextPutAll: (refactorings occurrencesOf: name) printString; nextPutAll: ' '; nextPutAll: name; cr]! ! Object subclass: #RefactoryChange instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! RefactoryChange subclass: #CompositeRefactoryChange instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !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: 'lr 7/1/2008 10:54'! comment: aString in: aClass ^ self addChange: (CommentChange comment: aString in: aClass)! ! !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: '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-Changes'! !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-Changes'! RenameVariableChange subclass: #RenameClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !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-Changes'! !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: '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: 'accessing' stamp: ''! name ^name isNil ifTrue: [self changeString] ifFalse: [name]! ! !RefactoryChange methodsFor: 'initialize-release' stamp: ''! name: aString name := aString! ! !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-Changes'! RefactoryClassChange subclass: #AddClassChange instanceVariableNames: 'definition superclassName instanceVariableNames classVariableNames poolDictionaryNames category' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !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: 'lr 4/7/2010 08:22'! 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-Changes'! !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-Changes'! !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: 'lr 4/7/2010 08:22'! 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: 'lr 3/4/2010 22:14'! printOn: aStream aStream nextPut: $!!; nextPutAll: self displayClassName; nextPutAll: ' methodsFor: '''; nextPutAll: self protocol; "Breaks in Pharo 1.1: 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 methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:25'! source ^ source! ! AddMethodChange subclass: #InteractiveAddMethodChange instanceVariableNames: 'controller definedSelector' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !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 subclass: #CommentChange instanceVariableNames: 'comment' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !CommentChange class methodsFor: 'instance creation' stamp: 'lr 7/1/2008 10:50'! comment: aString in: aClass ^ self new changeClass: aClass; comment: aString; yourself! ! !CommentChange methodsFor: 'converting' stamp: 'lr 7/1/2008 10:43'! asUndoOperation ^ self copy comment: self changeClass comment; yourself! ! !CommentChange methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:44'! changeClass: aBehavior super changeClass: aBehavior. isMeta := false! ! !CommentChange methodsFor: 'printing' stamp: 'lr 7/1/2008 10:48'! changeString ^ 'Comment ' , self displayClassName! ! !CommentChange methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:41'! comment ^ comment! ! !CommentChange methodsFor: 'accessing' stamp: 'lr 7/1/2008 10:41'! comment: aString comment := aString! ! !CommentChange methodsFor: 'private' stamp: 'lr 2/14/2009 11:13'! primitiveExecute self changeClass comment: comment. SystemChangeNotifier uniqueInstance classCommented: self changeClass! ! !CommentChange methodsFor: 'printing' stamp: 'lr 7/1/2008 10:47'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' comment: '; print: (self comment copyReplaceAll: '!!' with: '!!!!'); nextPutAll: '!!'! ! !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: 'lr 10/31/2009 17:37'! changeClass: aBehavior isMeta := aBehavior isMeta. className := aBehavior theNonMetaClass 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-Changes'! RefactoryVariableChange subclass: #AddClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !AddClassVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^RemoveClassVariableChange remove: variable from: self changeClass! ! !AddClassVariableChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:20'! changeString ^ 'Add class variable <1s> to <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-Changes'! !AddInstanceVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^RemoveInstanceVariableChange remove: variable from: self changeClass! ! !AddInstanceVariableChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:20'! changeString ^ 'Add instance variable <1s> to <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-Changes'! !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: 'lr 4/7/2010 08:19'! changeString ^ 'Add pool variable <1s> to <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: 'lr 2/14/2009 11:12'! primitiveExecute | oldClass changeSymbol | oldClass := self changeClass copy. changeSymbol := self changeSymbol. self changeClass perform: changeSymbol with: self changeObject. SystemChangeNotifier uniqueInstance classDefinitionChangedFrom: oldClass to: self changeClass! ! !RefactoryVariableChange methodsFor: 'private' stamp: ''! variable ^variable! ! RefactoryVariableChange subclass: #RemoveClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Changes'! !RemoveClassVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddClassVariableChange add: variable to: self changeClass! ! !RemoveClassVariableChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:20'! changeString ^ 'Remove class variable <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-Changes'! !RemoveInstanceVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddInstanceVariableChange add: variable to: self changeClass! ! !RemoveInstanceVariableChange methodsFor: 'printing' stamp: 'lr 4/7/2010 08:20'! changeString ^ 'Remove instance variable <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-Changes'! !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: 'lr 4/7/2010 08:20'! changeString ^ 'Remove pool variable <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-Changes'! !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: 'lr 4/7/2010 08:20'! changeString ^ 'Remove ' , 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-Changes'! !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: 'lr 4/7/2010 08:21'! changeString ^ 'Remove <1s>>>#<2s>' expandMacrosWith: self displayClassName with: selector! ! !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-Changes'! !RefactoryChangeManager class methodsFor: 'class initialization' stamp: 'lr 4/4/2010 08:32'! initialize self nuke. UndoSize := 20! ! !RefactoryChangeManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:35'! instance ^ Instance ifNil: [ Instance := self basicNew initialize ]! ! !RefactoryChangeManager class methodsFor: 'instance creation' stamp: 'lr 4/4/2010 08:33'! new ^ self shouldNotImplement! ! !RefactoryChangeManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:34'! nuke Instance notNil ifTrue: [ Instance release ]. Instance := nil! ! !RefactoryChangeManager class methodsFor: 'settings' stamp: 'LukasRenggli 12/18/2009 10:42'! settingsOn: aBuilder (aBuilder setting: #undoSize) target: self; label: 'Undo size'; parentName: #refactoring! ! !RefactoryChangeManager class methodsFor: 'class initialization' stamp: 'lr 4/4/2010 08:33'! undoSize ^ UndoSize! ! !RefactoryChangeManager class methodsFor: 'class initialization' stamp: ''! undoSize: anInteger UndoSize := anInteger max: 0! ! !RefactoryChangeManager class methodsFor: 'public' stamp: 'lr 4/4/2010 08:34'! unload self nuke! ! !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: 'lr 3/13/2009 17:32'! connectToChanges SystemChangeNotifier uniqueInstance notify: self ofAllSystemChangesUsing: #update:! ! !RefactoryChangeManager methodsFor: 'initialize-release' stamp: 'lr 3/13/2009 17:29'! disconnectFromChanges SystemChangeNotifier uniqueInstance noMoreNotificationsFor: 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: 'lr 3/13/2009 17:35'! update: anEvent (isPerformingRefactoring or: [ anEvent isDoIt or: [ anEvent isCommented or: [ anEvent isRecategorized ] ] ]) ifFalse: [ self clearUndoRedoList ]! ! !RefactoryChangeManager methodsFor: 'updating' stamp: 'lr 3/13/2009 18:11'! update: anAspectSymbol with: aParameter from: aSender "To be removed, just kept for compatiblity in case this method is still called while loading." ChangeSet removeDependent: self! ! Object subclass: #RefactoryTyper instanceVariableNames: 'model class variableTypes bestGuesses variableMessages 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: 'lr 11/2/2009 00:14'! typesFor: variableName in: aParseTree model: aRBSmalltalk | searcher messages | searcher := RBParseTreeSearcher new. searcher matches: variableName , ' `@message: ``@args' do: [:aNode :answer | answer add: aNode selector; yourself]. messages := searcher executeTree: aParseTree initialAnswer: Set new. ^(self new) model: aRBSmalltalk; findTypeFor: messages! ! !RefactoryTyper methodsFor: 'private' stamp: 'lr 8/10/2009 16:36'! backpointersDictionary "Create a special dictionary, because the host systems wrongly treats #abc and 'abc' as equal." ^ PluggableDictionary new equalBlock: [ :a :b | a class == b class and: [ a = b ] ]; hashBlock: [ :a | a class identityHash bitXor: a hash ]; yourself! ! !RefactoryTyper methodsFor: 'private' stamp: 'lr 8/10/2009 16:37'! backpointersSetWith: anObject "Create a special set, because the host systems wrongly treats #abc and 'abc' as equal." ^ PluggableSet new equalBlock: [ :a :b | a class == b class and: [ a = b ] ]; hashBlock: [ :a | a class identityHash bitXor: a hash ]; add: anObject; yourself! ! !RefactoryTyper methodsFor: 'printing' stamp: ''! collectionNameFor: aString ^'-<1s>-' expandMacrosWith: aString! ! !RefactoryTyper methodsFor: 'equivalence classes' stamp: 'lr 11/2/2009 00:14'! computeEquivalenceClassesForMethodsAndVars | searcher | backpointers := self backpointersDictionary. class instanceVariableNames do: [:each | backpointers at: each put: (self backpointersSetWith: each)]. class withAllSubclasses do: [:sub | sub selectors do: [:each | backpointers at: each put: (self backpointersSetWith: each)]]. searcher := RBParseTreeSearcher new. searcher matches: '^``@object' do: [:aNode :answer | self processNode: aNode value]. self executeSearch: searcher! ! !RefactoryTyper methodsFor: 'selectors' stamp: 'lr 11/19/2009 11:45'! computeMessagesSentToVariables | searcher | variableMessages := Dictionary new. class instanceVariableNames do: [:each | variableMessages at: each put: Set new]. searcher := RBParseTreeSearcher new. class instanceVariableNames do: [:each | | block | block := [:aNode :answer | (variableMessages at: each ifAbsentPut: [Set new]) add: aNode selector. self processCollectionMessagesFor: each in: aNode]. searcher matches: each , ' `@messageName: ``@args' do: block. (backpointers at: each) do: [:sel | sel isSymbol ifTrue: [searcher matches: ('(self <1s>) `@messageName: ``@args' expandMacrosWith: (RBParseTreeSearcher buildSelectorString: sel)) asString do: block]]]. searcher answer: variableMessages. self executeSearch: searcher! ! !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: 'lr 11/2/2009 23:38'! 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: ProtoObject) 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: 'lr 8/10/2009 15:27'! merge: aName "rr 3/15/2004 14:05 add: the ifAbsent: keyword in the last line, as I encountered a failing case" | set1 set2 | set1 := backpointers at: methodName ifAbsent: [nil]. set2 := backpointers at: aName ifAbsent: [nil]. (set1 isNil or: [set2 isNil or: [set1 == set2]]) ifTrue: [^self]. set1 addAll: set2. set2 do: [:each | backpointers at: each put: set1]! ! !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: 'lr 11/2/2009 00:14'! processCollectionFor: key messagesTo: aName in: aBlock | searcher | searcher := RBParseTreeSearcher new. searcher matches: aName , ' `@message: ``@args' do: [:aNode :answer | self processCollectionMessagesFor: key in: aNode. answer add: aNode selector; yourself]. searcher executeTree: aBlock initialAnswer: (variableMessages at: (self collectionNameFor: key) ifAbsentPut: [Set new])! ! !RefactoryTyper methodsFor: 'selectors-collections' stamp: 'lr 11/2/2009 23:38'! 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 11/2/2009 23:38'! refineTypesByLookingAtAssignments | searcher needsSearch | needsSearch := false. searcher := RBParseTreeSearcher new. variableTypes keysAndValuesDo: [:key :value | (key first = $-) ifFalse: [needsSearch := true. searcher matches: key , ' := ``@object' do: [:aNode :answer | self guessTypeFromAssignment: aNode]]]. needsSearch ifTrue: [self executeSearch: searcher]! ! !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: 'lr 1/21/2010 23:43'! run rule resetResult. environment classesDo: [ :class | class isTrait ifFalse: [ self checkClass: class. self checkMethodsForClass: class ] ]! ! 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: 'lr 2/5/2010 15:50'! addLiteralsFor: aCompiledMethod 2 to: aCompiledMethod numLiterals - 1 do: [ :index | self checkLiteral: (aCompiledMethod objectAt: index) ]! ! !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: 'lr 11/2/2009 00:14'! computeMessages | searcher | selfMessages := Set new. superMessages := Set new. messages := Set new. searcher := RBParseTreeSearcher 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: 'printing' stamp: 'lr 3/28/2009 14:39'! printOn: aStream super printOn: aStream. self selectedClass isNil ifFalse: [ aStream nextPut: $ ; nextPutAll: self selectedClass name. self selector isNil ifFalse: [ aStream nextPutAll: '>>'; print: self selector ] ]! ! !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! ! Exception subclass: #RefactoringWarning instanceVariableNames: 'parameter' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Core-Support'! !RefactoringWarning class methodsFor: 'signalling' stamp: 'lr 1/4/2010 19:51'! signal: aString with: anObject ^ self new parameter: anObject; signal: aString! ! !RefactoringWarning methodsFor: 'actions' stamp: 'lr 1/4/2010 20:05'! defaultAction ^ nil! ! !RefactoringWarning methodsFor: 'testing' stamp: 'lr 1/4/2010 20:05'! isResumable ^ true! ! !RefactoringWarning methodsFor: 'accessing' stamp: 'lr 1/4/2010 20:05'! parameter ^ parameter ! ! !RefactoringWarning methodsFor: 'accessing' stamp: 'lr 1/4/2010 20:05'! parameter: anObject parameter := anObject! ! !Trait methodsFor: '*refactoring-core' stamp: 'md 3/14/2006 16:44'! includesBehavior: aClass ^false! ! !ClassDescription methodsFor: '*refactoring-core-deprecated' stamp: 'lr 10/31/2009 17:30'! metaclass self deprecated: 'Use aClass>>#theMetaClass instead'. ^ self theMetaClass! ! !ClassDescription methodsFor: '*refactoring-core-deprecated' stamp: 'lr 10/31/2009 17:31'! nonMetaclass self deprecated: 'Use aClass>>#theNonMetaClass instead'. ^ self theNonMetaClass! ! !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: 'lr 1/4/2010 19:50'! signal: aString with: anObject ^ self new parameter: anObject; signal: aString! ! !RefactoringError methodsFor: 'accessing' stamp: 'lr 2/14/2009 10:57'! parameter ^ parameter ! ! !RefactoringError methodsFor: 'accessing' stamp: 'lr 2/14/2009 10:57'! parameter: anObject parameter := anObject! ! RBAbstractClass initialize! RBClass initialize! RBTransformationRule initialize! Refactoring initialize! RefactoryChangeManager initialize!