SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Refactoring'! SystemOrganization addCategory: #'OB-Refactory-Changes'! SystemOrganization addCategory: #'OB-Refactory-Matcher'! SystemOrganization addCategory: #'OB-Refactory-Lint'! SystemOrganization addCategory: #'OB-Refactory-Tools'! Refactoring subclass: #ORPrettyPrintCodeRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORPrettyPrintCodeRefactoring methodsFor: 'preconditions' stamp: 'lr 10/23/2008 15:52'! preconditions ^ RBCondition empty! ! !ORPrettyPrintCodeRefactoring methodsFor: 'transforming' stamp: 'lr 11/8/2009 10:38'! transform | classes tree formatted protocols | self model allClassesDo: [ :class | class selectors do: [ :selector | (self model environment includesSelector: selector in: class realClass) ifTrue: [ tree := class parseTreeFor: selector. tree isNil ifFalse: [ formatted := tree formattedCode. (RBParser parseMethod: formatted) = tree ifTrue: [ protocols := class protocolsFor: selector. class compile: formatted classified: protocols ] ] ] ] ]! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 2/6/2009 11:36'! browserEnvironment "Answer a refactoring browser environemnt of the receiving node." ^ BrowserEnvironment new! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 9/26/2008 12:11'! containingPackage "Answer the PackageInfo instance that contains the receiver, or nil if no such package exists." ^ nil! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:23'! definedWithinBrowserEnvironment: anEnvironment ^ self withinBrowserEnvironment: anEnvironment! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 16:23'! isDescendantOfClass: aNode ^ false! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 11:54'! withinBrowserEnvironment: anEnvironment ^ false! ! OBCodeNode subclass: #ORChangeNode instanceVariableNames: 'change parent' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! ORChangeNode subclass: #ORAddMethodChangeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORAddMethodChangeNode methodsFor: 'accessing' stamp: 'lr 11/2/2009 00:02'! accept: aText notifying: aController "Just to make sure that it compiles, try with the standard compiler." | compilerClass | compilerClass := self theClass isNil ifTrue: [ Object compilerClass ] ifFalse: [ self theClass compilerClass ]. compilerClass new compile: aText asString in: self theClass classified: nil notifying: aController ifFail: [ ^ false ]. change class: change changeClass protocol: change protocol source: aText asString. ^ true! ! !ORAddMethodChangeNode methodsFor: 'private' stamp: 'lr 11/1/2009 23:30'! after ^ ORChangesBrowser prettyPrint ifTrue: [ change parseTree formattedCode ] ifFalse: [ change source ]! ! !ORAddMethodChangeNode methodsFor: 'private' stamp: 'lr 11/1/2009 23:42'! before ^ (self theClass isNil or: [ (self theClass includesSelector: self selector) not ]) ifTrue: [ String new ] ifFalse: [ ORChangesBrowser prettyPrint ifTrue: [ (self theClass parseTreeFor: self selector) formattedCode ] ifFalse: [ self theClass sourceCodeAt: self selector ] ]! ! !ORAddMethodChangeNode methodsFor: 'actions' stamp: 'lr 1/31/2009 00:15'! browse OBSystemBrowser openOnClass: self theClass selector: self selector! ! !ORAddMethodChangeNode methodsFor: 'accessing' stamp: 'lr 1/31/2009 00:15'! selector ^ self change selector! ! !ORChangeNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 18:15'! on: aRule ^ self new initializeOn: aRule! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 3/19/2008 16:49'! add: aNode to: aCollection | node | aNode change changes do: [ :each | aNode change == each ifFalse: [ node := each asNode setParent: aNode. aCollection addLast: node. self add: node to: aCollection ] ]. ^ aCollection! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 11/1/2009 23:40'! after | text | text := change printString. (text endsWith: '!!') ifTrue: [ text := text allButLast ]. ^ (RBParser parseExpression: text) formattedCode! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 11/1/2009 23:40'! before ^ String new! ! !ORChangeNode methodsFor: 'actions' stamp: 'lr 1/31/2009 00:18'! browse OBSystemBrowser openOnClass: self theClass! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 18:16'! change ^ change! ! !ORChangeNode methodsFor: 'navigation' stamp: 'lr 3/19/2008 16:48'! changes ^ self add: self to: OrderedCollection new! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 1/31/2009 00:04'! doItReceiver ^ self theClass isNil ifFalse: [ self theClass theNonMetaClass ]! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 3/19/2008 16:57'! indent ^ String new: (0 max: 2 * self level) withAll: Character space! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 3/19/2008 16:57'! indentedName ^ self indent , self name! ! !ORChangeNode methodsFor: 'initialization' stamp: 'lr 3/12/2008 09:15'! initializeOn: aChange change := aChange! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 3/19/2008 16:57'! level ^ self parent isNil ifTrue: [ -1 ] ifFalse: [ self parent level + 1 ]! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 3/19/2008 16:51'! name ^ self change name! ! !ORChangeNode methodsFor: 'accessing' stamp: 'dc 3/13/2008 17:55'! parent ^ parent! ! !ORChangeNode methodsFor: 'copying' stamp: 'lr 3/12/2008 10:09'! postCopy super postCopy. parent := nil! ! !ORChangeNode methodsFor: 'actions' stamp: 'lr 3/12/2008 10:02'! remove self parent isNil ifTrue: [ ^ self ]. self parent remove: self! ! !ORChangeNode methodsFor: 'actions' stamp: 'lr 3/12/2008 10:08'! remove: aNode self change removeChange: aNode change! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 11/12/2009 22:35'! selectedClass ^ self theClass! ! !ORChangeNode methodsFor: 'initialization' stamp: 'lr 3/12/2008 09:14'! setParent: aNode parent := aNode! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:41'! text ^ ORChangesBrowser displayDiffs ifFalse: [ self after ] ifTrue: [ TextDiffBuilder buildDisplayPatchFrom: self before to: self after ]! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 1/31/2009 00:03'! theClass ^ self change changeClass! ! !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 instanceVariableNames: 'displayDiffs prettyPrint'! ORChangesBrowser class instanceVariableNames: 'displayDiffs prettyPrint'! !ORChangesBrowser class methodsFor: 'instance creation' stamp: 'lr 2/7/2008 18:23'! change: aChange ^ self root: aChange asNode! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2008 16:52'! defaultMetaNode | root change | root := OBMetaNode named: 'root'. change := OBMetaNode named: 'change'. change displaySelector: #indentedName. root childAt: #changes put: change. ^ root! ! !ORChangesBrowser class methodsFor: 'global settings' stamp: 'lr 11/1/2009 23:36'! displayDiffs ^ displayDiffs ifNil: [ displayDiffs := true ]! ! !ORChangesBrowser class methodsFor: 'global settings' stamp: 'lr 11/1/2009 23:36'! displayDiffs: aBoolean displayDiffs := aBoolean! ! !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: 'global settings' stamp: 'lr 11/1/2009 23:36'! prettyPrint ^ prettyPrint ifNil: [ prettyPrint := false ]! ! !ORChangesBrowser class methodsFor: 'global settings' stamp: 'lr 11/1/2009 23:36'! prettyPrint: aBoolean prettyPrint := aBoolean! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 20:25'! titleForRoot: aNode ^ 'Changes: ' , aNode name! ! !ORChangesBrowser methodsFor: 'commands' stamp: 'lr 3/12/2008 09:08'! cmdCommands ^ ORCmdChangeCommand allSubclasses! ! !ORChangesBrowser methodsFor: 'building' stamp: 'lr 2/7/2008 18:25'! defaultBackgroundColor ^ Color lightBlue! ! OBBrowser subclass: #ORLintBrowser instanceVariableNames: 'environment process status' 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/24/2009 00:05'! defaultRootNode ^ RBCompositeLintRule lintChecks asNode! ! !ORLintBrowser class methodsFor: 'opening' stamp: 'lr 2/23/2009 23:57'! openRule: aRule ^ (self rule: aRule) open! ! !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 6/6/2008 16:58'! titleForRoot: aNode ^ 'Code Critics: ' , aNode name! ! !ORLintBrowser methodsFor: 'private' stamp: 'lr 12/3/2009 13:28'! basicSearch: aRule | numberSelectors precentIncrement percent checker | aRule resetResult. self status: 'Searching'; refresh. numberSelectors := self environment numberSelectors. precentIncrement := numberSelectors isZero ifFalse: [ 100.0 / numberSelectors ] ifTrue: [ 100.0 ]. percent := 0.0. checker := SmalllintChecker new. checker rule: aRule; context: SmalllintContext new; environment: self environment; methodBlock: [ percent := percent + precentIncrement min: 100. self status: percent truncated asString , '%' ]. [ checker run ] ensure: [ self refresh. self status: (self root problemCount > 0 ifTrue: [ self root problemCount asString , ' problems' ]). checker release. process := nil ]! ! !ORLintBrowser methodsFor: 'commands' stamp: 'lr 10/22/2008 13:31'! cmdCommands ^ ORCmdLintCommand allSubclasses! ! !ORLintBrowser methodsFor: 'building' stamp: 'lr 3/25/2008 20:41'! defaultBackgroundColor ^ Color orange! ! !ORLintBrowser methodsFor: 'building' stamp: 'lr 3/1/2009 08:44'! defaultLabel ^ super defaultLabel , ' on ' , (self environment printStringLimitedTo: 45) , (status isNil ifFalse: [ ' (' , status , ')' ] ifTrue: [ '' ])! ! !ORLintBrowser methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:21'! environment ^ environment! ! !ORLintBrowser methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:08'! environment: anEnvironment environment := anEnvironment! ! !ORLintBrowser methodsFor: 'testing' stamp: 'lr 5/29/2008 14:35'! isSearching ^ process notNil and: [ process isTerminated not ]! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 7/16/2009 09:34'! refresh self root update: self environment. self navigationPanel selectedNode isNil ifFalse: [ self announcer announce: (OBSelectingNode node: self navigationPanel selectedNode) ]. self signalRefresh! ! !ORLintBrowser methodsFor: 'accessing-dynamic' stamp: 'lr 11/11/2008 21:41'! rule ^ self root rule! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 1/25/2009 15:24'! search: aRule process := [ self basicSearch: aRule ] newProcess. process name: 'lint'. process resume! ! !ORLintBrowser methodsFor: 'initialization' stamp: 'lr 1/25/2009 15:22'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. self search: self root rule! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 11/11/2008 21:56'! status: aString status = aString ifTrue: [ ^ self ]. status := aString. self relabel: self defaultLabel! ! !ORLintBrowser methodsFor: 'private' stamp: 'lr 5/29/2008 14:46'! windowIsClosing self isSearching ifTrue: [ process terminate ]! ! !CategoryEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/8/2009 10:51'! browserClass ^ self categories size > 1 ifTrue: [ ORCategoryBrowser ] ifFalse: [ ORClassBrowser ]! ! 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 3/13/2008 08:06'! preconditions ^ (RBCondition definesSelector: selector in: class) & (RBCondition definesSelector: selector in: target) not & (RBCondition withBlock: [ self checkInstVars. true ])! ! !ORSwapMethodRefactoring methodsFor: 'initialization' stamp: 'lr 10/26/2009 22:09'! swapMethod: aSelector in: aClass class := self classObjectFor: aClass. target := self classObjectFor: (class isMeta ifTrue: [ class theNonMetaClass ] ifFalse: [ class theMetaClass ]). 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! ! OBDefinition subclass: #ORSearcherDefinition instanceVariableNames: 'environment text' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Matcher'! ORSearcherDefinition subclass: #ORRewriterDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Matcher'! !ORRewriterDefinition methodsFor: 'configuration' stamp: 'lr 2/24/2009 13:55'! createRuleFor: aMatcher ^ ORPluggableRewriteRule new rewriteRule: aMatcher; yourself! ! !ORRewriterDefinition methodsFor: 'configuration' stamp: 'lr 11/2/2009 00:15'! template ^ 'RBParseTreeRewriter new replace: ''`@object'' with: ''`@object''; replace: ''`@object'' with: ''`@object'' when: [ :node | true ]; replace: ''`@object'' withValueFrom: [ :node | node ]; replace: ''`@object'' withValueFrom: [ :node | node ] when: [ :node | true ]; replaceMethod: ''`@method: `@args | `@temps | `@.statements'' with: ''`@method: `@args | `@temps | `@.statements''; replaceMethod: ''`@method: `@args | `@temps | `@.statements'' with: ''`@method: `@args | `@temps | `@.statements'' when: [ :node | true ]; replaceMethod: ''`@method: `@args | `@temps | `@.statements'' withValueFrom: [ :node | node ]; replaceMethod: ''`@method: `@args | `@temps | `@.statements'' withValueFrom: [ :node | node ] when: [ :node | true ]; yourself'! ! !ORSearcherDefinition class methodsFor: 'instance-creation' stamp: 'lr 3/1/2008 18:14'! on: anEnvironment ^ self new initializeOn: anEnvironment! ! !ORSearcherDefinition methodsFor: 'accessing' stamp: 'lr 11/9/2008 16:29'! accept: aText notifying: aController | rule | text := aText asString. rule := self createRuleFor: (self class evaluatorClass evaluate: text for: self notifying: aController logged: false). OBWaitRequest block: [ rule runOnEnvironment: environment ]. rule problemCount = 0 ifTrue: [ OBInformRequest message: 'No matches found.' ] ifFalse: [ rule browserInstance open ]. ^ rule problemCount > 0! ! !ORSearcherDefinition methodsFor: 'configuration' stamp: 'lr 2/24/2009 13:54'! createRuleFor: aMatcher ^ ORPluggableSearchRule new matcher: aMatcher; yourself! ! !ORSearcherDefinition methodsFor: 'initialization' stamp: 'lr 3/1/2008 18:15'! initializeOn: anEnvironment environment := anEnvironment! ! !ORSearcherDefinition methodsFor: 'configuration' stamp: 'lr 11/2/2009 00:15'! template ^ 'RBParseTreeSearcher new matches: ''`@object'' do: [ :node :answer | node ]; matchesMethod: ''`@method: `@args | `@temps | `@.statements'' do: [ :node :answer | node ]; yourself'! ! !ORSearcherDefinition methodsFor: 'accessing' stamp: 'lr 3/1/2008 18:16'! text ^ text ifNil: [ text := self template ]! ! !VariableEnvironment methodsFor: '*ob-refactory' stamp: 'lr 3/8/2009 15:38'! browserClass ^ ORVariableBrowser! ! 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 10/30/2009 16:46'! refactorings | class | class := self classObjectFor: 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 10/26/2009 22:21'! preconditions ^ RBCondition withBlock: [ (self theClass withAllSubclasses detect: [ :each | (each whichSelectorsReferToSymbol: #subclassResponsibility) notEmpty or: [ (each theMetaClass whichSelectorsReferToSymbol: #subclassResponsibility) notEmpty ] ] ifNone: [ nil ]) isNil ] errorString: self theClass printString , ' is abstract or has abstract subclasses.'! ! !ORRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/30/2009 16:27'! theClass ^ (self classObjectFor: className) theNonMetaClass! ! !ORRealizeClassRefactoring methodsFor: 'transforming' stamp: 'lr 10/26/2009 22:09'! transform self transform: self theClass. self transform: self theClass theMetaClass! ! !ORRealizeClassRefactoring methodsFor: 'transforming' stamp: 'lr 11/1/2009 23:59'! transform: aClass | class method parseTree | aClass allSelectors do: [ :selector | class := aClass whoDefinesMethod: selector. (class notNil and: [ class ~= aClass ]) 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). method compileTree: parseTree ] ] ]! ! !OBMethodDefinition methodsFor: '*ob-refactory' stamp: 'lr 11/8/2009 10:26'! prettyPrint: aString | tree | tree := RBParser parseMethod: aString onError: [ :err :pos | ^ aString ]. source := RBProgramNode formatterClass new format: tree. ^ source! ! !OBClassNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:41'! definedWithinBrowserEnvironment: anEnvironment ^ (super definedWithinBrowserEnvironment: anEnvironment) and: [ anEnvironment definesClass: self theClass ]! ! 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: 'InsideAttribute OutsideAttribute' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORHightlightEnvironmentFilter class methodsFor: 'class initialization' stamp: 'lr 11/25/2009 11:33'! initialize InsideAttribute := TextEmphasis normal. OutsideAttribute := TextColor gray! ! !ORHightlightEnvironmentFilter methodsFor: 'filtering' stamp: 'lr 11/25/2009 11:35'! displayString: aString forParent: aParentNode child: aNode ^ aString asText addAttribute: ((aNode definedWithinBrowserEnvironment: environment ) ifTrue: [ InsideAttribute ] ifFalse: [ OutsideAttribute ]); yourself! ! OBFilter subclass: #ORLintResultFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORLintResultFilter methodsFor: 'filtering' stamp: 'lr 10/22/2008 13:59'! displayString: aString forNode: aNode | problemCount | problemCount := aNode problemCount. problemCount = 0 ifTrue: [ ^ aString ]. ^ (aString , ' (' , 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 ]! ! !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 11/8/2009 10:31'! cmdFormat ^ ORCmdFormat! ! !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 2/26/2009 20:49'! cmdPrettyPrintAll ^ ORCmdPrettyPrintAll! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 2/6/2009 11:37'! cmdRecompile ^ ORCmdRecompile! ! !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: #ORCategoryBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORCategoryBrowser class methodsFor: 'configuration' stamp: 'lr 2/8/2009 10:53'! defaultMetaNode | root cat | root := OBMetaNode named: 'Environment'. cat := OBMetaNode named: 'Class Category'. root childAt: #classCategories put: cat. cat ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: cat. ^ root! ! 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: 'opening' stamp: 'lr 3/12/2008 10:21'! 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/12/2009 10:23'! defaultMetaNode | class method | class := OBMetaNode named: 'Class'. method := OBMetaNode named: 'Method'. class childAt: #methods put: method; addFilter: OBClassSortFilter new. method displaySelector: #fullNameWithProtocol. ^ 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/12/2009 10:21'! 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: #fullNameWithProtocol. ^ 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/12/2009 22:03'! 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: #ORProtocolBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORProtocolBrowser class methodsFor: 'configuration' stamp: 'lr 2/12/2009 21:36'! defaultMetaNode | browser protocol method | browser := OBMetaNode named: 'Environment'. protocol := OBMetaNode named: 'Protocol'. method := OBMetaNode named: 'Method'. browser childAt: #protocols put: protocol; ancestrySelector: #isDescendantOfClass:. protocol childAt: #methods put: method; ancestrySelector: #isDescendantOfMethodCat:. method ancestrySelector: #isDescendantOfMethod:; addFilter: OBInheritanceFilter new. ^ browser! ! !ORProtocolBrowser class methodsFor: 'configuration' stamp: 'lr 2/12/2009 21:33'! paneCount ^ 2! ! !ORProtocolBrowser methodsFor: 'initialization' stamp: 'lr 2/12/2009 20:57'! setMetaNode: aMetaNode node: aNode | filter | filter := ORHideEnvironmentFilter on: aNode browserEnvironment. aMetaNode withAllChildrenDo: [ :each | each addFilter: filter ]. super setMetaNode: aMetaNode node: aNode! ! OREnvironmentBrowser subclass: #ORSingleClassBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORSingleClassBrowser class methodsFor: 'configuration' stamp: 'lr 2/12/2009 21:40'! defaultMetaNode | browser protocol method | browser := OBMetaNode named: 'Environment'. protocol := OBMetaNode named: 'Protocol'. method := OBMetaNode named: 'Method'. browser childAt: #classProtocols labeled: 'instance' put: protocol; childAt: #metaclassProtocols labeled: 'class' put: protocol; ancestrySelector: #isDescendantOfClass:; addFilter: OBModalFilter new. protocol childAt: #methods put: method; ancestrySelector: #isDescendantOfMethodCat:. method ancestrySelector: #isDescendantOfMethod:; addFilter: OBInheritanceFilter new. ^ browser! ! !ORSingleClassBrowser class methodsFor: 'configuration' stamp: 'lr 2/12/2009 21:36'! paneCount ^ 2! ! 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! ! OREnvironmentBrowser subclass: #ORVariableBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORVariableBrowser class methodsFor: 'configuration' stamp: 'lr 3/13/2009 14:18'! defaultMetaNode | browser variable method | browser := OBMetaNode named: 'Environment'. variable := OBMetaNode named: 'Variable'. method := OBMetaNode named: 'Method'. browser childAt: #instanceVariables put: variable; childAt: #classVariables put: variable; addFilter: OBClassSortFilter new. variable childAt: #accessors put: method; displaySelector: #fullName; addFilter: OBClassSortFilter new. method displaySelector: #fullNameWithProtocol. ^ browser! ! !ORVariableBrowser class methodsFor: 'configuration' stamp: 'lr 3/8/2009 18:49'! paneCount ^ 2! ! !ORVariableBrowser methodsFor: 'initializing' stamp: 'lr 3/8/2009 18:52'! setMetaNode: aMetaNode node: aNode | filter | filter := ORHideEnvironmentFilter on: aNode browserEnvironment. aMetaNode withAllChildrenDo: [ :each | each name = 'Environment' ifFalse: [ each addFilter: filter ] ]. super setMetaNode: aMetaNode node: aNode! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 12:27'! browserEnvironment ^ BrowserEnvironment new forCategories: (Array with: self name)! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 9/26/2008 12:15'! containingPackage ^ PackageOrganizer default packages detect: [ :each | each includesSystemCategory: self name ] ifNone: [ super containingPackage ]! ! !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 11/25/2009 09:15'! classes ^ self extensionClasses collect: [ :each | each asNode ]! ! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 11/25/2009 09:15'! comments ^ self extensionClasses collect: [ :each | each asCommentNode ]! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:11'! definition ^ self! ! !ORPackageExtensionNode methodsFor: 'private' stamp: 'lr 12/3/2009 18:51'! extensionClasses ^ environment packages inject: Set new into: [ :classes :info | classes addAll: (info extensionClasses collect: [ :each | each theNonMetaClass ]); yourself ]! ! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 11/25/2009 09:15'! metaclasses ^ self 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! ! !ProtocolEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/12/2009 20:10'! browserClass ^ ORProtocolBrowser! ! !BrowserEnvironment methodsFor: '*ob-refactory-accessing' stamp: 'lr 2/26/2009 14:44'! allClasses | classes | classes := IdentitySet new: 4096. self classesDo: [ :each | classes add: each theNonMetaClass ]. ^ classes asArray! ! !BrowserEnvironment methodsFor: '*ob-refactory-accessing' stamp: 'lr 2/26/2009 14:44'! allMetaClasses | classes | classes := IdentitySet new: 4096. self classesDo: [ :each | each isMeta ifTrue: [ classes add: each ] ]. ^ classes asArray! ! !BrowserEnvironment methodsFor: '*ob-refactory-accessing' stamp: 'lr 2/26/2009 14:44'! allNonMetaClasses | classes | classes := IdentitySet new: 4096. self classesDo: [ :each | each isMeta ifFalse: [ classes add: each ] ]. ^ classes asArray! ! !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! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/5/2009 14:37'! open ^ self browserInstance open! ! !PackageEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/10/2008 11:56'! browserClass ^ ORPackageBrowser! ! !RBBasicLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 2/23/2009 21:51'! asNode ^ ORBasicLintNode on: self! ! !RBBasicLintRule methodsFor: '*ob-refactory' stamp: 'lr 2/24/2009 19:37'! browserInstance ^ self filteredResult browserInstance! ! !RBBasicLintRule methodsFor: '*ob-refactory' stamp: 'lr 2/23/2009 21:51'! open ^ self browserInstance open! ! RBParseTreeLintRule subclass: #ORPluggableSearchRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Matcher'! !ORPluggableSearchRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:10'! isVisible ^ false! ! !ORPluggableSearchRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 13:56'! matcher: aMatcher matcher := aMatcher! ! !ORPluggableSearchRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 13:57'! name ^ 'Search Code'! ! !RefactoryChange methodsFor: '*ob-refactory-converting' stamp: 'lr 3/12/2008 09:16'! 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! ! !RefactoryChange methodsFor: '*ob-refactory-accessing' stamp: 'lr 3/12/2008 10:18'! changeClass ^ nil! ! !RefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/5/2009 14:43'! open ^ self browserInstance open! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 13:48'! browserEnvironment ^ BrowserEnvironment new forClass: self theClass protocols: (Array with: self category)! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 13:46'! withinBrowserEnvironment: anEnvironment ^ self methods anySatisfy: [ :each | each withinBrowserEnvironment: anEnvironment ] ! ! !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 ]! ! !OBClassCommentNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:42'! definedWithinBrowserEnvironment: anEnvironment ^ (super definedWithinBrowserEnvironment: anEnvironment) and: [ anEnvironment definesClass: self theClass ]! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 12:23'! browserEnvironment ^ BrowserEnvironment new forClass: self theClass selectors: (Array with: self selector)! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:11'! containingPackage ^ PackageOrganizer default mostSpecificPackageOfMethod: self reference ifNone: [ super containingPackage ]! ! !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 11/11/2008 13:30'! browserEnvironment ^ BrowserEnvironment new forClasses: (Array with: self theClass)! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:10'! containingPackage ^ PackageOrganizer default mostSpecificPackageOfClass: self theClass ifNone: [ super containingPackage ]! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:23'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesClass: self theClass! ! OBNode subclass: #ORLintNode instanceVariableNames: 'rule problemCount' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! ORLintNode subclass: #ORBasicLintNode instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORBasicLintNode methodsFor: 'actions' stamp: 'lr 1/17/2009 12:16'! browse self result browserInstance open! ! !ORBasicLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:05'! result ^ result! ! !ORBasicLintNode methodsFor: 'accessing' stamp: 'lr 7/16/2009 09:48'! text | text | text := String streamContents: [ :stream | stream cr; cr. self result isClassEnvironment ifTrue: [ self result classNames asSortedCollection do: [ :each | stream nextPutAll: each; cr ] ] ifFalse: [ self result classesAndSelectorsDo: [ :class :selector | stream nextPutAll: class name; nextPutAll: '>>'; print: selector; cr ] ] ] limitedTo: 4096. text size < 4096 ifFalse: [ text := text , '...' ]. ^ super text , text! ! !ORBasicLintNode methodsFor: 'actions' stamp: 'lr 8/7/2009 12:58'! update: anEnvironment result := rule filteredResult. result isSelectorEnvironment ifTrue: [ result copy classesAndSelectorsDo: [ :class :selector | (anEnvironment includesSelector: selector in: class) ifFalse: [ result removeClass: class selector: selector ] ] ]. problemCount := result problemCount! ! ORLintNode subclass: #ORCompositeLintNode instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 10/22/2008 13:48'! compositeRules ^ self 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 10/22/2008 13:48'! leafRules ^ self rules reject: [ :each | each isComposite ]! ! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 15:30'! rules ^ rules! ! !ORCompositeLintNode methodsFor: 'actions' stamp: 'lr 5/29/2008 14:41'! update rules := rule rules collect: [ :each | each asNode ]! ! !ORCompositeLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:22'! update: anEnvironment self rules do: [ :each | each update: anEnvironment ]. problemCount := self rules inject: 0 into: [ :result :each | result + each problemCount ]! ! !ORLintNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 15:21'! on: aRule ^ self new initializeOn: aRule! ! !ORLintNode methodsFor: 'actions' stamp: 'lr 1/17/2009 12:16'! browse! ! !ORLintNode methodsFor: 'initialization' stamp: 'lr 10/22/2008 14:16'! initializeOn: aRule rule := aRule. problemCount := 0! ! !ORLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ false! ! !ORLintNode methodsFor: 'accessing' stamp: 'djr 11/9/2008 13:17'! isEmpty ^ problemCount = 0! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:23'! name ^ rule name! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:16'! problemCount ^ problemCount! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 13:50'! rationale ^ self rule rationale! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:22'! rule ^ rule! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/24/2009 19:56'! text ^ self name asText allBold , (self rationale isEmpty ifFalse: [ String cr , String cr , self rationale ] ifTrue: [ String new ])! ! !ORLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:04'! update: anEnvironment! ! ORLintNode subclass: #ORTransformationLintNode instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORTransformationLintNode methodsFor: 'actions' stamp: 'lr 1/17/2009 12:16'! browse self changes browserInstance open! ! !ORTransformationLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:09'! changes ^ changes! ! !ORTransformationLintNode methodsFor: 'accessing' stamp: 'lr 2/24/2009 19:56'! text ^ super text , (String streamContents: [ :stream | stream cr; cr. self changes changes do: [ :each | stream nextPutAll: each displayString; cr ] ])! ! !ORTransformationLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:17'! update: anEnvironment changes := CompositeRefactoryChange named: self name. changes changes: self rule changes. problemCount := changes problemCount! ! !RBLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 2/23/2009 21:51'! asNode ^ self subclassResponsibility! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 13:54'! browserEnvironment ^ ClassEnvironment onEnvironment: BrowserEnvironment new classes: (Array with: self theClass)! ! RBTransformationRule subclass: #ORPluggableRewriteRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Matcher'! !ORPluggableRewriteRule class methodsFor: 'testing' stamp: 'lr 2/24/2009 17:10'! isVisible ^ false! ! !ORPluggableRewriteRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 13:57'! name ^ 'Rewrite Code'! ! !ORPluggableRewriteRule methodsFor: 'accessing' stamp: 'lr 2/24/2009 13:53'! rewriteRule: aRule rewriteRule := aRule! ! !RBTransformationRule methodsFor: '*ob-refactory-converting' stamp: 'lr 2/23/2009 23:50'! asNode ^ ORTransformationLintNode on: self! ! !RBTransformationRule methodsFor: '*ob-refactory' stamp: 'lr 2/23/2009 23:50'! browserInstance | change | change := CompositeRefactoryChange named: self name. change changes: self changes. ^ change browserInstance! ! !RBTransformationRule methodsFor: '*ob-refactory' stamp: 'lr 2/23/2009 23:50'! open ^ self browserInstance open! ! 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/12/2009 20:45'! classCategories ^ self browserEnvironment categories collect: [ :each | OBClassCategoryNode on: each ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/12/2009 21:54'! classProtocols ^ self browserEnvironment allNonMetaClasses gather: [ :class | class asNode categories ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 7/3/2009 21:40'! classVariables | classes variables | classes := Dictionary new. self browserEnvironment classesDo: [ :class | (self browserEnvironment classVariablesFor: class) do: [ :name | (classes at: ((class whichClassDefinesClassVar: name) ifNil: [ class whichSuperclassSatisfies: [ :each | each poolDictionaryNames includes: name ] ]) ifAbsentPut: [ Set new ]) add: name ] ]. variables := OrderedCollection new. classes keysAndValuesDo: [ :class :names | names do: [ :name | variables add: (OBClassVariableNode on: name inClass: class) ] ]. ^ variables! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/12/2009 21:54'! classes ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 3/8/2009 15:55'! comments ^ self browserEnvironment allClasses collect: [ :each | each asCommentNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 3/5/2009 20:45'! environments ^ self browserEnvironment environments asSortedCollection collect: [ :label | self class onEnvironment: ((self browserEnvironment environmentNamed: label) label: label) ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 3/8/2009 18:47'! instanceVariables | classes variables | classes := Dictionary new. self browserEnvironment classesDo: [ :class | (self browserEnvironment instanceVariablesFor: class) do: [ :name | (classes at: (class whichClassDefinesInstVar: name) ifAbsentPut: [ Set new ]) add: name ] ]. variables := OrderedCollection new. classes keysAndValuesDo: [ :class :names | names do: [ :name | variables add: (OBInstanceVariableNode on: name inClass: class) ] ]. ^ variables! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/12/2009 21:54'! metaclassProtocols ^ self browserEnvironment allMetaClasses gather: [ :class | class asClassSideNode categories ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/12/2009 21:54'! metaclasses ^ self browserEnvironment allMetaClasses 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 11/25/2009 09:12'! packageCategories ^ self browserEnvironment categories collect: [ :each | OBClassCategoryNode on: each ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 11/11/2008 13:44'! packageExtensionCategory ^ Array with: (ORPackageExtensionNode on: '*Extensions' inEnvironment: self browserEnvironment)! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/12/2009 21:56'! protocols ^ self browserEnvironment classes gather: [ :class | class asNode categories ]! ! !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: 'initialization' stamp: 'lr 2/10/2008 13:00'! setBrowserEnvironment: anEnvironment browserEnvironment := anEnvironment! ! !OREnvironmentNode methodsFor: 'accessing' stamp: 'lr 2/8/2009 10:33'! text ^ self name! ! !ClassEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/12/2009 21:05'! browserClass ^ self classNames size > 1 ifTrue: [ ORClassBrowser ] ifFalse: [ ORSingleClassBrowser ]! ! !AddMethodChange methodsFor: '*ob-refactory-converting' stamp: 'lr 2/7/2008 18:30'! asNode ^ ORAddMethodChangeNode on: self! ! !OBVariableNode methodsFor: '*ob-refactory' stamp: 'lr 3/13/2009 14:18'! fullName ^ self theClassName , ' ' , self name! ! !RBMethodName methodsFor: '*ob-refactory' stamp: 'lr 3/12/2008 16:23'! printOn: aStream | argumentStream | self selector isNil ifTrue: [ self selector: (#value numArgs: self arguments size) ]. argumentStream := self arguments readStream. self selector keywords keysAndValuesDo: [ :key :part | key = 1 ifFalse: [ aStream space ]. aStream nextPutAll: part. (self selector isUnary or: [ argumentStream atEnd ]) ifTrue: [ ^ self ]. aStream space; nextPutAll: argumentStream next ]! ! !RBCompositeLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 2/23/2009 21:09'! asNode ^ ORCompositeLintNode on: self! ! !OBClassVariableNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 12:25'! browserEnvironment ^ VariableEnvironment referencesToClassVariable: self name in: self theClass! ! !OBClassVariableNode methodsFor: '*ob-refactory' stamp: 'lr 3/8/2009 18:01'! withinBrowserEnvironment: anEnvironment ^ (anEnvironment classVariablesFor: self theClass) includes: self name! ! 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 3/12/2008 09:08'! group ^ #action! ! !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: #ORCmdApplyChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdApplyChange methodsFor: 'execution' stamp: 'lr 3/12/2008 10:21'! execute self performChange: target change. self refresh! ! !ORCmdApplyChange methodsFor: 'accessing' stamp: 'lr 1/30/2009 23:40'! label ^ 'apply'! ! ORCmdChangeCommand subclass: #ORCmdBrowseChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdBrowseChange methodsFor: 'execution' stamp: 'lr 3/24/2008 11:51'! execute target browse! ! !ORCmdBrowseChange methodsFor: 'testing' stamp: 'lr 3/24/2008 11:54'! isEnabled ^ target change changeClass notNil! ! !ORCmdBrowseChange methodsFor: 'accessing' stamp: 'lr 3/24/2008 11:51'! keystroke ^ $b! ! !ORCmdBrowseChange methodsFor: 'accessing' stamp: 'lr 3/24/2008 11:51'! label ^ 'browse'! ! 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 3/12/2008 09:09'! group ^ #action! ! !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: #ORCmdDisplayDiffChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdDisplayDiffChanges methodsFor: 'execution' stamp: 'lr 11/1/2009 23:23'! execute ORChangesBrowser displayDiffs: ORChangesBrowser displayDiffs not. self browser announce: (OBDefinitionChanged node: target definition: target)! ! !ORCmdDisplayDiffChanges methodsFor: 'accessing' stamp: 'lr 1/30/2009 23:38'! group ^ #settings! ! !ORCmdDisplayDiffChanges methodsFor: 'accessing' stamp: 'lr 1/30/2009 23:38'! keystroke ^ $d! ! !ORCmdDisplayDiffChanges methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:35'! label ^ (ORChangesBrowser displayDiffs ifTrue: [ '' ] ifFalse: [ '']) , 'diff changes'! ! ORCmdChangeCommand subclass: #ORCmdFileOutChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdFileOutChanges methodsFor: 'execution' stamp: 'lr 3/13/2009 17:23'! 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! ! !ORCmdFileOutChanges methodsFor: 'accessing' stamp: 'lr 1/30/2009 23:36'! group ^ #action! ! !ORCmdFileOutChanges methodsFor: 'accessing' stamp: 'lr 1/30/2009 23:40'! keystroke ^ $o! ! !ORCmdFileOutChanges methodsFor: 'accessing' stamp: 'lr 1/30/2009 23:40'! label ^ 'file out'! ! ORCmdChangeCommand subclass: #ORCmdPrettyPrintChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdPrettyPrintChanges methodsFor: 'execution' stamp: 'lr 11/1/2009 23:33'! execute ORChangesBrowser prettyPrint: ORChangesBrowser prettyPrint not. self browser announce: (OBDefinitionChanged node: target definition: target)! ! !ORCmdPrettyPrintChanges methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:32'! group ^ #settings! ! !ORCmdPrettyPrintChanges methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:33'! keystroke ^ $p! ! !ORCmdPrettyPrintChanges methodsFor: 'accessing' stamp: 'lr 11/1/2009 23:37'! label ^ (ORChangesBrowser prettyPrint ifTrue: [ '' ] ifFalse: [ '']) , 'pretty print'! ! ORCmdChangeCommand subclass: #ORCmdRemoveChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdRemoveChange methodsFor: 'execution' stamp: 'lr 3/12/2008 10:19'! execute target remove. self refresh! ! !ORCmdRemoveChange methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:14'! keystroke ^ $x! ! !ORCmdRemoveChange methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:13'! label ^ 'remove'! ! ORCmdChangeCommand subclass: #ORCmdRemoveClassChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdRemoveClassChanges methodsFor: 'execution' stamp: 'lr 3/12/2008 10:20'! execute self browser root changes do: [ :each | (target change changeClass = each change changeClass) ifTrue: [ each remove ] ]. self refresh! ! !ORCmdRemoveClassChanges methodsFor: 'testing' stamp: 'lr 3/12/2008 10:19'! isEnabled ^ target change changeClass notNil! ! !ORCmdRemoveClassChanges methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:13'! label ^ 'remove class'! ! 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 2/26/2009 17:11'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !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 2/26/2009 17:11'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !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 3/8/2009 19:08'! environment ^ super environment classVarRefsTo: (self chooseFrom: self classVariables) in: target theClass! ! !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 subclass: #ORCmdDependenciesEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdDependenciesEnvironment methodsFor: 'private' stamp: 'lr 3/16/2009 09:57'! add: aClass to: anEnvironment anEnvironment addClass: aClass theNonMetaClass; addClass: aClass theMetaClass! ! !ORCmdDependenciesEnvironment methodsFor: 'accessing' stamp: 'lr 3/16/2009 10:06'! environment "Build an environment with all the static dependnecies." | result parent | result := ClassEnvironment new. parent := super environment. parent classesDo: [ :each | "(1) super classes" (each superclass isNil and: [ (parent includesClass: each superclass) not ]) ifTrue: [ self add: each superclass to: result ] ]. parent classesAndSelectorsDo: [ :class :selector | "(2) extended classes" (parent includesClass: class) ifFalse: [ self add: class superclass to: result ]. "(3) referenced classes" (class compiledMethodAt: selector) literals allButLast do: [ :literal | (literal isVariableBinding and: [ literal value isBehavior and: [ (parent includesClass: literal value) not ]]) ifTrue: [ self add: literal value superclass to: result ] ] ]. ^ result label: 'External Dependencies of ' , parent label! ! !ORCmdDependenciesEnvironment methodsFor: 'testing' stamp: 'lr 3/16/2009 09:50'! isActive ^ super isActive and: [ self browser environment isSystem not ]! ! !ORCmdDependenciesEnvironment methodsFor: 'accessing' stamp: 'lr 3/16/2009 09:50'! label ^ 'dependencies'! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 3/8/2009 19:55'! cluster ^ #'refactoring scope'! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 2/12/2009 10:51'! execute [ self openEnvironment: self environment ] on: ORUICancellationError do: [ :err | ^ 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 2/26/2009 17:11'! isActive ^ super isActive and: [ (target isKindOf: OBClassAwareNode) 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 2/26/2009 17:12'! isActive ^ super isActive and: [ (target isKindOf: OBClassAwareNode) 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 2/26/2009 17:12'! isActive ^ super isActive and: [ (target isKindOf: OBClassAwareNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable writer'! ! ORCmdEnvironment subclass: #ORCmdInverseEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInverseEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:29'! environment ^ super environment not! ! !ORCmdInverseEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:43'! group ^ #noble! ! !ORCmdInverseEnvironment methodsFor: 'testing' stamp: 'lr 11/14/2007 10:33'! isActive ^ super isActive and: [ self environment isSystem not ]! ! !ORCmdInverseEnvironment methodsFor: 'accessing' stamp: 'lr 6/13/2008 14:18'! label ^ 'inverse'! ! ORCmdEnvironment subclass: #ORCmdManualEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdManualEnvironment methodsFor: 'execution' stamp: 'lr 2/9/2008 13:52'! execute | browser | browser := ORSystemBrowser on: self environment. browser jumpTo: target. browser open! ! !ORCmdManualEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:43'! group ^ #noble! ! !ORCmdManualEnvironment methodsFor: 'accessing' stamp: 'lr 6/13/2008 14:19'! label ^ 'manual'! ! ORCmdEnvironment subclass: #ORCmdMatchesEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 13:34'! environment | literal | literal := self request: 'Literals matching:'. ^ (super environment matches: literal) label: 'Literals matching ' , literal printString; yourself! ! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:31'! label ^ 'literal matches...'! ! 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 10/17/2009 13:45'! keystroke ^ $p! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:53'! label ^ 'browse package'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/25/2009 09:11'! environment | package | ^ (super environment forPackages: (Array with: (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 9/26/2008 12:16'! package ^ target containingPackage! ! ORCmdEnvironment subclass: #ORCmdPragmaEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 7/21/2008 10:29'! environment ^ super environment forPragmas: (Array with: target selector)! ! !ORCmdPragmaEnvironment methodsFor: 'testing' stamp: 'lr 7/21/2008 10:23'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 7/21/2008 10:23'! label ^ 'pragmas'! ! 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/26/2009 17:12'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !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: #ORCmdSelectionEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectionEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 12:29'! environment ^ target browserEnvironment! ! !ORCmdSelectionEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 13:24'! group ^ #noble! ! !ORCmdSelectionEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 12:29'! label ^ 'selection'! ! ORCmdEnvironment subclass: #ORCmdSelfSendEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelfSendEnvironment methodsFor: 'accessing' stamp: 'lr 11/2/2009 00:14'! environment | parent environment matcher | parent := super environment. environment := ParseTreeEnvironment onEnvironment: parent. environment label: 'Self-Sends'; matcher: (matcher := RBParseTreeSearcher new). matcher matches: 'self `@message: ``@args' do: [ :node :answer | node ]. parent classesAndSelectorsDo: [ :class :selector | (matcher executeTree: (class compiledMethodAt: selector) parseTree initialAnswer: nil) notNil ifTrue: [ environment addClass: class selector: selector ] ]. ^ environment! ! !ORCmdSelfSendEnvironment methodsFor: 'accessing' stamp: 'lr 6/22/2008 14:15'! label ^ 'self-sends'! ! ORCmdEnvironment subclass: #ORCmdSenderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 13:35'! environment ^ (super environment referencesTo: target selector) label: 'Senders of ' , target selector printString; yourself! ! !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: #ORCmdSubclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 14:07'! environment ^ (super environment forClasses: target theNonMetaClass allSubclasses) label: 'Subclasses of ' , target theNonMetaClassName; yourself! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 2/26/2009 17:12'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'subclasses'! ! ORCmdEnvironment subclass: #ORCmdSubclassesWithHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSubclassesWithHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 14:07'! environment ^ (super environment forClasses: target theNonMetaClass withAllSubclasses) label: 'Subclasses with ' , target theNonMetaClassName; yourself! ! !ORCmdSubclassesWithHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 2/26/2009 17:12'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdSubclassesWithHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 13:39'! label ^ 'subclasses with'! ! ORCmdEnvironment subclass: #ORCmdSuperSendEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperSendEnvironment methodsFor: 'accessing' stamp: 'lr 11/2/2009 00:14'! environment | parent environment matcher | parent := super environment. environment := ParseTreeEnvironment onEnvironment: parent. environment label: 'Super-Sends'; matcher: (matcher := RBParseTreeSearcher new). matcher matches: 'super `@message: ``@args' do: [ :node :answer | node ]. parent classesAndSelectorsDo: [ :class :selector | (matcher executeTree: (class compiledMethodAt: selector) parseTree initialAnswer: nil) notNil ifTrue: [ environment addClass: class selector: selector ] ]. ^ environment! ! !ORCmdSuperSendEnvironment methodsFor: 'accessing' stamp: 'lr 6/22/2008 14:15'! label ^ 'super-sends'! ! ORCmdEnvironment subclass: #ORCmdSuperclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 14:07'! environment ^ (super environment forClasses: target theNonMetaClass allSuperclasses) label: 'Superclasses of ' , target theNonMetaClassName; yourself! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 2/26/2009 17:12'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'superclasses'! ! ORCmdEnvironment subclass: #ORCmdSuperclassesWithHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperclassesWithHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 14:07'! environment ^ (super environment forClasses: target theNonMetaClass withAllSuperclasses) label: 'Superclasses with ' , target theNonMetaClassName; yourself! ! !ORCmdSuperclassesWithHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 2/26/2009 17:12'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdSuperclassesWithHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/11/2008 13:41'! label ^ 'superclasses with'! ! ORCommand subclass: #ORCmdFormat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdFormat class methodsFor: 'testing' stamp: 'lr 6/14/2007 19:49'! takesText ^ true! ! !ORCmdFormat methodsFor: 'execution' stamp: 'lr 11/8/2009 10:25'! execute "Now this is utterly ugly, but unfortunately I see no better way doing this." | panel definition class morph source | panel := requestor browser panels detect: [ :each | each isKindOf: OBDefinitionPanel ] ifNone: [ ^ self ]. definition := panel getDefinition ifNil: [ ^ self ]. class := Smalltalk classNamed: #OBPluggableTextMorph. class isNil ifTrue: [ ^ self ]. morph := class 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! ! !ORCmdFormat methodsFor: 'accessing' stamp: 'lr 10/3/2007 20:11'! group ^ #general! ! !ORCmdFormat 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 ] ] ] ! ! !ORCmdFormat methodsFor: 'accessing' stamp: 'lr 11/8/2009 10:30'! label ^ 'format'! ! ORCommand subclass: #ORCmdLintCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! ORCmdLintCommand subclass: #ORCmdBrowse instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdBrowse methodsFor: 'execution' stamp: 'lr 1/17/2009 12:15'! execute target browse! ! !ORCmdBrowse methodsFor: 'testing' stamp: 'lr 1/25/2009 15:33'! isEnabled ^ target isComposite not and: [ target isEmpty not ]! ! !ORCmdBrowse methodsFor: 'accessing' stamp: 'lr 1/17/2009 12:15'! keystroke ^ $b! ! !ORCmdBrowse methodsFor: 'accessing' stamp: 'lr 1/17/2009 12:15'! label ^ 'browse'! ! !ORCmdBrowse methodsFor: 'testing' stamp: 'lr 1/25/2009 15:24'! wantsButton ^ true! ! ORCmdLintCommand subclass: #ORCmdImplementor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdImplementor methodsFor: 'execution' stamp: 'lr 2/24/2009 14:00'! execute target rule class browse! ! !ORCmdImplementor methodsFor: 'testing' stamp: 'lr 1/17/2009 12:35'! isEnabled ^ target isComposite not! ! !ORCmdImplementor methodsFor: 'accessing' stamp: 'lr 1/17/2009 12:34'! keystroke ^ $m! ! !ORCmdImplementor methodsFor: 'accessing' stamp: 'lr 1/17/2009 12:34'! label ^ 'implementor'! ! ORCmdLintCommand subclass: #ORCmdRefresh instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdRefresh methodsFor: 'execution' stamp: 'lr 1/25/2009 15:22'! execute self browser search: self browser root rule! ! !ORCmdRefresh methodsFor: 'testing' stamp: 'lr 1/25/2009 15:25'! isEnabled ^ requestor browser isSearching not! ! !ORCmdRefresh methodsFor: 'accessing' stamp: 'lr 8/29/2008 12:04'! keystroke ^ $r! ! !ORCmdRefresh methodsFor: 'accessing' stamp: 'lr 1/25/2009 15:26'! label ^ 'refresh'! ! !ORCmdRefresh methodsFor: 'testing' stamp: 'lr 1/25/2009 15:23'! wantsButton ^ true! ! ORCmdLintCommand subclass: #ORCmdRefreshRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdRefreshRule methodsFor: 'execution' stamp: 'lr 1/25/2009 15:23'! execute self browser search: target rule! ! !ORCmdRefreshRule methodsFor: 'testing' stamp: 'lr 1/25/2009 15:25'! isEnabled ^ requestor browser isSearching not! ! !ORCmdRefreshRule methodsFor: 'accessing' stamp: 'lr 1/25/2009 12:26'! label ^ 'refresh rule'! ! ORCommand subclass: #ORCmdOpen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpen methodsFor: 'accessing' stamp: 'lr 2/26/2009 16:55'! cluster ^ #refactor! ! !ORCmdOpen methodsFor: 'private' stamp: 'lr 5/30/2008 10:15'! definition: aDefinition requestor announce: (OBDefinitionChanged definition: aDefinition)! ! !ORCmdOpen methodsFor: 'accessing' stamp: 'lr 2/26/2009 17:03'! group ^ #open! ! ORCmdOpen subclass: #ORCmdOpenLint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenLint methodsFor: 'execution' stamp: 'lr 2/24/2009 00:07'! execute ORLintBrowser openRule: RBCompositeLintRule allRules environment: self environment! ! !ORCmdOpenLint methodsFor: 'accessing' stamp: 'lr 5/30/2008 10:11'! label ^ 'code critics'! ! ORCmdOpen subclass: #ORCmdOpenRewriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenRewriter methodsFor: 'execution' stamp: 'lr 5/30/2008 10:14'! execute self definition: (ORRewriterDefinition on: self environment)! ! !ORCmdOpenRewriter methodsFor: 'accessing' stamp: 'lr 6/6/2008 16:57'! label ^ 'rewrite code'! ! ORCmdOpen subclass: #ORCmdOpenSearcher instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenSearcher methodsFor: 'execution' stamp: 'lr 5/30/2008 10:15'! execute self definition: (ORSearcherDefinition on: self environment)! ! !ORCmdOpenSearcher methodsFor: 'accessing' stamp: 'lr 6/6/2008 16:57'! label ^ 'search code'! ! ORCmdOpen subclass: #ORCmdOpenTypeClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenTypeClass methodsFor: 'execution' stamp: 'lr 8/10/2009 16:53'! execute | typer | typer := RefactoryTyper new. typer runOn: target theClass. self definition: (OBTextDefinition text: typer printString)! ! !ORCmdOpenTypeClass methodsFor: 'testing' stamp: 'lr 8/10/2009 16:52'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdOpenTypeClass methodsFor: 'accessing' stamp: 'lr 8/10/2009 16:52'! label ^ 'type class'! ! ORCmdOpen subclass: #ORCmdOpenTypeMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenTypeMethod methodsFor: 'execution' stamp: 'lr 8/10/2009 17:30'! execute | typer tree messages stream types | typer := RefactoryTyper new. tree := RBParser parseMethod: target source. messages := tree allChildren inject: OrderedCollection new into: [ :result :node | (node isMessage and: [ node receiver isVariable ]) ifTrue: [ result addLast: node ]. result ]. stream := String new writeStream. tree allDefinedVariables do: [ :name | types := typer findTypeFor: ((messages select: [ :each | each receiver name = name ]) collect: [ :each | each selector ]). stream nextPutAll: name; nextPutAll: ': <'. types do: [ :type | stream nextPutAll: type name ] separatedBy: [ stream nextPutAll: ' | ' ]. stream nextPut: $>; cr ]. self definition: (OBTextDefinition text: stream contents)! ! !ORCmdOpenTypeMethod methodsFor: 'testing' stamp: 'lr 8/10/2009 17:32'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdOpenTypeMethod methodsFor: 'accessing' stamp: 'lr 8/10/2009 16:56'! label ^ 'type method'! ! ORCommand subclass: #ORCmdRecompile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRecompile methodsFor: 'accessing' stamp: 'lr 2/26/2009 17:03'! cluster ^ #refactor! ! !ORCmdRecompile methodsFor: 'execution' stamp: 'lr 2/26/2009 20:50'! execute OBWaitRequest block: [ self environment classesAndSelectorsDo: [ :class :selector | class recompile: selector from: class ] ]! ! !ORCmdRecompile methodsFor: 'accessing' stamp: 'lr 2/26/2009 17:03'! group ^ #tools! ! !ORCmdRecompile methodsFor: 'accessing' stamp: 'lr 2/6/2009 11:35'! label ^ 'recompile'! ! 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 3/14/2008 22:55'! refactoring ^ ORAccessorClassRefactoring className: self currentNode theClass name! ! !ORCmdClassRefactoring class methodsFor: 'testing' stamp: 'lr 3/15/2008 09:23'! takesText ^ true! ! !ORCmdClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor class'! ! !ORCmdClassRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 09:22'! isActive ^ super isActive and: [ self currentNode isKindOf: OBClassAwareNode ]! ! ORCmdClassRefactoring subclass: #ORCmdCreateSubclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdCreateSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2008 10:35'! 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 2/12/2009 10:49'! refactoring | class subclassName | class := self currentNode theNonMetaClass. subclassName := self request: 'Enter new subclass name:'. ^ AddClassRefactoring addClass: subclassName superclass: class subclasses: ((OBMultipleChoiceRequest prompt: 'Select subclasses of ' , subclassName , ':' labels: (class subclasses collect: [ :each | each name ]) values: class subclasses) ifNil: [ ^ nil ]) category: class 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 2/12/2009 10:49'! refactoring | class superclassName | class := self currentNode theNonMetaClass. superclassName := self request: 'Enter new superclass name:'. ^ ChildrenToSiblingsRefactoring name: superclassName class: class subclasses: ((OBMultipleChoiceRequest prompt: 'Select subclasses of ' , superclassName , ':' labels: (class subclasses collect: [ :each | each name ]) values: class subclasses) ifNil: [ ^ nil ])! ! 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 3/18/2008 08:39'! refactoring ^ ORRealizeClassRefactoring className: self currentNode theNonMetaClass 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/14/2008 22:55'! refactoring ^ RemoveClassRefactoring classNames: (Array with: self currentNode 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 3/15/2008 09:22'! refactoring ^ RenameClassRefactoring rename: self currentNode theNonMetaClass to: (self request: 'Enter new class name:' initialAnswer: self currentNode 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/14/2008 22:55'! refactoring ^ SplitClassRefactoring class: self currentNode 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/14/2008 23:36'! refactoring ^ self classAndVariable: [ :class :variable | AbstractClassVariableRefactoring variable: variable class: class ]! ! 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/14/2008 23:36'! refactoring ^ self classAndVariable: [ :class :variable | CreateAccessorsForVariableRefactoring variable: variable class: class 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/15/2008 09:18'! refactoring ^ AddClassVariableRefactoring variable: (self request: 'Enter the new variable name:' initialAnswer: (self selection ifNil: [ 'Var' ])) class: self currentNode theNonMetaClass! ! !ORCmdClassVarRefactoring class methodsFor: 'testing' stamp: 'lr 3/14/2008 23:18'! takesText ^ true! ! !ORCmdClassVarRefactoring methodsFor: 'private' stamp: 'lr 3/14/2008 23:35'! classAndVariable: aBlock | variable class | variable := self chooseFrom: self classVariables. class := self currentNode theNonMetaClass whichClassDefinesClassVar: variable. ^ aBlock value: class value: variable! ! !ORCmdClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor class variable'! ! !ORCmdClassVarRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 09:21'! isActive ^ super isActive and: [ self currentNode isKindOf: OBClassAwareNode ]! ! !ORCmdClassVarRefactoring methodsFor: 'testing' stamp: 'lr 3/14/2008 23:29'! isEnabled (self class = ORCmdAddClassVarRefactoring or: [ target isKindOf: OBClassAwareNode ]) ifTrue: [ ^ true ]. ^ self currentNode theNonMetaClass allClassVarNames includes: self selection! ! 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/14/2008 23:37'! refactoring ^ self classAndVariable: [ :class :variable | PullUpClassVariableRefactoring variable: variable class: class 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/14/2008 23:37'! refactoring ^ self classAndVariable: [ :class :variable | PushDownClassVariableRefactoring variable: variable class: class ]! ! 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/14/2008 23:37'! refactoring ^ self classAndVariable: [ :class :variable | RemoveClassVariableRefactoring variable: variable class: class ]! ! 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 3/14/2008 23:39'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RenameClassVariableRefactoring rename: variable to: name in: class ]! ! 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/14/2008 23:42'! refactoring ^ self classAndVariable: [ :class :variable | AbstractInstanceVariableRefactoring variable: variable class: class ]! ! 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/14/2008 23:42'! refactoring ^ self classAndVariable: [ :class :variable | CreateAccessorsForVariableRefactoring variable: variable class: class 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/15/2008 09:20'! refactoring ^ AddInstanceVariableRefactoring variable: (self request: 'Enter the new variable name:' initialAnswer: (self selection ifNil: [ 'var' ])) class: self currentNode theClass! ! !ORCmdInstVarRefactoring class methodsFor: 'testing' stamp: 'lr 3/14/2008 23:11'! takesText ^ true! ! !ORCmdInstVarRefactoring methodsFor: 'private' stamp: 'lr 3/14/2008 23:41'! classAndVariable: aBlock | variable class | variable := self chooseFrom: self instanceVariables. class := self currentNode theClass whichClassDefinesInstVar: variable. ^ aBlock value: class value: variable! ! !ORCmdInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor instance variable'! ! !ORCmdInstVarRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 09:13'! isActive ^ super isActive and: [ self currentNode isKindOf: OBClassAwareNode ]! ! !ORCmdInstVarRefactoring methodsFor: 'testing' stamp: 'lr 3/14/2008 23:28'! isEnabled (self class = ORCmdAddInstVarRefactoring or: [ target isKindOf: OBClassAwareNode ]) ifTrue: [ ^ true ]. ^ self currentNode theClass allInstVarNames includes: self selection! ! 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/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | ProtectInstanceVariableRefactoring variable: variable class: class ]! ! 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/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | PullUpInstanceVariableRefactoring variable: variable class: class 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/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | PushDownInstanceVariableRefactoring variable: variable class: class ]! ! 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/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | RemoveInstanceVariableRefactoring remove: variable from: class ]! ! 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 3/14/2008 23:55'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RenameInstanceVariableRefactoring rename: variable to: name in: class ]! ! 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/14/2008 22:52'! refactoring | initializer newSelector initialAnswer | initialAnswer := self currentNode selector numArgs = 0 ifTrue: [ self currentNode selector , ':' ] ifFalse: [ self currentNode 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: self currentNode selector in: self currentNode 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/14/2008 22:52'! refactoring ^ InlineParameterRefactoring inlineParameter: (self chooseFrom: self arguments) in: self currentNode theClass selector: self currentNode 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 3/14/2008 22:52'! refactoring ^ InlineAllSendersRefactoring sendersOf: self currentNode selector in: self currentNode theClass! ! !ORCmdMethodRefactoring class methodsFor: 'testing' stamp: 'lr 3/14/2008 22:48'! takesText ^ true! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 11/2/2009 16:16'! arguments | parser | parser := RBParser new. parser errorBlock: [ :error :position | ^ #() ]. parser initializeParserWith: self source. ^ parser parseMessagePattern argumentNames! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor method'! ! !ORCmdMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/14/2008 22:59'! isActive ^ super isActive and: [ self currentNode hasSelector ]! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:51'! source ^ self currentNode 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 3/14/2008 22:52'! refactoring ^ MoveMethodRefactoring selector: self currentNode selector class: self currentNode 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 3/14/2008 22:52'! refactoring ^ PushDownMethodRefactoring pushDown: (Array with: self currentNode selector) from: self currentNode 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 3/14/2008 22:52'! refactoring ^ PushUpMethodRefactoring pushUp: (Array with: self currentNode selector) from: self currentNode 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 3/14/2008 22:52'! refactoring ^ RemoveMethodRefactoring removeMethods: (Array with: self currentNode selector) from: self currentNode 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/14/2008 22:52'! refactoring ^ RemoveParameterRefactoring removeParameter: (self chooseFrom: self arguments) in: self currentNode theClass selector: self currentNode 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 3/14/2008 22:52'! refactoring | oldMethodName newMethodName oldArguments argumentPermutation | oldArguments := (RBParser parseMethod: (self currentNode theClass methodHeaderFor: self currentNode selector)) argumentNames. oldMethodName := RBMethodName selector: self currentNode selector arguments: oldArguments. (newMethodName := self requestMethodNameFor: oldMethodName) ifNil: [ ^ nil ]. argumentPermutation := newMethodName arguments collect: [ :each | oldArguments indexOf: each ]. ^ RenameMethodRefactoring renameMethod: self currentNode selector in: self currentNode theClass to: newMethodName selector permutation: argumentPermutation! ! ORCmdMethodRefactoring subclass: #ORCmdSwapMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! label ^ self currentNode 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 3/14/2008 22:52'! refactoring ^ ORSwapMethodRefactoring swapMethod: self currentNode selector in: self currentNode theClass! ! ORCmdRefactoring subclass: #ORCmdPrettyPrintAll instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPrettyPrintAll methodsFor: 'accessing' stamp: 'lr 2/26/2009 20:47'! cluster ^ #refactor! ! !ORCmdPrettyPrintAll methodsFor: 'accessing' stamp: 'lr 2/26/2009 20:47'! group ^ #tools! ! !ORCmdPrettyPrintAll methodsFor: 'accessing' stamp: 'lr 2/26/2009 17:06'! label ^ 'pretty print'! ! !ORCmdPrettyPrintAll methodsFor: 'accessing' stamp: 'lr 10/23/2008 15:52'! refactoring ^ ORPrettyPrintCodeRefactoring new! ! !ORCmdRefactoring methodsFor: 'execution' stamp: 'lr 2/12/2009 10:51'! execute | refactoring | refactoring := [ self refactoring ] on: ORUICancellationError do: [ :err | ^ self ]. refactoring ifNil: [ ^ self ]. refactoring model environment: self environment. [ self handleError: [ self performRefactoring: refactoring ] ] on: ORUICancellationError do: [ :err | ^ self ]! ! !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 3/15/2008 00:04'! isActive ^ super isActive and: [ self currentNode hasSelector ]! ! !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/26/2009 16:53'! cluster ^ #refactor! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/26/2009 17:05'! group ^ #'undo-redo'! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 3/13/2009 18:05'! label ^ String streamContents: [ :stream | self isEnabled ifTrue: [ stream nextPutAll: ': '; nextPutAll: self change name. stream position > 30 ifTrue: [ stream position: 30; 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 11/25/2009 10:40'! execute | current selected | current := self environment. selected := target browserEnvironment. (target definedWithinBrowserEnvironment: self environment) ifTrue: [ selected classesAndSelectorsDo: [ :class :selector | current removeClass: class selector: selector ] ] ifFalse: [ selected classesAndSelectorsDo: [ :class :selector | current addClass: class selector: selector ] ]. requestor browser signalRefresh! ! !ORCmdToggleContainment methodsFor: 'testing' stamp: 'lr 8/7/2009 12:58'! isActive ^ super isActive and: [ self environment isSelectorEnvironment ]! ! !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/14/2009 11:48'! initialize Preferences addPreference: #promptOnRefactoring categories: #('refactoring') default: true balloonHelp: 'Show the changes before applying a refactoring.'. Refactoring refactoringOptions at: #implementorToInline put: [ :ref :imps | self new requestImplementorToInline: imps ]; at: #methodName put: [ :ref :string | self new requestMethodNameFor: string ]; at: #selfArgumentName put: [ :ref | self new requestSelfArgumentName ]; at: #selectVariableToMoveTo put: [ :ref :class :selector | self new selectVariableToMoveMethodTo: selector class: class ]; at: #variableTypes put: [ :ref :types :selected | self new selectVariableTypesFrom: types selected: selected for: ref ]; at: #extractAssignment put: [ :ref :string | self new shouldExtractAssignmentTo: string ]; at: #inlineExpression put: [ :ref :string | self new shouldInlineExpression: string ]; at: #alreadyDefined put: [ :ref :class :selector | self new shouldOverride: selector in: class ]; at: #useExistingMethod put: [ :ref :selector | self new shouldUseExistingMethod: selector ]; at: #openBrowser put: [ :ref :env | self new openEnvironment: env ]! ! !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 3/1/2008 21:58'! chooseFrom: anArray title: aString ^ self chooseFrom: anArray title: aString lines: #()! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 3/1/2008 21:58'! chooseFrom: anArray title: aString lines: aCollection anArray isEmpty ifTrue: [ self uiCancellationError ]. anArray size = 1 ifTrue: [ ^ anArray first ]. ^ (OBChoiceRequest prompt: aString labels: anArray values: anArray lines: aCollection) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 3/15/2008 09:03'! classVariables | variables | variables := self currentNode theNonMetaClass allClassVarNames asSortedArray. ^ (variables includes: self selection) ifTrue: [ Array with: self selection ] ifFalse: [ (target isKindOf: OBClassVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ variables ] ]! ! !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 3/15/2008 09:08'! currentNode ^ self browser currentOrRootNode! ! !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 3/14/2008 23:56'! 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 3/15/2008 09:02'! instanceVariables | variables | variables := self currentNode theClass allInstVarNames asSortedArray. ^ (variables includes: self selection) ifTrue: [ Array with: self selection ] ifFalse: [ (target isKindOf: OBInstanceVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ variables ] ]! ! !ORCommand methodsFor: 'testing' stamp: 'lr 3/14/2008 22:57'! isActive (self class takesText and: [ target isKindOf: OBTextSelection ]) ifTrue: [ ^ true ]. (self class takesNodes and: [ requestor isSelected: target ]) ifTrue: [ ^ true ]. ^ false! ! !ORCommand methodsFor: 'actions' stamp: 'lr 5/14/2008 13:21'! openEnvironment: anEnvironment anEnvironment isSystem ifTrue: [ ^ target browse ]. anEnvironment isEmpty ifTrue: [ ^ self inform: 'Empty environment' ]. self waitWhile: [ | instance | instance := anEnvironment browserInstance. [ instance jumpTo: target ] ifError: [ instance jumpToRoot ]. instance open ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 5/14/2008 13:23'! performChange: aChange self waitWhile: [ RefactoryChangeManager instance performChange: aChange ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 3/13/2009 17:46'! performRefactoring: aRefactoring "Try to properly label aRefactoring and perform it or open the changes browser, depending on the preferences of the user." self label isNil ifFalse: [ aRefactoring model name: (String streamContents: [ :stream | self cluster isNil ifFalse: [ stream nextPutAll: self cluster; nextPutAll: ', ' ]. stream nextPutAll: self label ]) ]. self waitWhile: [ Preferences promptOnRefactoring ifFalse: [ aRefactoring execute ] ifTrue: [ aRefactoring primitiveExecute. ORChangesBrowser openChange: aRefactoring changes ] ]! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/12/2008 10:20'! refresh ^ self browser signalRefresh! ! !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: 'actions' stamp: 'lr 3/1/2008 22:54'! requestImplementorToInline: aCollection ^ Smalltalk classNamed: (self chooseFrom: (aCollection collect: [ :each | each name ]) title: 'Which implementation should be inlined?')! ! !ORCommand methodsFor: 'actions' stamp: 'lr 11/1/2009 23:13'! requestMethodNameFor: aMethodName | string parser pattern | string := self request: 'Selector Name:' initialAnswer: aMethodName asString. parser := RBParser new. parser errorBlock: [ :error :position | ^ nil ]. parser initializeParserWith: string. pattern := parser parseMessagePattern. ^ RBMethodName selector: pattern selector arguments: pattern argumentNames! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 22:55'! requestSelfArgumentName ^ self request: 'Enter name for argument to refer to "self" in extracted method'! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 21:59'! selectVariableToMoveMethodTo: aSelector class: aClass | parseTree nameList | parseTree := aClass parseTreeFor: aSelector. parseTree isNil ifTrue: [ parseTree := RBMethodNode selector: #value body: (RBSequenceNode statements: #()) ]. nameList := OrderedCollection new. nameList addAll: parseTree argumentNames asSortedCollection; addAll: aClass allInstanceVariableNames asSortedCollection. ^ self chooseFrom: nameList title: 'Select variable to move method into:' lines: (Array with: parseTree argumentNames size)! ! !ORCommand methodsFor: 'actions' stamp: 'lr 2/14/2009 11:48'! selectVariableTypesFrom: aCollectionOfTypes selected: aSelectedCollection for: aRefactoring | stream result | stream := WriteStream on: String new. aCollectionOfTypes do: [ :each | stream nextPutAll: each name ] separatedBy: [ stream cr ]. result := OBMultiLineTextRequest prompt: 'Select classes to move to:' template: stream contents. result isNil ifTrue: [ ^ self uiCancellationError ]. ^ (result findTokens: String crlf) collect: [ :each | aRefactoring model classFor: (Smalltalk classNamed: each withBlanksTrimmed) ] ! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:15'! selection ^ (target isKindOf: OBTextSelection) ifTrue: [ target text asString ]! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 21:42'! shouldExtractAssignmentTo: aString ^ self confirm: ('Do you want to extract the assignment of <1s> at the end of selection?' expandMacrosWith: aString)! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 21:42'! shouldInlineExpression: aString ^ self confirm: ('Do you want to inline <1s>? If not, it will be assigned as a temporary.' expandMacrosWith: aString)! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 21:54'! shouldOverride: aSelector in: aClass ^ self confirm: ('<1s> is already defined in the <2p> hierarchy. Extracting it to an existing selector may change behavior. Do you wish to use <1s> anyway?' expandMacrosWith: aSelector with: aClass)! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 21:41'! shouldUseExistingMethod: aSelector ^ self confirm: ('Use existing method <1s> instead of creating new method?' expandMacrosWith: aSelector)! ! !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! ! !ORCommand methodsFor: 'private' stamp: 'lr 5/14/2008 15:47'! waitWhile: aBlock ^ OBWaitRequest block: aBlock! ! !OBInstanceVariableNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 12:26'! browserEnvironment ^ VariableEnvironment referencesToInstanceVariable: self name in: self theClass! ! !OBInstanceVariableNode methodsFor: '*ob-refactory' stamp: 'lr 3/8/2009 18:00'! withinBrowserEnvironment: anEnvironment ^ (anEnvironment instanceVariablesFor: self theClass) includes: self name! ! ORHightlightEnvironmentFilter initialize! ORCommand initialize!