SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Tools'! MethodRefactoring subclass: #ORSwapMethodChange instanceVariableNames: 'target selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORSwapMethodChange class methodsFor: 'instance-creation' stamp: 'lr 4/5/2007 08:48'! model: aRBSmalltalk swapMethod: aSelector in: aClass ^ self new model: aRBSmalltalk; swapMethod: aSelector in: aClass; yourself! ! !ORSwapMethodChange class methodsFor: 'instance-creation' stamp: 'lr 4/5/2007 08:48'! swapMethod: aSelector in: aClass ^ self new swapMethod: aSelector in: aClass! ! !ORSwapMethodChange methodsFor: 'preconditions' stamp: 'lr 4/5/2007 09:06'! checkInstVars class instanceVariableNames do: [ :each | (target instanceVariableNames includes: each) ifFalse: [ ((class whichSelectorsReferToInstanceVariable: each) includes: selector) ifTrue: [ self refactoringError: ('<1p> refers to <2s> which not defined in <3p>' expandMacrosWith: selector with: each with: target) ] ] ]! ! !ORSwapMethodChange methodsFor: 'preconditions' stamp: 'lr 4/5/2007 09:07'! preconditions ^ (RBCondition definesSelector: selector in: class) & (RBCondition definesSelector: selector in: target) not & (RBCondition withBlock: [ self checkInstVars. true ])! ! !ORSwapMethodChange methodsFor: 'initialization' stamp: 'lr 4/5/2007 08:53'! swapMethod: aSelector in: aClass class := self classObjectFor: aClass. target := self classObjectFor: (class isMeta ifTrue: [ class nonMetaclass ] ifFalse: [ class metaclass ]). selector := aSelector! ! !ORSwapMethodChange methodsFor: 'transforming' stamp: 'lr 4/5/2007 09:00'! transform target compile: (class sourceCodeFor: selector) classified: (class protocolsFor: selector). class removeMethod: selector! ! OBFilter subclass: #ORFilter instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! ORFilter subclass: #ORCategoryFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! ORFilter subclass: #ORClassFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORClassFilter methodsFor: 'as yet unclassified' stamp: 'lr 5/19/2007 09:43'! edgesFrom: aCollection forNode: aNode self halt. ^ aCollection collect: [ :each | each copy ]! ! !ORFilter methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:41'! environment ^ environment! ! !ORFilter methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:42'! environment: anEnvironment environment := anEnvironment! ! ORFilter subclass: #ORMethodFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:10'! cmdClassRefactroings ^ ORCmdClassRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:10'! cmdClassVarRefactroings ^ ORCmdClassVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/19/2007 09:02'! cmdEnvironments ^ ORCmdEnvironment allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:10'! cmdInstVarRefactroings ^ ORCmdInstVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:10'! cmdMethodRefactroings ^ ORCmdMethodRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:10'! cmdRefactoryTools ^ ORCmdRefactoringTools allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:10'! cmdSourceRefactroings ^ ORCmdSourceRefactoring allSubclasses! ! OBCodeBrowser subclass: #OREnvironmentBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/19/2007 09:50'! addTo: root class: classSel comment: commentSel metaclass: metaclassSel | class metaclass comment methodCategory method allMethodCategory | class := OBMetaNode named: 'Class'. comment := OBMetaNode named: 'ClassComment'. metaclass := OBMetaNode named: 'Metaclass'. allMethodCategory := OBMetaNode named: 'AllMethodCategory'. methodCategory := OBMetaNode named: 'MethodCategory'. method := OBMetaNode named: 'Method'. root childAt: classSel labeled: 'instance' put: class; childAt: commentSel labeled: '?' put: comment; childAt: metaclassSel labeled: 'class' put: metaclass; addFilter: ORClassFilter new; addFilter: OBModalFilter new. class ancestrySelector: #isDescendantOfClass:; displaySelector: #indentedName; childAt: #allCategory put: allMethodCategory; childAt: #categories put: methodCategory; addFilter: ORCategoryFilter new. comment displaySelector: #indentedName. metaclass ancestrySelector: #isDescendantOfClass:; displaySelector: #indentedName; childAt: #allCategory put: allMethodCategory; childAt: #categories put: methodCategory; addFilter: ORCategoryFilter new. allMethodCategory childAt: #methods put: method; addFilter: ORMethodFilter new. methodCategory ancestrySelector: #isDescendantOfMethodCat:; childAt: #methods put: method; addFilter: ORMethodFilter new. method ancestrySelector: #isDescendantOfMethod:. ^ root! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:38'! alphabeticalMetaNode ^ self imageClass: #classes comment: #comments metaclass: #metaclasses ! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:38'! defaultMetaNode ^ self hierarchicalMetaNode! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 13:20'! defaultRootNode ^ OREnvironmentNode on: BrowserEnvironment new! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:38'! hierarchicalMetaNode ^ self imageClass: #classesHierarchically comment: #commentsHierarchically metaclass: #metaclassesHierarchically! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:37'! imageClass: classSel comment: commentSel metaclass: metaclassSel | env | env := OBMetaNode named: 'Environment'. self addTo: env class: classSel comment: commentSel metaclass: metaclassSel. ^ env! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:37'! mercuryPanel ^ nil! ! !OREnvironmentBrowser class methodsFor: 'instance-creation' stamp: 'lr 5/18/2007 13:58'! onEnvironment: anEnvironment ^ self root: (OREnvironmentNode on: anEnvironment)! ! !OREnvironmentBrowser class methodsFor: 'opening' stamp: 'lr 5/18/2007 11:19'! openEnvironment: anEnvironment ^ (self onEnvironment: anEnvironment) open! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:39'! paneCount ^ 3! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 5/18/2007 11:28'! title ^ 'Environment Browser'! ! !OREnvironmentBrowser methodsFor: 'morphic' stamp: 'lr 5/19/2007 09:30'! defaultBackgroundColor ^ Color lightGreen! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 5/18/2007 13:11'! open ^ OREnvironmentBrowser openEnvironment: self! ! OBCommand subclass: #ORCmdEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdEnvironment subclass: #ORCmdClassEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:24'! environment ^ ClassEnvironment onEnvironment: super environment classes: (Array with: target theNonMetaClass)! ! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:00'! label ^ 'class environment'! ! ORCmdEnvironment subclass: #ORCmdClassHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:09'! environment ^ ClassEnvironment onEnvironment: super environment classes: (Set new addAll: target theClass allSuperclasses; addAll: target theClass allSubclasses; add: target theClass; yourself)! ! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:00'! label ^ 'class hierarchy environment'! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:02'! environment ^ BrowserEnvironment new! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 5/19/2007 09:06'! execute self environment open! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 08:58'! group ^ #'refactory.environment'! ! !ORCmdEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:04'! isActive ^ (target isKindOf: OBClassAwareNode) and: [ requestor isSelected: target ]! ! ORCmdEnvironment subclass: #ORCmdImplementorEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:21'! environment ^ SelectorEnvironment implementorsOf: target selector in: super environment! ! !ORCmdImplementorEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:22'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:25'! label ^ 'implementor environment'! ! ORCmdEnvironment subclass: #ORCmdPackageEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:14'! environment | package | package := target hasSelector ifTrue: [ PackageOrganizer default packageOfMethod: target reference ] ifFalse: [ PackageOrganizer default packageOfClass: target theClass ]. ^ PackageEnvironment onEnvironment: super environment package: package! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:13'! label ^ 'package environment'! ! ORCmdEnvironment subclass: #ORCmdSelectorEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectorEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:19'! environment | environment | environment := SelectorEnvironment onEnvironment: super environment. target hasSelector ifTrue: [ environment addClass: target theClass selector: target selector ] ifFalse: [ environment addClass: target theClass ]. ^ environment! ! !ORCmdSelectorEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:16'! label ^ 'selector environment'! ! ORCmdEnvironment subclass: #ORCmdSenderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:21'! environment ^ SelectorEnvironment referencesTo: target selector in: super environment! ! !ORCmdSenderEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:22'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:24'! label ^ 'sender environment'! ! OBCommand subclass: #ORCmdRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdRefactoring subclass: #ORCmdClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdClassRefactoring subclass: #ORCmdAddSubclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAddSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:52'! label ^ 'add subclass'! ! !ORCmdAddSubclassRefactoring 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! ! ORCmdClassRefactoring subclass: #ORCmdAddSuperclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAddSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:01'! label ^ 'add superclass'! ! !ORCmdAddSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:02'! refactoring ^ ChildrenToSiblingsRefactoring name: (self request: 'Enter new superclass name:') class: target theNonMetaClass subclasses: #()! ! !ORCmdClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:46'! group ^ #'refactory.class'! ! !ORCmdClassRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:47'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! ORCmdClassRefactoring subclass: #ORCmdRemoveClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:48'! label ^ 'remove class'! ! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:05'! refactoring ^ RemoveClassRefactoring classNames: (Array with: target theNonMetaClass name)! ! ORCmdClassRefactoring subclass: #ORCmdRenameClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:48'! label ^ 'rename class'! ! !ORCmdRenameClassRefactoring 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)! ! ORCmdClassRefactoring subclass: #ORCmdSplitClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSplitClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:49'! label ^ 'split class'! ! !ORCmdSplitClassRefactoring 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:')! ! ORCmdRefactoring subclass: #ORCmdClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdClassVarRefactoring subclass: #ORCmdAbstractClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:49'! label ^ 'abstract classvar'! ! !ORCmdAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:34'! refactoring ^ AbstractClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass! ! ORCmdClassVarRefactoring subclass: #ORCmdAccessorClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'accessors for classvar'! ! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:34'! refactoring ^ CreateAccessorsForVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass classVariable: true! ! ORCmdClassVarRefactoring subclass: #ORCmdAddClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'add classvar'! ! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:04'! refactoring ^ AddClassVariableRefactoring variable: (self request: 'Enter the new variable name:') class: target theNonMetaClass! ! !ORCmdClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:42'! group ^ #'refactory.classvar'! ! !ORCmdClassVarRefactoring 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 ] ] ]! ! ORCmdClassVarRefactoring subclass: #ORCmdPullUpClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'pull up classvar'! ! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:34'! refactoring ^ PullUpClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass superclass! ! ORCmdClassVarRefactoring subclass: #ORCmdPushDownClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'push down classvar'! ! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:33'! refactoring ^ PushDownClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass! ! ORCmdClassVarRefactoring subclass: #ORCmdRemoveClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:50'! label ^ 'remove classvar'! ! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:36'! refactoring ^ RemoveClassVariableRefactoring variable: (self chooseFrom: self classVariables) class: target theNonMetaClass! ! ORCmdClassVarRefactoring subclass: #ORCmdRenameClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:51'! label ^ 'rename classvar'! ! !ORCmdRenameClassVarRefactoring 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! ! ORCmdRefactoring subclass: #ORCmdInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdInstVarRefactoring subclass: #ORCmdAbstractInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:24'! label ^ 'abstract instvar'! ! !ORCmdAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:31'! refactoring ^ AbstractInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass! ! ORCmdInstVarRefactoring subclass: #ORCmdAccessorInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'accessors for instvar'! ! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:31'! refactoring ^ CreateAccessorsForVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass classVariable: false! ! ORCmdInstVarRefactoring subclass: #ORCmdAddInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'add instvar'! ! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:04'! refactoring ^ AddInstanceVariableRefactoring variable: (self request: 'Enter the new variable name:') class: target theClass! ! !ORCmdInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:13'! group ^ #'refactory.instvar'! ! !ORCmdInstVarRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:20'! isActive ^ super isActive and: [ (target isKindOf: OBInstanceVariableNode) or: [ target isKindOf: OBClassNode ] ]! ! ORCmdInstVarRefactoring subclass: #ORCmdProtectInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'protect instvar'! ! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:31'! refactoring ^ ProtectInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass! ! ORCmdInstVarRefactoring subclass: #ORCmdPullUpInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:35'! label ^ 'pull up instvar'! ! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:32'! refactoring ^ PullUpInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass superclass! ! ORCmdInstVarRefactoring subclass: #ORCmdPushDownInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'push down instvar'! ! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:32'! refactoring ^ PushDownInstanceVariableRefactoring variable: (self chooseFrom: self instanceVariables) class: target theClass! ! ORCmdInstVarRefactoring subclass: #ORCmdRemoveInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'remove instvar'! ! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:35'! refactoring ^ RemoveInstanceVariableRefactoring remove: (self chooseFrom: self instanceVariables) from: target theClass! ! ORCmdInstVarRefactoring subclass: #ORCmdRenameInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:25'! label ^ 'rename instvar'! ! !ORCmdRenameInstVarRefactoring 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! ! ORCmdRefactoring subclass: #ORCmdMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdMethodRefactoring subclass: #ORCmdAddParameterMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAddParameterMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:04'! label ^ 'add parameter'! ! !ORCmdAddParameterMethodRefactoring 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! ! ORCmdMethodRefactoring subclass: #ORCmdInlineParameterRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 09:57'! label ^ 'inline parameter'! ! !ORCmdInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:20'! refactoring ^ InlineParameterRefactoring inlineParameter: (self chooseFrom: self arguments) in: target theClass selector: target selector! ! ORCmdMethodRefactoring subclass: #ORCmdInlineSelfSendsMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:07'! label ^ 'inline self sends'! ! !ORCmdInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:09'! refactoring ^ InlineAllSendersRefactoring sendersOf: target selector in: target theClass! ! !ORCmdMethodRefactoring 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! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 09:49'! group ^ #'refactory.method'! ! !ORCmdMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:26'! isActive ^ super isActive and: [ target class = OBMethodNode ]! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 11:35'! source ^ target source! ! ORCmdMethodRefactoring subclass: #ORCmdMoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:17'! label ^ 'move method'! ! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 18:40'! refactoring ^ MoveMethodRefactoring selector: target selector class: target theClass variable: (self chooseFrom: self instanceVariables)! ! ORCmdMethodRefactoring subclass: #ORCmdPushDownMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:26'! label ^ 'push down method'! ! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:00'! refactoring ^ PushDownMethodRefactoring pushDown: (Array with: target selector) from: target theClass! ! ORCmdMethodRefactoring subclass: #ORCmdPushUpMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:29'! label ^ 'push up method'! ! !ORCmdPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:00'! refactoring ^ PushUpMethodRefactoring pushUp: (Array with: target selector) from: target theClass! ! ORCmdMethodRefactoring subclass: #ORCmdRemoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:27'! label ^ 'remove method'! ! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:10'! refactoring ^ RemoveMethodRefactoring removeMethods: (Array with: target selector) from: target theClass! ! ORCmdMethodRefactoring subclass: #ORCmdRemoveParameterRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 10:09'! label ^ 'remove parameter'! ! !ORCmdRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 17:20'! refactoring ^ RemoveParameterRefactoring removeParameter: (self chooseFrom: self arguments) in: target theClass selector: target selector! ! ORCmdMethodRefactoring subclass: #ORCmdRenameMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:07'! label ^ 'rename method'! ! !ORCmdRenameMethodRefactoring 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! ! ORCmdMethodRefactoring subclass: #ORCmdSwapMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2007 08:57'! label ^ 'swap method'! ! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 5/18/2007 13:07'! refactoring ^ ORSwapMethodChange swapMethod: target selector in: target theClass! ! !ORCmdRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !ORCmdRefactoring 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! ! !ORCmdRefactoring 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 ]! ! !ORCmdRefactoring methodsFor: 'utilities' stamp: 'lr 1/22/2007 08:49'! confirm: aString ^ OBConfirmationRequest prompt: aString confirm: 'Yes' cancel: 'No'! ! !ORCmdRefactoring methodsFor: 'execution' stamp: 'lr 3/16/2007 16:06'! execute | refactoring | refactoring := self refactoring ifNil: [ ^ nil ]. self handleError: [ refactoring execute ]. ^ refactoring! ! !ORCmdRefactoring 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 ]! ! !ORCmdRefactoring 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 ]! ! !ORCmdRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 10:15'! isActive ^ (target isKindOf: OBClassAwareNode) and: [ requestor isSelected: target ]! ! !ORCmdRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:02'! refactoring self subclassResponsibility! ! !ORCmdRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:41'! request: aString ^ self request: aString initialAnswer: String new! ! !ORCmdRefactoring methodsFor: 'utilities' stamp: 'lr 3/16/2007 17:18'! request: aString initialAnswer: aTemplateString ^ OBTextRequest prompt: aString template: aTemplateString! ! ORCmdRefactoring subclass: #ORCmdSourceRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdSourceRefactoring subclass: #ORCmdExtractMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdExtractMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !ORCmdExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:06'! label ^ 'extract method'! ! !ORCmdExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:03'! refactoring ^ ExtractMethodRefactoring extract: self interval from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdExtractMethodToComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:06'! label ^ 'extract method to component'! ! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:03'! refactoring ^ ExtractMethodToComponentRefactoring extract: self interval from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdExtractToTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdExtractToTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !ORCmdExtractToTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:05'! label ^ 'extract to temporary'! ! !ORCmdExtractToTemporaryRefactoring 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! ! ORCmdSourceRefactoring subclass: #ORCmdInlineMethodFromComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:16'! isEnabled ^ self isNonSelfSendSelected! ! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline method from component'! ! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:49'! refactoring ^ InlineMethodFromComponentRefactoring inline: self interval inMethod: self selector forClass: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdInlineMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInlineMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:16'! isEnabled ^ self isSelfSendSelected! ! !ORCmdInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline method'! ! !ORCmdInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:48'! refactoring ^ InlineMethodRefactoring inline: self interval inMethod: self selector forClass: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdInlineTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInlineTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:21'! isEnabled ^ self isAssignmentSelected! ! !ORCmdInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline temporary'! ! !ORCmdInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:23'! refactoring ^ InlineTemporaryRefactoring inline: self interval from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdMoveVariableDefinitionRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:26'! isEnabled ^ self isVariableSelected! ! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'move variable definition'! ! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:25'! refactoring ^ MoveVariableDefinitionRefactoring bindTight: self interval in: self theClass selector: self selector! ! ORCmdSourceRefactoring subclass: #ORCmdRenameTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRenameTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:31'! isEnabled ^ self isVariableSelected! ! !ORCmdRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:10'! label ^ 'rename temporary'! ! !ORCmdRenameTemporaryRefactoring 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! ! !ORCmdSourceRefactoring class methodsFor: 'testing' stamp: 'lr 3/17/2007 10:42'! takesNodes ^ false! ! !ORCmdSourceRefactoring class methodsFor: 'testing' stamp: 'lr 3/17/2007 10:41'! takesText ^ true! ! !ORCmdSourceRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 19:17'! group ^ #'refactory.source'! ! !ORCmdSourceRefactoring 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! ! !ORCmdSourceRefactoring methodsFor: 'testing-private' stamp: 'lr 3/17/2007 13:18'! ifSendSelected: aBlock ^ self ifNodeSelected: [ :node | node isMessage and: [ aBlock value: node ] ]! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 12:03'! interval ^ target instVarNamed: 'selection'! ! !ORCmdSourceRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 10:42'! isActive ^ true "^ super isActive and: [ target class = OBMethodNode ]"! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:22'! isAssignmentSelected ^ self ifNodeSelected: [ :node | node isAssignment ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:12'! isExtractableSelected ^ self ifNodeSelected: [ :node | node isMethod not and: [ node isVariable not ] ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:09'! isNonSelfSendSelected ^ self ifSendSelected: [ :node | node receiver isVariable not or: [ node receiver name ~= 'self' ] ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:04'! isSelfSendSelected ^ self ifSendSelected: [ :node | node receiver isVariable and: [ node receiver name = 'self' ] ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:26'! isVariableSelected ^ self ifNodeSelected: [ :node | node isVariable ]! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:33'! node ^ RBParser parseExpression: self selection onError: [ :str :pos | ^ nil ]! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:42'! selection ^ target text asString! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 11:44'! selector ^ RBParser parseMethodPattern: self text! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:42'! text ^ target fullText asString! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 10:50'! theClass ^ requestor selectedClass! ! ORCmdSourceRefactoring subclass: #ORCmdTemporaryToInstvarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:39'! isEnabled ^ self isVariableSelected! ! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:10'! label ^ 'temporary to instvar'! ! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:39'! refactoring ^ TemporaryToInstanceVariableRefactoring class: self theClass selector: self selector variable: self selection! ! OBCommand subclass: #ORCmdRefactoringTools instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdRefactoringTools subclass: #ORCmdRefactoringRedo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRefactoringRedo methodsFor: 'execution' stamp: 'lr 3/31/2007 13:33'! execute self changeManager redoOperation! ! !ORCmdRefactoringRedo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasRedoableOperations! ! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:35'! label ^ self isEnabled ifTrue: [ 'redo ' , self changeManager redoChange name ] ifFalse: [ 'redo refactoring' ]! ! !ORCmdRefactoringTools methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:16'! changeManager ^ RefactoryChangeManager instance! ! !ORCmdRefactoringTools methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:19'! group ^ #'refactory.tools'! ! !ORCmdRefactoringTools methodsFor: 'testing' stamp: 'lr 3/31/2007 13:25'! isActive ^ (target isKindOf: OBClassAwareNode) and: [ requestor isSelected: target ]! ! ORCmdRefactoringTools subclass: #ORCmdRefactoringUndo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRefactoringUndo methodsFor: 'execution' stamp: 'lr 3/31/2007 13:33'! execute self changeManager undoOperation! ! !ORCmdRefactoringUndo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasUndoableOperations! ! !ORCmdRefactoringUndo 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 ]! ! OBEnvironmentNode subclass: #OREnvironmentNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentNode methodsFor: 'navigating' stamp: 'lr 5/18/2007 13:21'! classes ^ environment classes asArray collect: [ :each | each asNode ]! ! !OREnvironmentNode methodsFor: 'navigating' stamp: 'lr 5/19/2007 08:55'! classesHierarchically ^ OBClassAwareNode sortHierarchically: self classes! ! !OREnvironmentNode methodsFor: 'navigating' stamp: 'lr 5/18/2007 13:21'! comments ^ environment classes asArray collect: [ :each | each asCommentNode ]! ! !OREnvironmentNode methodsFor: 'navigating' stamp: 'lr 5/18/2007 13:21'! commentsHierarchically ^ OBClassAwareNode sortHierarchically: self comments! ! !OREnvironmentNode methodsFor: 'testing' stamp: 'lr 5/18/2007 13:21'! hasOrganization ^ false! ! !OREnvironmentNode methodsFor: 'navigating' stamp: 'lr 5/18/2007 13:21'! metaclasses ^ environment classes asArray collect: [ :each | each asClassSideNode ]! ! !OREnvironmentNode methodsFor: 'navigating' stamp: 'lr 5/18/2007 13:21'! metaclassesHierarchically ^ OBClassAwareNode sortHierarchically: self metaclasses! ! !OREnvironmentNode methodsFor: 'displaying' stamp: 'lr 5/18/2007 13:24'! name ^ environment printString! !