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: 'lr 9/7/2010 19:43'! named: aString ^ self new name: aString; yourself! ! !CompositeRefactoryChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:27'! = aRefactoryBuilder self class = aRefactoryBuilder class ifFalse: [ ^ false ]. changes size = aRefactoryBuilder changes size ifFalse: [ ^ false ]. changes with: aRefactoryBuilder changes do: [ :first :second | first = second ifFalse: [ ^ false ] ]. ^ true! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:27'! addChange: aRefactoryChange changes add: 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: 'lr 9/6/2010 17:28'! changes ^ changes! ! !CompositeRefactoryChange methodsFor: 'private-inspector accessing' stamp: ''! changes: aCollection changes := aCollection! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:27'! 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: 'lr 9/6/2010 17:31'! hash ^ self class hash bitXor: self changes size hash! ! !CompositeRefactoryChange methodsFor: 'initialize-release' stamp: ''! initialize super initialize. changes := OrderedCollection new! ! !CompositeRefactoryChange methodsFor: 'copying' stamp: 'lr 9/6/2010 17:27'! postCopy super postCopy. changes := changes collect: [ :each | each copy ]! ! !CompositeRefactoryChange methodsFor: 'printing' stamp: 'lr 9/6/2010 17:28'! printOn: aStream name isNil ifTrue: [ ^ super printOn: aStream ]. aStream nextPutAll: name! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:27'! problemCount ^ self changesSize! ! !CompositeRefactoryChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:29'! removeChange: aChange ^ changes remove: aChange ifAbsent: [ nil ]! ! !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: 'lr 9/6/2010 13:56'! renameChangesForClass: oldClassName to: newClassName ^ self copy changes: (self changes collect: [ :each | each renameChangesForClass: oldClassName 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: 'lr 9/7/2010 19:43'! rename: oldString to: newString ^ self new rename: oldString to: newString; yourself! ! !RenameClassChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:33'! = aRenameClassChange super class = aRenameClassChange class ifFalse: [ ^ false ]. ^oldName = aRenameClassChange oldName and: [ newName = aRenameClassChange newName ]! ! !RenameClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:30'! changeClass ^ Smalltalk globals at: oldName asSymbol ifAbsent: [ Smalltalk globals at: newName asSymbol ]! ! !RenameClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 17:31'! 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: 'accessing' stamp: 'lr 9/6/2010 17:31'! newName ^ newName! ! !RenameClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:31'! 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: 'lr 9/6/2010 13:57'! renameChangesForClass: oldClassName to: newClassName | change | change := super renameChangesForClass: oldClassName to: newClassName. oldName asSymbol = oldClassName 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 9/6/2010 13:48'! copyOldValuesToNewVariable | oldValue | oldValue := self changeClass classPool at: oldName ifAbsent: [ nil ]. 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: 'lr 9/6/2010 13:48'! copyOldValuesToNewVariable | newIndex oldIndex | oldIndex := self changeClass allInstVarNames indexOf: oldName asString. newIndex := self changeClass allInstVarNames indexOf: newName asString. self changeClass withAllSubclasses do: [ :class | class allInstances do: [ :each | each instVarAt: newIndex put: (each 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: 'lr 9/7/2010 19:43'! rename: oldName to: newName in: aClass ^ self new oldName: oldName; newName: newName; changeClass: aClass; yourself! ! !RenameVariableChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:34'! = 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 9/6/2010 17:32'! changeClass | class | class := Smalltalk globals at: self changeClassName ifAbsent: [ ^ nil ]. ^ isMeta ifTrue: [ class class ] ifFalse: [ class ]! ! !RenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'! changeClass: aBehavior isMeta := aBehavior isMeta. className := isMeta ifTrue: [ aBehavior soleInstance name ] ifFalse: [ aBehavior name ]! ! !RenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'! changeClassName ^ className! ! !RenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'! changeClassName: aSymbol className := aSymbol. isMeta isNil ifTrue: [ isMeta := false ]! ! !RenameVariableChange methodsFor: 'printing' stamp: 'lr 9/6/2010 17:34'! changeString ^ 'Rename ' , oldName , ' to ' , newName! ! !RenameVariableChange methodsFor: 'private' stamp: ''! copyOldValuesToNewVariable self subclassResponsibility! ! !RenameVariableChange methodsFor: 'printing' stamp: 'lr 9/6/2010 21:17'! displayClassName ^ isMeta ifTrue: [ self changeClassName , ' class' ] ifFalse: [ self changeClassName asString ]! ! !RenameVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:46'! executeNotifying: aBlock | undo | self addNewVariable. self copyOldValuesToNewVariable. undo := super executeNotifying: aBlock. undo oldName: newName; newName: oldName. self removeOldVariable. ^ undo! ! !RenameVariableChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 17:33'! hash ^ (self class hash bitXor: self oldName hash) bitXor: self newName hash! ! !RenameVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 13:46'! isMeta ^ isMeta! ! !RenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'! newName ^ newName! ! !RenameVariableChange methodsFor: 'private' stamp: ''! newName: aString newName := aString! ! !RenameVariableChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 17:32'! oldName ^ oldName! ! !RenameVariableChange methodsFor: 'private' stamp: ''! oldName: aString oldName := aString! ! !RenameVariableChange methodsFor: 'printing' stamp: 'lr 9/6/2010 13:55'! 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: 'lr 9/6/2010 13:56'! renameChangesForClass: oldClassName 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: #AddMethodChange instanceVariableNames: 'source selector protocols' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'! compile: aString in: aClass ^ self new class: aClass source: aString! ! !AddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'! compile: aString in: aBehavior classified: aProtocol ^ self new class: aBehavior protocol: aProtocol source: aString! ! !AddMethodChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:24'! = anAddMethodChange super = anAddMethodChange ifFalse: [ ^ false ]. ^ self parseTree = anAddMethodChange parseTree! ! !AddMethodChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:25'! 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: 'lr 9/6/2010 21:25'! class: aClass source: aString self changeClass: aClass. source := aString. self protocols: (BrowserEnvironment new whichProtocolIncludes: self selector in: aClass)! ! !AddMethodChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:27'! controller ^ nil! ! !AddMethodChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:25'! hash ^ self parseTree hash! ! !AddMethodChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:27'! 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 9/6/2010 21:26'! printOn: aStream aStream nextPut: $!!; nextPutAll: self displayClassName; nextPutAll: ' methodsFor: '''; nextPutAll: self protocol; nextPutAll: ''' stamp: '; print: Author changeStamp; nextPut: $!!; cr; nextPutAll: (source copyReplaceAll: '!!' with: '!!!!'); nextPutAll: '!! !!'! ! !AddMethodChange methodsFor: 'accessing' stamp: 'lr 9/7/2010 19:10'! protocol ^ self protocols first! ! !AddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:24'! protocols ^ protocols! ! !AddMethodChange methodsFor: 'initialize-release' stamp: 'lr 9/7/2010 19:10'! protocols: aCollection protocols := aCollection isString ifTrue: [ Array with: aCollection ] ifFalse: [ aCollection ]. protocols isNil ifTrue: [ protocols := #(accessing) ]! ! !AddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:24'! 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: 'lr 9/7/2010 19:44'! compile: aString in: aBehavior classified: aProtocol for: aController ^ (self compile: aString in: aBehavior classified: aProtocol) controller: aController; yourself! ! !InteractiveAddMethodChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'! compile: aString in: aClass for: aController ^ (self compile: aString in: aClass) controller: aController; yourself! ! !InteractiveAddMethodChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:27'! controller ^ controller! ! !InteractiveAddMethodChange methodsFor: 'private' stamp: ''! controller: aController controller := aController! ! !InteractiveAddMethodChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:27'! 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: 'lr 9/6/2010 21:18'! = 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 9/6/2010 21:18'! 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: 'lr 9/6/2010 21:19'! changeClassName ^ className! ! !RefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:19'! changeClassName: aSymbol className := aSymbol. isMeta isNil ifTrue: [ isMeta := false ]! ! !RefactoryClassChange methodsFor: 'printing' stamp: 'lr 9/6/2010 21:19'! changeString ^ self displayClassName! ! !RefactoryClassChange methodsFor: 'printing' stamp: 'lr 9/6/2010 21:19'! displayClassName ^ isMeta ifTrue: [ self changeClassName , ' class' ] ifFalse: [ self changeClassName asString ]! ! !RefactoryClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:19'! executeNotifying: aBlock | undo | undo := self asUndoOperation. undo name: self name. self primitiveExecute. aBlock value. ^ undo! ! !RefactoryClassChange methodsFor: 'comparing' stamp: 'lr 9/6/2010 21:19'! hash ^ self changeClassName hash! ! !RefactoryClassChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:19'! isMeta ^ isMeta! ! !RefactoryClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:19'! methodSourceFor: aSymbol ^ (self changeClass includesSelector: aSymbol) ifTrue: [ 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: 'lr 9/6/2010 13:57'! renameChangesForClass: oldClassName to: newClassName ^ self changeClassName = oldClassName ifFalse: [ self ] ifTrue: [ self copy changeClassName: newClassName; yourself ]! ! RefactoryClassChange subclass: #RefactoryDefinitionChange instanceVariableNames: 'controller definition definedClass' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! RefactoryDefinitionChange subclass: #AddClassChange instanceVariableNames: 'superclassName instanceVariableNames classVariableNames poolDictionaryNames category' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddClassChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:20'! 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: 'lr 9/6/2010 21:20'! category category isNil ifTrue: [ self fillOutDefinition ]. ^ category! ! !AddClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:20'! classVariableNames classVariableNames isNil ifTrue: [ self fillOutDefinition ]. ^ classVariableNames! ! !AddClassChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:21'! definitionClass ^ Smalltalk globals at: self superclassName! ! !AddClassChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:57'! definitionPatterns ^ #('`superclassName subclass: `#className' '`superclassName subclass: `#className instanceVariableNames: `#instanceVariableNames' '`superclassName subclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category' '`superclassName variableByteSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category' '`superclassName variableSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category' '`superclassName variableWordSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category' '`superclassName weakSubclass: `#className instanceVariableNames: `#instanceVariableNames classVariableNames: `#classVariableNames poolDictionaries: `#poolDictionaries category: `#category')! ! !AddClassChange methodsFor: 'private' stamp: 'lr 9/30/2010 15:08'! fillOutDefinition: aDictionary superclassName := (aDictionary at: (RBPatternVariableNode named: '`superclassName') ifAbsent: [ ^ self parseDefinitionError ]) name asSymbol. className := (aDictionary at: (RBPatternVariableNode named: '`#className') ifAbsent: [ ^ self parseDefinitionError ]) value asSymbol. instanceVariableNames := self namesIn: (aDictionary at: (RBPatternVariableNode named: '`#instanceVariableNames') ifAbsent: [ RBLiteralNode value: String new ]) value. classVariableNames := self namesIn: (aDictionary at: (RBPatternVariableNode named: '`#classVariableNames') ifAbsent: [ RBLiteralNode value: String new ]) value. poolDictionaryNames := self namesIn: (aDictionary at: (RBPatternVariableNode named: '`#poolDictionaries') ifAbsent: [ RBLiteralNode value: String new ]) value. category := (aDictionary at: (RBPatternVariableNode named: '`#category') ifAbsent: [ RBLiteralNode value: #Unknown ]) value! ! !AddClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:21'! instanceVariableNames instanceVariableNames isNil ifTrue: [ self fillOutDefinition ]. ^ instanceVariableNames! ! !AddClassChange methodsFor: 'testing' stamp: 'lr 9/30/2010 14:22'! isValidMessageName: aMessageNode ^ self class classDefinitionMessages includes: aMessageNode selector! ! !AddClassChange methodsFor: 'testing' stamp: 'lr 9/6/2010 21:21'! 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/30/2010 14:16'! parseDefinitionError super parseDefinitionError. instanceVariableNames := #(). classVariableNames := #(). poolDictionaryNames := #()! ! !AddClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:22'! poolDictionaryNames poolDictionaryNames isNil ifTrue: [ self fillOutDefinition ]. ^ poolDictionaryNames! ! !AddClassChange methodsFor: 'accessing' stamp: 'lr 9/6/2010 21:23'! superclassName className isNil ifTrue: [ self fillOutDefinition ]. ^ superclassName! ! RefactoryDefinitionChange subclass: #AddMetaclassChange instanceVariableNames: 'classInstanceVariableNames' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddMetaclassChange methodsFor: 'converting' stamp: 'lr 9/30/2010 14:32'! asUndoOperation ^ self class definition: self changeClass class definition! ! !AddMetaclassChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:16'! classInstanceVariableNames classInstanceVariableNames isNil ifTrue: [ self fillOutDefinition ]. ^ classInstanceVariableNames! ! !AddMetaclassChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:21'! definitionClass ^ self changeClass! ! !AddMetaclassChange methodsFor: 'private' stamp: 'lr 9/30/2010 15:00'! definitionPatterns ^ #('`className class instanceVariableNames: `#instanceVariableNames')! ! !AddMetaclassChange methodsFor: 'private' stamp: 'lr 9/30/2010 15:11'! fillOutDefinition: aDictionary className := (aDictionary at: (RBPatternVariableNode named: '`className') ifAbsent: [ ^ self parseDefinitionError ]) name value asSymbol. classInstanceVariableNames := self namesIn: (aDictionary at: (RBPatternVariableNode named: '`#instanceVariableNames') ifAbsent: [ RBLiteralNode value: String new ]) value.! ! !AddMetaclassChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:16'! parseDefinitionError super parseDefinitionError. classInstanceVariableNames := #()! ! !RefactoryDefinitionChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 14:01'! definition: aString ^ self definition: aString for: nil! ! !RefactoryDefinitionChange class methodsFor: 'instance creation' stamp: 'lr 9/30/2010 14:40'! definition: aString for: aController (Array with: AddClassChange with: AddMetaclassChange) do: [ :class | | change | change := class new. change initializeDefinition: aString controller: aController. change changeClassName = change unknownClassName ifFalse: [ ^ change ] ]. ^ self error: 'Invalid definition string'! ! !RefactoryDefinitionChange methodsFor: 'comparing' stamp: 'lr 9/30/2010 14:07'! = aDefinitionChange ^ self class = aDefinitionChange class and: [ self definition = aDefinitionChange definition ]! ! !RefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:14'! changeClassName className isNil ifTrue: [ self fillOutDefinition ]. ^ className! ! !RefactoryDefinitionChange methodsFor: 'printing' stamp: 'lr 9/30/2010 14:12'! changeString ^ 'Define ' , self displayClassName! ! !RefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:13'! controller ^ controller! ! !RefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:09'! definedClass ^ definedClass! ! !RefactoryDefinitionChange methodsFor: 'accessing' stamp: 'lr 9/30/2010 14:08'! definition ^ definition! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:20'! definitionClass self subclassResponsibility! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:58'! definitionPatterns self subclassResponsibility! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:59'! fillOutDefinition | parseTree rewriter | parseTree := RBParser parseExpression: definition onError: [ :str :pos | ^ self parseDefinitionError ]. rewriter := RBParseTreeRewriter new. self definitionPatterns do: [ :each | rewriter replace: each withValueFrom: [ :node | ^ self fillOutDefinition: rewriter context ] ]. rewriter executeTree: parseTree. ^ self parseDefinitionError ! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:59'! fillOutDefinition: aContext self subclassResponsibility! ! !RefactoryDefinitionChange methodsFor: 'comparing' stamp: 'lr 9/30/2010 14:07'! hash ^ definition hash! ! !RefactoryDefinitionChange methodsFor: 'initialization' stamp: 'lr 9/30/2010 14:07'! initialize super initialize. isMeta := false! ! !RefactoryDefinitionChange methodsFor: 'initialization' stamp: 'lr 9/30/2010 14:06'! initializeDefinition: aString controller: aController definition := aString. controller := aController! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:04'! 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! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:37'! parseDefinitionError className := self unknownClassName! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:30'! primitiveExecute ^ definedClass := self definitionClass compilerClass evaluate: self definition notifying: self controller logged: true! ! !RefactoryDefinitionChange methodsFor: 'printing' stamp: 'lr 9/30/2010 14:12'! printOn: aStream aStream nextPutAll: definition; nextPut: $!!! ! !RefactoryDefinitionChange methodsFor: 'private' stamp: 'lr 9/30/2010 14:37'! unknownClassName ^ #'Unknown Class'! ! RefactoryClassChange subclass: #RefactoryVariableChange instanceVariableNames: 'variable' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! RefactoryVariableChange subclass: #AddClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddClassVariableChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:29'! 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: 'lr 9/6/2010 21:29'! changeSymbol ^ #addClassVarName:! ! !AddClassVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:29'! variable ^ variable asSymbol! ! RefactoryVariableChange subclass: #AddInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddInstanceVariableChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:29'! 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: 'lr 9/6/2010 21:29'! changeSymbol ^ #addInstVarName:! ! RefactoryVariableChange subclass: #AddPoolVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !AddPoolVariableChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:30'! asUndoOperation ^ RemovePoolVariableChange remove: variable from: self changeClass! ! !AddPoolVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:30'! 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: 'lr 9/6/2010 21:30'! changeSymbol ^ #addSharedPool:! ! !AddPoolVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:30'! variable ^ variable isString ifTrue: [ variable ] ifFalse: [ Smalltalk globals keyAtValue: variable ifAbsent: [ self error: 'Cannot find value' ] ]! ! !RefactoryVariableChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:44'! 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: 'lr 9/7/2010 19:44'! 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: 'lr 9/6/2010 21:27'! = aRefactoryVariableChange ^ super = aRefactoryVariableChange and: [ variable = aRefactoryVariableChange variable ]! ! !RefactoryVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:27'! 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: 'lr 9/6/2010 21:28'! hash ^ self changeClassName hash bitXor: variable hash! ! !RefactoryVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:29'! primitiveExecute | oldClass changeSymbol | oldClass := self changeClass copy. self changeClass perform: self 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: 'lr 9/6/2010 21:29'! variable ^ variable! ! RefactoryVariableChange subclass: #RemoveClassVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !RemoveClassVariableChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:30'! 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: 'lr 9/6/2010 21:30'! 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: 'lr 9/6/2010 21:30'! variable ^ variable asSymbol! ! RefactoryVariableChange subclass: #RemoveInstanceVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !RemoveInstanceVariableChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:30'! 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: 'lr 9/6/2010 21:31'! changeSymbol ^ #removeInstVarName:! ! RefactoryVariableChange subclass: #RemovePoolVariableChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Refactoring-Changes'! !RemovePoolVariableChange methodsFor: 'converting' stamp: 'lr 9/6/2010 21:31'! asUndoOperation ^ AddPoolVariableChange add: variable to: self changeClass! ! !RemovePoolVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:31'! 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: 'lr 9/6/2010 21:31'! changeSymbol ^ #removeSharedPool:! ! !RemovePoolVariableChange methodsFor: 'private' stamp: 'lr 9/6/2010 21:31'! 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: 'lr 9/7/2010 19:44'! remove: aClass ^ self new changeClass: aClass! ! !RemoveClassChange class methodsFor: 'instance creation' stamp: 'lr 9/7/2010 19:45'! removeClassName: aSymbol ^ self new changeClassName: aSymbol! ! !RemoveClassChange methodsFor: 'converting' stamp: 'lr 9/7/2010 19:07'! 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: 'lr 9/7/2010 19:45'! remove: aSymbol from: aClass ^ self new changeClass: aClass; selector: aSymbol; yourself! ! !RemoveMethodChange methodsFor: 'comparing' stamp: 'lr 9/7/2010 19:10'! = aRemoveMethodChange super = aRemoveMethodChange ifFalse: [ ^ false ]. ^ selector = aRemoveMethodChange selector! ! !RemoveMethodChange methodsFor: 'converting' stamp: 'lr 9/7/2010 19:10'! 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: 'lr 9/7/2010 19:11'! hash ^ selector hash! ! !RemoveMethodChange methodsFor: 'private' stamp: 'lr 9/7/2010 19:11'! 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: 'lr 9/7/2010 19:11'! selector ^ selector! ! !RemoveMethodChange methodsFor: 'initialize-release' stamp: 'lr 9/7/2010 19:11'! 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: 'lr 9/7/2010 19:11'! 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: 'lr 9/7/2010 19:11'! hasRedoableOperations ^ redo isEmpty not! ! !RefactoryChangeManager methodsFor: 'testing' stamp: 'lr 9/7/2010 19:11'! hasUndoableOperations ^ undo isEmpty not! ! !RefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:11'! 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: 'lr 9/7/2010 19:11'! performChange: aRefactoringChange self ignoreChangesWhile: [ self addUndo: aRefactoringChange execute ]! ! !RefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:11'! redoChange ^ redo last! ! !RefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:12'! 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: 'lr 9/7/2010 19:12'! undoChange ^ undo last! ! !RefactoryChangeManager methodsFor: 'public access' stamp: 'lr 9/7/2010 19:12'! 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 initialize!