SystemOrganization addCategory: #'OB-Refactory'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Browsers'! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 3/16/2007 18:47'! cmdClassRefactroings ^ OBClassRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 3/16/2007 18:47'! cmdClassVarRefactroings ^ OBClassVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 3/16/2007 18:47'! cmdInstVarRefactroings ^ OBInstVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 3/16/2007 18:47'! cmdMethodRefactroings ^ OBMethodRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 3/31/2007 13:21'! cmdRefactoryTools ^ OBRefactoringTools allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 3/16/2007 19:16'! cmdSourceRefactroings ^ OBSourceRefactoring allSubclasses! ! OBCodeBrowser subclass: #OBSelectorEnvironmentBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OBSelectorEnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2007 08:07'! defaultMetaNode | class metaclass method | environment := OBMetaNode named: 'Environment'. class := OBMetaNode named: 'Class'. metaclass := OBMetaNode named: 'Metaclass'. method := OBMetaNode named: 'Method'. environment childAt: #classesHierarchically labeled: 'instance' put: class; childAt: #metaclassesHierarchically labeled: 'class' put: metaclass; filterClass: OBModalFilter. class displaySelector: #indentedName; childAt: #methods put: method. metaclass displaySelector: #indentedName; childAt: #methods put: method. ^ environment! ! !OBSelectorEnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2007 07:51'! defaultRootNode ^ OBEnvironmentNode on: BrowserEnvironment new! ! !OBSelectorEnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2007 07:12'! maxPanes ^ 2! ! !OBSelectorEnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2007 08:05'! mercuryPanel ^ nil! ! !OBSelectorEnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2007 07:12'! minPanes ^ 2! ! !OBSelectorEnvironmentBrowser class methodsFor: 'instance-creation' stamp: 'lr 3/19/2007 07:51'! on: anEnvironment ^ self root: (OBEnvironmentNode on: anEnvironment)! ! !OBSelectorEnvironmentBrowser class methodsFor: 'opening' stamp: 'lr 3/19/2007 07:40'! openOn: anEnvironment ^ (self on: anEnvironment) open! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 3/19/2007 07:03'! open ^ self asSelectorEnvironment open! ! OBCommand subclass: #OBRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBRefactoring subclass: #OBClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBClassRefactoring subclass: #OBAddSubclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAddSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:52'! label ^ 'add subclass'! ! !OBAddSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:02'! refactoring ^ AddClassRefactoring addClass: (self request: 'Enter new subclass name:') superclass: target theNonMetaClass subclasses: #() category: target theNonMetaClass category! ! OBClassRefactoring subclass: #OBAddSuperclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAddSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:01'! label ^ 'add superclass'! ! !OBAddSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:02'! refactoring ^ ChildrenToSiblingsRefactoring name: (self request: 'Enter new superclass name:') class: target theNonMetaClass subclasses: #()! ! !OBClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:46'! group ^ #'refactory.class'! ! !OBClassRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:47'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! OBClassRefactoring subclass: #OBRemoveClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:48'! label ^ 'remove class'! ! !OBRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:05'! refactoring ^ RemoveClassRefactoring classNames: (Array with: target theNonMetaClass name)! ! OBClassRefactoring subclass: #OBRenameClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:48'! label ^ 'rename class'! ! !OBRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:08'! refactoring ^ RenameClassRefactoring rename: target theNonMetaClass to: (self request: 'Enter new class name:' initialAnswer: target theNonMetaClass name)! ! OBClassRefactoring subclass: #OBSplitClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBSplitClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:49'! label ^ 'split class'! ! !OBSplitClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:11'! refactoring ^ SplitClassRefactoring class: target theNonMetaClass instanceVariables: #() newClassName: (self request: 'Enter new class name:') referenceVariableName: (self request: 'Enter new variable name where requests will be forwarded:')! ! OBRefactoring subclass: #OBClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBClassVarRefactoring subclass: #OBAbstractClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:49'! label ^ 'abstract classvar'! ! !OBAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:34'! refactoring ^ AbstractClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass! ! OBClassVarRefactoring subclass: #OBAccessorClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'accessors for classvar'! ! !OBAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:34'! refactoring ^ CreateAccessorsForVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass classVariable: true! ! OBClassVarRefactoring subclass: #OBAddClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'add classvar'! ! !OBAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:04'! refactoring ^ AddClassVariableRefactoring variable: (self request: 'Enter the new variable name:') class: target theNonMetaClass! ! !OBClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:42'! group ^ #'refactory.classvar'! ! !OBClassVarRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:19'! isActive ^ super isActive and: [ target theClass isMeta not and: [ (target isKindOf: OBClassVariableNode) or: [ target isKindOf: OBClassNode ] ] ]! ! OBClassVarRefactoring subclass: #OBPullUpClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'pull up classvar'! ! !OBPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:34'! refactoring ^ PullUpClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass superclass! ! OBClassVarRefactoring subclass: #OBPushDownClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'push down classvar'! ! !OBPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:33'! refactoring ^ PushDownClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass! ! OBClassVarRefactoring subclass: #OBRemoveClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'remove classvar'! ! !OBRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:36'! refactoring ^ RemoveClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass! ! OBClassVarRefactoring subclass: #OBRenameClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:51'! label ^ 'rename classvar'! ! !OBRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:04'! refactoring ^ RenameClassVariableRefactoring rename: (self chooseFrom: self classVariables) to: (self request: 'Enter the new variable name:') in: target theNonMetaClass! ! OBRefactoring subclass: #OBInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBInstVarRefactoring subclass: #OBAbstractInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:24'! label ^ 'abstract instvar'! ! !OBAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:31'! refactoring ^ AbstractInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass! ! OBInstVarRefactoring subclass: #OBAccessorInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'accessors for instvar'! ! !OBAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:31'! refactoring ^ CreateAccessorsForVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass classVariable: false! ! OBInstVarRefactoring subclass: #OBAddInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'add instvar'! ! !OBAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:04'! refactoring ^ AddInstanceVariableRefactoring variable: (self request: 'Enter the new variable name:') class: target theClass! ! !OBInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:13'! group ^ #'refactory.instvar'! ! !OBInstVarRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:20'! isActive ^ super isActive and: [ (target isKindOf: OBInstanceVariableNode) or: [ target isKindOf: OBClassNode ] ]! ! OBInstVarRefactoring subclass: #OBProtectInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'protect instvar'! ! !OBProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:31'! refactoring ^ ProtectInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass! ! OBInstVarRefactoring subclass: #OBPullUpInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:35'! label ^ 'pull up instvar'! ! !OBPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:32'! refactoring ^ PullUpInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass superclass! ! OBInstVarRefactoring subclass: #OBPushDownInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'push down instvar'! ! !OBPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:32'! refactoring ^ PushDownInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass! ! OBInstVarRefactoring subclass: #OBRemoveInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'remove instvar'! ! !OBRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:35'! refactoring ^ RemoveInstanceVariableRefactoring remove: (self chooseFrom: self instanceVariables) from: target theClass! ! OBInstVarRefactoring subclass: #OBRenameInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'rename instvar'! ! !OBRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:03'! refactoring ^ RenameInstanceVariableRefactoring rename: (self chooseFrom: self instanceVariables) to: (self request: 'Enter the new variable name:') in: target theClass! ! OBRefactoring subclass: #OBMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBMethodRefactoring subclass: #OBAddParameterMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBAddParameterMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:04'! label ^ 'add parameter'! ! !OBAddParameterMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:22'! refactoring | initializer newSelector initialAnswer | initialAnswer := target selector numArgs = 0 ifTrue: [ target selector , ':' ] ifFalse: [ target selector ]. newSelector := self request: 'Enter new selector:' initialAnswer: initialAnswer. newSelector isEmpty ifTrue: [ ^ nil ]. initializer := self request: 'Enter default value for parameter:' initialAnswer: 'nil'. initializer isEmpty ifTrue: [ ^ nil ]. ^ AddParameterRefactoring addParameterToMethod: target selector in: target theClass newSelector: newSelector asSymbol initializer: initializer! ! OBMethodRefactoring subclass: #OBInlineParameterRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 09:57'! label ^ 'inline parameter'! ! !OBInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:20'! refactoring ^ InlineParameterRefactoring inlineParameter: (self chooseFrom: self arguments) in: target theClass selector: target selector! ! OBMethodRefactoring subclass: #OBInlineSelfSendsMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:07'! label ^ 'inline self sends'! ! !OBInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:09'! refactoring ^ InlineAllSendersRefactoring sendersOf: target selector in: target theClass! ! !OBMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 11:31'! arguments | parser | parser := RBParser new. parser errorBlock: [ :error :position | ^ #() ]. parser initializeParserWith: self source type: #on:errorBlock:. ^ parser parseMessagePattern argumentNames! ! !OBMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 09:49'! group ^ #'refactory.method'! ! !OBMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:26'! isActive ^ super isActive and: [ target class = OBMethodNode ]! ! !OBMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 11:35'! source ^ target source! ! OBMethodRefactoring subclass: #OBMoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:17'! label ^ 'move method'! ! !OBMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:40'! refactoring ^ MoveMethodRefactoring selector: target selector class: target theClass variable: (self chooseFrom: self instanceVariables)! ! OBMethodRefactoring subclass: #OBPushDownMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:26'! label ^ 'push down method'! ! !OBPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:00'! refactoring ^ PushDownMethodRefactoring pushDown: (Array with: target selector) from: target theClass! ! OBMethodRefactoring subclass: #OBPushUpMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:29'! label ^ 'push up method'! ! !OBPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:00'! refactoring ^ PushUpMethodRefactoring pushUp: (Array with: target selector) from: target theClass! ! OBMethodRefactoring subclass: #OBRemoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:27'! label ^ 'remove method'! ! !OBRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:10'! refactoring ^ RemoveMethodRefactoring removeMethods: (Array with: target selector) from: target theClass! ! OBMethodRefactoring subclass: #OBRemoveParameterRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 10:09'! label ^ 'remove parameter'! ! !OBRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:20'! refactoring ^ RemoveParameterRefactoring removeParameter: (self chooseFrom: self arguments) in: target theClass selector: target selector! ! OBMethodRefactoring subclass: #OBRenameMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:07'! label ^ 'rename method'! ! !OBRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:20'! refactoring | oldMethodName newMethodName oldArguments argumentPermutation | oldArguments := (RBParser parseMethod: (target theClass methodHeaderFor: target selector)) argumentNames. oldMethodName := RBMethodName selector: target selector arguments: oldArguments. (newMethodName := MethodNameEditor forMethodName: oldMethodName) ifNil: [ ^ nil ]. argumentPermutation := newMethodName arguments collect: [ :each | oldArguments indexOf: each ]. ^ RenameMethodRefactoring renameMethod: target selector in: target theClass to: newMethodName selector permutation: argumentPermutation! ! OBMethodRefactoring subclass: #OBSwapMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2007 08:57'! label ^ 'swap method'! ! !OBSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2007 08:58'! refactoring ^ SwapMethodRefactoring swapMethod: target selector in: target theClass! ! !OBRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !OBRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:19'! chooseFrom: anArray title: aString anArray isEmpty ifTrue: [ ^ nil ]. anArray size = 1 ifTrue: [ ^ anArray first ]. ^ OBChoiceRequest prompt: aString labels: anArray values: anArray! ! !OBRefactoring methodsFor: 'accessing-calculated' stamp: 'lr 3/16/2007 18:32'! classVariables ^ (target isKindOf: OBClassVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theNonMetaClass classVarNames asArray sort ]! ! !OBRefactoring methodsFor: 'utilities' stamp: 'lr 1/22/2007 08:49'! confirm: aString ^ OBConfirmationRequest prompt: aString confirm: 'Yes' cancel: 'No'! ! !OBRefactoring methodsFor: 'execution' stamp: 'lr 3/16/2007 16:06'! execute | refactoring | refactoring := self refactoring ifNil: [ ^ nil ]. self handleError: [ refactoring execute ]. ^ refactoring! ! !OBRefactoring methodsFor: 'private' stamp: 'lr 3/31/2007 13:16'! handleError: aBlock ^ aBlock on: Refactoring preconditionSignal do: [ :ex | ex isResumable ifTrue: [ (self confirm: (ex messageText last = $? ifTrue: [ ex messageText ] ifFalse: [ ex messageText , '\Do you want to proceed?' withCRs ])) ifTrue: [ ex resume ] ] ifFalse: [ ex parameter notNil ifTrue: [ (self confirm: ex messageText) ifTrue: [ ex parameter value ] ] ifFalse: [ self inform: ex messageText ] ]. ex return: nil ]! ! !OBRefactoring methodsFor: 'accessing-calculated' stamp: 'lr 3/16/2007 18:28'! instanceVariables ^ (target isKindOf: OBInstanceVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theClass instVarNames asArray sort ]! ! !OBRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 10:15'! isActive ^ (target isKindOf: OBClassAwareNode) and: [ requestor isSelected: target ]! ! !OBRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:02'! refactoring self subclassResponsibility! ! !OBRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:41'! request: aString ^ self request: aString initialAnswer: String new! ! !OBRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:18'! request: aString initialAnswer: aTemplateString ^ OBTextRequest prompt: aString template: aTemplateString! ! OBRefactoring subclass: #OBSourceRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBSourceRefactoring subclass: #OBExtractMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBExtractMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !OBExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:06'! label ^ 'extract method'! ! !OBExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:03'! refactoring ^ ExtractMethodRefactoring extract: self interval from: self selector in: self theClass! ! OBSourceRefactoring subclass: #OBExtractMethodToComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBExtractMethodToComponentRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !OBExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:06'! label ^ 'extract method to component'! ! !OBExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:03'! refactoring ^ ExtractMethodToComponentRefactoring extract: self interval from: self selector in: self theClass! ! OBSourceRefactoring subclass: #OBExtractToTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBExtractToTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !OBExtractToTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:05'! label ^ 'extract to temporary'! ! !OBExtractToTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:04'! refactoring ^ ExtractToTemporaryRefactoring extract: self interval to: (self request: 'Enter the new variable name:') from: self selector in: self theClass! ! OBSourceRefactoring subclass: #OBInlineMethodFromComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBInlineMethodFromComponentRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:16'! isEnabled ^ self isNonSelfSendSelected! ! !OBInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline method from component'! ! !OBInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:49'! refactoring ^ InlineMethodFromComponentRefactoring inline: self interval inMethod: self selector forClass: self theClass! ! OBSourceRefactoring subclass: #OBInlineMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBInlineMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:16'! isEnabled ^ self isSelfSendSelected! ! !OBInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline method'! ! !OBInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:48'! refactoring ^ InlineMethodRefactoring inline: self interval inMethod: self selector forClass: self theClass! ! OBSourceRefactoring subclass: #OBInlineTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBInlineTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:21'! isEnabled ^ self isAssignmentSelected! ! !OBInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline temporary'! ! !OBInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:23'! refactoring ^ InlineTemporaryRefactoring inline: self interval from: self selector in: self theClass! ! OBSourceRefactoring subclass: #OBMoveVariableDefinitionRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBMoveVariableDefinitionRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:26'! isEnabled ^ self isVariableSelected! ! !OBMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'move variable definition'! ! !OBMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:25'! refactoring ^ MoveVariableDefinitionRefactoring bindTight: self interval in: self theClass selector: self selector! ! OBSourceRefactoring subclass: #OBRenameTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRenameTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:31'! isEnabled ^ self isVariableSelected! ! !OBRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:10'! label ^ 'rename temporary'! ! !OBRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:32'! refactoring ^ RenameTemporaryRefactoring renameTemporaryFrom: self interval to: (self request: 'Enter the new variable name:' initialAnswer: self selection) in: self theClass selector: self selector! ! !OBSourceRefactoring class methodsFor: 'testing' stamp: 'lr 3/17/2007 10:42'! takesNodes ^ false! ! !OBSourceRefactoring class methodsFor: 'testing' stamp: 'lr 3/17/2007 10:41'! takesText ^ true! ! !OBSourceRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:17'! group ^ #'refactory.source'! ! !OBSourceRefactoring methodsFor: 'testing-private' stamp: 'lr 3/17/2007 13:00'! ifNodeSelected: aBlock "Answer the result of evaluating aBlock with the currently selected parse tree node as argument or false, if there is no valid selection." | node | self interval isEmpty ifTrue: [ ^ false ]. (node := self node) isNil ifTrue: [ ^ false ]. ^ aBlock value: node! ! !OBSourceRefactoring methodsFor: 'testing-private' stamp: 'lr 3/17/2007 13:18'! ifSendSelected: aBlock ^ self ifNodeSelected: [ :node | node isMessage and: [ aBlock value: node ] ]! ! !OBSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 12:03'! interval ^ target instVarNamed: 'selection'! ! !OBSourceRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 10:42'! isActive ^ true "^ super isActive and: [ target class = OBMethodNode ]"! ! !OBSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:22'! isAssignmentSelected ^ self ifNodeSelected: [ :node | node isAssignment ]! ! !OBSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:12'! isExtractableSelected ^ self ifNodeSelected: [ :node | node isMethod not and: [ node isVariable not ] ]! ! !OBSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:09'! isNonSelfSendSelected ^ self ifSendSelected: [ :node | node receiver isVariable not or: [ node receiver name ~= 'self' ] ]! ! !OBSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:04'! isSelfSendSelected ^ self ifSendSelected: [ :node | node receiver isVariable and: [ node receiver name = 'self' ] ]! ! !OBSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:26'! isVariableSelected ^ self ifNodeSelected: [ :node | node isVariable ]! ! !OBSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:33'! node ^ RBParser parseExpression: self selection onError: [ :str :pos | ^ nil ]! ! !OBSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:42'! selection ^ target text asString! ! !OBSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 11:44'! selector ^ RBParser parseMethodPattern: self text! ! !OBSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:42'! text ^ target fullText asString! ! !OBSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 10:50'! theClass ^ requestor selectedClass! ! OBSourceRefactoring subclass: #OBTemporaryToInstvarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBTemporaryToInstvarRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:39'! isEnabled ^ self isVariableSelected! ! !OBTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:10'! label ^ 'temporary to instvar'! ! !OBTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:39'! refactoring ^ TemporaryToInstanceVariableRefactoring class: self theClass selector: self selector variable: self selection! ! OBCommand subclass: #OBRefactoringTools instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! OBRefactoringTools subclass: #OBRefactoringRedo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRefactoringRedo methodsFor: 'execution' stamp: 'lr 3/31/2007 13:33'! execute self changeManager redoOperation! ! !OBRefactoringRedo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasRedoableOperations! ! !OBRefactoringRedo methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:35'! label ^ self isEnabled ifTrue: [ 'redo ' , self changeManager redoChange name ] ifFalse: [ 'redo refactoring' ]! ! !OBRefactoringTools methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:16'! changeManager ^ RefactoryChangeManager instance! ! !OBRefactoringTools methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:19'! group ^ #'refactory.tools'! ! !OBRefactoringTools methodsFor: 'testing' stamp: 'lr 3/31/2007 13:25'! isActive ^ (target isKindOf: OBClassAwareNode) and: [ requestor isSelected: target ]! ! OBRefactoringTools subclass: #OBRefactoringUndo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !OBRefactoringUndo methodsFor: 'execution' stamp: 'lr 3/31/2007 13:33'! execute self changeManager undoOperation! ! !OBRefactoringUndo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasUndoableOperations! ! !OBRefactoringUndo methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:35'! label ^ self isEnabled ifTrue: [ 'undo ' , self changeManager undoChange name ] ifFalse: [ 'undo refactoring' ]! ! !OBClassNode methodsFor: '*ob-refactory' stamp: 'lr 3/19/2007 09:12'! methods ^ self theClass selectors collect: [ :each | (MethodReference new setClassSymbol: self theNonMetaClassName classIsMeta: self theClass isMeta methodSymbol: each stringVersion: '') asNode ]! ! !SelectorEnvironment methodsFor: '*ob-refactory' stamp: 'lr 3/19/2007 07:06'! open ^ OBSelectorEnvironmentBrowser openOn: self! !