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! ! !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! ! !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: 'testing' stamp: 'lr 5/24/2007 20:43'! isEnvironmentBrowser ^ true! ! !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! ! !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! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 5/21/2007 13:54'! withinBrowserEnvironment: anEnvironment anEnvironment selectorsForClass: self theClass do: [ :each | ^ true ]. ^ false ! ! !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 11/21/2007 14:15'! cmdMethodWrapper ^ ORCmdMethodWrapper 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! ! !OBCodeBrowser methodsFor: '*ob-refactory-testing' stamp: 'lr 5/24/2007 20:44'! isEnvironmentBrowser ^ false! ! !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 1/4/2008 16:02'! browseIn: anEnvironment ^ (OREnvironmentBrowser onEnvironment: environment category: name) environment: anEnvironment; open! ! !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! ! Error subclass: #ORUICancellationError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! 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! ! ClassRefactoring subclass: #ORAccessorClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORAccessorClassRefactoring methodsFor: 'as yet unclassified' stamp: 'lr 11/30/2007 09:19'! preconditions ^ self refactorings inject: RBCondition empty into: [ :result :each | result & each preconditions ]! ! !ORAccessorClassRefactoring methodsFor: 'as yet unclassified' 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: 'as yet unclassified' 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 10/17/2007 20:29'! preconditions ^ (RBCondition hasSubclasses: self theClass) not & (RBCondition isAbstractClass: self theClass)! ! !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) ] ] ]! ! !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! ! 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 10/3/2007 20:04'! cluster ^ 'open environment'! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:25'! compositions ^ Array with: 'union' -> #| with: 'intersection' -> #&! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 11/14/2007 10:39'! 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 1/4/2008 15:49'! isActive ^ requestor isSelected: target! ! !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 methodsFor: 'execution' stamp: 'lr 11/14/2007 10:45'! open: anEnvironment (OREnvironmentBrowser selection: target) environment: anEnvironment; open! ! 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/4/2008 22:05'! package | package | 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: #ORCmdMethodWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdMethodWrapper subclass: #ORCmdInstallMethodWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstallMethodWrapper methodsFor: 'execution' stamp: 'lr 11/21/2007 14:43'! execute | wrapper environment | wrapper := self chooseFrom: self wrapperNames title: 'select wrapper class'. wrapper := (Smalltalk classNamed: wrapper) ifNil: [ ^ self ]. environment := SelectorEnvironment new. self environment classesAndSelectorsDo: [ :class :selector | (wrapper on: selector inClass: class) isNil ifFalse: [ environment addClass: class selector: selector ] ]. (OREnvironmentBrowser selection: target) environment: environment; open ! ! !ORCmdInstallMethodWrapper methodsFor: 'accessing' stamp: 'lr 11/21/2007 14:35'! label ^ 'install'! ! !ORCmdInstallMethodWrapper methodsFor: 'private' stamp: 'lr 11/21/2007 14:33'! wrapperNames ^ (MwMethodWrapper withAllSubclasses collect: [ :each | each name ]) asSortedCollection: [ :a :b | a <= b ]! ! !ORCmdMethodWrapper methodsFor: 'accessing' stamp: 'lr 11/21/2007 14:19'! cluster ^ 'wrapper'! ! !ORCmdMethodWrapper methodsFor: 'testing' stamp: 'lr 11/21/2007 14:17'! isActive ^ (requestor isSelected: target) and: [ Smalltalk hasClassNamed: #MwMethodWrapper ]! ! ORCmdMethodWrapper subclass: #ORCmdUninstallMethodWrapper instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdUninstallMethodWrapper methodsFor: 'execution' stamp: 'lr 11/21/2007 14:39'! execute | method | self environment classesAndSelectorsDo: [ :class :selector | method := class compiledMethodAt: selector. method isMwMethodWrapper ifTrue: [ method uninstall ] ]! ! !ORCmdUninstallMethodWrapper methodsFor: 'accessing' stamp: 'lr 11/21/2007 14:14'! label ^ 'uninstall'! ! ORCommand subclass: #ORCmdOpen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpen methodsFor: 'accessing' stamp: 'cwp 9/30/2007 22:04'! cluster ^ #open! ! !ORCmdOpen methodsFor: 'testing' stamp: 'lr 6/14/2007 18:39'! isActive ^ (requestor isSelected: target) and: [ target isKindOf: OBClassAwareNode ]! ! 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 11/30/2007 09:05'! label ^ 'accessors'! ! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 11/30/2007 09:17'! refactoring ^ ORAccessorClassRefactoring className: target theClass name! ! 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: 'dc 7/16/2007 16:14'! refactoring ^ (self request: 'Enter new superclass name:') ifNotNilDo: [:superClassName | ChildrenToSiblingsRefactoring name: superClassName class: target theNonMetaClass subclasses: #()]! ! !ORCmdClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:41'! cluster ^ 'refactor class'! ! !ORCmdClassRefactoring methodsFor: 'testing' stamp: 'lr 3/16/2007 18:47'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! 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 10/17/2007 20:20'! label ^ 'remove'! ! !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: 'dc 9/13/2007 15:49'! 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 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 11/30/2007 09:05'! label ^ 'accessors'! ! !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 3/16/2007 19:04'! refactoring ^ AddClassVariableRefactoring variable: (self request: 'Enter the new variable name:') class: target theNonMetaClass! ! !ORCmdClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:46'! cluster ^ 'refactor class variable'! ! !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 10/3/2007 16:49'! label ^ 'pull up'! ! !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 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 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 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 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 11/30/2007 08:52'! label ^ 'accessors'! ! !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 3/16/2007 19:04'! refactoring ^ AddInstanceVariableRefactoring variable: (self request: 'Enter the new variable name:') class: target theClass! ! !ORCmdInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:47'! cluster ^ 'refactor instance variable'! ! !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 10/3/2007 16:50'! label ^ 'protect'! ! !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 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 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 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 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 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 10/3/2007 16:47'! cluster ^ 'refactor 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 10/3/2007 17:00'! label ^ 'move'! ! !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/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/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/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 10/3/2007 17:01'! label ^ 'rename'! ! !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 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: '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 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 10/3/2007 16:47'! cluster ^ 'refactor'! ! !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 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 methodsFor: 'testing' stamp: 'lr 3/31/2007 13:25'! isActive ^ (target isKindOf: OBClassAwareNode) and: [ requestor isSelected: target ]! ! 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'! isActive ^ requestor isSelected: target! ! !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: 'testing' stamp: 'lr 5/21/2007 21:35'! isActive ^ requestor isSelected: target! ! !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: 'utilities' stamp: 'lr 10/15/2007 09:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !ORCommand methodsFor: 'utilities' 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: 'accessing-variables' stamp: 'lr 1/4/2008 22:12'! classVariables ^ (target isKindOf: OBClassVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theNonMetaClass allClassVarNames asArray sort ]! ! !ORCommand methodsFor: 'utilities' 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: 'accessing-variables' stamp: 'lr 1/4/2008 22:18'! instanceVariables ^ (target isKindOf: OBInstanceVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theClass allInstVarNames asArray sort ]! ! !ORCommand methodsFor: 'utilities' stamp: 'lr 10/15/2007 09:20'! request: aString ^ self request: aString initialAnswer: String new! ! !ORCommand methodsFor: 'utilities' 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! ! !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! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 5/21/2007 13:24'! filters ^ filters! !