SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Changes'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Commands-Replacement'! SystemOrganization addCategory: #'OB-Refactory-Definitions-Replacement'! SystemOrganization addCategory: #'OB-Refactory-Critics'! SystemOrganization addCategory: #'OB-Refactory-Matcher'! SystemOrganization addCategory: #'OB-Refactory-Refactoring'! SystemOrganization addCategory: #'OB-Refactory-Tools'! SystemOrganization addCategory: #'OB-Refactory-Utilities'! RBMethodRefactoring 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! ! RBMethodRefactoring 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! ! RBMethodRefactoring 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! ! OBClassCommentDefinition subclass: #ORClassCommentDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Definitions-Replacement'! !ORClassCommentDefinition commentStamp: '' prior: 0! An ORClassCommentDefinition is xxxxxxxxx. Instance Variables ! !ORClassCommentDefinition methodsFor: 'accessing' stamp: 'lr 5/29/2010 08:54'! template ^ String streamContents: [ :stream | self templateOn: stream ]! ! !ORClassCommentDefinition methodsFor: 'accessing' stamp: 'lr 10/5/2010 16:14'! templateLabel: aString class: aClass variables: anArray on: aStream | typer position | anArray isEmpty ifTrue: [ ^ self ]. typer := RBRefactoryTyper new runOn: aClass. aStream cr; cr; nextPutAll: aString. anArray do: [ :each | aStream cr; tab; nextPutAll: each; tab; nextPut: $<. position := aStream position. typer printTypeFor: each on: aStream. aStream position = position ifTrue: [ aStream nextPutAll: 'Object' ]. aStream nextPut: $> ]! ! !ORClassCommentDefinition methodsFor: 'accessing' stamp: 'lr 5/29/2010 09:10'! templateOn: aStream aStream nextPutAll: theClass name; nextPutAll: ' has not been documented yet. The class comment should describe the purpose of the class, its collaborations and its variables.'. self templateLabel: 'Instance Variables:' class: theClass variables: theClass instVarNames on: aStream. self templateLabel: 'Class Instance Variables:' class: theClass class variables: theClass class instVarNames on: aStream! ! !ORClassCommentDefinition methodsFor: 'callbacks' stamp: 'lr 9/8/2011 20:10'! text: aText | change | change := RBCommentChange comment: aText asString in: theClass. RBRefactoryChangeManager instance performChange: change. ^ true! ! !OBVariableNode methodsFor: '*ob-refactory' stamp: 'lr 3/13/2009 14:18'! fullName ^ self theClassName , ' ' , self name! ! OBClassDefinition subclass: #ORClassDefinition instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Definitions-Replacement'! !ORClassDefinition methodsFor: 'class definition' stamp: 'lr 1/8/2012 15:10'! defineClass: definition notifying: aController | change | (self confirmDefinition: definition) ifFalse: [ ^ false ]. change := RBRefactoryDefinitionChange definition: definition for: aController. RBRefactoryChangeManager instance performChange: change. change definedClass ifNil: [ ^ false ]. self updateComment: definition class: change definedClass. self signalSelectionOf: change definedClass. ^ true ! ! !ORClassDefinition methodsFor: 'callbacks' stamp: 'lr 1/8/2012 15:25'! text "Patch the class comment into the class definition template." | name class | name := self nameOfClassDefinedBy: template. class := environment classNamed: name. (class isNil or: [ class organization hasComment not ]) ifTrue: [ ^ template ]. ^ template , String cr , String cr , (String with: $") , (class organization classComment copyReplaceAll: '"' with: '""') , (String with: $")! ! !ORClassDefinition methodsFor: 'class definition' stamp: 'lr 1/8/2012 15:23'! updateComment: aString class: aClass | tree comment | tree := RBParser parseExpression: aString onError: [ :msg :pos | ^ self ]. comment := String streamContents: [ :stream | tree methodNode nodesDo: [ :node | node comments do: [ :each | stream nextPutAll: (node source copyFrom: each first to: each last) ] ] ]. comment isEmpty ifTrue: [ ^ self ]. comment := (comment copyFrom: 2 to: comment size - 1) copyReplaceAll: '""' with: '"'. aClass organization classComment = comment ifFalse: [ aClass classComment: comment ]! ! !RBRefactoryChange methodsFor: '*ob-refactory-converting' stamp: 'lr 3/12/2008 09:16'! asNode ^ ORChangeNode on: self! ! !RBRefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 17:28'! browserClass ^ ORChangesBrowser! ! !RBRefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 17:28'! browserInstance ^ self browserClass change: self! ! !RBRefactoryChange methodsFor: '*ob-refactory-accessing' stamp: 'lr 3/12/2008 10:18'! changeClass ^ nil! ! !RBRefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/5/2009 14:43'! open ^ self browserInstance open! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:25'! browserEnvironment "Answer a refactoring browser environemnt of the receiving node." ^ RBBrowserEnvironment 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 8/13/2010 16:22'! on: aChange ^ self new initializeOn: aChange! ! !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! ! !RBCategoryEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/8/2009 10:51'! browserClass ^ self categories size > 1 ifTrue: [ ORCategoryBrowser ] ifFalse: [ ORClassBrowser ]! ! OBMethodDefinition subclass: #ORMethodDefinition instanceVariableNames: '' classVariableNames: 'AutoFormatOnAccept AutoFormatOnDisplay' poolDictionaries: '' category: 'OB-Refactory-Definitions-Replacement'! !ORMethodDefinition class methodsFor: 'accessing' stamp: 'lr 9/13/2010 13:13'! autoFormatOnAccept ^ AutoFormatOnAccept! ! !ORMethodDefinition class methodsFor: 'accessing' stamp: 'lr 9/13/2010 13:14'! autoFormatOnAccept: aBoolean AutoFormatOnAccept := aBoolean! ! !ORMethodDefinition class methodsFor: 'accessing' stamp: 'lr 9/13/2010 13:14'! autoFormatOnDisplay ^ AutoFormatOnDisplay! ! !ORMethodDefinition class methodsFor: 'accessing' stamp: 'lr 9/13/2010 13:14'! autoFormatOnDisplay: aBoolean AutoFormatOnDisplay := aBoolean! ! !ORMethodDefinition class methodsFor: 'as yet unclassified' stamp: 'lr 9/13/2010 13:14'! initialize self autoFormatOnDisplay: false. self autoFormatOnAccept: false! ! !ORMethodDefinition class methodsFor: 'settings' stamp: 'lr 9/13/2010 13:15'! settingsOn: aBuilder (aBuilder setting: #autoFormatOnDisplay) target: self; parentName: #refactoring; label: 'Auto Format on Display'; description: 'Automatically format source code when displaying code.'. (aBuilder setting: #autoFormatOnAccept) target: self; parentName: #refactoring; label: 'Auto Format on Accept'; description: 'Automatically format source code when accepting code.' ! ! !ORMethodDefinition methodsFor: 'visiting' stamp: 'lr 9/13/2010 13:28'! accept: aText notifying: aController ^ super accept: (AutoFormatOnAccept ifTrue: [ self format: aText ] ifFalse: [ aText ]) notifying: aController! ! !ORMethodDefinition methodsFor: 'private' stamp: 'lr 9/13/2010 13:34'! badlyFormatted " fasdfasdf " 1. 2. "123" 3. 4 "123"! ! !ORMethodDefinition methodsFor: 'compiling' stamp: 'lr 9/8/2011 20:10'! compileNotifying: aController | change | change := RBAddMethodChange compile: self compileText in: self compileClass classified: self compileCategory for: aController. RBRefactoryChangeManager instance performChange: change. ^ change definedSelector! ! !ORMethodDefinition methodsFor: 'private' stamp: 'lr 9/13/2010 13:28'! format: aString ^ (RBParser parseMethod: aString asString onError: [ :err :pos | ^ aString ]) formattedCode! ! !ORMethodDefinition methodsFor: 'callbacks' stamp: 'lr 9/13/2010 13:38'! text ^ (AutoFormatOnDisplay and: [ self theClass sourceCodeTemplate ~= super text and: [ selection isNil or: [ selection isEmpty ] ] ]) ifTrue: [ self format: super text ] ifFalse: [ super text ]! ! 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 9/24/2011 09:56'! shoutAboutToStyle: aPluggableTextMorph aPluggableTextMorph styler 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 ]! ! 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: 'cwp 12/12/2011 16:45'! classProtocols ^ self browserEnvironment allNonMetaClasses inject: OrderedCollection new into: [ :result :class | result addAll: (class asNode syntheticCategories); addAll: (class asNode categories); yourself ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 10/7/2010 17:12'! classVariables | classes variables | classes := Dictionary new. self browserEnvironment classesDo: [ :class | (self browserEnvironment classVariablesFor: class) do: [ :name | | definingClass | definingClass := class whichClassDefinesClassVar: name. definingClass isNil ifFalse: [ (classes at: definingClass 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 10/7/2010 17:09'! instanceVariables | classes variables | classes := Dictionary new. self browserEnvironment classesDo: [ :class | (self browserEnvironment instanceVariablesFor: class) do: [ :name | | definingClass | definingClass := class whichClassDefinesInstVar: name. definingClass isNil ifFalse: [ (classes at: definingClass 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: 'cwp 12/12/2011 16:45'! metaclassProtocols ^ self browserEnvironment allMetaClasses inject: OrderedCollection new into: [ :result :class | result addAll: (class asClassSideNode syntheticCategories); 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 9/8/2011 20:32'! selectorEnvironment "Make sure that the receiver is a selector environment." | selectorEnvironment | selectorEnvironment := RBSelectorEnvironment 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! ! !OBIcon methodsFor: '*ob-refactory' stamp: 'cwp 12/8/2011 12:26'! lintError width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 252 159 159 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 233 160 160 0 0 0 0 0 0 0 0 0 0 0 0 255 255 159 159 255 248 0 0 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 197 0 0 255 231 160 160 0 0 0 0 0 0 0 0 255 255 0 0 255 248 0 0 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 197 0 0 255 190 0 0 0 0 0 0 0 0 0 0 255 255 0 0 255 248 0 0 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 197 0 0 255 190 0 0 0 0 0 0 0 0 0 0 255 255 0 0 255 248 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 211 0 0 255 255 255 255 255 197 0 0 255 190 0 0 0 0 0 0 0 0 0 0 255 255 0 0 255 248 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 211 0 0 255 255 255 255 255 197 0 0 255 190 0 0 0 0 0 0 0 0 0 0 255 255 0 0 255 248 0 0 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 197 0 0 255 190 0 0 0 0 0 0 0 0 0 0 255 255 0 0 255 248 0 0 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 197 0 0 255 190 0 0 0 0 0 0 0 0 0 0 255 255 96 96 255 248 0 0 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 197 0 0 255 214 96 96 0 0 0 0 0 0 0 0 0 0 0 0 255 251 96 96 255 241 0 0 255 233 0 0 255 226 0 0 255 219 0 0 255 211 0 0 255 204 0 0 255 219 96 96 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-refactory' stamp: 'cwp 12/8/2011 12:26'! lintInfo width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 159 180 252 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 160 177 233 0 0 0 0 0 0 0 0 0 0 0 0 255 159 181 255 255 0 57 248 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 0 45 197 255 160 176 231 0 0 0 0 0 0 0 0 255 0 59 255 255 0 57 248 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 0 45 197 255 0 44 190 0 0 0 0 0 0 0 0 255 0 59 255 255 0 57 248 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 0 45 197 255 0 44 190 0 0 0 0 0 0 0 0 255 0 59 255 255 0 57 248 255 240 243 254 255 0 54 233 255 240 243 253 255 240 243 253 255 240 243 252 255 240 243 252 255 0 45 197 255 0 44 190 0 0 0 0 0 0 0 0 255 0 59 255 255 0 57 248 255 240 243 254 255 0 54 233 255 240 243 253 255 240 243 253 255 240 243 252 255 240 243 252 255 0 45 197 255 0 44 190 0 0 0 0 0 0 0 0 255 0 59 255 255 0 57 248 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 0 45 197 255 0 44 190 0 0 0 0 0 0 0 0 255 0 59 255 255 0 57 248 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 0 45 197 255 0 44 190 0 0 0 0 0 0 0 0 255 96 133 255 255 0 57 248 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 0 45 197 255 96 123 214 0 0 0 0 0 0 0 0 0 0 0 0 255 96 132 251 255 0 56 241 255 0 54 233 255 0 52 226 255 0 50 219 255 0 49 211 255 0 47 204 255 96 124 219 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! !OBIcon methodsFor: '*ob-refactory' stamp: 'cwp 12/8/2011 12:26'! lintWarn width := 12. height := 12. bytes := #[0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 252 223 170 255 249 184 66 255 249 178 50 255 252 217 154 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 252 223 170 255 249 184 66 255 249 179 2 255 253 212 1 255 253 212 1 255 249 178 50 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 254 247 233 255 250 199 107 255 248 171 3 255 253 222 1 255 255 236 0 255 255 230 0 255 255 224 0 255 247 160 3 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 250 199 107 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 247 160 3 255 247 160 3 255 255 255 255 255 255 255 255 255 247 160 3 255 255 255 255 255 247 160 3 255 247 160 3 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 250 199 107 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 247 160 3 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 254 247 233 255 250 199 107 255 248 171 3 255 253 222 1 255 255 236 0 255 255 230 0 255 255 224 0 255 247 160 3 255 255 255 255 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 252 223 170 255 249 184 66 255 249 179 2 255 253 212 1 255 253 212 1 255 249 178 50 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 252 223 170 255 249 184 66 255 249 178 50 255 252 217 154 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]! ! OBFilter subclass: #ORCriticsResultFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !ORCriticsResultFilter 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! ! !ORCriticsResultFilter methodsFor: 'filtering' stamp: 'lr 11/4/2010 13:09'! icon: aSymbol forNode: aNode ^ (aNode class = ORBasicCriticsNode and: [ aNode problemCount > 0 ]) ifFalse: [ #blank ] ifTrue: [ aNode rule severity = #error ifTrue: [ #lintError ] ifFalse: [ aNode rule severity = #information ifFalse: [ #lintWarn ] ifTrue: [ #lintInfo ] ] ]! ! 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: #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 ]! ! !RBProtocolEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/12/2009 20:10'! browserClass ^ ORProtocolBrowser! ! OBBrowser subclass: #ORChangesBrowser instanceVariableNames: 'closeBlock' 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: 'buttons' stamp: 'cwp 12/1/2011 16:25'! acceptButton ^ ORCmdAcceptChanges! ! !ORChangesBrowser methodsFor: 'buttons' stamp: 'cwp 12/1/2011 16:57'! cancelButton ^ ORCmdCancelChanges! ! !ORChangesBrowser methodsFor: 'opening' stamp: 'lr 7/18/2010 10:56'! close closeBlock isNil ifFalse: [ closeBlock value ]. ^ super close! ! !ORChangesBrowser methodsFor: 'accessing' stamp: 'lr 7/18/2010 10:56'! closeBlock: aBlock closeBlock := aBlock! ! !ORChangesBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! commandsCommand ^ ORCmdChangeCommand allSubclasses! ! !ORChangesBrowser methodsFor: 'building' stamp: 'lr 2/7/2008 18:25'! defaultBackgroundColor ^ Color lightBlue! ! OBBrowser subclass: #ORCriticsBrowser instanceVariableNames: 'environment process status' classVariableNames: 'PaneCount' poolDictionaries: '' category: 'OB-Refactory-Critics'! !ORCriticsBrowser class methodsFor: 'configuration' stamp: 'lr 11/4/2010 13:09'! 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: ORCriticsResultFilter new. leaf addFilter: ORCriticsResultFilter new. ^ comp! ! !ORCriticsBrowser class methodsFor: 'configuration' stamp: 'lr 2/24/2009 00:05'! defaultRootNode ^ RBCompositeLintRule lintChecks asNode! ! !ORCriticsBrowser class methodsFor: 'opening' stamp: 'lr 2/23/2009 23:57'! openRule: aRule ^ (self rule: aRule) open! ! !ORCriticsBrowser class methodsFor: 'opening' stamp: 'lr 2/7/2008 14:37'! openRule: aRule environment: anEnvironment ^ (self rule: aRule environment: anEnvironment) open! ! !ORCriticsBrowser class methodsFor: 'configuration' stamp: 'lr 2/8/2008 09:49'! paneCount ^ PaneCount ifNil: [ 2 ]! ! !ORCriticsBrowser 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 ]! ! !ORCriticsBrowser class methodsFor: 'instance-creation' stamp: 'lr 9/8/2011 20:25'! rule: aRule ^ self rule: aRule environment: RBBrowserEnvironment new! ! !ORCriticsBrowser 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! ! !ORCriticsBrowser class methodsFor: 'configuration' stamp: 'lr 6/6/2008 16:58'! titleForRoot: aNode ^ 'Code Critics: ' , aNode name! ! !ORCriticsBrowser methodsFor: 'private' stamp: 'lr 1/1/2012 22:09'! 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 := RBSmalllintChecker new. checker rule: aRule; context: RBSmalllintContext new; environment: self environment; methodBlock: [ percent := percent + precentIncrement min: 100. self status: percent truncated asString , '%' ]. [ checker run ] ensure: [ checker release. process := nil. self refresh. self status: (self root problemCount > 0 ifTrue: [ self root problemCount asString , ' problems' ]) ]! ! !ORCriticsBrowser methodsFor: 'buttons' stamp: 'cwp 12/1/2011 16:59'! browseButton ^ ORCmdBrowse! ! !ORCriticsBrowser methodsFor: 'commands' stamp: 'lr 11/8/2010 16:55'! criticsCommands ^ ORCriticsCommand allSubclasses! ! !ORCriticsBrowser methodsFor: 'building' stamp: 'lr 3/25/2008 20:41'! defaultBackgroundColor ^ Color orange! ! !ORCriticsBrowser methodsFor: 'building' stamp: 'lr 3/1/2009 08:44'! defaultLabel ^ super defaultLabel , ' on ' , (self environment printStringLimitedTo: 45) , (status isNil ifFalse: [ ' (' , status , ')' ] ifTrue: [ '' ])! ! !ORCriticsBrowser methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:21'! environment ^ environment! ! !ORCriticsBrowser methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:08'! environment: anEnvironment environment := anEnvironment! ! !ORCriticsBrowser methodsFor: 'testing' stamp: 'lr 5/29/2008 14:35'! isSearching ^ process notNil and: [ process isTerminated not ]! ! !ORCriticsBrowser methodsFor: 'actions' stamp: 'lr 1/1/2012 22:05'! refresh self root update: self environment. self navigationPanel selectedNode ifNotNil: [ :node | self announcer announce: (OBSelectingNode node: node) ]. self signalRefresh! ! !ORCriticsBrowser methodsFor: 'buttons' stamp: 'cwp 12/1/2011 16:59'! refreshButton ^ ORCmdRefresh! ! !ORCriticsBrowser methodsFor: 'accessing-dynamic' stamp: 'lr 11/11/2008 21:41'! rule ^ self root rule! ! !ORCriticsBrowser methodsFor: 'actions' stamp: 'lr 1/25/2009 15:24'! search: aRule process := [ self basicSearch: aRule ] newProcess. process name: 'lint'. process resume! ! !ORCriticsBrowser methodsFor: 'initialization' stamp: 'lr 1/25/2009 15:22'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. self search: self root rule! ! !ORCriticsBrowser methodsFor: 'actions' stamp: 'lr 11/11/2008 21:56'! status: aString status = aString ifTrue: [ ^ self ]. status := aString. self relabel: self defaultLabel! ! !ORCriticsBrowser methodsFor: 'private' stamp: 'lr 5/29/2008 14:46'! windowIsClosing self isSearching ifTrue: [ process terminate ]! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:25'! browserEnvironment ^ RBBrowserEnvironment 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! ! !OBInstanceVariableNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:32'! browserEnvironment ^ RBVariableEnvironment 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! ! !OBClassVariableNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:32'! browserEnvironment ^ RBVariableEnvironment 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! ! !RBBasicLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 11/4/2010 13:09'! asNode ^ ORBasicCriticsNode 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! ! OBInteractionRequest subclass: #ORMethodNameRequest instanceVariableNames: 'methodName' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Utilities'! !ORMethodNameRequest class methodsFor: 'instance creation' stamp: 'lr 6/15/2010 09:09'! methodName: aMethodName ^ self new methodName: aMethodName; signal! ! !ORMethodNameRequest methodsFor: 'dispatching' stamp: 'lr 6/15/2010 09:07'! handleWith: anObject ^ anObject handleMethodNameRequest: self! ! !ORMethodNameRequest methodsFor: 'accessing' stamp: 'lr 6/15/2010 09:09'! methodName ^ methodName! ! !ORMethodNameRequest methodsFor: 'accessing' stamp: 'lr 6/15/2010 09:10'! methodName: aMethodName methodName := aMethodName! ! !RBClassEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/12/2009 21:05'! browserClass ^ self classNames size > 1 ifTrue: [ ORClassBrowser ] ifFalse: [ ORSingleClassBrowser ]! ! OBMercuryQuery subclass: #ORParseTreeQuery instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Utilities'! !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! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:32'! browserEnvironment ^ RBClassEnvironment onEnvironment: RBBrowserEnvironment new classes: (Array with: self theClass)! ! !OBClassNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:41'! definedWithinBrowserEnvironment: anEnvironment ^ (super definedWithinBrowserEnvironment: anEnvironment) and: [ anEnvironment definesClass: self theClass ]! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:25'! browserEnvironment ^ RBBrowserEnvironment 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! ! OBCmdRemoveMethod subclass: #ORCmdRemoveMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands-Replacement'! !ORCmdRemoveMethod methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'! doRemove RBRefactoryChangeManager instance performChange: (RBRemoveMethodChange remove: target selector from: target theClass). requestor announce: (OBNodeDeleted node: target)! ! OBNode subclass: #ORCriticsNode instanceVariableNames: 'rule problemCount' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! ORCriticsNode subclass: #ORBasicCriticsNode instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !ORBasicCriticsNode methodsFor: 'actions' stamp: 'lr 4/9/2011 09:27'! browse ^ self result browserInstance open! ! !ORBasicCriticsNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:05'! result ^ result! ! !ORBasicCriticsNode 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! ! !ORBasicCriticsNode 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! ! ORCriticsNode subclass: #ORCompositeCriticsNode instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !ORCompositeCriticsNode methodsFor: 'navigation' stamp: 'lr 10/22/2008 13:48'! compositeRules ^ self rules select: [ :each | each isComposite ]! ! !ORCompositeCriticsNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 16:46'! initializeOn: aRule super initializeOn: aRule. self update! ! !ORCompositeCriticsNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ true! ! !ORCompositeCriticsNode methodsFor: 'navigation' stamp: 'lr 10/22/2008 13:48'! leafRules ^ self rules reject: [ :each | each isComposite ]! ! !ORCompositeCriticsNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 15:30'! rules ^ rules! ! !ORCompositeCriticsNode methodsFor: 'actions' stamp: 'lr 5/29/2008 14:41'! update rules := rule rules collect: [ :each | each asNode ]! ! !ORCompositeCriticsNode 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 ]! ! !ORCriticsNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 15:21'! on: aRule ^ self new initializeOn: aRule! ! !ORCriticsNode methodsFor: 'actions' stamp: 'lr 1/17/2009 12:16'! browse! ! !ORCriticsNode methodsFor: 'initialization' stamp: 'lr 10/22/2008 14:16'! initializeOn: aRule rule := aRule. problemCount := 0! ! !ORCriticsNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ false! ! !ORCriticsNode methodsFor: 'accessing' stamp: 'djr 11/9/2008 13:17'! isEmpty ^ problemCount = 0! ! !ORCriticsNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:23'! name ^ rule name! ! !ORCriticsNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:16'! problemCount ^ problemCount! ! !ORCriticsNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 13:50'! rationale ^ self rule rationale! ! !ORCriticsNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:22'! rule ^ rule! ! !ORCriticsNode 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 ])! ! !ORCriticsNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:04'! update: anEnvironment! ! ORCriticsNode subclass: #ORTransformationCriticsNode instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !ORTransformationCriticsNode methodsFor: 'actions' stamp: 'lr 4/9/2011 09:27'! browse ^ self changes browserInstance open! ! !ORTransformationCriticsNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:09'! changes ^ changes! ! !ORTransformationCriticsNode 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 ] ])! ! !ORTransformationCriticsNode methodsFor: 'actions' stamp: 'lr 9/8/2011 20:10'! update: anEnvironment changes := RBCompositeRefactoryChange named: self name. changes changes: self rule changes. problemCount := changes problemCount! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:25'! browserEnvironment ^ RBBrowserEnvironment 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! ! !RBVariableEnvironment methodsFor: '*ob-refactory' stamp: 'lr 3/8/2009 15:38'! browserClass ^ ORVariableBrowser! ! !RBPackageEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/10/2008 11:56'! browserClass ^ ORPackageBrowser! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 9/8/2011 20:21'! classRefactroingsCommands ^ ORCmdClassRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 9/8/2011 20:21'! classVarRefactroingsCommands ^ ORCmdClassVarRefactoring 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 9/8/2011 20:25'! environment ^ RBBrowserEnvironment new! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 10/29/2010 11:48'! environmentsCommands ^ ORCmdEnvironment allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 10/29/2010 11:40'! formatCommand ^ ORCmdFormat! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 9/8/2011 20:21'! instVarRefactroingsCommands ^ ORCmdInstVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 9/8/2011 20:21'! methodRefactroingsCommands ^ ORCmdMethodRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 4/25/2011 11:35'! navigationCommand ^ ORCmdSelectCode allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 10/29/2010 10:27'! obsoleteRemoveClass ^ OBCmdRemoveClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 10/29/2010 10:27'! obsoleteRemoveMethod ^ OBCmdRemoveMethod! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 10/29/2010 10:27'! obsoleteRenameClass ^ OBCmdRenameClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 10/29/2010 11:49'! openCommands ^ ORCmdOpen allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 10/29/2010 11:40'! recompileCommand ^ ORCmdRecompile! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 10/29/2010 11:49'! refactoryToolsCommands ^ ORCmdRefactoringTool allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 10/29/2010 11:40'! reformatCommand ^ ORCmdReformat! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 10/29/2010 11:40'! replaceRemoveClassCommand ^ ORCmdRemoveClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 10/29/2010 11:40'! replaceRemoveMethodCommand ^ ORCmdRemoveMethod! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands-replacement' stamp: 'lr 10/29/2010 11:40'! replaceRenameClassCommand ^ ORCmdRenameClass! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 9/8/2011 20:21'! sourceRefactroingsCommands ^ ORCmdSourceRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-definitions-replacement' stamp: 'lr 1/8/2012 13:45'! 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: [ Array 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: 'updating' stamp: 'lr 12/18/2011 12:15'! definitionChanged: anAnnouncement | definition interval | definition := anAnnouncement definition ifNil: [ ^ self ]. interval := self environment selectionIntervalFor: definition text. interval isNil ifFalse: [ self definitionPanel selection: interval ]! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 2/10/2008 12:55'! environment ^ self root browserEnvironment! ! !OREnvironmentBrowser methodsFor: 'opening' stamp: 'lr 7/18/2010 14:29'! open self signalRefresh. ^ super open! ! !OREnvironmentBrowser methodsFor: 'initializing' stamp: 'lr 12/18/2011 12:27'! subscribe super subscribe. self announcer on: OBDefinitionChanged send: #definitionChanged: 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 8/25/2010 11:29'! defaultMetaNode | browser protocol method comment | browser := OBMetaNode named: 'Environment'. protocol := OBMetaNode named: 'Protocol'. method := OBMetaNode named: 'Method'. comment := OBMetaNode named: 'Comment'. browser childAt: #classProtocols labeled: 'Instance' put: protocol; childAt: #comments labeled: '?' put: comment; childAt: #metaclassProtocols labeled: 'Class' put: protocol; ancestrySelector: #isDescendantOfClass:; addFilter: OBModalFilter new. protocol childAt: #methods put: method; ancestrySelector: #isDescendantOfMethodCat:. method ancestrySelector: #isDescendantOfMethod:; addFilter: OBMethodIconFilter new. comment addFilter: (OBPluggableFilter new nodeDisplay: [ :string :node | '-- all --' ]; yourself). ^ 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 9/8/2011 20:25'! defaultRootNode ^ OREnvironmentNode onEnvironment: RBBrowserEnvironment new! ! !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! ! !ORSystemBrowser methodsFor: 'commands' stamp: 'lr 10/29/2010 11:40'! toggleContainmentCommand ^ ORCmdToggleContainment! ! 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! ! 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'! ! !RBAddMethodChange methodsFor: '*ob-refactory-converting' stamp: 'lr 2/7/2008 18:30'! asNode ^ ORAddMethodChangeNode on: self! ! !RBBrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:34'! browserClass ^ ORMethodBrowser! ! !RBBrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 16:08'! browserInstance ^ self browserClass on: self! ! !RBBrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/5/2009 14:37'! open ^ self browserInstance open! ! 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 8/8/2010 10:07'! label ^ 'Accept'! ! 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 8/8/2010 10:07'! 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 8/8/2010 10:07'! 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 8/8/2010 10:07'! label ^ 'Cancel'! ! 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 8/8/2010 10:10'! 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 8/8/2010 10:07'! 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 8/8/2010 10:10'! 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 8/8/2010 10:07'! 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 8/8/2010 10:07'! label ^ 'Remove class'! ! ORCommand subclass: #ORCmdEnvironment instanceVariableNames: '' classVariableNames: 'SavedEnvironments' 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 8/8/2010 10:07'! label ^ 'Category'! ! !ORCmdCategoryEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:16'! longDescription ^ 'Opens a scoped browser on the selected 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 8/8/2010 10:07'! label ^ 'Class'! ! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:16'! longDescription ^ 'Opens a scoped browser on the selected 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 8/8/2010 10:07'! label ^ 'Class hierarchy'! ! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:16'! longDescription ^ 'Opens a scoped browser on the selected class hierarchy (super- and subclasses).'! ! 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 9/1/2011 21:54'! label ^ 'Class variable references...'! ! !ORCmdClassVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:17'! longDescription ^ 'Opens a scoped browser on all the methods referring a class variable.'! ! 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 9/8/2011 20:32'! environment "Build an environment with all the static dependencies." | result parent inside | result := RBClassEnvironment new. parent := super environment. inside := [ :class | (parent definesClass: class) and: [ parent includesClass: class ] ]. parent classesDo: [ :class | "(1) super classes" (class isMeta not and: [ class superclass notNil and: [ (inside value: class superclass) not ] ]) ifTrue: [ self add: class superclass to: result ] ]. parent classesAndSelectorsDo: [ :class :selector | "(2) extended classes" (inside value: class) ifFalse: [ self add: class to: result ]. "(3) referenced classes" (class compiledMethodAt: selector) literals allButLast do: [ :literal | (literal isVariableBinding and: [ literal value isBehavior and: [ (inside value: literal value) not ] ]) ifTrue: [ self add: literal value 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 8/8/2010 10:07'! label ^ 'Dependencies'! ! !ORCmdDependenciesEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:18'! longDescription ^ 'Opens a scoped browser on all the static depedencies of the scope.'! ! !ORCmdEnvironment class methodsFor: 'initialization' stamp: 'lr 4/21/2010 15:08'! initialize SavedEnvironments := SortedCollection sortBlock: [ :a :b | a label < b label ]! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:09'! cluster ^ #'Refactoring scope'! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 2/12/2009 10:51'! execute [ self openEnvironment: self environment ] on: ORUICancellationError do: [ :err | ^ self ]! ! !ORCmdEnvironment methodsFor: 'utilities' stamp: 'lr 4/21/2010 15:19'! selectEnvironment: aString | environment | environment := OBChoiceRequest prompt: aString labels: (SavedEnvironments collect: [ :each | each label ]) values: SavedEnvironments. environment isNil ifTrue: [ ORUICancellationError signal ]. ^ environment! ! !ORCmdEnvironment methodsFor: 'utilities' stamp: 'lr 4/21/2010 15:40'! selectEnvironments: aString | environments | environments := OBMultipleChoiceRequest prompt: aString labels: (SavedEnvironments collect: [ :each | each label ]) values: SavedEnvironments. (environments isNil or: [ environments isEmpty ]) ifTrue: [ ORUICancellationError signal ]. ^ environments! ! ORCmdEnvironment subclass: #ORCmdImplementorEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:46'! environment | selectors selector | selectors := target hasSelector ifTrue: [ target selectorAndMessages collect: [ :each | each name ] ] ifFalse: [ target theClass selectors ]. selectors isEmpty ifFalse: [ selector := selectors first ]. selector := OBCmdBrowseList selectSymbol: 'Choose Implementor' default: selector proposed: selectors. selector isNil ifTrue: [ ^ self uiCancellationError ]. ^ super environment implementorsOf: selector! ! !ORCmdImplementorEnvironment methodsFor: 'testing' stamp: 'lr 9/1/2011 21:46'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:36'! label ^ 'Implementors...'! ! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:21'! longDescription ^ 'Opens a scoped browser on all the implementors of a method.'! ! 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 9/1/2011 21:54'! label ^ 'Instance variable reader...'! ! !ORCmdInstVarReaderEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:18'! longDescription ^ 'Opens a scoped browser on all the methods reading an instance-variable.'! ! 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 9/1/2011 21:54'! label ^ 'Instance variable references...'! ! !ORCmdInstVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:19'! longDescription ^ 'Opens a scoped browser on all the methods referring to an instance-variable (reading or writing).'! ! 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 9/1/2011 21:54'! label ^ 'Instance variable writer...'! ! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:19'! longDescription ^ 'Opens a scoped browser on all the methods writing an instance-variable.'! ! ORCmdEnvironment subclass: #ORCmdIntersectionEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdIntersectionEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 15:36'! environment ^ super environment & (self selectEnvironment: 'Select scope to intersect with:')! ! !ORCmdIntersectionEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 14:57'! group ^ #logical! ! !ORCmdIntersectionEnvironment methodsFor: 'testing' stamp: 'lr 4/21/2010 15:34'! isEnabled ^ super isEnabled and: [ super environment isSystem not and: [ SavedEnvironments notEmpty ] ]! ! !ORCmdIntersectionEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Itersection...'! ! !ORCmdIntersectionEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:19'! longDescription ^ 'Opens a scoped browser on the intersection of the current scope and another scope.'! ! 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 4/21/2010 15:01'! group ^ #abstract! ! !ORCmdManualEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Manual'! ! !ORCmdManualEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:20'! longDescription ^ 'Opens a scoped browser where individual elements can be included and excluded.'! ! 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 8/8/2010 10:07'! label ^ 'Literal matches...'! ! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:20'! longDescription ^ 'Opens a scoped browser on methods that match a given literal.'! ! ORCmdEnvironment subclass: #ORCmdNegationEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdNegationEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:29'! environment ^ super environment not! ! !ORCmdNegationEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 14:59'! group ^ #logical! ! !ORCmdNegationEnvironment methodsFor: 'testing' stamp: 'lr 4/21/2010 15:15'! isEnabled ^ super isEnabled and: [ super environment isSystem not ]! ! !ORCmdNegationEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Negation'! ! !ORCmdNegationEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:21'! longDescription ^ 'Opens a scoped browser on the negation of the current scope (all but the current scope).'! ! ORCmdEnvironment subclass: #ORCmdOpenEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 15:19'! environment ^ self selectEnvironment: 'Select scope to open:'! ! !ORCmdOpenEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 15:11'! group ^ #file! ! !ORCmdOpenEnvironment methodsFor: 'testing' stamp: 'lr 4/21/2010 15:16'! isEnabled ^ super isEnabled and: [ SavedEnvironments notEmpty ]! ! !ORCmdOpenEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Open...'! ! !ORCmdOpenEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:21'! longDescription ^ 'Opens a previously saved scoped browser.'! ! 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: 'testing' stamp: 'lr 12/25/2011 15:49'! isEnabled ^ self package notNil! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 10/17/2009 13:45'! keystroke ^ $p! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Browse package'! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 12/25/2011 15:50'! package ^ target containingPackage! ! !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: 'accessing' stamp: 'lr 12/25/2011 15:50'! label ^ 'Package...'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:22'! longDescription ^ 'Opens a scoped browser on the package of the selected element.'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 12/25/2011 16:15'! package | package | package := OBCompletionRequest new prompt: 'Select package'; labelBlock: [ :each | each packageName ]; collection: (PackageOrganizer default packages asSortedCollection: [ :a :b | a packageName <= b packageName ]); default: (target containingPackage isNil ifFalse: [ target containingPackage packageName ]); signal. ^ package isNil ifFalse: [ package ] ifTrue: [ ORUICancellationError signal ]! ! ORCmdEnvironment subclass: #ORCmdPragmaEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 12/27/2011 21:57'! environment | selectors selector | selectors := Set new. super environment classesAndSelectorsDo: [ :class :selec | (class compiledMethodAt: selec) pragmas do: [ :pragma | selectors add: pragma keyword ] ]. selectors := selectors asSortedCollection. selectors isEmpty ifFalse: [ selector := selectors first ]. selector := OBCmdBrowseList selectSymbol: 'Choose Pragma' default: selector proposed: selectors. selector isNil ifTrue: [ ^ self uiCancellationError ]. ^ (super environment referencesTo: selector) label: 'Pragmas of ' , selector printString; yourself! ! !ORCmdPragmaEnvironment methodsFor: 'testing' stamp: 'lr 9/1/2011 21:48'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:49'! label ^ 'Pragmas...'! ! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:22'! longDescription ^ 'Opens a scoped browser on methods with a selected pragma.'! ! 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 8/8/2010 10:07'! label ^ 'Protocol'! ! !ORCmdProtocolEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:30'! longDescription ^ 'Opens a scoped browser on all methods of a given 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 8/8/2010 10:07'! label ^ 'References'! ! !ORCmdReferencesEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:31'! longDescription ^ 'Opens a scoped browser on methods that refer the selected class.'! ! ORCmdEnvironment subclass: #ORCmdRemoveEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRemoveEnvironment methodsFor: 'execution' stamp: 'lr 4/21/2010 15:36'! execute SavedEnvironments removeAll: (self selectEnvironments: 'Select scopes to remove:') ! ! !ORCmdRemoveEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 15:20'! group ^ #file! ! !ORCmdRemoveEnvironment methodsFor: 'testing' stamp: 'lr 4/21/2010 15:20'! isEnabled ^ super isEnabled and: [ SavedEnvironments notEmpty ]! ! !ORCmdRemoveEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Remove...'! ! !ORCmdRemoveEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:33'! longDescription ^ 'Removes a previously saved scoped browser.'! ! ORCmdEnvironment subclass: #ORCmdSaveEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSaveEnvironment methodsFor: 'execution' stamp: 'lr 4/21/2010 15:38'! execute | label | label := self prompt: 'Type name of scope:' initialAnswer: self environment label. (label isNil or: [ label isEmpty ]) ifTrue: [ ^ self ]. SavedEnvironments add: (self environment label: label; yourself)! ! !ORCmdSaveEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 15:11'! group ^ #file! ! !ORCmdSaveEnvironment methodsFor: 'testing' stamp: 'lr 4/21/2010 15:34'! isEnabled ^ super isEnabled and: [ self environment isSystem not ]! ! !ORCmdSaveEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Save...'! ! !ORCmdSaveEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:21'! longDescription ^ 'Saves a scoped browser.'! ! 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 8/8/2010 10:07'! label ^ 'Select methods...'! ! !ORCmdSelectMethodsEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:55'! longDescription ^ 'Opens a scoped browser on methods selected from a provided Smalltalk condition.'! ! 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 4/21/2010 15:01'! group ^ #abstract! ! !ORCmdSelectionEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Selection'! ! !ORCmdSelectionEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:56'! longDescription ^ 'Opens a scoped browser on the current selection.'! ! ORCmdEnvironment subclass: #ORCmdSelfSendEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelfSendEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'! environment | parent environment matcher | parent := super environment. environment := RBParseTreeEnvironment 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 8/8/2010 10:07'! label ^ 'Self-sends'! ! !ORCmdSelfSendEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:39'! longDescription ^ 'Opens a scoped browser on methods that send messages to the receiver (self).'! ! ORCmdEnvironment subclass: #ORCmdSenderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:47'! environment | selectors selector | selectors := target hasSelector ifTrue: [ target selectorAndMessages collect: [ :each | each name ] ] ifFalse: [ target theClass selectors ]. selectors isEmpty ifFalse: [ selector := selectors first ]. selector := OBCmdBrowseList selectSymbol: 'Choose Sender' default: selector proposed: selectors. selector isNil ifTrue: [ ^ self uiCancellationError ]. ^ (super environment referencesTo: selector) label: 'Senders of ' , selector printString; yourself! ! !ORCmdSenderEnvironment methodsFor: 'testing' stamp: 'lr 9/1/2011 21:47'! isActive ^ super isActive and: [ target isKindOf: OBClassAwareNode ]! ! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:47'! label ^ 'Senders...'! ! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:40'! longDescription ^ 'Opens a scoped browser on all the senders of a method.'! ! 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 8/8/2010 10:07'! label ^ 'Subclasses'! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:42'! longDescription ^ 'Opens a scoped browser on the subclasses of the selected class.'! ! 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 8/8/2010 10:07'! label ^ 'Subclasses with'! ! !ORCmdSubclassesWithHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:42'! longDescription ^ 'Opens a scoped browser on the selected class and its subclasses.'! ! ORCmdEnvironment subclass: #ORCmdSuperSendEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperSendEnvironment methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:15'! environment | parent environment matcher | parent := super environment. environment := RBParseTreeEnvironment 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 8/8/2010 10:07'! label ^ 'Super-sends'! ! !ORCmdSuperSendEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:50'! longDescription ^ 'Opens a scoped browser on methods that send messages to the super-class.'! ! 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 8/8/2010 10:07'! label ^ 'Superclasses'! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:45'! longDescription ^ 'Opens a scoped browser on the superclasses of the selected class.'! ! 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 8/8/2010 10:07'! label ^ 'Superclasses with'! ! !ORCmdSuperclassesWithHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:43'! longDescription ^ 'Opens a scoped browser on the selected class and its superclasses.'! ! ORCmdEnvironment subclass: #ORCmdUnionEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdUnionEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 15:39'! environment ^ super environment | (self selectEnvironment: 'Select scope to build the union with:')! ! !ORCmdUnionEnvironment methodsFor: 'accessing' stamp: 'lr 4/21/2010 14:58'! group ^ #logical! ! !ORCmdUnionEnvironment methodsFor: 'testing' stamp: 'lr 4/21/2010 15:34'! isEnabled ^ super isEnabled and: [ super environment isSystem not and: [ SavedEnvironments notEmpty ] ]! ! !ORCmdUnionEnvironment methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Union...'! ! !ORCmdUnionEnvironment methodsFor: 'accessing' stamp: 'lr 12/26/2011 20:19'! longDescription ^ 'Opens a scoped browser on the union of the current scope and another scope.'! ! 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 6/4/2010 13:36'! 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 class morph source tree formatted | panel := requestor browser definitionPanel. 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 8/8/2010 10:07'! label ^ 'Format'! ! ORCommand subclass: #ORCmdOpen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpen methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:09'! 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 11/4/2010 13:08'! execute ORCriticsBrowser openRule: RBCompositeLintRule allRules environment: self environment! ! !ORCmdOpenLint methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/2/2011 19:20'! 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 9/2/2011 19:19'! label ^ 'Search code...'! ! ORCmdOpen subclass: #ORCmdOpenTypeClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenTypeClass methodsFor: 'execution' stamp: 'lr 10/5/2010 16:14'! execute | typer | typer := RBRefactoryTyper 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/8/2010 10:07'! label ^ 'Type class'! ! ORCmdOpen subclass: #ORCmdOpenTypeMethod instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenTypeMethod methodsFor: 'execution' stamp: 'lr 10/5/2010 16:14'! execute | typer tree messages stream types | typer := RBRefactoryTyper 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/8/2010 10:07'! label ^ 'Type method'! ! ORCommand subclass: #ORCmdRecompile instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdRecompile methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:09'! 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 8/8/2010 10:07'! 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 8/8/2010 10:07'! 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 9/8/2011 20:22'! 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 8/8/2010 10:08'! 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 9/1/2011 21:12'! 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 9/8/2011 20:11'! refactoring | class subclassName | class := self currentNode theNonMetaClass. subclassName := self request: 'Enter new subclass name:'. ^ RBAddClassRefactoring 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 9/1/2011 21:12'! 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 9/8/2011 20:11'! refactoring | class superclassName | class := self currentNode theNonMetaClass. superclassName := self request: 'Enter new superclass name:'. ^ RBChildrenToSiblingsRefactoring 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 9/1/2011 21:12'! 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 9/8/2011 20:22'! refactoring ^ ORGenerateEqualHashRefactoring model: self model className: self currentNode theNonMetaClass name variables: (self chooseMultipleFrom: self instanceVariables title: 'Choose instance variables to compare:')! ! 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 9/1/2011 21:12'! 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 9/8/2011 20:22'! 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 8/8/2010 10:07'! 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 9/8/2011 20:22'! 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ RBRemoveClassRefactoring 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 9/1/2011 21:11'! 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 9/8/2011 20:11'! refactoring ^ RBRenameClassRefactoring 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 9/1/2011 21:11'! 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 9/8/2011 20:11'! refactoring ^ RBSplitClassRefactoring 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBAbstractClassVariableRefactoring model: self model variable: variable class: class ]! ! ORCmdClassVarRefactoring subclass: #ORCmdAccessorClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBCreateAccessorsForVariableRefactoring model: self model variable: variable class: class classVariable: true ]! ! ORCmdClassVarRefactoring subclass: #ORCmdAddClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:13'! label ^ 'Add...'! ! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Add a variable to the class.'! ! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:11'! refactoring ^ RBAddClassVariableRefactoring 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 8/8/2010 10:08'! 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 9/8/2011 20:21'! 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBPullUpClassVariableRefactoring model: self model variable: variable class: class superclass ]! ! ORCmdClassVarRefactoring subclass: #ORCmdPushDownClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBPushDownClassVariableRefactoring model: self model variable: variable class: class ]! ! ORCmdClassVarRefactoring subclass: #ORCmdRemoveClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBRemoveClassVariableRefactoring model: self model variable: variable class: class ]! ! ORCmdClassVarRefactoring subclass: #ORCmdRenameClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:13'! 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 9/8/2011 20:11'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RBRenameClassVariableRefactoring 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBAbstractInstanceVariableRefactoring model: self model variable: variable class: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdAccessorInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBCreateAccessorsForVariableRefactoring model: self model variable: variable class: class classVariable: false ]! ! ORCmdInstVarRefactoring subclass: #ORCmdAddInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:13'! label ^ 'Add...'! ! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Add a variable to the class.'! ! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:11'! refactoring ^ RBAddInstanceVariableRefactoring 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 8/8/2010 10:08'! 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 9/8/2011 20:21'! 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBProtectInstanceVariableRefactoring model: self model variable: variable class: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdPullUpInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBPullUpInstanceVariableRefactoring model: self model variable: variable class: class superclass ]! ! ORCmdInstVarRefactoring subclass: #ORCmdPushDownInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBPushDownInstanceVariableRefactoring model: self model variable: variable class: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdRemoveInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ self classAndVariable: [ :class :variable | RBRemoveInstanceVariableRefactoring model: self model remove: variable from: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdRenameInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 9/1/2011 21:14'! 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 9/8/2011 20:11'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RBRenameInstanceVariableRefactoring 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 9/1/2011 21:14'! 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 9/8/2011 20:11'! 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 ]. ^ RBAddParameterRefactoring 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 9/1/2011 21:14'! 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 9/8/2011 20:11'! refactoring ^ RBInlineParameterRefactoring 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 8/8/2010 10: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 9/8/2011 20:11'! refactoring ^ RBInlineAllSendersRefactoring 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 8/8/2010 10:09'! 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 9/1/2011 21:14'! 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 9/8/2011 20:11'! refactoring ^ RBMoveMethodRefactoring model: self model selector: self currentNode selector class: self currentNode theClass variable: (self chooseFrom: self instanceVariables)! ! ORCmdMethodRefactoring subclass: #ORCmdPullUpMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPullUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Pull up'! ! !ORCmdPullUpMethodRefactoring 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).'! ! !ORCmdPullUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:11'! refactoring ^ RBPullUpMethodRefactoring model: self model pullUp: (Array with: self currentNode selector) from: self currentNode theClass! ! ORCmdMethodRefactoring subclass: #ORCmdPushDownMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ RBPushDownMethodRefactoring model: self model pushDown: (Array with: self currentNode selector) from: self currentNode theClass! ! ORCmdMethodRefactoring subclass: #ORCmdRemoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ RBRemoveMethodRefactoring 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 9/1/2011 21:15'! 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 9/8/2011 20:11'! refactoring ^ RBRemoveParameterRefactoring 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 9/1/2011 21:15'! 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 9/8/2011 20:11'! 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 ]. ^ RBRenameMethodRefactoring 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 8/8/2010 10:11'! 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 9/8/2011 20:22'! refactoring ^ ORSwapMethodRefactoring model: self model swapMethod: self currentNode selector in: self currentNode theClass! ! !ORCmdRefactoring methodsFor: 'execution' stamp: 'lr 12/13/2010 08:21'! 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 performRefactoring: refactoring ] on: RBRefactoringWarning do: [ :exception | self handleWarning: exception ] ] on: RBRefactoringError do: [ :exception | self handleError: exception ] ] on: ORUICancellationError do: [ :exception | ^ 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 12/13/2010 08:15'! refactoring "Answer the refactoring of the receiver or nil." self subclassResponsibility! ! ORCmdRefactoring subclass: #ORCmdReformat instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdReformat methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:09'! 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 8/8/2010 10:07'! label ^ 'Reformat'! ! !ORCmdReformat methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:22'! 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 8/8/2010 10:07'! 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 9/8/2011 20:22'! 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ RBExtractMethodRefactoring 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ RBExtractMethodToComponentRefactoring 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 9/1/2011 21:15'! 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 9/8/2011 20:11'! refactoring ^ RBExtractToTemporaryRefactoring 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 8/8/2010 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 9/8/2011 20:11'! refactoring ^ RBInlineMethodFromComponentRefactoring 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 8/8/2010 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 9/8/2011 20:11'! refactoring ^ RBInlineMethodRefactoring 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 8/8/2010 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 9/8/2011 20:11'! refactoring ^ RBInlineTemporaryRefactoring 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 8/8/2010 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 9/8/2011 20:11'! refactoring ^ RBMoveVariableDefinitionRefactoring 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 9/1/2011 21:15'! label ^ 'Rename temporary...'! ! !ORCmdRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:54'! longDescription ^ 'Renames a temporary variable.'! ! !ORCmdRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:11'! refactoring ^ RBRenameTemporaryRefactoring 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 8/8/2010 10:09'! 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 8/8/2010 10:07'! 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 9/8/2011 20:22'! 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 8/8/2010 10:07'! 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 9/8/2011 20:11'! refactoring ^ RBTemporaryToInstanceVariableRefactoring 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 7/18/2010 14:51'! execute self changeManager redoOperation. self refresh! ! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 12/14/2011 21:16'! icon ^ #redoIcon! ! !ORCmdRefactoringRedo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasRedoableOperations! ! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 12/14/2011 21:20'! keystroke ^ OBKeystroke key: $z shift: true control: true option: false command: false! ! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:11'! label ^ 'Redo' , super label! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:56'! change self subclassResponsibility! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 9/8/2011 20:10'! changeManager ^ RBRefactoryChangeManager instance! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:09'! cluster ^ #Refactor! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/26/2009 17:05'! group ^ #'undo-redo'! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:12'! label ^ String streamContents: [ :stream | self isEnabled ifTrue: [ stream nextPut: $ ; nextPutAll: self change name. stream position > 40 ifTrue: [ stream position: 40; 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 7/18/2010 14:51'! execute self changeManager undoOperation. self refresh! ! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 12/14/2011 21:16'! icon ^ #undoIcon! ! !ORCmdRefactoringUndo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasUndoableOperations! ! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 12/14/2011 21:20'! keystroke ^ OBKeystroke key: $z shift: false control: true option: false command: false! ! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:11'! 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: 'execution' stamp: 'lr 4/25/2011 11:36'! 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 methodsFor: 'testing' stamp: 'lr 4/25/2011 11:41'! wantsMenu ^ false! ! ORCmdSelectCode subclass: #ORCmdSelectNext instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectNext methodsFor: 'accessing' stamp: 'lr 5/20/2011 19:24'! keystroke ^ OBKeystroke key: Character arrowRight shift: false control: false option: true command: false! ! !ORCmdSelectNext methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Next'! ! !ORCmdSelectNext methodsFor: 'accessing' stamp: 'lr 4/25/2011 11:43'! selectionFor: aNode interval: anInterval | nodes index | nodes := aNode methodNode allChildren. index := nodes identityIndexOf: aNode ifAbsent: [ ^ aNode ]. [ index < nodes size and: [ (nodes at: index) sourceInterval = anInterval ] ] whileTrue: [ index := index + 1 ]. ^ nodes at: index! ! ORCmdSelectCode subclass: #ORCmdSelectNextStatement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectNextStatement methodsFor: 'accessing' stamp: 'lr 5/20/2011 19:24'! keystroke ^ OBKeystroke key: Character arrowRight shift: true control: false option: true command: false! ! !ORCmdSelectNextStatement methodsFor: 'accessing' stamp: 'lr 4/25/2011 11:44'! label ^ 'Next'! ! !ORCmdSelectNextStatement methodsFor: 'accessing' stamp: 'lr 4/25/2011 12:03'! selectionFor: aNode interval: anInterval | nodes index | nodes := aNode methodNode allChildren select: [ :each | each parent isNil or: [ each parent isSequence ] ]. index := nodes identityIndexOf: aNode statementNode ifAbsent: [ ^ aNode ]. [ index < nodes size and: [ (nodes at: index) sourceInterval = anInterval ] ] whileTrue: [ index := index + 1 ]. ^ nodes at: index! ! ORCmdSelectCode subclass: #ORCmdSelectPrevious instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectPrevious methodsFor: 'accessing' stamp: 'lr 5/20/2011 19:24'! keystroke ^ OBKeystroke key: Character arrowLeft shift: false control: false option: true command: false! ! !ORCmdSelectPrevious methodsFor: 'accessing' stamp: 'lr 8/8/2010 10:07'! label ^ 'Previous'! ! !ORCmdSelectPrevious methodsFor: 'accessing' stamp: 'lr 4/25/2011 11:43'! selectionFor: aNode interval: anInterval | nodes index | nodes := aNode methodNode allChildren. index := nodes identityIndexOf: aNode ifAbsent: [ ^ aNode ]. [ 1 < index and: [ (nodes at: index) sourceInterval = anInterval ] ] whileTrue: [ index := index - 1 ]. ^ nodes at: index! ! ORCmdSelectCode subclass: #ORCmdSelectPreviousStatement instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectPreviousStatement methodsFor: 'accessing' stamp: 'lr 5/20/2011 19:24'! keystroke ^ OBKeystroke key: Character arrowLeft shift: true control: false option: true command: false! ! !ORCmdSelectPreviousStatement methodsFor: 'accessing' stamp: 'lr 4/25/2011 12:01'! label ^ 'Previous'! ! !ORCmdSelectPreviousStatement methodsFor: 'accessing' stamp: 'lr 4/25/2011 12:03'! selectionFor: aNode interval: anInterval | nodes index | nodes := aNode methodNode allChildren select: [ :each | each parent isNil or: [ each parent isSequence ] ]. index := nodes identityIndexOf: aNode statementNode ifAbsent: [ ^ aNode ]. [ 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 8/8/2010 10:07'! 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 4/23/2010 08:35'! classVariables | variables | variables := self currentNode theNonMetaClass allClassVarNames asArray sort. ^ (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 10/5/2010 16:09'! handleError: anException anException actionBlock isNil ifTrue: [ self inform: anException messageText ] ifFalse: [ (self confirm: anException messageText) ifTrue: [ anException actionBlock value ] ]. anException return! ! !ORCommand methodsFor: 'private' stamp: 'lr 10/5/2010 16:05'! handleWarning: anException | message | message := (anException messageText endsWith: '?') ifTrue: [ anException messageText ] ifFalse: [ anException messageText , String cr , 'Do you want to proceed?' ]. (self confirm: message) ifTrue: [ anException resume ] ifFalse: [ anException return ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 2/9/2008 16:13'! inform: aString ^ OBInformRequest message: aString! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 4/23/2010 08:36'! instanceVariables | variables | variables := self currentNode theClass allInstVarNames asArray sort. ^ (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 12/14/2011 21:12'! openEnvironment: anEnvironment anEnvironment isSystem ifTrue: [ ^ target browse ]. anEnvironment isEmpty ifTrue: [ ^ self inform: 'Empty scope' ]. self waitWhile: [ | instance | instance := anEnvironment browserInstance. [ instance jumpTo: target ] ifError: [ instance jumpToRoot ]. instance open ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'! performChange: aChange self waitWhile: [ RBRefactoryChangeManager instance performChange: aChange. self refreshChange: aChange ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 12/13/2010 08:22'! 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: [ | browser | aRefactoring primitiveExecute. browser := ORChangesBrowser change: aRefactoring changes. browser closeBlock: [ self refreshRefactoring: aRefactoring ]. browser open ]. self refreshRefactoring: aRefactoring ]! ! !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 6/15/2010 13:13'! refactoringOptions: aRefactoring aRefactoring setOption: #implementorToInline toUse: [ :ref :imps | self requestImplementorToInline: imps ]; setOption: #methodName toUse: [ :ref :name | self requestMethodNameFor: name ]; 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 12/13/2010 08:24'! refresh "Refresh the browser." self browser signalRefresh! ! !ORCommand methodsFor: 'actions' stamp: 'lr 12/13/2010 08:23'! refreshChange: aChange "Called after a successful change application to refresh the views." self refresh! ! !ORCommand methodsFor: 'actions' stamp: 'lr 12/13/2010 08:23'! refreshRefactoring: aRefactoring "Called after a successful refactoring to refresh the browser." self refresh! ! !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 8/8/2010 15:04'! requestImplementorToInline: aCollection ^ self chooseFrom: aCollection title: 'Which implementation should be inlined?'! ! !ORCommand methodsFor: 'actions' stamp: 'lr 6/15/2010 09:09'! requestMethodNameFor: aMethodName ^ ORMethodNameRequest methodName: aMethodName! ! !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! ! ORCommand subclass: #ORCriticsCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! ORCriticsCommand subclass: #ORCmdBrowse instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !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 8/8/2010 10:07'! label ^ 'Browse'! ! ORCriticsCommand subclass: #ORCmdImplementor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !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 8/8/2010 10:07'! label ^ 'Implementor'! ! ORCriticsCommand subclass: #ORCmdRefresh instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !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 8/8/2010 10:07'! label ^ 'Refresh'! ! ORCriticsCommand subclass: #ORCmdRefreshRule instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Critics'! !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 8/8/2010 10:07'! label ^ 'Refresh rule'! ! OBCmdRemoveClass subclass: #ORCmdRemoveClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands-Replacement'! !ORCmdRemoveClass methodsFor: 'private' stamp: 'lr 9/8/2011 20:10'! doRemove RBRefactoryChangeManager instance performChange: (RBRemoveClassChange remove: target theNonMetaClass). requestor announce: (OBNodeDeleted node: target)! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:25'! browserEnvironment ^ RBBrowserEnvironment 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 ] ! ! !RBMultiEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 01:21'! browserClass ^ ORMultiBrowser! ! !RBMultiEnvironment methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:32'! environmentNamed: aString ^ environmentDictionaries at: aString ifAbsent: [ RBSelectorEnvironment new ]! ! 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 11/4/2010 13:09'! asNode ^ ORTransformationCriticsNode on: self! ! !RBTransformationRule methodsFor: '*ob-refactory' stamp: 'lr 9/8/2011 20:10'! browserInstance | change | change := RBCompositeRefactoryChange named: self name. change changes: self changes. ^ change browserInstance! ! !RBTransformationRule methodsFor: '*ob-refactory' stamp: 'lr 2/23/2009 23:50'! open ^ self browserInstance open! ! !OBClassCommentNode methodsFor: '*ob-refactory' stamp: 'lr 11/25/2009 10:42'! definedWithinBrowserEnvironment: anEnvironment ^ (super definedWithinBrowserEnvironment: anEnvironment) and: [ anEnvironment definesClass: self theClass ]! ! RBClassRefactoring 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 9/8/2011 20:11'! refactorings | class | class := self classObjectFor: className asSymbol. ^ class instanceVariableNames collect: [ :each | RBCreateAccessorsForVariableRefactoring variable: each class: class classVariable: false ]! ! !ORAccessorClassRefactoring methodsFor: 'transforming' stamp: 'lr 11/30/2007 09:13'! transform self refactorings do: [ :each | self performComponentRefactoring: each ]! ! RBClassRefactoring subclass: #ORGenerateEqualHashRefactoring instanceVariableNames: 'variables' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORGenerateEqualHashRefactoring class methodsFor: 'instance-creation' stamp: 'lr 3/6/2011 16:46'! className: aClass variables: anArray ^ (self className: aClass) variables: anArray! ! !ORGenerateEqualHashRefactoring class methodsFor: 'instance-creation' stamp: 'lr 3/6/2011 16:46'! model: aNamespace className: aClass variables: anArray ^ (self model: aNamespace className: aClass) variables: anArray! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 9/8/2011 20:11'! accessorForVariable: aString | refactoring | refactoring := RBCreateAccessorsForVariableRefactoring model: self model variable: aString class: self theClass classVariable: false. refactoring createGetterAccessor. ^ refactoring getterMethod! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 3/6/2011 16:44'! 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. variables reversed do: [ :each | | accessor | accessor := self accessorForVariable: each. comparison := RBMessageNode receiver: (RBVariableNode named: each) selector: #= arguments: (Array with: (RBMessageNode receiver: (RBVariableNode named: 'anObject') selector: accessor)). statement := statement isNil ifTrue: [ comparison ] ifFalse: [ 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 3/6/2011 16:43'! compileHash | method statement hash | method := RBParser parseMethod: 'hash "Answer an integer value that is related to the identity of the receiver."'. statement := nil. variables reversed do: [ :each | hash := RBMessageNode receiver: (RBVariableNode named: each) selector: #hash. statement := statement isNil ifTrue: [ hash ] ifFalse: [ 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 7/18/2010 09:54'! preconditions ^ variables inject: RBCondition empty into: [ :condition :variable | condition & (RBCondition definesInstanceVariable: variable in: self theClass) ]! ! !ORGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 2/25/2010 10:55'! theClass ^ (self classObjectFor: className) theNonMetaClass! ! !ORGenerateEqualHashRefactoring methodsFor: 'transforming' stamp: 'lr 9/1/2011 18:19'! transform variables isEmpty ifTrue: [ ^ self ]. self compileHash. self compileEqual! ! !ORGenerateEqualHashRefactoring methodsFor: 'accessing' stamp: 'lr 7/18/2010 09:54'! variables: anArray variables := anArray! ! RBClassRefactoring subclass: #ORGeneratePrintStringRefactoring instanceVariableNames: 'variables' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORGeneratePrintStringRefactoring class methodsFor: 'instance-creation' stamp: 'lr 3/6/2011 16:46'! className: aClass variables: anArray ^ (self className: aClass) variables: anArray! ! !ORGeneratePrintStringRefactoring class methodsFor: 'instance-creation' stamp: 'lr 3/6/2011 16:46'! model: aNamespace className: aClass variables: anArray ^ (self 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! ! RBClassRefactoring 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: 'transforming' stamp: 'lr 9/1/2011 21:09'! realize: aStartClass upTo: aStopClass | selectors method parseTree | selectors := IdentitySet withAll: aStartClass selectors. aStartClass allSuperclasses do: [ :class | class selectors do: [ :selector | (selectors includes: selector) ifFalse: [ 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). aStartClass compile: parseTree newSource withAttributesFrom: method ]. selectors add: selector ] ]. class = aStopClass ifTrue: [ ^ self ] ]! ! !ORRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/30/2009 16:27'! theClass ^ (self classObjectFor: className) theNonMetaClass! ! !ORRealizeClassRefactoring methodsFor: 'transforming' stamp: 'lr 9/1/2011 21:08'! transform self realize: self theClass theNonMetaClass upTo: (self model classFor: Object). self realize: self theClass theMetaClass upTo: (self model classFor: Object class).! ! !RBCompositeLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 11/4/2010 13:09'! asNode ^ ORCompositeCriticsNode on: self! ! OBCmdRenameClass subclass: #ORCmdRenameClass instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands-Replacement'! !ORCmdRenameClass methodsFor: 'execution' stamp: 'lr 9/8/2011 20:31'! execute "Delegate the execution to the real refactoring." (ORCmdRenameClassRefactoring on: target for: requestor) execute! ! !RBLintRule methodsFor: '*ob-refactory-converting' stamp: 'lr 2/23/2009 21:51'! asNode ^ self subclassResponsibility! ! !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 ]! ! RBRefactoring 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 6/4/2010 13:36'! transform | source tree formatted | 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) ] ] ] ] ] ] ! ! Error subclass: #ORUICancellationError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! ORCmdEnvironment initialize! ORHightlightEnvironmentFilter initialize! ORMethodDefinition initialize!