SystemOrganization addCategory: #'Refactoring-Changes'! Object subclass: #RefactoryChange instanceVariableNames: 'name' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! RefactoryChange subclass: #CompositeRefactoryChange instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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: 'lr 9/5/2010 19:33'! addClassVariable: variableName to: aClass ^ self addChange: (AddClassVariableChange add: variableName to: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:37'! addInstanceVariable: variableName to: aClass ^ self addChange: (AddInstanceVariableChange add: variableName to: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:37'! addPool: aPoolVariable to: aClass ^ self addChange: (AddPoolVariableChange add: aPoolVariable to: aClass)! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'! changeForClass: aClassName selector: aSelector changes reverseDo: [ :each | | change | change := each changeForClass: aClassName selector: aSelector. change notNil ifTrue: [ ^ change ] ]. ^ nil! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:30'! changeForMetaclass: aClassName selector: aSelector changes reverseDo: [ :each | | change | change := each changeForMetaclass: aClassName 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: 'lr 9/5/2010 19:40'! compile: source in: class ^ self addChange: (AddMethodChange compile: source in: class)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:40'! compile: source in: class classified: aProtocol ^ self addChange: (AddMethodChange compile: source in: class classified: aProtocol)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:37'! defineClass: aString ^ self addChange: (AddClassChange definition: aString)! ! !CompositeRefactoryChange methodsFor: 'private' stamp: 'lr 5/9/2010 11:31'! executeNotifying: aBlock | undos undo | undos := changes collect: [ :each | each executeNotifying: aBlock ]. undo := self copy. undo changes: undos reversed. ^ undo! ! !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: 'lr 9/5/2010 19:33'! removeClass: aClass ^ self addChange: (RemoveClassChange removeClassName: aClass name)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:33'! removeClassNamed: aSymbol ^ self addChange: (RemoveClassChange removeClassName: aSymbol)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:37'! removeClassVariable: variableName from: aClass ^ self addChange: (RemoveClassVariableChange remove: variableName from: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:37'! removeInstanceVariable: variableName from: aClass ^ self addChange: (RemoveInstanceVariableChange remove: variableName from: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:42'! removeMethod: aSelector from: aClass ^ self addChange: (RemoveMethodChange remove: aSelector from: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 19:38'! removePool: aPoolVariable from: aClass ^ self addChange: (RemovePoolVariableChange remove: aPoolVariable 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: 'lr 9/5/2010 19:43'! renameClass: class to: newName ^ self addChange: (RenameClassChange rename: class name to: newName)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 20:03'! renameClassVariable: oldName to: newName in: aClass ^ self addChange: (RenameClassVariableChange rename: oldName to: newName in: aClass)! ! !CompositeRefactoryChange methodsFor: 'refactory-changes' stamp: 'lr 9/5/2010 20:04'! renameInstanceVariable: oldName to: newName in: aClass ^ self addChange: (RenameInstanceVariableChange rename: oldName to: newName in: aClass)! ! CompositeRefactoryChange subclass: #RenameClassChange instanceVariableNames: 'oldName newName' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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: 'lr 7/23/2010 08:05'! changeClass ^Smalltalk at: oldName asSymbol ifAbsent: [Smalltalk globals 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: 'comparing' stamp: 'lr 5/18/2010 20:56'! hash ^ (self class hash bitXor: self oldName hash) bitXor: self newName hash! ! !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-Changes'! RenameVariableChange subclass: #RenameClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !RenameClassVariableChange methodsFor: 'private' stamp: 'lr 5/18/2010 20:39'! addNewVariable (AddClassVariableChange add: newName to: self changeClass) execute! ! !RenameClassVariableChange methodsFor: 'private' stamp: 'lr 5/18/2010 20:40'! copyOldValuesToNewVariable | oldValue | oldValue := self changeClass classPool at: oldName ifAbsent: [ ]. self changeClass classPool at: newName asSymbol put: oldValue! ! !RenameClassVariableChange methodsFor: 'printing' stamp: 'lr 5/18/2010 20:37'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeClassVarName: '; print: self oldName; nextPut: $!!; cr. aStream nextPutAll: self displayClassName; nextPutAll: ' addClassVarName: '; print: self newName; nextPut: $!!! ! !RenameClassVariableChange methodsFor: 'private' stamp: 'lr 5/18/2010 20:40'! removeOldVariable (RemoveClassVariableChange remove: oldName from: self changeClass) execute! ! RenameVariableChange subclass: #RenameInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !RenameInstanceVariableChange methodsFor: 'private' stamp: 'lr 5/18/2010 20:39'! 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 5/18/2010 20:39'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' removeInstVarName: '; print: self oldName; nextPut: $!!; cr. aStream nextPutAll: self displayClassName; nextPutAll: ' addInstVarName: '; 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: 'lr 7/23/2010 08:05'! changeClass | class | class := Smalltalk globals 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: 'lr 9/6/2010 11:29'! changeForClass: aClassName selector: aSelector ^ nil! ! !RefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'! changeForMetaclass: aClassName 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: '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-Changes'! RefactoryClassChange subclass: #AddClassChange instanceVariableNames: 'definition superclassName instanceVariableNames classVariableNames poolDictionaryNames category' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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: 'lr 7/23/2010 08:04'! asUndoOperation | class | class := Smalltalk globals 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: 'lr 9/6/2010 13:29'! 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: 'lr 9/5/2010 19:09'! isValidMessageName: aMessageNode ^ #( subclass:instanceVariableNames:classVariableNames:poolDictionaries:category: variableByteSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: variableSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: variableWordSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: weakSubclass: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: 'lr 9/5/2010 19:24'! namesIn: aString | names scanner token | names := OrderedCollection new. scanner := RBScanner on: (ReadStream on: aString) errorBlock: [ :msg :pos | ^ names ]. [ scanner atEnd ] whileFalse: [ token := scanner next. token isIdentifier ifTrue: [ names add: token value ] ]. ^ 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: 'lr 9/6/2010 13:29'! 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-Changes'! !InteractiveAddClassChange class methodsFor: 'instance creation' stamp: ''! definition: aString for: aController ^(self definition: aString) controller: aController; yourself! ! !InteractiveAddClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:29'! controller ^ controller! ! !InteractiveAddClassChange methodsFor: 'private' stamp: ''! controller: aController controller := aController! ! !InteractiveAddClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 13:29'! definedClass ^ definedClass! ! !InteractiveAddClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:29'! primitiveExecute ^ definedClass := super primitiveExecute! ! RefactoryClassChange subclass: #AddMethodChange instanceVariableNames: 'source selector protocols' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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: 'lr 9/6/2010 11:28'! changeForClass: aClassName selector: aSelector ^ (isMeta not and: [ self selector = aSelector and: [ className = aClassName ] ]) ifTrue: [ self ] ifFalse: [ nil ]! ! !AddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 11:29'! changeForMetaclass: aClassName selector: aSelector ^ (isMeta and: [ self selector = aSelector and: [ className = aClassName ] ]) 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: 'lr 9/6/2010 13:29'! 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-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: 'lr 9/6/2010 13:29'! primitiveExecute ^ definedSelector := super primitiveExecute! ! RefactoryClassChange subclass: #CommentChange instanceVariableNames: 'comment' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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 9/6/2010 10:48'! asUndoOperation ^ self copy comment: self changeClass organization classComment; 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 9/6/2010 10:53'! primitiveExecute self changeClass classComment: comment stamp: Author changeStamp. SystemChangeNotifier uniqueInstance classCommented: self changeClass! ! !CommentChange methodsFor: 'printing' stamp: 'lr 9/6/2010 10:52'! printOn: aStream aStream nextPutAll: self displayClassName; nextPutAll: ' classComment: '; print: (self comment copyReplaceAll: '!!' with: '!!!!'); nextPutAll: ' stamp: '; print: (Author changeStamp); 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: 'lr 7/23/2010 08:04'! changeClass | class | class := Smalltalk globals 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: 'lr 9/6/2010 13:29'! 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-Changes'! RefactoryVariableChange subclass: #AddClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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: 'private' stamp: ''! variable ^variable asSymbol! ! RefactoryVariableChange subclass: #AddInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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:! ! RefactoryVariableChange subclass: #AddPoolVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddPoolVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^RemovePoolVariableChange remove: variable from: self changeClass! ! !AddPoolVariableChange methodsFor: 'private' stamp: 'lr 7/23/2010 08:05'! changeObject | dictionary | dictionary := variable isString ifTrue: [Smalltalk globals 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: 'lr 7/23/2010 08:05'! variable ^variable isString ifTrue: [variable] ifFalse: [Smalltalk globals 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: '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: 'printing' stamp: 'lr 5/18/2010 20:48'! printOn: aStream aStream nextPutAll: self displayClassName; nextPut: $ ; nextPutAll: self changeSymbol; nextPut: $ ; print: self variable; nextPut: $!!! ! !RefactoryVariableChange methodsFor: 'private' stamp: ''! variable ^variable! ! RefactoryVariableChange subclass: #RemoveClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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: 'lr 4/21/2010 15:10'! primitiveExecute [ [ super primitiveExecute ] on: InMidstOfFileinNotification do: [ :ex | ex resume: true ] ] on: Notification do: [ :ex | ex resume ]! ! !RemoveClassVariableChange methodsFor: 'private' stamp: ''! variable ^variable asSymbol! ! RefactoryVariableChange subclass: #RemoveInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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:! ! RefactoryVariableChange subclass: #RemovePoolVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !RemovePoolVariableChange methodsFor: 'converting' stamp: ''! asUndoOperation ^AddPoolVariableChange add: variable to: self changeClass! ! !RemovePoolVariableChange methodsFor: 'private' stamp: 'lr 7/23/2010 08:05'! changeObject | dictionary | dictionary := variable isString ifTrue: [Smalltalk globals 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: 'lr 7/23/2010 08:05'! variable ^variable isString ifTrue: [variable] ifFalse: [Smalltalk globals keyAtValue: variable ifAbsent: [self error: 'Cannot find value']]! ! RefactoryClassChange subclass: #RemoveClassChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-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-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-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! ! RefactoryChangeManager initialize!