SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Commands-Replacement'! SystemOrganization addCategory: #'OB-Refactory-Definitions-Replacement'! 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'! !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! ! 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 12/27/2009 13:34'! transform | classes source tree formatted protocols | self model allClassesDo: [ :class | class selectors do: [ :selector | (self model environment includesSelector: selector in: class realClass) ifTrue: [ source := class sourceCodeFor: selector. source isNil ifFalse: [ tree := class parseTreeFor: selector. tree isNil ifFalse: [ formatted := tree formattedCode. (source ~= formatted and: [ (RBParser parseMethod: formatted) = tree ]) ifTrue: [ class compile: formatted classified: (class protocolsFor: selector) ] ] ] ] ] ] ! ! !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 1/20/2010 08:51'! mostSpecificPackage: aCollection ^ aCollection detectMax: [ :each | each packageName size ]! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 1/18/2010 21:58'! mostSpecificPackageIn: aCollectionOfPackages "Answer the most specific package of a collection of packages." ^ aCollectionOfPackages detectMax: [ :a | a packageName size ]! ! !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: 'comparing' stamp: 'lr 3/28/2010 14:46'! = aNode ^ self class = aNode class and: [ self change = aNode change ]! ! !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: 'comparing' stamp: 'lr 3/28/2010 14:44'! hash ^ self change hash! ! !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: 'testing' stamp: 'lr 3/28/2010 14:52'! isDescendantOf: aNode | current | current := self. [ current isNil ] whileFalse: [ current = aNode ifTrue: [ ^ true ]. current := current parent ]. ^ false! ! !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 3/28/2010 14:52'! change: aChange | root changes | root := aChange asNode. changes := root changes. ^ self root: root selection: (changes isEmpty ifTrue: [ root ] ifFalse: [ changes first ])! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 3/28/2010 14:50'! 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: #ORCreateCascadeRefactoring instanceVariableNames: 'selector selectedInterval parseTree sequenceNode statementNodes transformedNode' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORCreateCascadeRefactoring class methodsFor: 'instance-creation' stamp: 'lr 1/20/2010 08:45'! combine: anInterval from: aSelector in: aClass ^ self new combine: anInterval from: aSelector in: aClass; yourself! ! !ORCreateCascadeRefactoring class methodsFor: 'instance-creation' stamp: 'lr 1/20/2010 08:45'! model: aNamespace combine: anInterval from: aSelector in: aClass ^ self new model: aNamespace; combine: anInterval from: aSelector in: aClass; yourself! ! !ORCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 14:17'! addStatementNode: aNode aNode isMessage ifTrue: [ ^ statementNodes add: aNode ]. aNode isCascade ifTrue: [ ^ statementNodes addAll: aNode messages ]. self refactoringError: aNode formattedCode , ' is not a valid message'! ! !ORCreateCascadeRefactoring methodsFor: 'initialization' stamp: 'lr 1/5/2010 13:46'! combine: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. selectedInterval := anInterval! ! !ORCreateCascadeRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 09:11'! combineMessages "This combines the messages and adds the assignements of the last statement to the cascade. This is not necessary if there is a return, because the refactoring engine automatically compensates for that." | expression | transformedNode := RBCascadeNode messages: (statementNodes collect: [ :each | each copy ]). expression := statementNodes last parent. [ expression isAssignment ] whileTrue: [ transformedNode := RBAssignmentNode variable: expression variable value: transformedNode. expression := expression parent ]! ! !ORCreateCascadeRefactoring methodsFor: 'transforming' stamp: 'lr 1/5/2010 14:27'! compileCode class compileTree: (RBParseTreeRewriter replaceStatements: sequenceNode formattedCode with: transformedNode formattedCode in: self parseTree onInterval: selectedInterval)! ! !ORCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 14:36'! findReceiverNode "Find the sequence to be combined." | receiverNodes | receiverNodes := statementNodes collect: [ :each | each receiver ]. receiverNodes asSet size = 1 ifFalse: [ self refactoringError: 'All statements must have the same receiver' ]. (receiverNodes first isLiteralNode or: [ receiverNodes first isVariable ]) ifFalse: [ self refactoringWarning: 'The receiver is an expression. Proceed with caution' ]! ! !ORCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 14:34'! findSequenceNode "Find the sequence to be combined." sequenceNode := RBParser parseExpression: self selectedSource onError: [ :msg :pos | self refactoringError: 'Invalid source to rewrite' ]. (sequenceNode isSequence and: [ sequenceNode statements size > 1 ]) ifFalse: [ self refactoringError: 'You must select two or more statements' ]! ! !ORCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 14:35'! findStatementNodes "Find the sequence to be combined." statementNodes := OrderedCollection new. sequenceNode statements do: [ :each | (sequenceNode isLast: each) ifFalse: [ self addStatementNode: each ] ifTrue: [ | current | current := each. [ current isReturn or: [ current isAssignment ] ] whileTrue: [ current := current value ]. self addStatementNode: current ] ]! ! !ORCreateCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 1/5/2010 13:49'! parseTree parseTree isNil ifTrue: [ parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [ self refactoringError: 'Could not parse sources' ] ]. ^ parseTree! ! !ORCreateCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 14:18'! preconditions ^ (RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [ self findSequenceNode; findStatementNodes; findReceiverNode. true ])! ! !ORCreateCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 1/5/2010 13:54'! selectedSource ^ self parseTree source copyFrom: selectedInterval first to: selectedInterval last! ! !ORCreateCascadeRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 09:04'! transform self combineMessages. self compileCode! ! MethodRefactoring subclass: #ORSplitCascadeRefactoring instanceVariableNames: 'selector selectedInterval parseTree cascadeNode beforeNodes afterNodes ancestorNode' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORSplitCascadeRefactoring class methodsFor: 'instance-creation' stamp: 'lr 1/20/2010 08:46'! model: aNamespace split: anInterval from: aSelector in: aClass ^ self new model: aNamespace; split: anInterval from: aSelector in: aClass; yourself! ! !ORSplitCascadeRefactoring class methodsFor: 'instance-creation' stamp: 'lr 1/20/2010 08:46'! split: anInterval from: aSelector in: aClass ^ self new split: anInterval from: aSelector in: aClass; yourself! ! !ORSplitCascadeRefactoring methodsFor: 'transforming' stamp: 'lr 1/5/2010 13:33'! extractReceiver | name | (cascadeNode receiver isLiteralNode or: [ cascadeNode receiver isVariable ]) ifTrue: [ ^ self ]. name := self safeVariableNameFor: class temporaries: self parseTree allDefinedVariables basedOn: 'receiver'. ancestorNode parent addTemporaryNamed: name; addNode: (RBAssignmentNode variable: (RBVariableNode named: name) value: cascadeNode receiver) before: ancestorNode. cascadeNode messages do: [ :each | each receiver: (RBVariableNode named: name) ] ! ! !ORSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 13:34'! findAncestorNode "The ancestor node is the node that is contained within the sequence. In most cases this is the cascade itself, but it also can be an assignment or a return node." ancestorNode := cascadeNode. [ ancestorNode parent isSequence not and: [ ancestorNode parent isAssignment ] ] whileTrue: [ ancestorNode := ancestorNode parent ]. [ ancestorNode parent isSequence not and: [ ancestorNode parent isReturn ] ] whileTrue: [ ancestorNode := ancestorNode parent ]. ancestorNode parent isSequence ifFalse: [ self refactoringError: 'To split this cascade, you must extract it to a temporary first' ]! ! !ORSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 13:12'! findCascadeNode "Find the cascade to be split." cascadeNode := self parseTree bestNodeFor: selectedInterval. [ cascadeNode isNil or: [ cascadeNode isCascade ] ] whileFalse: [ cascadeNode := cascadeNode parent ]. cascadeNode isNil ifTrue: [ self refactoringError: 'The selection doesn''t appear to be within a cascade' ]! ! !ORSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 13:34'! findMessageNodes "Find the nodes that form the first part of the cascade and the second part of the cascade." beforeNodes := cascadeNode messages select: [ :each | each stop <= selectedInterval first ]. afterNodes := cascadeNode messages select: [ :each | selectedInterval last <= each selectorParts first start ]. (beforeNodes isEmpty or: [ afterNodes isEmpty ]) ifTrue: [ self refactoringError: 'Splitting a cascade into the whole cascade and an empty one is pointless' ]. (beforeNodes size + afterNodes size = cascadeNode messages size) ifFalse: [ self refactoringError: 'To set the split boundary place the cursor inbetween two cascaded messages' ]! ! !ORSplitCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 1/5/2010 13:34'! parseTree parseTree isNil ifTrue: [ parseTree := class parseTreeFor: selector. parseTree isNil ifTrue: [ self refactoringError: 'Could not parse sources' ] ]. ^ parseTree! ! !ORSplitCascadeRefactoring methodsFor: 'preconditions' stamp: 'lr 1/5/2010 12:58'! preconditions ^ (RBCondition definesSelector: selector in: class) & (RBCondition withBlock: [ self findCascadeNode; findAncestorNode; findMessageNodes. true ])! ! !ORSplitCascadeRefactoring methodsFor: 'initialization' stamp: 'lr 1/5/2010 11:57'! split: anInterval from: aSelector in: aClass class := self classObjectFor: aClass. selector := aSelector. selectedInterval := anInterval! ! !ORSplitCascadeRefactoring methodsFor: 'transforming' stamp: 'lr 1/5/2010 13:26'! splitCascade ancestorNode parent addNode: (beforeNodes size > 1 ifTrue: [ RBCascadeNode messages: beforeNodes ] ifFalse: [ beforeNodes first ]) before: ancestorNode. afterNodes size > 1 ifTrue: [ cascadeNode messages: afterNodes ] ifFalse: [ cascadeNode replaceWith: afterNodes first ]. class compileTree: ancestorNode methodNode! ! !ORSplitCascadeRefactoring methodsFor: 'transforming' stamp: 'lr 1/5/2010 12:45'! transform self extractReceiver. self splitCascade! ! 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: 'testing' stamp: 'lr 1/28/2010 15:30'! shouldBeStyledBy: aPluggableShoutMorph aPluggableShoutMorph classOrMetaClass: nil. ^ true! ! !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 ]! ! OBClassCommentDefinition subclass: #ORClassCommentDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Definitions-Replacement'! !ORClassCommentDefinition commentStamp: '' prior: 0! An ORClassCommentDefinition is xxxxxxxxx. Instance Variables ! !ORClassCommentDefinition methodsFor: 'callbacks' stamp: 'lr 4/3/2010 17:55'! text: aText | change | change := CommentChange comment: aText in: theClass. RefactoryChangeManager instance performChange: change. ^ true! ! !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: #ORGenerateEqualHashRefactoring instanceVariableNames: 'selectors' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORGenerateEqualHashRefactoring class methodsFor: 'instance-creation' stamp: 'lr 2/25/2010 10:54'! className: aClass selectors: anArray ^ (super className: aClass) selectors: anArray! ! !ORGenerateEqualHashRefactoring class methodsFor: 'instance-creation' stamp: 'lr 2/25/2010 10:54'! model: aNamespace className: aClass selectors: anArray ^ (super model: aNamespace className: aClass) selectors: anArray! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 10:42'! accessor: aSelector for: aVariableString ^ RBMessageNode receiver: (RBVariableNode named: aVariableString) selector: aSelector! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 11:17'! compileEqual | method statement comparison | method := RBParser parseMethod: '= anObject "Answer whether the receiver and anObject represent the same object." self == anObject ifTrue: [ ^ true ]. self class = anObject class ifFalse: [ ^ false ]'. statement := nil. selectors reverse do: [ :each | comparison := RBMessageNode receiver: (self accessor: each for: 'self') selector: #= arguments: (Array with: (self accessor: each for: 'anObject')). statement isNil ifTrue: [ statement := comparison ] ifFalse: [ statement := RBMessageNode receiver: comparison selector: #and: arguments: (Array with: (RBBlockNode body: (RBSequenceNode statements: (Array with: statement)))) ] ]. method addNode: statement; addReturn. self theClass compile: method formattedCode classified: #(comparing)! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 11:17'! compileHash | method statement hash | method := RBParser parseMethod: 'hash "Answer an integer value that is related to the identity of the receiver."'. statement := nil. selectors reverse do: [ :each | hash := RBMessageNode receiver: (self accessor: each for: 'self') selector: #hash. statement isNil ifTrue: [ statement := hash ] ifFalse: [ statement := RBMessageNode receiver: hash selector: #bitXor: arguments: (Array with: statement) ] ]. method addNode: statement; addReturn. self theClass compile: method formattedCode classified: #(comparing)! ! !ORGenerateEqualHashRefactoring methodsFor: 'preconditions' stamp: 'lr 2/25/2010 10:55'! preconditions ^ selectors inject: (RBCondition withBlock: [ selectors notEmpty and: [ selectors allSatisfy: [ :each | each numArgs = 0 ] ] ] errorString: 'No valid accessor methods given') into: [ :condition :selector | condition & (RBCondition hierarchyOf: self theClass canUnderstand: selector) ]! ! !ORGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 10:54'! selectors: anArray selectors := anArray! ! !ORGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 10:55'! theClass ^ (self classObjectFor: className) theNonMetaClass! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 10:33'! transform self compileHash. self compileEqual! ! ClassRefactoring subclass: #ORGeneratePrintStringRefactoring instanceVariableNames: 'variables' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORGeneratePrintStringRefactoring class methodsFor: 'instance-creation' stamp: 'lr 2/25/2010 11:42'! className: aClass variables: anArray ^ (super className: aClass) variables: anArray! ! !ORGeneratePrintStringRefactoring class methodsFor: 'instance-creation' stamp: 'lr 2/25/2010 11:42'! model: aNamespace className: aClass variables: anArray ^ (super model: aNamespace className: aClass) variables: anArray! ! !ORGeneratePrintStringRefactoring methodsFor: 'preconditions' stamp: 'lr 2/25/2010 11:49'! preconditions ^ variables inject: RBCondition empty into: [ :condition :variable | condition & (RBCondition definesInstanceVariable: variable in: self theClass) ]! ! !ORGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:39'! theClass ^ (self classObjectFor: className) theNonMetaClass! ! !ORGeneratePrintStringRefactoring methodsFor: 'transforming' stamp: 'lr 2/25/2010 11:52'! transform | method | method := RBParser parseMethod: 'printOn: aStream "Append a sequence of characters to aStream that identify the receiver." super printOn: aStream'. variables do: [ :each | method body addNode: (RBParser parseExpression: ('aStream nextPutAll: '' <1s>: ''; print: <1s>' expandMacrosWith: each)) ]. self theClass compile: method formattedCode classified: #(printing)! ! !ORGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:42'! variables: anArray variables := anArray! ! 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 1/21/2010 16:14'! 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). aClass compile: parseTree newSource withAttributesFrom: method ] ] ]! ! OBMethodDefinition subclass: #ORMethodDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Definitions-Replacement'! !ORMethodDefinition methodsFor: 'compiling' stamp: 'lr 4/3/2010 17:53'! compileNotifying: aController | change | change := InteractiveAddMethodChange compile: self compileText in: self compileClass classified: self compileCategory for: aController. RefactoryChangeManager instance performChange: change. ^ change definedSelector! ! !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: 'OutsideAttribute' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORHightlightEnvironmentFilter class methodsFor: 'class initialization' stamp: 'AdrianKuhn 12/24/2009 01:53'! initialize OutsideAttribute := TextColor gray! ! !ORHightlightEnvironmentFilter methodsFor: 'filtering' stamp: 'AdrianKuhn 12/24/2009 01:51'! displayString: aString forParent: aParentNode child: aNode ^ (aNode definedWithinBrowserEnvironment: environment) ifTrue: [ aString ] ifFalse: [ aString asText addAttribute: OutsideAttribute ]! ! 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/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 12/30/2009 22:43'! cmdReformat ^ ORCmdReformat! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 4/3/2010 11:56'! cmdReplaceRemoveClass ^ ORCmdRemoveClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 4/3/2010 11:56'! cmdReplaceRemoveMethod ^ ORCmdRemoveMethod! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 4/3/2010 12:28'! cmdReplaceRenameClass ^ ORCmdRenameClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdSourceRefactroings ^ ORCmdSourceRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-definitions-replacement' stamp: 'lr 4/3/2010 17:52'! definitionChanged: anAnnouncement | definition | definition := anAnnouncement definition. self definitionReplacements do: [ :spec | definition class = spec first ifTrue: [ anAnnouncement definition: (spec second new copyFrom: definition). ^ self ] ]! ! !OBCodeBrowser methodsFor: '*ob-refactory-definitions-replacement' stamp: 'lr 4/3/2010 17:10'! definitionReplacements ^ Array with: (Array with: OBClassDefinition with: ORClassDefinition) with: (Array with: OBMethodDefinition with: ORMethodDefinition) with: (Array with: OBClassCommentDefinition with: ORClassCommentDefinition)! ! !OBCodeBrowser methodsFor: '*ob-refactory-accessing' stamp: 'lr 5/21/2007 14:48'! environment ^ BrowserEnvironment new! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 4/3/2010 12:03'! obsoleteRemoveClass ^ #cmdRemoveClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 4/3/2010 12:03'! obsoleteRemoveMethod ^ #cmdRemoveMethod! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 4/3/2010 12:28'! obsoleteRenameClass ^ #cmdRenameClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-definitions-replacement' stamp: 'lr 4/3/2010 17:52'! subscribe "We want to be notified first about changes of the definition, so that we can replace it with a custom one." | actions | super subscribe. actions := announcer subscriptions at: OBDefinitionChanged ifAbsent: [ ActionSequence new ]. announcer subscriptions at: OBDefinitionChanged put: (actions copyWithFirst: (MessageSend receiver: self selector: #definitionChanged:))! ! 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'! 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 3/10/2010 11:11'! 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: OBMethodIconFilter 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 3/10/2010 11:11'! 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: OBMethodIconFilter 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 1/18/2010 22:04'! containingPackage ^ self mostSpecificPackageIn: (PackageOrganizer default packages select: [ :each | each includesSystemCategory: self name ])! ! !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'! ! OBCmdRemoveMethod subclass: #ORCmdRemoveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands-Replacement'! !ORCmdRemoveMethod methodsFor: 'private' stamp: 'lr 4/3/2010 11:58'! doRemove RefactoryChangeManager instance performChange: (RemoveMethodChange remove: target selector from: target theClass). target signalDeletion! ! !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 1/18/2010 22:01'! containingPackage ^ self mostSpecificPackageIn: (PackageOrganizer default packages select: [ :each | each includesMethodCategory: self name ofClass: self theClass ])! ! !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 ]! ! OBCmdRenameClass subclass: #ORCmdRenameClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands-Replacement'! !ORCmdRenameClass methodsFor: 'private' stamp: 'lr 4/3/2010 12:30'! doRename: oldName to: newName RefactoryChangeManager instance performChange: (RenameClassChange rename: oldName to: newName)! ! !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 1/18/2010 22:02'! containingPackage ^ self mostSpecificPackageIn: (PackageOrganizer default packages select: [ :each | each includesMethod: self selector ofClass: self theClass ])! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 5/20/2007 09:04'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesSelector: self selector in: self theClass! ! OBCmdRemoveClass subclass: #ORCmdRemoveClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands-Replacement'! !ORCmdRemoveClass methodsFor: 'private' stamp: 'lr 4/3/2010 12:04'! doRemove RefactoryChangeManager instance performChange: (RemoveClassChange remove: target theNonMetaClass). target signalDeletion! ! !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 1/18/2010 21:59'! containingPackage ^ self mostSpecificPackageIn: (PackageOrganizer default packages select: [ :each | each includesClass: self theClass ])! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:23'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesClass: self theClass! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 11/11/2008 13:54'! browserEnvironment ^ ClassEnvironment onEnvironment: BrowserEnvironment new classes: (Array with: 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! ! OBMercuryQuery subclass: #ORParseTreeQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORParseTreeQuery class methodsFor: 'configuration' stamp: 'lr 3/13/2010 13:26'! isValidQuery: aString ^ aString includes: RBScanner patternVariableCharacter! ! !ORParseTreeQuery methodsFor: 'executing' stamp: 'lr 3/13/2010 13:24'! find | rule matcher | matcher := RBParseTreeSearcher new matches: pattern do: [ :node :answer | node ]; yourself. rule := ORPluggableSearchRule new matcher: matcher; yourself. OBWaitRequest block: [ rule runOnEnvironment: browser environment ]. rule problemCount = 0 ifTrue: [ OBInformRequest message: 'No matches found.' ] ifFalse: [ rule browserInstance open ]! ! !ORParseTreeQuery methodsFor: 'initialization' stamp: 'lr 3/13/2010 13:24'! setRawQuery: aString pattern := aString! ! 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 12/8/2009 08:15'! classProtocols ^ self browserEnvironment allNonMetaClasses inject: OrderedCollection new into: [ :result :class | result addAll: (class asNode allCategory); addAll: (class asNode categories); yourself ]! ! !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 12/8/2009 08:15'! metaclassProtocols ^ self browserEnvironment allMetaClasses inject: OrderedCollection new into: [ :result :class | result addAll: (class asClassSideNode allCategory); addAll: (class asClassSideNode categories); yourself ]! ! !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! ! !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! ! !RBCompositeLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 2/23/2009 21:09'! asNode ^ ORCompositeLintNode on: self! ! OBCommand subclass: #ORCommand instanceVariableNames: '' classVariableNames: 'PromptOnRefactoring' 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 12/4/2009 08:06'! environment | condition | condition := self prompt: '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 1/28/2010 11:31'! execute "Now this is utterly ugly, but unfortunately I see no better way doing this. This is not going to work in any view other than morphic and will silently fail." | panel definition class morph source tree formatted | panel := requestor browser definitionPanel. 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. tree := RBParser parseMethod: source onError: [ :msg :pos | ^ self ]. formatted := tree formattedCode. formatted = source ifTrue: [ ^ self ]. morph editString: formatted; 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 1/28/2010 15:15'! keystroke ^ $r! ! !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: 'testing' stamp: 'lr 12/30/2009 22:39'! isActive ^ super isActive and: [ self environment isSystem not ]! ! !ORCmdRecompile methodsFor: 'accessing' stamp: 'lr 2/6/2009 11:35'! label ^ 'recompile'! ! ORCommand subclass: #ORCmdRefactoring instanceVariableNames: 'model' 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 1/20/2010 08:40'! refactoring ^ ORAccessorClassRefactoring model: self model 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 1/20/2010 08:40'! refactoring | class subclassName | class := self currentNode theNonMetaClass. subclassName := self request: 'Enter new subclass name:'. ^ AddClassRefactoring model: self model addClass: subclassName superclass: class subclasses: (self chooseMultipleFrom: class subclasses title: 'Select subclasses of ' , subclassName , ':') 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 1/20/2010 08:40'! refactoring | class superclassName | class := self currentNode theNonMetaClass. superclassName := self request: 'Enter new superclass name:'. ^ ChildrenToSiblingsRefactoring model: self model name: superclassName class: class subclasses: (self chooseMultipleFrom: class subclasses title: 'Select subclasses of ' , superclassName , ':')! ! ORCmdClassRefactoring subclass: #ORCmdGenerateEqualHashRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:28'! chooseFieldAccessors | labels accessors matcher selectors | labels := OrderedCollection new. accessors := OrderedCollection new. matcher := RBParseTreeSearcher new. matcher matches: '^ `var' do: [ :node :answer | answer add: node value name; yourself ]; matches: '^ `var `@method: `@args' do: [ :node :answer | answer add: node value receiver name; yourself ]. self currentNode theNonMetaClass withAllSuperclassesDo: [ :class | class allInstVarNames do: [ :variable | selectors := (((class whichSelectorsAccess: variable) select: [ :each | each numArgs = 0 ]) reject: [ :each | accessors includes: each ]) select: [ :each | | tree | tree := class parseTreeFor: each. tree notNil and: [ (matcher executeTree: tree initialAnswer: Set new) includes: variable ] ]. selectors do: [ :selector | accessors add: selector. labels add: selector printString , ' (' , variable , ')' ] ] ]. ^ OBMultipleChoiceRequest prompt: 'Select the fields to compare:' labels: labels values: accessors! ! !ORCmdGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 10:51'! label ^ 'generate #= and #hash'! ! !ORCmdGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 10:52'! longDescription ^ 'This refactoring adds comparator method for the selected accessors.'! ! !ORCmdGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:07'! refactoring ^ ORGenerateEqualHashRefactoring model: self model className: self currentNode theNonMetaClass name selectors: self chooseFieldAccessors! ! ORCmdClassRefactoring subclass: #ORCmdGeneratePrintStringRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:30'! chooseFieldAccessors | labels accessors matcher selectors | labels := OrderedCollection new. accessors := OrderedCollection new. matcher := RBParseTreeSearcher new. matcher matches: '^ `var' do: [ :node :answer | answer add: node value name; yourself ]; matches: '^ `var `@method: `@args' do: [ :node :answer | answer add: node value receiver name; yourself ]. self currentNode theNonMetaClass withAllSuperclassesDo: [ :class | class allInstVarNames do: [ :variable | selectors := (((class whichSelectorsAccess: variable) select: [ :each | each numArgs = 0 ]) reject: [ :each | accessors includes: each ]) select: [ :each | | tree | tree := class parseTreeFor: each. tree notNil and: [ (matcher executeTree: tree initialAnswer: Set new) includes: variable ] ]. selectors do: [ :selector | accessors add: selector. labels add: selector printString , ' (' , variable , ')' ] ] ]. ^ OBMultipleChoiceRequest prompt: 'Select the fields to compare:' labels: labels values: accessors! ! !ORCmdGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:30'! label ^ 'generate #printOn:'! ! !ORCmdGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:31'! longDescription ^ 'This refactoring adds a default print string implementation'! ! !ORCmdGeneratePrintStringRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 11:51'! refactoring ^ ORGeneratePrintStringRefactoring model: self model className: self currentNode theNonMetaClass name variables: (self chooseMultipleFrom: self instanceVariables title: 'Choose instance variables to print:')! ! 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 1/17/2010 11:00'! longDescription ^ 'This refactoring makes an abstract class concrete by installing some stub methods.'! ! !ORCmdRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:40'! refactoring ^ ORRealizeClassRefactoring model: self model 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 1/20/2010 08:40'! refactoring ^ RemoveClassRefactoring model: self model 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 1/20/2010 08:40'! refactoring ^ RenameClassRefactoring model: self model rename: self currentNode theNonMetaClass to: (self request: 'Enter the 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 1/17/2010 12:01'! longDescription ^ 'This refactoring splits a class into two classes.'! ! !ORCmdSplitClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:40'! refactoring ^ SplitClassRefactoring model: self model class: self currentNode theClass instanceVariables: (self chooseMultipleFrom: self currentNode theClass instVarNames title: 'Select variables to extract:') 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 1/20/2010 08:41'! refactoring ^ self classAndVariable: [ :class :variable | AbstractClassVariableRefactoring model: self model 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 1/20/2010 08:41'! refactoring ^ self classAndVariable: [ :class :variable | CreateAccessorsForVariableRefactoring model: self model 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 1/20/2010 08:41'! refactoring ^ AddClassVariableRefactoring model: self model 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 1/17/2010 13:27'! isActive ^ super isActive and: [ (self currentNode isKindOf: OBClassAwareNode) and: [ (self currentNode isKindOf: OBInstanceVariableNode) not ] ]! ! !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 1/20/2010 08:41'! refactoring ^ self classAndVariable: [ :class :variable | PullUpClassVariableRefactoring model: self model 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 1/20/2010 08:41'! refactoring ^ self classAndVariable: [ :class :variable | PushDownClassVariableRefactoring model: self model 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 1/20/2010 08:41'! refactoring ^ self classAndVariable: [ :class :variable | RemoveClassVariableRefactoring model: self model 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 1/20/2010 08:41'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RenameClassVariableRefactoring model: self model 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 1/20/2010 08:41'! refactoring ^ self classAndVariable: [ :class :variable | AbstractInstanceVariableRefactoring model: self model 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 1/20/2010 08:42'! refactoring ^ self classAndVariable: [ :class :variable | CreateAccessorsForVariableRefactoring model: self model 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 1/20/2010 08:42'! refactoring ^ AddInstanceVariableRefactoring model: self model 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 1/17/2010 13:28'! isActive ^ super isActive and: [ (self currentNode isKindOf: OBClassAwareNode) and: [ (self currentNode isKindOf: OBClassVariableNode) not ] ]! ! !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 1/20/2010 08:42'! refactoring ^ self classAndVariable: [ :class :variable | ProtectInstanceVariableRefactoring model: self model 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 1/20/2010 08:42'! refactoring ^ self classAndVariable: [ :class :variable | PullUpInstanceVariableRefactoring model: self model 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 1/20/2010 08:42'! refactoring ^ self classAndVariable: [ :class :variable | PushDownInstanceVariableRefactoring model: self model 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 1/20/2010 08:43'! refactoring ^ self classAndVariable: [ :class :variable | RemoveInstanceVariableRefactoring model: self model 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 1/20/2010 08:43'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RenameInstanceVariableRefactoring model: self model 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 1/20/2010 08:44'! refactoring | initializer newSelector initialAnswer | initialAnswer := self currentNode selector numArgs = 0 ifTrue: [ self currentNode selector , ':' ] ifFalse: [ self currentNode selector ]. newSelector := self prompt: 'Enter new selector:' initialAnswer: initialAnswer. newSelector isEmpty ifTrue: [ ^ nil ]. initializer := self prompt: 'Enter default value for parameter:' initialAnswer: 'nil'. initializer isEmpty ifTrue: [ ^ nil ]. ^ AddParameterRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ InlineParameterRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ InlineAllSendersRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ MoveMethodRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ PushDownMethodRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ PushUpMethodRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ RemoveMethodRefactoring model: self model 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 1/20/2010 08:44'! refactoring ^ RemoveParameterRefactoring model: self model 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 1/20/2010 08:44'! 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 model: self model 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 1/20/2010 08:44'! refactoring ^ ORSwapMethodRefactoring model: self model swapMethod: self currentNode selector in: self currentNode theClass! ! !ORCmdRefactoring methodsFor: 'execution' stamp: 'lr 1/20/2010 08:36'! execute "Execute the refactoring of the receiver." | 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 1/20/2010 18:11'! model "Answer the code-model this refactoring is supposed to work on." ^ model ifNil: [ model := RBNamespace new description: self description; yourself ]! ! !ORCmdRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:39'! model: aNamespace "Set the model this refactoring is supposed to work on, mostly used for testing." model := aNamespace! ! !ORCmdRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:37'! refactoring "Answer the refactoring of the receiver of nil." self subclassResponsibility! ! ORCmdRefactoring subclass: #ORCmdReformat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdReformat methodsFor: 'accessing' stamp: 'lr 2/26/2009 20:47'! cluster ^ #refactor! ! !ORCmdReformat methodsFor: 'accessing' stamp: 'lr 2/26/2009 20:47'! group ^ #tools! ! !ORCmdReformat methodsFor: 'testing' stamp: 'lr 12/30/2009 22:42'! isActive ^ super isActive and: [ self environment isSystem not ]! ! !ORCmdReformat methodsFor: 'accessing' stamp: 'lr 12/30/2009 22:44'! label ^ 'reformat'! ! !ORCmdReformat methodsFor: 'accessing' stamp: 'lr 10/23/2008 15:52'! refactoring ^ ORPrettyPrintCodeRefactoring new! ! ORCmdRefactoring subclass: #ORCmdSourceRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdSourceRefactoring subclass: #ORCmdCreateCascadeRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdCreateCascadeRefactoring methodsFor: 'testing' stamp: 'lr 1/5/2010 15:29'! isEnabled ^ super isEnabled and: [ self isSequenceSelected ]! ! !ORCmdCreateCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 08:32'! label ^ 'create cascade'! ! !ORCmdCreateCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 08:32'! longDescription ^ 'Create a cascade from a sequence of statements with the same receiver.'! ! !ORCmdCreateCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 08:30'! refactoring ^ ORCreateCascadeRefactoring model: self model combine: self interval from: self selector in: self theClass! ! 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/19/2010 19:25'! longDescription ^ 'Extracts the selected code as a separate method.'! ! !ORCmdExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:45'! refactoring ^ ExtractMethodRefactoring model: self model 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 1/18/2010 19:42'! longDescription ^ 'Extracts the selected code as a separate method into a different class.'! ! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:45'! refactoring ^ ExtractMethodToComponentRefactoring model: self model 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 1/20/2010 08:45'! refactoring ^ ExtractToTemporaryRefactoring model: self model 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 1/18/2010 19:43'! longDescription ^ 'Inlines a message send to a different object.'! ! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:45'! refactoring ^ InlineMethodFromComponentRefactoring model: self model 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/19/2010 19:28'! longDescription ^ 'Inlines a message send.'! ! !ORCmdInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:45'! refactoring ^ InlineMethodRefactoring model: self model 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 1/20/2010 08:45'! refactoring ^ InlineTemporaryRefactoring model: self model 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 1/20/2010 08:46'! refactoring ^ MoveVariableDefinitionRefactoring model: self model 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 1/20/2010 08:46'! refactoring ^ RenameTemporaryRefactoring model: self model 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 12/11/2009 22:16'! takesNodes ^ false! ! !ORCmdSourceRefactoring class methodsFor: 'testing' stamp: 'lr 12/11/2009 22:17'! takesText ^ true! ! !ORCmdSourceRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor source'! ! !ORCmdSourceRefactoring methodsFor: 'testing-private' stamp: 'lr 1/5/2010 15:42'! ifBestSelected: aBlock "Answer the result of evaluating aBlock with the best selected parse tree node as argument or false, if there is no valid selection." | parseTree node | parseTree := RBParser parseMethod: self text onError: [ :msg :pos | ^ false ]. node := parseTree bestNodeFor: self interval. node isNil ifTrue: [ ^ false ]. ^ aBlock value: node! ! !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 12/11/2009 14:17'! interval ^ target 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 1/5/2010 15:42'! isCascadeSelected ^ self ifBestSelected: [ :node | node parents anySatisfy: [ :each | each isCascade ] ]! ! !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 1/5/2010 15:28'! isSequenceSelected ^ self ifNodeSelected: [ :node | node isSequence ]! ! !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: #ORCmdSplitCascadeRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdSplitCascadeRefactoring methodsFor: 'testing' stamp: 'lr 1/5/2010 15:30'! isEnabled ^ super isEnabled and: [ self isCascadeSelected ]! ! !ORCmdSplitCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 1/5/2010 13:01'! label ^ 'split cascade'! ! !ORCmdSplitCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 1/19/2010 19:29'! longDescription ^ 'Splits a cascade into two cascades.'! ! !ORCmdSplitCascadeRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2010 08:46'! refactoring ^ ORSplitCascadeRefactoring model: self model split: self interval from: self selector in: self theClass! ! 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 1/20/2010 08:46'! refactoring ^ TemporaryToInstanceVariableRefactoring model: self model 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: #ORCmdSelectCode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectCode class methodsFor: 'testing' stamp: 'lr 12/11/2009 08:48'! takesNodes ^ false! ! !ORCmdSelectCode class methodsFor: 'testing' stamp: 'lr 12/11/2009 08:48'! takesText ^ true! ! !ORCmdSelectCode methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:51'! cluster ^ #selection! ! !ORCmdSelectCode methodsFor: 'execution' stamp: 'lr 12/11/2009 14:29'! execute | tree node | tree := self currentNode hasSelector ifTrue: [ RBParser parseMethod: target fullText onError: [ :err :pos | ^ self ] ] ifFalse: [ RBParser parseExpression: target fullText onError: [ :err :pos | ^ self ] ]. node := self selectionFor: ((tree bestNodeFor: target selection) ifNil: [ ^ self ]) interval: target selection. node isNil ifFalse: [ requestor selection: node sourceInterval ]! ! !ORCmdSelectCode methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:21'! selectionFor: aNode interval: anInterval "Answer a new node a given aNode in the current selection anInterval." ^ aNode! ! ORCmdSelectCode subclass: #ORCmdSelectNext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectNext methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:33'! label ^ 'next'! ! !ORCmdSelectNext methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:50'! selectionFor: aNode interval: anInterval | nodes index | nodes := aNode methodNode allChildren. index := nodes identityIndexOf: aNode ifAbsent: [ ^ nil ]. [ index < nodes size and: [ (nodes at: index) sourceInterval = anInterval ] ] whileTrue: [ index := index + 1 ]. ^ nodes at: index! ! ORCmdSelectCode subclass: #ORCmdSelectParent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectParent methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:53'! label ^ 'parent'! ! !ORCmdSelectParent methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:31'! selectionFor: aNode interval: anInterval ^ (aNode notNil and: [ aNode sourceInterval = anInterval ]) ifTrue: [ self selectionFor: aNode parent interval: anInterval ] ifFalse: [ aNode ]! ! ORCmdSelectCode subclass: #ORCmdSelectPrevious instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectPrevious methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:33'! label ^ 'previous'! ! !ORCmdSelectPrevious methodsFor: 'accessing' stamp: 'lr 12/11/2009 14:50'! selectionFor: aNode interval: anInterval | nodes index | nodes := aNode methodNode allChildren. index := nodes identityIndexOf: aNode ifAbsent: [ ^ nil ]. [ 1 < index and: [ (nodes at: index) sourceInterval = anInterval ] ] whileTrue: [ index := index - 1 ]. ^ nodes at: index! ! 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: 'accessing' stamp: 'lr 12/18/2009 20:31'! promptOnRefactoring ^ PromptOnRefactoring ifNil: [ PromptOnRefactoring := true ]! ! !ORCommand class methodsFor: 'accessing' stamp: 'lr 12/18/2009 20:31'! promptOnRefactoring: aBoolean PromptOnRefactoring := aBoolean! ! !ORCommand class methodsFor: 'settings' stamp: 'lr 12/18/2009 21:19'! settingsOn: aBuilder (aBuilder setting: #promptOnRefactoring) target: self; parentName: #refactoring; label: 'Prompt on refactoring'; description: 'Show the changes before applying a refactoring'! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:17'! browser ^ requestor browser! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 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-conveniance' stamp: 'lr 1/17/2010 11:30'! chooseMultipleFrom: anArray ^ self chooseMultipleFrom: anArray title: nil! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 1/17/2010 11:30'! chooseMultipleFrom: anArray title: aString ^ self chooseMultipleFrom: anArray title: aString lines: #()! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 1/17/2010 11:30'! chooseMultipleFrom: anArray title: aString lines: aCollection ^ anArray isEmpty ifTrue: [ anArray copyEmpty ] ifFalse: [ (OBMultipleChoiceRequest 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 1/20/2010 18:10'! description ^ String streamContents: [ :stream | self cluster isNil ifFalse: [ stream nextPutAll: self cluster; nextPutAll: ', ' ]. stream nextPutAll: self label ]! ! !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 1/18/2010 20:58'! performRefactoring: aRefactoring "Try to properly label aRefactoring and perform it or open the changes browser, depending on the preferences of the user." self refactoringOptions: aRefactoring. 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: [ self class promptOnRefactoring ifFalse: [ aRefactoring execute ] ifTrue: [ aRefactoring primitiveExecute. ORChangesBrowser openChange: aRefactoring changes ] ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 12/4/2009 08:04'! prompt: aString ^ self prompt: aString initialAnswer: String new! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 12/4/2009 08:04'! prompt: aString initialAnswer: aTemplateString ^ (OBMultiLineTextRequest prompt: aString template: aTemplateString) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 1/18/2010 20:59'! refactoringOptions: aRefactoring aRefactoring setOption: #implementorToInline toUse: [ :ref :imps | self requestImplementorToInline: imps ]; setOption: #methodName toUse: [ :ref :string | self requestMethodNameFor: string ]; setOption: #selfArgumentName toUse: [ :ref | self requestSelfArgumentName ]; setOption: #selectVariableToMoveTo toUse: [ :ref :class :selector | self selectVariableToMoveMethodTo: selector class: class ]; setOption: #variableTypes toUse: [ :ref :types :selected | self selectVariableTypesFrom: types selected: selected for: ref ]; setOption: #extractAssignment toUse: [ :ref :string | self shouldExtractAssignmentTo: string ]; setOption: #inlineExpression toUse: [ :ref :string | self shouldInlineExpression: string ]; setOption: #alreadyDefined toUse: [ :ref :class :selector | self shouldOverride: selector in: class ]; setOption: #useExistingMethod toUse: [ :ref :selector | self shouldUseExistingMethod: selector ]; setOption: #openBrowser toUse: [ :ref :env | self openEnvironment: env ]! ! !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 12/4/2009 08:05'! requestMethodNameFor: aMethodName | string parser pattern | string := self prompt: 'Method 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! ! !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 ]! ! OBClassDefinition subclass: #ORClassDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Definitions-Replacement'! !ORClassDefinition methodsFor: 'class definition' stamp: 'lr 4/3/2010 17:30'! defineClass: definition notifying: aController | change | (self confirmDefinition: definition) ifFalse: [ ^ false ]. change := InteractiveAddClassChange definition: definition for: aController. change controller: aController. RefactoryChangeManager instance performChange: change. change definedClass ifNil: [ ^ false ]. self signalSelectionOf: change definedClass. ^ true ! ! ORHightlightEnvironmentFilter initialize!