SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Refactoring'! SystemOrganization addCategory: #'OB-Refactory-Changes'! SystemOrganization addCategory: #'OB-Refactory-Lint'! SystemOrganization addCategory: #'OB-Refactory-Tools'! !CompositeLintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/7/2008 17:29'! asNode ^ ORCompositeLintNode on: self! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! addToEnvironment: anEnvironment! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 16:23'! isDescendantOfClass: aNode ^ false! ! !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! ! OBCodeNode subclass: #ORChangeNode instanceVariableNames: 'change level' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! ORChangeNode subclass: #ORAddMethodChangeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORAddMethodChangeNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 18:40'! text | class previous | class := change changeClass. (class isNil or: [ (class includesSelector: change selector) not ]) ifTrue: [ ^ change parseTree formattedCode ]. previous := class parseTreeFor: change selector. ^ TextDiffBuilder buildDisplayPatchFrom: previous formattedCode to: change parseTree formattedCode! ! !ORChangeNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 18:15'! on: aRule ^ self new initializeOn: aRule! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 2/7/2008 20:01'! add: aChange level: anInteger to: aCollection aChange changes do: [ :each | aChange == each ifFalse: [ aCollection addLast: (each asNode setLevel: anInteger). self add: each level: anInteger + 1 to: aCollection ] ]. ^ aCollection! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 18:16'! change ^ change! ! !ORChangeNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 19:58'! changes ^ self add: change level: 0 to: OrderedCollection new.! ! !ORChangeNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 19:41'! initializeOn: aChange change := aChange. level := 0! ! !ORChangeNode methodsFor: 'testing' stamp: 'lr 2/7/2008 18:20'! isEditable ^ false! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:47'! name ^ (String new: 2 * level withAll: $ ) , change name! ! !ORChangeNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 19:45'! setLevel: anInteger level := anInteger! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:33'! text | text | text := change printString. (text endsWith: '!!') ifTrue: [ text := text allButLast ]. ^ (RBParser parseExpression: text) formattedCode! ! !MultiEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 01:21'! browserClass ^ ORMultiBrowser! ! !MultiEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:59'! environmentNamed: aString ^ environmentDictionaries at: aString ifAbsent: [ SelectorEnvironment new ]! ! OBBrowser subclass: #ORChangesBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORChangesBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 18:23'! change: aChange ^ self root: aChange asNode! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 18:18'! defaultMetaNode | root change | root := OBMetaNode named: 'root'. change := OBMetaNode named: 'change'. root childAt: #changes put: change. ^ root! ! !ORChangesBrowser class methodsFor: 'opening' stamp: 'lr 2/9/2008 09:51'! openChange: aChange ^ (self change: aChange) open! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 18:24'! paneCount ^ 1! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 20:25'! titleForRoot: aNode ^ 'Changes: ' , aNode name! ! !ORChangesBrowser methodsFor: 'commands' stamp: 'lr 2/7/2008 21:22'! cmdCommands ^ ORCmdChangeCommand allSubclasses! ! !ORChangesBrowser methodsFor: 'building' stamp: 'lr 2/7/2008 18:25'! defaultBackgroundColor ^ Color lightBlue! ! OBBrowser subclass: #ORLintBrowser instanceVariableNames: 'environment process' classVariableNames: 'PaneCount' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 17:26'! defaultMetaNode | comp leaf | comp := OBMetaNode named: 'comp'. leaf := OBMetaNode named: 'leaf'. comp childAt: #compositeRules put: comp. comp childAt: #leafRules put: leaf. comp addFilter: ORSortingFilter new; addFilter: ORLintResultFilter new. leaf addFilter: ORLintResultFilter new. ^ comp! ! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 15:21'! defaultRootNode ^ CompositeLintRule lintChecks asNode! ! !ORLintBrowser class methodsFor: 'opening' stamp: 'lr 2/7/2008 14:37'! openRule: aRule environment: anEnvironment ^ (self rule: aRule environment: anEnvironment) open! ! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/8/2008 09:49'! paneCount ^ PaneCount ifNil: [ 2 ]! ! !ORLintBrowser class methodsFor: 'private' stamp: 'lr 2/8/2008 09:56'! panesFor: aRule level: anInteger ^ (aRule rules collect: [ :each | each isComposite ifFalse: [ anInteger ] ifTrue: [ self panesFor: each level: anInteger + 1 ] ]) detectMax: [ :each | each ]! ! !ORLintBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 14:20'! rule: aRule ^ self rule: aRule environment: BrowserEnvironment new! ! !ORLintBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/8/2008 09:56'! rule: aRule environment: anEnvironment PaneCount := self panesFor: aRule level: 1. ^ (self root: aRule asNode) environment: anEnvironment! ! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 14:22'! titleForRoot: aNode ^ aNode name! ! !ORLintBrowser methodsFor: 'private' stamp: 'lr 2/7/2008 16:18'! basicRun self root rule resetResult; runOnEnvironment: self environment. process := nil. self refresh! ! !ORLintBrowser methodsFor: 'commands' stamp: 'lr 2/7/2008 14:28'! cmdCommands ^ ORCmdLintCommand allSubclasses! ! !ORLintBrowser methodsFor: 'building' stamp: 'lr 2/7/2008 18:06'! defaultBackgroundColor ^ Color red! ! !ORLintBrowser methodsFor: 'building' stamp: 'lr 2/7/2008 16:12'! defaultLabel ^ super defaultLabel , ' on ' , self environment name , (self isRunning ifTrue: [ ' (running)' ] ifFalse: [ '' ])! ! !ORLintBrowser methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:21'! environment ^ environment! ! !ORLintBrowser methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:21'! environment: anEnvironment environment := anEnvironment! ! !ORLintBrowser methodsFor: 'testing' stamp: 'lr 2/7/2008 16:11'! isRunning ^ process notNil and: [ process isTerminated not ]! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 2/7/2008 16:35'! refresh self relabel: self defaultLabel. self signalRefresh! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 2/7/2008 16:35'! reset self root rule resetResult. self refresh! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 2/7/2008 16:15'! run self isRunning ifTrue: [ ^ self ]. process := [ self basicRun ] newProcess. process name: self defaultLabel. process resume. self refresh! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 2/7/2008 16:22'! stop self isRunning ifTrue: [ process terminate ]. process := nil. self reset! ! !ORLintBrowser methodsFor: 'private' stamp: 'lr 2/7/2008 16:07'! windowIsClosing self stop! ! !CategoryEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:36'! browserClass ^ ORClassBrowser! ! !BasicLintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/9/2008 17:30'! browserInstance ^ self result browserInstance! ! 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 2/10/2008 09:57'! checkInstVars class instanceVariableNames do: [ :each | (target instanceVariableNames includes: each) ifFalse: [ ((class whichSelectorsReferToInstanceVariable: each) includes: selector) ifTrue: [ self refactoringError: ('<1p> refers to <2s>, which is 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! ! !LintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/7/2008 17:29'! asNode ^ ORLintNode on: self! ! 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) ] ] ]! ! !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! ! !OBClassNode methodsFor: '*ob-refactory-navigation' stamp: 'lr 2/9/2008 09:18'! methods ^ self theClass selectors collect: [ :each | (MethodReference class: self theClass selector: each) asNode ]! ! Error subclass: #ORUICancellationError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! OBFilter subclass: #OREnvironmentFilter instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentFilter class methodsFor: 'instance-creation' stamp: 'lr 2/9/2008 12:42'! on: anEnvironment ^ self new setEnvironment: anEnvironment! ! !OREnvironmentFilter methodsFor: 'accessing' stamp: 'lr 2/9/2008 11:25'! environment ^ environment! ! !OREnvironmentFilter methodsFor: 'initalizing' stamp: 'lr 2/9/2008 12:42'! setEnvironment: anEnvironment environment := anEnvironment! ! OREnvironmentFilter subclass: #ORHideEnvironmentFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORHideEnvironmentFilter methodsFor: 'filtering' stamp: 'lr 2/9/2008 12:24'! nodesFrom: aCollection forNode: aNode ^ aCollection select: [ :each | each withinBrowserEnvironment: environment ]! ! OREnvironmentFilter subclass: #ORHightlightEnvironmentFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORHightlightEnvironmentFilter methodsFor: 'filtering' stamp: 'lr 2/10/2008 13:08'! displayString: aString forParent: aParentNode child: aNode ^ (aNode withinBrowserEnvironment: environment) ifFalse: [ aString asText addAttribute: TextEmphasis struckOut ] ifTrue: [ aString ]! ! OBFilter subclass: #ORLintResultFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORLintResultFilter methodsFor: 'filtering' stamp: 'lr 2/7/2008 15:54'! displayString: aString forNode: aNode | problemCount | problemCount := aNode rule problemCount. problemCount = 0 ifTrue: [ ^ aString ]. ^ (aString , ' (' , aNode rule problemCount asString , ')') asText addAttribute: TextEmphasis bold! ! OBFilter subclass: #ORSortingFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORSortingFilter methodsFor: 'filtering' stamp: 'lr 2/9/2008 17:26'! nodesFrom: nodes forNode: parent ^ nodes asSortedCollection: [ :a :b | a name < b name ]! ! !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 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 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! ! !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! ! OBCodeBrowser subclass: #OREnvironmentBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! OREnvironmentBrowser subclass: #ORClassBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORClassBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 11:50'! defaultMetaNode | root | root := OBMetaNode named: 'Environment'. ^ self buildMetagraphOn: root! ! !ORClassBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 11:52'! paneCount ^ 3! ! !OREnvironmentBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/11/2008 22:06'! on: anEnvironment ^ self root: (OREnvironmentNode onEnvironment: anEnvironment)! ! !OREnvironmentBrowser class methodsFor: 'opening' stamp: 'lr 2/9/2008 01:24'! openOn: anEnvironment ^ (self on: anEnvironment) open! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 13:37'! titleForRoot: aNode ^ aNode browserEnvironment label! ! !OREnvironmentBrowser methodsFor: 'building' stamp: 'lr 2/9/2008 12:03'! defaultBackgroundColor ^ Color yellow! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 2/10/2008 12:55'! definitionPanel ^ self panels detect: [ :each | each isKindOf: OBDefinitionPanel ] ifNone: [ self error: 'No definition panel configured' ]! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 2/10/2008 12:55'! environment ^ self root browserEnvironment! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 2/9/2008 17:24'! open self signalRefresh. super open! ! !OREnvironmentBrowser methodsFor: 'updating' stamp: 'lr 2/10/2008 12:56'! selectionChanged: anAnnouncement | interval | interval := self environment selectionIntervalFor: self definitionPanel text. interval isNil ifFalse: [ self definitionPanel selection: interval ]! ! !OREnvironmentBrowser methodsFor: 'initializing' stamp: 'lr 2/10/2008 12:56'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. announcer observe: OBSelectionChanged send: #selectionChanged: to: self! ! OREnvironmentBrowser subclass: #ORMethodBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORMethodBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 10:17'! defaultMetaNode | class method | class := OBMetaNode named: 'Class'. method := OBMetaNode named: 'Method'. class childAt: #methods put: method; addFilter: OBClassSortFilter new. method displaySelector: #fullName. ^ class! ! !ORMethodBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 01:36'! paneCount ^ 1! ! OREnvironmentBrowser subclass: #ORMultiBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORMultiBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 11:46'! defaultMetaNode | multi envi method | multi := OBMetaNode named: 'MultiEnvironment'. envi := OBMetaNode named: 'Environment'. method := OBMetaNode named: 'Method'. multi childAt: #environments put: envi. envi childAt: #methods put: method; addFilter: OBClassSortFilter new. method displaySelector: #fullName. ^ multi! ! !ORMultiBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 11:46'! paneCount ^ 2! ! OREnvironmentBrowser subclass: #ORPackageBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORPackageBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 13:12'! defaultMetaNode | root extensionCategory packageCategory | root := OBMetaNode named: 'Environment'. extensionCategory := OBMetaNode named: 'ExtensionCategory'. packageCategory := OBMetaNode named: 'PackageCategory'. root childAt: #packageExtensionCategory put: extensionCategory. root childAt: #packageCategories put: packageCategory. self buildMetagraphOn: extensionCategory. extensionCategory ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: packageCategory. packageCategory ancestrySelector: #isDescendantOfClassCat:. ^ root! ! !ORPackageBrowser methodsFor: 'initializing' stamp: 'lr 2/11/2008 22:23'! setMetaNode: aMetaNode node: aNode | filter | filter := ORHightlightEnvironmentFilter on: aNode browserEnvironment. aMetaNode withAllChildrenDo: [ :each | (self unfilteredNames includes: each name) ifFalse: [ each addFilter: filter ] ]. super setMetaNode: aMetaNode node: aNode! ! !ORPackageBrowser methodsFor: 'configuration' stamp: 'lr 2/10/2008 13:19'! unfilteredNames ^ #('Environment')! ! OREnvironmentBrowser subclass: #ORSystemBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORSystemBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 12:41'! defaultMetaNode | root cat | root := OBMetaNode named: 'Environment'. cat := OBMetaNode named: 'Class Category'. root childAt: #categories put: cat. cat ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: cat. ^ root! ! !ORSystemBrowser class methodsFor: 'configuration' stamp: 'lr 2/11/2008 22:06'! defaultRootNode ^ OREnvironmentNode onEnvironment: BrowserEnvironment new! ! !ORSystemBrowser methodsFor: 'commands' stamp: 'lr 2/9/2008 13:57'! cmdToggleContainment ^ ORCmdToggleContainment! ! !ORSystemBrowser methodsFor: 'initialization' stamp: 'lr 2/11/2008 22:23'! setMetaNode: aMetaNode node: aNode | filter | filter := ORHightlightEnvironmentFilter on: aNode selectorEnvironment. aMetaNode withAllChildrenDo: [ :each | each addFilter: filter ]. super setMetaNode: aMetaNode node: aNode! ! !TransformationRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/9/2008 17:29'! browserInstance | change | change := CompositeRefactoryChange named: self name. change changes: self changes. ^ change browserInstance! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 2/10/2008 13:21'! withinBrowserEnvironment: anEnvironment ^ self methods anySatisfy: [ :each | each withinBrowserEnvironment: anEnvironment ] ! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 08:54'! allNonMetaClasses | classes | classes := Set new. self classesDo: [ :each | classes add: each theNonMetaClass ]. ^ classes! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:34'! browserClass ^ ORMethodBrowser! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 16:08'! browserInstance ^ self browserClass on: self! ! OBNode subclass: #ORLintNode instanceVariableNames: 'owner rule' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! ORLintNode subclass: #ORCompositeLintNode instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 15:32'! compositeRules ^ rules select: [ :each | each isComposite ]! ! !ORCompositeLintNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 16:46'! initializeOn: aRule super initializeOn: aRule. self update! ! !ORCompositeLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ true! ! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 17:37'! leafRules ^ rules reject: [ :each | each isComposite ]! ! !ORCompositeLintNode methodsFor: 'actions' stamp: 'lr 2/7/2008 16:55'! remove: aNode self rule rules: (self rule rules copyWithout: aNode rule). self update! ! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 15:30'! rules ^ rules! ! !ORCompositeLintNode methodsFor: 'actions' stamp: 'lr 2/7/2008 22:09'! update rules := rule rules collect: [ :each | each asNode setOwner: self ]! ! !ORLintNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 15:21'! on: aRule ^ self new initializeOn: aRule! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 20:50'! changes | changes | changes := CompositeRefactoryChange named: self name. changes changes: rule changes. ^ changes! ! !ORLintNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 15:22'! initializeOn: aRule rule := aRule! ! !ORLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ false! ! !ORLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 16:00'! isEditable ^ false! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:23'! name ^ rule name! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 16:50'! owner ^ owner! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:22'! rule ^ rule! ! !ORLintNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 16:41'! setOwner: aNode owner := aNode! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:22'! text ^ rule rationale! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 13:54'! addToEnvironment: anEnvironment self classes do: [ :each | each addToEnvironment: anEnvironment ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 13:55'! removeFromEnvironment: anEnvironment self classes do: [ :each | each removeFromEnvironment: anEnvironment ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:12'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesCategory: self name! ! OBClassCategoryNode subclass: #ORPackageExtensionNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 2/10/2008 12:15'! classes ^ environment package extensionClasses collect: [ :each | each asNode ]! ! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 2/10/2008 13:18'! comments ^ environment package extensionClasses collect: [ :each | each asCommentNode ]! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:11'! definition ^ self! ! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 2/10/2008 12:15'! metaclasses ^ environment package extensionClasses collect: [ :each | each asClassSideNode ]! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:11'! name ^ '*Extensions'! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:12'! text ^ nil! ! OBEnvironmentNode subclass: #OREnvironmentNode instanceVariableNames: 'browserEnvironment' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentNode class methodsFor: 'instance-creation' stamp: 'lr 2/10/2008 13:01'! onEnvironment: aBrowserEnvironment ^ self forImage setBrowserEnvironment: aBrowserEnvironment! ! !OREnvironmentNode methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:00'! browserEnvironment ^ browserEnvironment! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:09'! classes ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:09'! comments ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asCommentNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! environments | selectorEnvironment | ^ self browserEnvironment environments asArray collect: [ :each | selectorEnvironment := self browserEnvironment environmentNamed: each. self class onEnvironment: (selectorEnvironment label: each) ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! metaclasses ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asClassSideNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! methods | result | result := OrderedCollection new. self browserEnvironment classesAndSelectorsDo: [ :class :selector | result add: (MethodReference class: class selector: selector) asNode ]. ^ result! ! !OREnvironmentNode methodsFor: 'accessing' stamp: 'lr 2/11/2008 22:09'! name ^ self browserEnvironment name! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! packageCategories ^ self browserEnvironment package systemCategories collect: [ :each | OBClassCategoryNode on: each ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! packageExtensionCategory ^ Array with: (ORPackageExtensionNode on: '*Extensions' inEnvironment: self browserEnvironment) ! ! !OREnvironmentNode methodsFor: 'public' stamp: 'lr 2/10/2008 13:30'! selectorEnvironment "Make sure that the receiver is a selector environment." | selectorEnvironment | selectorEnvironment := SelectorEnvironment new. browserEnvironment classesAndSelectorsDo: [ :class :selector | selectorEnvironment addClass: class selector: selector ]. ^ browserEnvironment := selectorEnvironment! ! !OREnvironmentNode methodsFor: 'initializing' stamp: 'lr 2/10/2008 13:00'! setBrowserEnvironment: anEnvironment browserEnvironment := anEnvironment! ! !PackageEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/10/2008 11:56'! browserClass ^ ORPackageBrowser! ! !ClassEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:35'! browserClass ^ ORClassBrowser! ! !AddMethodChange methodsFor: '*ob-refactory-changes' stamp: 'lr 2/7/2008 18:30'! asNode ^ ORAddMethodChangeNode on: self! ! !RefactoryChange methodsFor: '*ob-refactory-changes' stamp: 'lr 2/7/2008 18:14'! asNode ^ ORChangeNode on: self! ! !RefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 17:28'! browserClass ^ ORChangesBrowser! ! !RefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 17:28'! browserInstance ^ self browserClass change: self! ! !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 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-Browsers'! ORCommand subclass: #ORCmdChangeCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! ORCmdChangeCommand subclass: #ORCmdAcceptChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdAcceptChanges methodsFor: 'execution' stamp: 'lr 2/7/2008 20:22'! execute self performChange: self browser root change. self browser close! ! !ORCmdAcceptChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 20:45'! keystroke ^ $s! ! !ORCmdAcceptChanges methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:23'! label ^ 'accept'! ! !ORCmdAcceptChanges methodsFor: 'testing' stamp: 'lr 2/7/2008 19:05'! wantsButton ^ true! ! ORCmdChangeCommand subclass: #ORCmdCancelChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdCancelChanges methodsFor: 'execution' stamp: 'lr 2/7/2008 19:06'! execute self browser close! ! !ORCmdCancelChanges methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:23'! keystroke ^ $l! ! !ORCmdCancelChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:06'! label ^ 'cancel'! ! !ORCmdCancelChanges methodsFor: 'testing' stamp: 'lr 2/7/2008 19:05'! wantsButton ^ true! ! ORCmdChangeCommand subclass: #ORCmdFileOutChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdFileOutChanges methodsFor: 'execution' stamp: 'lr 2/7/2008 21:37'! execute | changes | changes := String streamContents: [ :stream | stream header; timeStamp. self browser root changes do: [ :each | stream cr; cr; print: each change ] ]. FileStream writeSourceCodeFrom: changes readStream baseName: self browser root change name isSt: true useHtml: false! ! !ORCmdFileOutChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 21:09'! group ^ #other! ! !ORCmdFileOutChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 21:06'! label ^ 'file out'! ! ORCmdChangeCommand subclass: #ORCmdPerformChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdPerformChange methodsFor: 'execution' stamp: 'lr 2/8/2008 09:36'! execute self performChange: target change. self browser signalRefresh! ! !ORCmdPerformChange methodsFor: 'accessing' stamp: 'lr 2/7/2008 20:07'! group ^ #other! ! !ORCmdPerformChange methodsFor: 'accessing' stamp: 'lr 2/7/2008 20:20'! label ^ 'perform'! ! 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 2/9/2008 15:59'! environment ^ super environment forCategories: (Array with: target name)! ! !ORCmdCategoryEnvironment methodsFor: 'testing' 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'! ! ORCmdEnvironment subclass: #ORCmdClassEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:01'! environment ^ super environment forClasses: (Array with: target theNonMetaClass)! ! !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'! ! ORCmdEnvironment subclass: #ORCmdClassHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:26'! environment | classes | classes := Set new addAll: target theNonMetaClass withAllSuperclasses; addAll: target theNonMetaClass allSubclasses; yourself. ^ (super environment forClasses: classes) label: 'Hierarchy of ' , target theNonMetaClassName! ! !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'! ! ORCmdEnvironment subclass: #ORCmdClassVarRefsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:18'! environment | binding | binding := target theNonMetaClass bindingOf: (self chooseFrom: self classVariables). ^ super environment referencesTo: binding in: target theNonMetaClass! ! !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'! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'open environment'! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 2/9/2008 16:37'! execute [ self openEnvironment: self environment ] on: ORUICancellationError do: [ ^ self ]! ! ORCmdEnvironment subclass: #ORCmdImplementorEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:27'! environment ^ super environment implementorsOf: target selector! ! !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'! ! ORCmdEnvironment subclass: #ORCmdInstVarReaderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarReaderEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:36'! environment ^ super environment instVarReadersTo: (self chooseFrom: self instanceVariables) in: target theClass! ! !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'! ! ORCmdEnvironment subclass: #ORCmdInstVarRefsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:28'! environment ^ super environment instVarRefsTo: (self chooseFrom: self instanceVariables) in: target theClass! ! !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'! ! ORCmdEnvironment subclass: #ORCmdInstVarWriterEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:28'! environment ^ super environment instVarWritersTo: (self chooseFrom: self instanceVariables) in: target theClass! ! !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'! ! ORCmdEnvironment subclass: #ORCmdMatchesEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:31'! environment | literal | literal := self request: 'Literals matching:'. ^ (super environment matches: literal) label: 'Literals matching ' , literal printString! ! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:31'! label ^ 'literal matches...'! ! ORCmdEnvironment subclass: #ORCmdNotEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:29'! environment ^ super environment not! ! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:43'! group ^ #noble! ! !ORCmdNotEnvironment methodsFor: 'testing' stamp: 'lr 11/14/2007 10:33'! isActive ^ super isActive and: [ self environment isSystem not ]! ! !ORCmdNotEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:28'! label ^ 'spawn inverse'! ! ORCmdEnvironment subclass: #ORCmdPackageEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdPackageEnvironment subclass: #ORCmdBrowsePackageEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:55'! cluster ^ nil! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:53'! group ^ #navigation! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:53'! label ^ 'browse package'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:38'! environment | package | ^ (super environment forPackage: (package := self package)) label: package packageName! ! !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/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 2/9/2008 16:45'! environment ^ super environment forClass: target theClass protocols: (Array with: target name)! ! !ORCmdProtocolEnvironment methodsFor: 'testing' 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'! ! ORCmdEnvironment subclass: #ORCmdReferencesEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdReferencesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:28'! environment ^ (super environment referencesTo: target theNonMetaClass binding) label: 'References to ' , target theNonMetaClassName! ! !ORCmdReferencesEnvironment methodsFor: 'testing' stamp: 'lr 2/9/2008 16:48'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdReferencesEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:48'! label ^ 'references'! ! ORCmdEnvironment subclass: #ORCmdSelectMethodsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectMethodsEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:24'! environment | condition | condition := self request: 'Select methods:' initialAnswer: '[ :each | false ]'. ^ (super environment selectMethods: (self class evaluatorClass evaluate: condition)) label: 'Methods matching ' , condition.! ! !ORCmdSelectMethodsEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:55'! label ^ 'select methods...'! ! ORCmdEnvironment subclass: #ORCmdSenderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:22'! environment ^ (super environment referencesTo: target selector) label: 'Senders of ' , target selector printString! ! !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'! ! ORCmdEnvironment subclass: #ORCmdSpawnEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSpawnEnvironment methodsFor: 'execution' stamp: 'lr 2/9/2008 13:52'! execute | browser | browser := ORSystemBrowser on: self environment. browser jumpTo: target. browser open! ! !ORCmdSpawnEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:43'! group ^ #noble! ! !ORCmdSpawnEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 12:21'! label ^ 'spawn'! ! ORCmdEnvironment subclass: #ORCmdSubclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:27'! environment ^ (super environment forClasses: target theNonMetaClass allSubclasses) label: 'Subclasses of ' , target theNonMetaClassName! ! !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'! ! ORCmdEnvironment subclass: #ORCmdSuperclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:27'! environment ^ (super environment forClasses: target theNonMetaClass allSuperclasses) label: 'Superclasses of ' , target theNonMetaClassName! ! !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'! ! ORCommand subclass: #ORCmdLintCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdLintCommand methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:35'! rule ^ target rule! ! ORCmdLintCommand subclass: #ORCmdOpenRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdOpenRule methodsFor: 'execution' stamp: 'lr 2/10/2008 13:51'! execute self isEnabled ifTrue: [ self rule browserInstance open ]! ! !ORCmdOpenRule methodsFor: 'testing' stamp: 'lr 2/9/2008 17:36'! isActive ^ super isActive and: [ self browser isRunning not ]! ! !ORCmdOpenRule methodsFor: 'testing' stamp: 'lr 2/9/2008 17:37'! isEnabled ^ target isComposite not and: [ target rule isEmpty not ]! ! !ORCmdOpenRule methodsFor: 'accessing' stamp: 'lr 2/7/2008 16:57'! keystroke ^ $o! ! !ORCmdOpenRule methodsFor: 'accessing' stamp: 'lr 2/7/2008 17:00'! label ^ 'open'! ! !ORCmdOpenRule methodsFor: 'testing' stamp: 'lr 2/7/2008 17:57'! wantsButton ^ true! ! ORCmdLintCommand subclass: #ORCmdRemoveRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdRemoveRule methodsFor: 'execution' stamp: 'lr 2/7/2008 16:54'! execute target owner remove: target. self browser signalRefresh! ! !ORCmdRemoveRule methodsFor: 'testing' stamp: 'lr 2/9/2008 17:37'! isActive ^ super isActive and: [ self browser isRunning not ]! ! !ORCmdRemoveRule methodsFor: 'testing' stamp: 'lr 2/9/2008 17:37'! isEnabled ^ target owner notNil! ! !ORCmdRemoveRule methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:55'! keystroke ^ $x! ! !ORCmdRemoveRule methodsFor: 'accessing' stamp: 'lr 2/7/2008 16:59'! label ^ 'remove'! ! ORCmdLintCommand subclass: #ORCmdRunLint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdRunLint methodsFor: 'execution' stamp: 'lr 2/8/2008 09:39'! execute self browser run! ! !ORCmdRunLint methodsFor: 'testing' stamp: 'lr 2/8/2008 09:40'! isActive ^ super isActive and: [ self browser isRunning not ]! ! !ORCmdRunLint methodsFor: 'accessing' stamp: 'lr 2/7/2008 16:19'! keystroke ^ $r! ! !ORCmdRunLint methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:39'! label ^ 'run'! ! !ORCmdRunLint methodsFor: 'testing' stamp: 'lr 2/7/2008 17:57'! wantsButton ^ true! ! ORCmdLintCommand subclass: #ORCmdStopLint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdStopLint methodsFor: 'execution' stamp: 'lr 2/8/2008 09:39'! execute self browser stop! ! !ORCmdStopLint methodsFor: 'testing' stamp: 'lr 2/8/2008 09:40'! isActive ^ super isActive and: [ self browser isRunning ]! ! !ORCmdStopLint methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:39'! label ^ 'stop'! ! 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: #ORCmsOpenLintChecks instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmsOpenLintChecks methodsFor: 'execution' stamp: 'lr 2/21/2008 10:25'! execute ORLintBrowser openRule: CompositeLintRule lintChecks environment: self environment! ! !ORCmsOpenLintChecks methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:36'! label ^ 'lint checks'! ! 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'! ! ORCmdOpen subclass: #ORCmsOpenTransformations instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmsOpenTransformations methodsFor: 'execution' stamp: 'lr 2/7/2008 21:40'! execute ORLintBrowser openRule: CompositeLintRule transformations environment: self environment! ! !ORCmsOpenTransformations methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:37'! label ^ 'transformations'! ! 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-Refactoring'! ORCmdRefactoring subclass: #ORCmdClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdClassRefactoring subclass: #ORCmdAccessorClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! ORCmdClassVarRefactoring subclass: #ORCmdAbstractClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! ORCmdInstVarRefactoring subclass: #ORCmdAbstractInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! ORCmdMethodRefactoring subclass: #ORCmdAddParameterMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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: 'lr 2/11/2008 23:28'! execute | refactoring | refactoring := [ self refactoring ] on: ORUICancellationError do: [ ^ self ]. refactoring ifNil: [ ^ self ]. refactoring model environment: self environment. self handleError: [ self performRefactoring: refactoring ]! ! !ORCmdRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:02'! refactoring self subclassResponsibility! ! ORCmdRefactoring subclass: #ORCmdSourceRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdSourceRefactoring subclass: #ORCmdExtractMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! !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-Refactoring'! ORCmdRefactoringTool subclass: #ORCmdRefactoringRedo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:58'! change ^ self changeManager redoChange! ! !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 2/9/2008 00:56'! label ^ 'redo' , super label! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:56'! change self subclassResponsibility! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:16'! changeManager ^ RefactoryChangeManager instance! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/9/2008 01:02'! label ^ String streamContents: [ :stream | self isEnabled ifTrue: [ stream nextPutAll: ': '; nextPutAll: self change name. stream position > 20 ifTrue: [ stream position: 20; nextPutAll: '...' ] ] ]! ! ORCmdRefactoringTool subclass: #ORCmdRefactoringUndo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:58'! change ^ self changeManager undoChange! ! !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 2/9/2008 00:56'! label ^ 'undo' , super label! ! ORCommand subclass: #ORCmdToggleContainment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORCmdToggleContainment methodsFor: 'execution' stamp: 'lr 2/10/2008 13:28'! execute (target withinBrowserEnvironment: self environment) ifTrue: [ target removeFromEnvironment: self environment ] ifFalse: [ target addToEnvironment: self environment ]. requestor browser signalRefresh! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:27'! keystroke ^ $/! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 2/9/2008 12:49'! label ^ 'toggle'! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 2/9/2008 12:49'! order ^ '0'! ! !ORCommand class methodsFor: 'initialization' stamp: 'lr 2/7/2008 19:13'! initialize Preferences addPreference: #promptOnRefactoring categories: #('refactoring') default: true balloonHelp: 'Show the changes before applying a refactoring.'! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:17'! browser ^ requestor browser! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 2/7/2008 19:20'! 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 2/10/2008 10:08'! classVariables ^ (target isKindOf: OBClassVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theNonMetaClass allClassVarNames asSortedArray ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:21'! confirm: aString ^ (OBConfirmationRequest prompt: aString confirm: 'Yes' cancel: 'No') ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:20'! environment ^ self browser environment! ! !ORCommand methodsFor: 'accessing' stamp: 'cwp 9/30/2007 22:03'! group ^ #refactory! ! !ORCommand methodsFor: 'private' stamp: 'lr 2/7/2008 19:11'! 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 ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 2/9/2008 16:13'! inform: aString ^ OBInformRequest message: aString! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 2/10/2008 10:09'! instanceVariables ^ (target isKindOf: OBInstanceVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ target theClass allInstVarNames asSortedArray ]! ! !ORCommand methodsFor: 'testing' stamp: 'lr 1/5/2008 11:57'! isActive ^ requestor isSelected: target! ! !ORCommand methodsFor: 'private' stamp: 'lr 2/10/2008 13:41'! openEnvironment: anEnvironment | instance | anEnvironment isSystem ifTrue: [ ^ target browse ]. anEnvironment isEmpty ifTrue: [ ^ self inform: 'Empty environment' ]. instance := anEnvironment browserInstance. [ instance jumpTo: target ] ifError: [ instance jumpToRoot ]. instance open! ! !ORCommand methodsFor: 'private' stamp: 'lr 2/7/2008 20:21'! performChange: aChange RefactoryChangeManager instance performChange: aChange! ! !ORCommand methodsFor: 'private' stamp: 'lr 2/7/2008 20:21'! performRefactoring: aRefactoring Preferences promptOnRefactoring ifFalse: [ aRefactoring execute ] ifTrue: [ aRefactoring primitiveExecute. ORChangesBrowser openChange: (aRefactoring changes name: aRefactoring name; yourself) ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:20'! request: aString ^ self request: aString initialAnswer: String new! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:21'! request: aString initialAnswer: aTemplateString ^ (OBTextRequest prompt: aString template: aTemplateString) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 2/9/2008 14:02'! uiCancellationError "The user pressed Cancel or there were nothing to ask for. The error must be catched by #execute in order to cancel the action." ^ ORUICancellationError signal! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 5/21/2007 13:24'! filters ^ filters! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 2/11/2008 22:22'! withAllChildrenDo: aBlock self withAllChildrenDo: aBlock seen: IdentitySet new! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 2/11/2008 23:20'! withAllChildrenDo: aBlock seen: aSet (aSet includes: self) ifTrue: [ ^ self ]. aSet add: self. aBlock value: self. self edges do: [ :each | each metaNode withAllChildrenDo: aBlock seen: aSet ]! ! ORCommand initialize!