SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Tools'! OBFilter subclass: #OREnvironmentFilter instanceVariableNames: 'environment filtered' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentFilter class methodsFor: 'instance-creation' stamp: 'lr 5/21/2007 14:45'! on: anEnvironment ^ self new environment: anEnvironment! ! !OREnvironmentFilter methodsFor: 'filtering' stamp: 'lr 10/3/2007 20:15'! displayString: aString forParent: aParentNode child: aNode "Display elements that are part of the environment in bold." ^ (aNode withinBrowserEnvironment: environment) ifTrue: [ aString asText addAttribute: TextEmphasis bold ] ifFalse: [ aString ]! ! !OREnvironmentFilter methodsFor: 'accessing' stamp: 'lr 5/19/2007 09:41'! environment ^ environment! ! !OREnvironmentFilter methodsFor: 'accessing' stamp: 'lr 5/21/2007 14:46'! environment: anEnvironment environment := anEnvironment! ! !OREnvironmentFilter methodsFor: 'testing' stamp: 'lr 10/17/2007 22:04'! isFiltered ^ filtered! ! !OREnvironmentFilter methodsFor: 'filtering' stamp: 'lr 10/17/2007 22:01'! nodesFrom: aCollection forNode: aNode "Remove elements that are not part of the environment if in filter mode." self isFiltered ifFalse: [ ^ aCollection ]. ^ aCollection select: [ :each | (each withinBrowserEnvironment: environment) or: [ each childrenWithinBrowserEnvironment: environment ] ]! ! !OREnvironmentFilter methodsFor: 'initialization' stamp: 'lr 10/17/2007 22:04'! setMetaNode: aMetaNode super setMetaNode: aMetaNode. aMetaNode children do: [ :each | (each filters includes: self) ifFalse: [ each addFilter: self ] ]. filtered := false! ! !OREnvironmentFilter methodsFor: 'actions' stamp: 'lr 10/3/2007 20:15'! toggle filtered := filtered not! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdClassRefactroings ^ ORCmdClassRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdClassVarRefactroings ^ ORCmdClassVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/21/2007 19:24'! cmdEnvironments ^ ORCmdEnvironment allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdInstVarRefactroings ^ ORCmdInstVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdMethodRefactroings ^ ORCmdMethodRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 6/14/2007 18:39'! cmdOpen ^ ORCmdOpen allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 6/14/2007 19:15'! cmdPrettyPrint ^ ORCmdPrettyPrint! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 6/14/2007 18:36'! cmdRefactoryTools ^ ORCmdRefactoringTool allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdSourceRefactroings ^ ORCmdSourceRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-accessing' stamp: 'lr 5/21/2007 14:48'! environment ^ BrowserEnvironment new! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:29'! addToEnvironment: anEnvironment anEnvironment addClass: self theNonMetaClass; addClass: self theMetaClass! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:00'! childrenWithinBrowserEnvironment: anEnvironment anEnvironment selectorsForClass: self theClass do: [ :each | ^ true ]. ^ false! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:29'! removeFromEnvironment: anEnvironment anEnvironment removeClass: self theNonMetaClass; removeClass: self theMetaClass! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:00'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesClass: self theClass! ! OBSystemBrowser subclass: #OREnvironmentBrowser instanceVariableNames: 'filter' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentBrowser class methodsFor: 'instance-creation' stamp: 'lr 5/21/2007 14:45'! onEnvironment: anEnvironment ^ self new environment: anEnvironment! ! !OREnvironmentBrowser class methodsFor: 'opening' stamp: 'lr 5/18/2007 11:19'! openEnvironment: anEnvironment ^ (self onEnvironment: anEnvironment) open! ! !OREnvironmentBrowser methodsFor: 'commands' stamp: 'lr 5/21/2007 21:14'! cmdToggleContainment ^ ORCmdToggleContainment! ! !OREnvironmentBrowser methodsFor: 'commands' stamp: 'lr 10/3/2007 20:16'! cmdToggleFilter ^ ORCmdToggleFilter! ! !OREnvironmentBrowser methodsFor: 'morphic' stamp: 'lr 5/21/2007 13:16'! defaultBackgroundColor ^ Color yellow! ! !OREnvironmentBrowser methodsFor: 'morphic' stamp: 'lr 1/4/2008 17:09'! defaultLabel ^ self environment label! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:21'! environment ^ filter environment! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:21'! environment: anEnvironment filter environment: anEnvironment! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:21'! filter ^ filter! ! !OREnvironmentBrowser methodsFor: 'initialization' stamp: 'lr 5/21/2007 21:24'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. filter := OREnvironmentFilter new. aMetaNode addFilter: filter! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:10'! addToEnvironment: anEnvironment anEnvironment addClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:08'! childrenWithinBrowserEnvironment: anEnvironment ^ false! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment anEnvironment removeClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 5/20/2007 09:04'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesSelector: self selector in: self theClass! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 5/21/2007 13:54'! withinBrowserEnvironment: anEnvironment anEnvironment selectorsForClass: self theClass do: [ :each | ^ true ]. ^ false ! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! addToEnvironment: anEnvironment! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:13'! childrenWithinBrowserEnvironment: anEnvironment ^ self withinBrowserEnvironment: anEnvironment! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 5/20/2007 08:59'! withinBrowserEnvironment: anEnvironment ^ true! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 5/21/2007 13:24'! filters ^ filters! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:11'! addToEnvironment: anEnvironment self classes , self metaclasses do: [ :each | each addToEnvironment: anEnvironment ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:10'! childrenWithinBrowserEnvironment: anEnvironment ^ self classes anySatisfy: [ :each | (each withinBrowserEnvironment: anEnvironment) or: [ each childrenWithinBrowserEnvironment: anEnvironment ] ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment self classes , self metaclasses do: [ :each | each removeFromEnvironment: anEnvironment ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:12'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesCategory: self name! ! MethodRefactoring subclass: #ORSwapMethodRefactoring instanceVariableNames: 'target selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORSwapMethodRefactoring commentStamp: 'lr 10/19/2007 09:16' prior: 0! Move a method from the class to the instance side, or vice versa. Normally this is not considered to be a refactoring.! !ORSwapMethodRefactoring 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! ! !ORSwapMethodRefactoring class methodsFor: 'instance-creation' stamp: 'lr 4/5/2007 08:48'! swapMethod: aSelector in: aClass ^ self new swapMethod: aSelector in: aClass! ! !ORSwapMethodRefactoring 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) ] ] ]! ! !ORSwapMethodRefactoring 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 ])! ! !ORSwapMethodRefactoring 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! ! !ORSwapMethodRefactoring methodsFor: 'transforming' stamp: 'lr 4/5/2007 09:00'! transform target compile: (class sourceCodeFor: selector) classified: (class protocolsFor: selector). class removeMethod: selector! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:10'! addToEnvironment: anEnvironment self methods do: [ :each | each addToEnvironment: anEnvironment ]! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:22'! childrenWithinBrowserEnvironment: anEnvironment ^ self withinBrowserEnvironment: anEnvironment! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment self methods do: [ :each | each removeFromEnvironment: anEnvironment ]! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:12'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesProtocol: self name in: self theClass! ! !OBMethodDefinition methodsFor: '*ob-refactory' stamp: 'lr 6/27/2007 12:06'! prettyPrint: aString ^ source := self theClass formatterClass format: aString in: theClass notifying: nil contentsSymbol: nil! ! ClassRefactoring subclass: #ORAccessorClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORAccessorClassRefactoring methodsFor: 'preconditions' stamp: 'lr 1/7/2008 00:10'! preconditions ^ self refactorings inject: RBCondition empty into: [ :result :each | result & each preconditions ]! ! !ORAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 11/30/2007 09:18'! refactorings | class | class := self model classNamed: className asSymbol. ^ class instanceVariableNames collect: [ :each | CreateAccessorsForVariableRefactoring variable: each class: class classVariable: false ]! ! !ORAccessorClassRefactoring methodsFor: 'transforming' stamp: 'lr 11/30/2007 09:13'! transform self refactorings do: [ :each | self performComponentRefactoring: each ]! ! ClassRefactoring subclass: #ORRealizeClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORRealizeClassRefactoring commentStamp: 'lr 10/19/2007 09:16' prior: 0! Make a given class concrete, by providing empty templates for all the abstract methods.! !ORRealizeClassRefactoring methodsFor: 'preconditions' stamp: 'lr 1/7/2008 00:12'! preconditions ^ (RBCondition hasSubclasses: self theClass) not! ! !ORRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/17/2007 20:36'! theClass ^ self model classNamed: className! ! !ORRealizeClassRefactoring methodsFor: 'transforming' stamp: 'lr 10/17/2007 20:50'! transform | root class method parseTree | root := self theClass. root allSelectors do: [ :selector | class := root whoDefinesMethod: selector. (class notNil and: [ class ~= root ]) ifTrue: [ method := class methodFor: selector. (method notNil and: [ method refersToSymbol: #subclassResponsibility ]) ifTrue: [ parseTree := method parseTree. parseTree body temporaries: OrderedCollection new; statements: OrderedCollection new; addNode: (RBMessageNode receiver: (RBVariableNode named: 'self') selector: #shouldBeImplemented). root compileTree: parseTree classified: (class protocolsFor: selector) ] ] ]! ! OBCommand subclass: #ORCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCommand subclass: #ORCmdEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdEnvironment subclass: #ORCmdCategoryEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdCategoryEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:11'! isActive ^ super isActive and: [ target isKindOf: OBClassCategoryNode ]! ! !ORCmdCategoryEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:03'! label ^ 'category'! ! !ORCmdCategoryEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:04'! newEnvironment ^ CategoryEnvironment onEnvironment: super newEnvironment categories: (Array with: target name)! ! ORCmdEnvironment subclass: #ORCmdClassEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'class'! ! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:18'! newEnvironment ^ ClassEnvironment onEnvironment: super newEnvironment classes: (Array with: target theNonMetaClass with: target theMetaClass)! ! ORCmdEnvironment subclass: #ORCmdClassHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'class hierarchy'! ! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:18'! newEnvironment | environment | environment := ClassEnvironment onEnvironment: super newEnvironment. target theNonMetaClass withAllSubAndSuperclassesDo: [ :each | environment addClass: each; addClass: each class ]. ^ environment! ! ORCmdEnvironment subclass: #ORCmdClassVarRefsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassVarRefsEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:50'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBClassVariableNode ] ]! ! !ORCmdClassVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:54'! label ^ 'class variable references'! ! !ORCmdClassVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 22:07'! newEnvironment ^ self classVariables inject: (VariableEnvironment onEnvironment: super newEnvironment) into: [ :result :each | result addClass: target theNonMetaClass classVariable: each ]! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'open environment'! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:25'! compositions ^ Array with: 'union' -> #| with: 'intersection' -> #&! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 1/28/2008 23:30'! execute | environment selected | environment := self newEnvironment. self isComposable ifTrue: [ selected := self chooseFrom: (self compositions collect: [ :each | each key ]) title: 'composition'. environment := self newEnvironment perform: (self compositions detect: [ :each | each key = selected ]) value withEnoughArguments: (Array with: self environment) ]. self open: environment! ! !ORCmdEnvironment methodsFor: 'testing' stamp: 'lr 11/14/2007 10:34'! isComposable ^ self environment isSystem not! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:17'! newEnvironment "Answer a new browser environment." ^ BrowserEnvironment new! ! ORCmdEnvironment subclass: #ORCmdImplementorEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdImplementorEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:22'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'implementors'! ! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:18'! newEnvironment ^ SelectorEnvironment implementorsOf: target selector in: super newEnvironment! ! ORCmdEnvironment subclass: #ORCmdInstVarReaderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarReaderEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:26'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarReaderEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable reader'! ! !ORCmdInstVarReaderEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 17:11'! newEnvironment ^ self instanceVariables inject: (VariableEnvironment onEnvironment: super newEnvironment) into: [ :result :each | result addClass: target theClass instanceVariableReader: each ]! ! ORCmdEnvironment subclass: #ORCmdInstVarRefsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarRefsEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:26'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable references'! ! !ORCmdInstVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:49'! newEnvironment ^ self instanceVariables inject: (VariableEnvironment onEnvironment: super newEnvironment) into: [ :result :each | result addClass: target theClass instanceVariable: each ]! ! ORCmdEnvironment subclass: #ORCmdInstVarWriterEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarWriterEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:26'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable writer'! ! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:48'! newEnvironment ^ self instanceVariables inject: (VariableEnvironment onEnvironment: super newEnvironment) into: [ :result :each | result addClass: target theClass instanceVariableWriter: each ]! ! ORCmdEnvironment subclass: #ORCmdNotEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:44'! group ^ #composition! ! !ORCmdNotEnvironment methodsFor: 'testing' stamp: 'lr 11/14/2007 10:33'! isActive ^ super isActive and: [ self environment isSystem not ]! ! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:38'! isComposable ^ false! ! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:42'! label ^ 'not'! ! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:39'! newEnvironment ^ self environment not! ! ORCmdEnvironment subclass: #ORCmdPackageEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPackageEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 15:53'! isEnabled ^ self package notNil! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'package'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 15:51'! newEnvironment ^ PackageEnvironment onEnvironment: super newEnvironment package: self package! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 1/5/2008 12:05'! package | package | package := nil. target hasSelector ifTrue: [ package := PackageOrganizer default packageOfMethod: target reference ifNone: [ nil ] ]. (package isNil and: [ target isKindOf: OBClassAwareNode ]) ifTrue: [ package := PackageOrganizer default packageOfClass: target theClass ifNone: [ nil ] ]. (package isNil and: [ target isCategory ]) ifTrue: [ package := PackageOrganizer default packages detect: [ :each | each includesSystemCategory: target name ] ifNone: [ nil ] ]. ^ package! ! ORCmdEnvironment subclass: #ORCmdProtocolEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdProtocolEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:12'! isActive ^ super isActive and: [ target isKindOf: OBMethodCategoryNode ]! ! !ORCmdProtocolEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:14'! label ^ 'protocol'! ! !ORCmdProtocolEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:13'! newEnvironment ^ ProtocolEnvironment onEnvironment: super newEnvironment class: target theClass protocols: (Array with: target name)! ! ORCmdEnvironment subclass: #ORCmdSenderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSenderEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:22'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'senders'! ! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:18'! newEnvironment ^ SelectorEnvironment referencesTo: target selector in: super newEnvironment! ! ORCmdEnvironment subclass: #ORCmdSubclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'subclasses'! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:18'! newEnvironment | environment | environment := ClassEnvironment onEnvironment: super newEnvironment. target theNonMetaClass allSubclassesDo: [ :each | environment addClass: each; addClass: each class ]. ^ environment! ! ORCmdEnvironment subclass: #ORCmdSuperclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'superclasses'! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:19'! newEnvironment | environment | environment := ClassEnvironment onEnvironment: super newEnvironment. target theNonMetaClass allSuperclassesDo: [ :each | environment addClass: each; addClass: each class ]. ^ environment! ! ORCommand subclass: #ORCmdOpen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpen methodsFor: 'accessing' stamp: 'cwp 9/30/2007 22:04'! cluster ^ #open! ! ORCmdOpen subclass: #ORCmsOpenFinder instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmsOpenFinder methodsFor: 'execution' stamp: 'lr 6/14/2007 18:40'! execute (FinderTool onBrowserEnvironment: self environment) openAsMorph! ! !ORCmsOpenFinder methodsFor: 'accessing' stamp: 'lr 10/3/2007 20:05'! label ^ 'finder tool'! ! ORCmdOpen subclass: #ORCmsOpenLint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmsOpenLint methodsFor: 'execution' stamp: 'lr 6/14/2007 18:46'! execute LintDialog onEnvironment: self environment! ! !ORCmsOpenLint methodsFor: 'accessing' stamp: 'lr 10/3/2007 20:05'! label ^ 'code critics'! ! ORCmdOpen subclass: #ORCmsOpenRewriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmsOpenRewriter methodsFor: 'execution' stamp: 'lr 6/14/2007 18:41'! execute (RewriteTool onBrowserEnvironment: self environment) openAsMorph! ! !ORCmsOpenRewriter methodsFor: 'accessing' stamp: 'lr 10/3/2007 20:04'! label ^ 'rewrite editor'! ! ORCommand subclass: #ORCmdPrettyPrint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPrettyPrint class methodsFor: 'testing' stamp: 'lr 6/14/2007 19:49'! takesText ^ true! ! !ORCmdPrettyPrint methodsFor: 'execution' stamp: 'lr 6/18/2007 18:49'! execute "Now this is utterly ugly, but unfortunately I see no better way doing this." | panel definition morph source | panel := requestor browser panels detect: [ :each | each isKindOf: OBDefinitionPanel ] ifNone: [ ^ self ]. definition := panel getDefinition ifNil: [ ^ self ]. morph := OBPluggableTextMorph allSubInstances detect: [ :each | each model == panel ] ifNone: [ ^ self ]. source := morph text asString. (definition prettyPrint: source) = source ifTrue: [ ^ self ]. requestor browser announce: definition. morph hasUnacceptedEdits: true! ! !ORCmdPrettyPrint methodsFor: 'accessing' stamp: 'lr 10/3/2007 20:11'! group ^ #general! ! !ORCmdPrettyPrint methodsFor: 'testing' stamp: 'lr 6/18/2007 18:45'! isActive ^ (target isKindOf: OBTextSelection) or: [ (target isKindOf: OBMethodNode) and: [ (target isKindOf: OBMethodVersionNode) not and: [ requestor isSelected: target ] ] ] ! ! !ORCmdPrettyPrint methodsFor: 'accessing' stamp: 'lr 6/18/2007 18:44'! keystroke ^ $r! ! !ORCmdPrettyPrint methodsFor: 'accessing' stamp: 'lr 6/14/2007 19:13'! label ^ 'pretty print'! ! ORCommand subclass: #ORCmdRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdRefactoring subclass: #ORCmdClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdClassRefactoring subclass: #ORCmdAccessorClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:35'! label ^ 'accessors'! ! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:35'! longDescription ^ 'Creates getter and setter methods for all variables.'! ! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 11/30/2007 09:17'! refactoring ^ ORAccessorClassRefactoring className: target theClass name! ! !ORCmdClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor class'! ! !ORCmdClassRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:47'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! ORCmdClassRefactoring subclass: #ORCmdCreateSubclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdCreateSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:24'! label ^ 'create subclass'! ! !ORCmdCreateSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:57'! longDescription ^ 'This refactoring allows you to insert a new class into an existing hierarchy.'! ! !ORCmdCreateSubclassRefactoring 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: #ORCmdCreateSuperclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdCreateSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:36'! label ^ 'create superclass'! ! !ORCmdCreateSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:00'! longDescription ^ 'This refactoring allows you to insert a new class into an existing hierarchy.'! ! !ORCmdCreateSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:58'! refactoring ^ ChildrenToSiblingsRefactoring name: (self request: 'Enter new superclass name:') class: target theNonMetaClass subclasses: #()! ! ORCmdClassRefactoring subclass: #ORCmdRealizeClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/17/2007 20:20'! label ^ 'realize'! ! !ORCmdRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 11/30/2007 09:02'! refactoring ^ ORRealizeClassRefactoring className: target theClass name! ! ORCmdClassRefactoring subclass: #ORCmdRemoveClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:04'! label ^ 'remove'! ! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:14'! longDescription ^ 'This refactoring checks for references to a class, and if there are no references, it will remove the 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 10/17/2007 20:20'! label ^ 'rename'! ! !ORCmdRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:14'! longDescription ^ 'This refactoring renames a class and also renames every reference to the class in the code. Even symbols with the same name as the class will also be renamed.'! ! !ORCmdRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:26'! 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 10/17/2007 20:20'! label ^ 'split'! ! !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 10/3/2007 16:48'! label ^ 'abstract'! ! !ORCmdAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:37'! longDescription ^ 'Performs the create accessors refactoring and then converts all direct variable to use the accessor methods.'! ! !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 1/20/2008 10:36'! label ^ 'accessors'! ! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Creates getter and setter methods for a variable.'! ! !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 10/3/2007 16:49'! label ^ 'add'! ! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Add a variable to the class.'! ! !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 1/28/2008 22:48'! cluster ^ #'refactor class variable'! ! !ORCmdClassVarRefactoring methodsFor: 'testing' stamp: 'lr 1/5/2008 12:14'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBClassVariableNode ] ]! ! ORCmdClassVarRefactoring subclass: #ORCmdPullUpClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:49'! label ^ 'pull up'! ! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Move a variable definition from the currently selected class into the superclass.'! ! !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 10/3/2007 16:49'! label ^ 'push down'! ! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:33'! longDescription ^ 'Moves a variable definition from the currently selected class to only those subclasses that use the variable.'! ! !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 10/3/2007 16:50'! label ^ 'remove'! ! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Removes a variable only if it is not referenced.'! ! !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 10/3/2007 16:50'! label ^ 'rename'! ! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:30'! longDescription ^ 'Renames a variable and all references to the variable.'! ! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:54'! refactoring | oldName newName | oldName := self chooseFrom: self classVariables. newName := self request: 'Enter the new variable name:' initialAnswer: oldName. ^ RenameClassVariableRefactoring rename: oldName to: newName 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 10/3/2007 16:48'! label ^ 'abstract'! ! !ORCmdAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:37'! longDescription ^ 'Performs the create accessors refactoring and then converts all direct variable to use the accessor methods.'! ! !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 1/20/2008 10:36'! label ^ 'accessors'! ! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Creates getter and setter methods for a variable.'! ! !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 10/3/2007 16:50'! label ^ 'add'! ! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Add a variable to the class.'! ! !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 1/28/2008 22:48'! cluster ^ #'refactor instance variable'! ! !ORCmdInstVarRefactoring methodsFor: 'testing' stamp: 'lr 1/5/2008 12:15'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! ORCmdInstVarRefactoring subclass: #ORCmdProtectInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'protect'! ! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:38'! longDescription ^ 'Converts all variable accessor sends to direct variable references. If the accessor is no longer used then it will be removed.'! ! !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 10/3/2007 16:50'! label ^ 'pull up'! ! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Move a variable definition from the currently selected class into the superclass.'! ! !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 10/3/2007 16:50'! label ^ 'push down'! ! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:33'! longDescription ^ 'Moves a variable definition from the currently selected class to only those subclasses that use the variable.'! ! !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 10/3/2007 16:51'! label ^ 'remove'! ! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Removes a variable only if it is not referenced.'! ! !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 10/3/2007 16:51'! label ^ 'rename'! ! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:30'! longDescription ^ 'Renames a variable and all references to the variable.'! ! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:53'! refactoring | oldName newName | oldName := self chooseFrom: self instanceVariables. newName := self request: 'Enter the new variable name:' initialAnswer: oldName. ^ RenameInstanceVariableRefactoring rename: oldName to: newName 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 1/20/2008 10:50'! longDescription ^ 'Adds a default parameter to all implementors of the method.'! ! !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 1/20/2008 10:54'! longDescription ^ 'Remove a parameter from the method, and adds an assignment at the beginning of the method. This can only be performed if all senders of the method have the same value for the 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/20/2008 10:51'! longDescription ^ 'Inlines all senders within the class of the method. If there are no more senders after all inlines have been performed, then it will remove the method.'! ! !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 1/28/2008 22:48'! cluster ^ #'refactor method'! ! !ORCmdMethodRefactoring methodsFor: 'testing' stamp: 'lr 1/5/2008 11:55'! isActive ^ super isActive and: [ target hasSelector ]! ! !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 10/3/2007 17:00'! label ^ 'move'! ! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:49'! longDescription ^ 'Moves a method to another object (defined by an argument or instance variable).'! ! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:00'! 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 10/3/2007 17:01'! label ^ 'push down'! ! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:51'! longDescription ^ 'Pushes a method down into all subclasses that don''t implement the method. This can only be allowed if the class is abstract.'! ! !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 10/3/2007 17:01'! label ^ 'push up'! ! !ORCmdPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:51'! longDescription ^ 'Pushes a method up into the superclass. If the superclass is abstract and already defines the method, then the superclass'' method will be copied down into the other subclasses (assuming they don''t already define the 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 10/3/2007 17:01'! label ^ 'remove'! ! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:50'! longDescription ^ 'Removes a method if there are no senders of the method or there are no symbol that reference the method name. Also, it will remove a method if it is equivalent to the superclass'' definition.'! ! !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 1/20/2008 10:53'! longDescription ^ 'Removes an unused parameter from all implementors of the method, and removes it from the message sends.'! ! !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 10/3/2007 17:01'! label ^ 'rename'! ! !ORCmdRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:53'! longDescription ^ 'Renames all implementors of a method, all senders, and all symbols references. In addition to strict renaming, it also allows you to rearrange the parameters.'! ! !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 5/20/2007 09:14'! label ^ target theClass isMeta ifTrue: [ 'move to instance side' ] ifFalse: [ 'move to class side' ]! ! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:17'! longDescription ^ 'Move the method from instance- to class-side or vice-versa.'! ! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 11/30/2007 09:03'! refactoring ^ ORSwapMethodRefactoring swapMethod: target selector in: target theClass! ! !ORCmdRefactoring methodsFor: 'execution' stamp: 'dc 9/13/2007 16:04'! execute | refactoring | refactoring := [self refactoring] on: ORUICancellationError do: [nil]. "The variable refactoring can be nil for two reasons: because #refactoring returned nil or because it threw a ORUICancellationError exception. Please take care of that before trying to refactor this method :-)." refactoring ifNil: [^ nil]. refactoring model environment: self environment. self handleError: [ refactoring execute ]. ^ refactoring! ! !ORCmdRefactoring methodsFor: 'private' stamp: 'lr 10/15/2007 09:20'! 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' stamp: 'lr 3/16/2007 16:02'! refactoring self subclassResponsibility! ! 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 1/20/2008 10:52'! longDescription ^ 'Extracts the selected code as a separate method. This refactoring determines what temporary variables are needed in the new method, and prompts for a selector that takes these arguments.'! ! !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 1/20/2008 10:55'! longDescription ^ 'Extracts a message into an assignment statement.'! ! !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 1/20/2008 10:55'! longDescription ^ 'Inlines a message send. If there are multiple implementors of the message, it will prompt for the implementation that should be inlined.'! ! !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 1/20/2008 10:52'! longDescription ^ 'Removes the assignment of a variable and replaces all references to the variable with the right hand side of the assignment.'! ! !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 1/20/2008 10:54'! longDescription ^ 'Moves a temporary variable definition into the tightest scope that contains both the variable assignment and references.'! ! !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 1/20/2008 10:54'! longDescription ^ 'Renames a temporary variable.'! ! !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 1/28/2008 22:48'! cluster ^ #'refactor 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 10/3/2007 17:04'! isActive ^ true! ! !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 1/20/2008 10:52'! longDescription ^ 'Converts a temporary into an instance variable.'! ! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:39'! refactoring ^ TemporaryToInstanceVariableRefactoring class: self theClass selector: self selector variable: self selection! ! ORCommand subclass: #ORCmdRefactoringTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdRefactoringTool 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 10/3/2007 17:14'! label ^ 'redo refactoring'! ! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:13'! longDescription ^ self isEnabled ifTrue: [ 'redo ' , self changeManager redoChange name ]! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:16'! changeManager ^ RefactoryChangeManager instance! ! ORCmdRefactoringTool 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 10/3/2007 17:12'! label ^ 'undo refactoring'! ! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:14'! longDescription ^ self isEnabled ifTrue: [ 'undo ' , self changeManager undoChange name ]! ! ORCommand subclass: #ORCmdToggleContainment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdToggleContainment methodsFor: 'execution' stamp: 'lr 10/17/2007 22:10'! execute | environment | environment := self environment asSelectorEnvironment. environment onEnvironment: BrowserEnvironment new. self isPresent ifTrue: [ target removeFromEnvironment: environment ] ifFalse: [ target addToEnvironment: environment ]. requestor browser environment: environment. requestor announcer announce: OBRefreshRequired! ! !ORCmdToggleContainment methodsFor: 'testing' stamp: 'lr 5/21/2007 19:28'! isPresent ^ target withinBrowserEnvironment: self environment! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:27'! keystroke ^ $/! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 5/21/2007 19:31'! label ^ 'toggle containment'! ! ORCommand subclass: #ORCmdToggleFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdToggleFilter methodsFor: 'execution' stamp: 'lr 10/3/2007 20:16'! execute requestor browser filter toggle. requestor browser announce: OBRefreshRequired! ! !ORCmdToggleFilter methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:36'! keystroke ^ $\! ! !ORCmdToggleFilter methodsFor: 'accessing' stamp: 'lr 10/17/2007 22:08'! label ^ 'toggle view'! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 10/15/2007 09:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 10/15/2007 09:21'! chooseFrom: anArray title: aString anArray isEmpty ifTrue: [ ^ self uiCancellationError]. anArray size = 1 ifTrue: [ ^ anArray first ]. ^ (OBChoiceRequest prompt: aString labels: anArray values: anArray) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'utilities' stamp: 'lr 1/28/2008 22:45'! classVariables ^ (target isKindOf: OBClassVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theNonMetaClass allClassVarNames asArray sort ]! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 10/15/2007 09:21'! confirm: aString ^ (OBConfirmationRequest prompt: aString confirm: 'Yes' cancel: 'No') ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 5/21/2007 14:57'! environment ^ requestor browser environment! ! !ORCommand methodsFor: 'accessing' stamp: 'cwp 9/30/2007 22:03'! group ^ #refactory! ! !ORCommand methodsFor: 'utilities' stamp: 'lr 1/4/2008 22:18'! instanceVariables ^ (target isKindOf: OBInstanceVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theClass allInstVarNames asArray sort ]! ! !ORCommand methodsFor: 'testing' stamp: 'lr 1/5/2008 11:57'! isActive ^ requestor isSelected: target! ! !ORCommand methodsFor: 'utilities' stamp: 'lr 1/28/2008 23:15'! open: anEnvironment anEnvironment isEmpty ifTrue: [ ^ self inform: 'Empty environment' ]. (OREnvironmentBrowser selection: target) environment: anEnvironment; open! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 10/15/2007 09:20'! request: aString ^ self request: aString initialAnswer: String new! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 10/15/2007 09:21'! request: aString initialAnswer: aTemplateString ^ (OBTextRequest prompt: aString template: aTemplateString) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 10/15/2007 09:20'! uiCancellationError "The user pressed Cancel or there were nothing to ask for. The error must be catched by #execute in order to cancel the refactoring." ^ ORUICancellationError signal! ! Error subclass: #ORUICancellationError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'!