SystemOrganization addCategory: #'OB-Refactory-Browsers'! SystemOrganization addCategory: #'OB-Refactory-Commands'! SystemOrganization addCategory: #'OB-Refactory-Refactoring'! SystemOrganization addCategory: #'OB-Refactory-Changes'! SystemOrganization addCategory: #'OB-Refactory-Matcher'! SystemOrganization addCategory: #'OB-Refactory-Lint'! SystemOrganization addCategory: #'OB-Refactory-Tools'! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! addToEnvironment: anEnvironment! ! !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 2/9/2008 16:23'! isDescendantOfClass: aNode ^ false! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment! ! !OBCodeNode methodsFor: '*ob-refactory' stamp: 'lr 5/20/2007 08:59'! withinBrowserEnvironment: anEnvironment ^ true! ! OBCodeNode subclass: #ORChangeNode instanceVariableNames: 'change parent' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! ORChangeNode subclass: #ORAddMethodChangeNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORAddMethodChangeNode methodsFor: 'actions' stamp: 'lr 3/24/2008 11:55'! browse OBSystemBrowser openOnClass: change changeClass selector: change selector! ! !ORAddMethodChangeNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 18:40'! text | class previous | class := change changeClass. (class isNil or: [ (class includesSelector: change selector) not ]) ifTrue: [ ^ change parseTree formattedCode ]. previous := class parseTreeFor: change selector. ^ TextDiffBuilder buildDisplayPatchFrom: previous formattedCode to: change parseTree formattedCode! ! !ORChangeNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 18:15'! on: aRule ^ self new initializeOn: aRule! ! !ORChangeNode methodsFor: 'private' stamp: 'lr 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: 'actions' stamp: 'lr 3/24/2008 11:54'! browse OBSystemBrowser openOnClass: change changeClass! ! !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: '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 2/7/2008 18:20'! isEditable ^ 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: 'initialization' stamp: 'lr 3/12/2008 09:14'! setParent: aNode parent := aNode! ! !ORChangeNode methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:33'! text | text | text := change printString. (text endsWith: '!!') ifTrue: [ text := text allButLast ]. ^ (RBParser parseExpression: text) formattedCode! ! !MultiEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 01:21'! browserClass ^ ORMultiBrowser! ! !MultiEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:59'! environmentNamed: aString ^ environmentDictionaries at: aString ifAbsent: [ SelectorEnvironment new ]! ! OBBrowser subclass: #ORChangesBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORChangesBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 18:23'! change: aChange ^ self root: aChange asNode! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 3/19/2008 16:52'! defaultMetaNode | root change | root := OBMetaNode named: 'root'. change := OBMetaNode named: 'change'. change displaySelector: #indentedName. root childAt: #changes put: change. ^ root! ! !ORChangesBrowser class methodsFor: 'opening' stamp: 'lr 2/9/2008 09:51'! openChange: aChange ^ (self change: aChange) open! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 18:24'! paneCount ^ 1! ! !ORChangesBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 20:25'! titleForRoot: aNode ^ 'Changes: ' , aNode name! ! !ORChangesBrowser methodsFor: 'commands' stamp: 'lr 3/12/2008 09:08'! cmdCommands ^ ORCmdChangeCommand allSubclasses! ! !ORChangesBrowser methodsFor: 'building' stamp: 'lr 2/7/2008 18:25'! defaultBackgroundColor ^ Color lightBlue! ! OBBrowser subclass: #ORLintBrowser instanceVariableNames: 'environment process' classVariableNames: 'PaneCount' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 17:26'! defaultMetaNode | comp leaf | comp := OBMetaNode named: 'comp'. leaf := OBMetaNode named: 'leaf'. comp childAt: #compositeRules put: comp. comp childAt: #leafRules put: leaf. comp addFilter: ORSortingFilter new; addFilter: ORLintResultFilter new. leaf addFilter: ORLintResultFilter new. ^ comp! ! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/7/2008 15:21'! defaultRootNode ^ CompositeLintRule lintChecks asNode! ! !ORLintBrowser class methodsFor: 'opening' stamp: 'lr 2/7/2008 14:37'! openRule: aRule environment: anEnvironment ^ (self rule: aRule environment: anEnvironment) open! ! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 2/8/2008 09:49'! paneCount ^ PaneCount ifNil: [ 2 ]! ! !ORLintBrowser class methodsFor: 'private' stamp: 'lr 2/8/2008 09:56'! panesFor: aRule level: anInteger ^ (aRule rules collect: [ :each | each isComposite ifFalse: [ anInteger ] ifTrue: [ self panesFor: each level: anInteger + 1 ] ]) detectMax: [ :each | each ]! ! !ORLintBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 14:20'! rule: aRule ^ self rule: aRule environment: BrowserEnvironment new! ! !ORLintBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/8/2008 09:56'! rule: aRule environment: anEnvironment PaneCount := self panesFor: aRule level: 1. ^ (self root: aRule asNode) environment: anEnvironment! ! !ORLintBrowser class methodsFor: 'configuration' stamp: 'lr 6/6/2008 16:58'! titleForRoot: aNode ^ 'Code Critics: ' , aNode name! ! !ORLintBrowser methodsFor: 'private' stamp: 'lr 5/29/2008 14:44'! basicSearch [ self root rule resetResult; runOnEnvironment: self environment ] ensure: [ process := nil. self refresh ]! ! !ORLintBrowser methodsFor: 'commands' stamp: 'lr 10/22/2008 13:31'! cmdCommands ^ ORCmdLintCommand allSubclasses! ! !ORLintBrowser methodsFor: 'building' stamp: 'lr 3/25/2008 20:41'! defaultBackgroundColor ^ Color orange! ! !ORLintBrowser methodsFor: 'building' stamp: 'lr 10/22/2008 14:21'! defaultLabel ^ super defaultLabel , ' on ' , self environment name , (self isSearching ifTrue: [ ' (searching)' ] ifFalse: [ self root problemCount isZero ifTrue: [ String new ] ifFalse: [ ' (' , self root problemCount asString , ' problems)' ] ])! ! !ORLintBrowser methodsFor: 'accessing' stamp: 'lr 2/7/2008 14:21'! environment ^ environment! ! !ORLintBrowser methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:08'! environment: anEnvironment environment := anEnvironment! ! !ORLintBrowser methodsFor: 'testing' stamp: 'lr 5/29/2008 14:35'! isSearching ^ process notNil and: [ process isTerminated not ]! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 10/22/2008 14:24'! refresh OBWaitRequest block: [ self root update: self environment. self relabel: self defaultLabel. self signalRefresh ]! ! !ORLintBrowser methodsFor: 'actions' stamp: 'lr 5/29/2008 14:39'! search process := [ self basicSearch ] newProcess. process name: 'lint'. process resume! ! !ORLintBrowser methodsFor: 'initialization' stamp: 'lr 5/29/2008 14:34'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. self search! ! !ORLintBrowser methodsFor: 'private' stamp: 'lr 5/29/2008 14:46'! windowIsClosing self isSearching ifTrue: [ process terminate ]! ! !CategoryEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:36'! browserClass ^ ORClassBrowser! ! MethodRefactoring subclass: #ORSwapMethodRefactoring instanceVariableNames: 'target selector' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORSwapMethodRefactoring commentStamp: 'lr 10/19/2007 09:16' prior: 0! Move a method from the class to the instance side, or vice versa. Normally this is not considered to be a refactoring.! !ORSwapMethodRefactoring class methodsFor: 'instance-creation' stamp: 'lr 4/5/2007 08:48'! model: aRBSmalltalk swapMethod: aSelector in: aClass ^ self new model: aRBSmalltalk; swapMethod: aSelector in: aClass; yourself! ! !ORSwapMethodRefactoring class methodsFor: 'instance-creation' stamp: 'lr 4/5/2007 08:48'! swapMethod: aSelector in: aClass ^ self new swapMethod: aSelector in: aClass! ! !ORSwapMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 2/10/2008 09:57'! checkInstVars class instanceVariableNames do: [ :each | (target instanceVariableNames includes: each) ifFalse: [ ((class whichSelectorsReferToInstanceVariable: each) includes: selector) ifTrue: [ self refactoringError: ('<1p> refers to <2s>, which is not defined in <3p>' expandMacrosWith: selector with: each with: target) ] ] ]! ! !ORSwapMethodRefactoring methodsFor: 'preconditions' stamp: 'lr 3/13/2008 08:06'! preconditions ^ (RBCondition definesSelector: selector in: class) & (RBCondition definesSelector: selector in: target) not & (RBCondition withBlock: [ self checkInstVars. true ])! ! !ORSwapMethodRefactoring methodsFor: 'initialization' stamp: 'lr 4/5/2007 08:53'! swapMethod: aSelector in: aClass class := self classObjectFor: aClass. target := self classObjectFor: (class isMeta ifTrue: [ class nonMetaclass ] ifFalse: [ class metaclass ]). selector := aSelector! ! !ORSwapMethodRefactoring methodsFor: 'transforming' stamp: 'lr 4/5/2007 09:00'! transform target compile: (class sourceCodeFor: selector) classified: (class protocolsFor: selector). class removeMethod: selector! ! !BasicLintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 10/22/2008 12:13'! asNode ^ ORBasicLintNode on: self! ! !BasicLintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/9/2008 17:30'! browserInstance ^ self result browserInstance! ! !VariableEnvironment methodsFor: '*ob-refactory' stamp: 'lr 3/4/2008 14:10'! browserClass self classesAndSelectorsDo: [ :class :selector | ^ super browserClass ]. ^ ORClassBrowser! ! !LintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 10/22/2008 12:13'! asNode ^ self subclassResponsibility! ! 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 3/1/2008 20:44'! createRuleFor: aMatcher ^ TransformationRule new rewriteUsing: aMatcher; name: 'Rewriter'; yourself! ! !ORRewriterDefinition methodsFor: 'configuration' stamp: 'lr 3/1/2008 20:45'! template ^ 'ParseTreeRewriter 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 3/1/2008 19:58'! accept: aText notifying: aController | rule | text := aText asString. rule := self createRuleFor: (self class evaluatorClass evaluate: text for: self notifying: aController logged: false). rule runOnEnvironment: environment. rule browserInstance open. ^ true! ! !ORSearcherDefinition methodsFor: 'configuration' stamp: 'lr 3/1/2008 20:44'! createRuleFor: aMatcher ^ ParseTreeLintRule new matcher: aMatcher; name: 'Searcher'; yourself! ! !ORSearcherDefinition methodsFor: 'initialization' stamp: 'lr 3/1/2008 18:15'! initializeOn: anEnvironment environment := anEnvironment! ! !ORSearcherDefinition methodsFor: 'configuration' stamp: 'lr 3/1/2008 20:38'! template ^ 'ParseTreeSearcher 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 ]! ! ClassRefactoring subclass: #ORAccessorClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORAccessorClassRefactoring methodsFor: 'preconditions' stamp: 'lr 1/7/2008 00:10'! preconditions ^ self refactorings inject: RBCondition empty into: [ :result :each | result & each preconditions ]! ! !ORAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 11/30/2007 09:18'! refactorings | class | class := self model classNamed: className asSymbol. ^ class instanceVariableNames collect: [ :each | CreateAccessorsForVariableRefactoring variable: each class: class classVariable: false ]! ! !ORAccessorClassRefactoring methodsFor: 'transforming' stamp: 'lr 11/30/2007 09:13'! transform self refactorings do: [ :each | self performComponentRefactoring: each ]! ! ClassRefactoring subclass: #ORRealizeClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Tools'! !ORRealizeClassRefactoring commentStamp: 'lr 10/19/2007 09:16' prior: 0! Make a given class concrete, by providing empty templates for all the abstract methods.! !ORRealizeClassRefactoring methodsFor: 'preconditions' stamp: 'lr 3/18/2008 08:43'! preconditions ^ RBCondition withBlock: [ (self theClass withAllSubclasses detect: [ :each | (each whichSelectorsReferToSymbol: #subclassResponsibility) notEmpty or: [ (each metaclass whichSelectorsReferToSymbol: #subclassResponsibility) notEmpty ] ] ifNone: [ nil ]) isNil ] errorString: self theClass printString , ' is abstract or has abstract subclasses.'! ! !ORRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/18/2008 08:43'! theClass ^ (self model classNamed: className) nonMetaclass! ! !ORRealizeClassRefactoring methodsFor: 'transforming' stamp: 'lr 3/18/2008 08:43'! transform self transform: self theClass. self transform: self theClass metaclass! ! !ORRealizeClassRefactoring methodsFor: 'transforming' stamp: 'lr 3/18/2008 08:38'! transform: aClass | class method parseTree | aClass allSelectors do: [ :selector | class := aClass whoDefinesMethod: selector. (class notNil and: [ class ~= aClass ]) ifTrue: [ method := class methodFor: selector. (method notNil and: [ method refersToSymbol: #subclassResponsibility ]) ifTrue: [ parseTree := method parseTree. parseTree body temporaries: OrderedCollection new; statements: OrderedCollection new; addNode: (RBMessageNode receiver: (RBVariableNode named: 'self') selector: #shouldBeImplemented). aClass compileTree: parseTree classified: (class protocolsFor: selector) ] ] ]! ! !OBMethodDefinition methodsFor: '*ob-refactory' stamp: 'lr 6/27/2007 12:06'! prettyPrint: aString ^ source := self theClass formatterClass format: aString in: theClass notifying: nil contentsSymbol: nil! ! !OBClassNode methodsFor: '*ob-refactory-navigation' stamp: 'lr 2/9/2008 09:18'! methods ^ self theClass selectors collect: [ :each | (MethodReference class: self theClass selector: each) asNode ]! ! Error subclass: #ORUICancellationError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! OBFilter subclass: #OREnvironmentFilter instanceVariableNames: 'environment' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentFilter class methodsFor: 'instance-creation' stamp: 'lr 2/9/2008 12:42'! on: anEnvironment ^ self new setEnvironment: anEnvironment! ! !OREnvironmentFilter methodsFor: 'accessing' stamp: 'lr 2/9/2008 11:25'! environment ^ environment! ! !OREnvironmentFilter methodsFor: 'initalizing' stamp: 'lr 2/9/2008 12:42'! setEnvironment: anEnvironment environment := anEnvironment! ! OREnvironmentFilter subclass: #ORHideEnvironmentFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORHideEnvironmentFilter methodsFor: 'filtering' stamp: 'lr 2/9/2008 12:24'! nodesFrom: aCollection forNode: aNode ^ aCollection select: [ :each | each withinBrowserEnvironment: environment ]! ! OREnvironmentFilter subclass: #ORHightlightEnvironmentFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORHightlightEnvironmentFilter methodsFor: 'filtering' stamp: 'lr 10/13/2008 10:40'! displayString: aString forParent: aParentNode child: aNode ^ (aNode withinBrowserEnvironment: environment) ifFalse: [ aString asText addAttribute: TextEmphasis italic ] ifTrue: [ aString ]! ! OBFilter subclass: #ORLintResultFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORLintResultFilter methodsFor: 'filtering' stamp: 'lr 10/22/2008 13:59'! displayString: aString forNode: aNode | problemCount | problemCount := aNode problemCount. problemCount = 0 ifTrue: [ ^ aString ]. ^ (aString , ' (' , problemCount asString , ')') asText addAttribute: TextEmphasis bold! ! OBFilter subclass: #ORSortingFilter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORSortingFilter methodsFor: 'filtering' stamp: 'lr 2/9/2008 17:26'! nodesFrom: nodes forNode: parent ^ nodes asSortedCollection: [ :a :b | a name < b name ]! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdClassRefactroings ^ ORCmdClassRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdClassVarRefactroings ^ ORCmdClassVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/21/2007 19:24'! cmdEnvironments ^ ORCmdEnvironment allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdInstVarRefactroings ^ ORCmdInstVarRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdMethodRefactroings ^ ORCmdMethodRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 6/14/2007 18:39'! cmdOpen ^ ORCmdOpen allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 6/14/2007 19:15'! cmdPrettyPrint ^ ORCmdPrettyPrint! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 6/14/2007 18:36'! cmdRefactoryTools ^ ORCmdRefactoringTool allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-commands' stamp: 'lr 5/18/2007 13:10'! cmdSourceRefactroings ^ ORCmdSourceRefactoring allSubclasses! ! !OBCodeBrowser methodsFor: '*ob-refactory-accessing' stamp: 'lr 5/21/2007 14:48'! environment ^ BrowserEnvironment new! ! OBCodeBrowser subclass: #OREnvironmentBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! OREnvironmentBrowser subclass: #ORClassBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORClassBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 11:50'! defaultMetaNode | root | root := OBMetaNode named: 'Environment'. ^ self buildMetagraphOn: root! ! !ORClassBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 11:52'! paneCount ^ 3! ! !OREnvironmentBrowser class methodsFor: 'instance-creation' stamp: 'lr 2/11/2008 22:06'! on: anEnvironment ^ self root: (OREnvironmentNode onEnvironment: anEnvironment)! ! !OREnvironmentBrowser class methodsFor: 'opening' stamp: 'lr 2/9/2008 01:24'! openOn: anEnvironment ^ (self on: anEnvironment) open! ! !OREnvironmentBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 13:37'! titleForRoot: aNode ^ aNode browserEnvironment label! ! !OREnvironmentBrowser methodsFor: 'building' stamp: 'lr 2/9/2008 12:03'! defaultBackgroundColor ^ Color yellow! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 2/10/2008 12:55'! definitionPanel ^ self panels detect: [ :each | each isKindOf: OBDefinitionPanel ] ifNone: [ self error: 'No definition panel configured' ]! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 2/10/2008 12:55'! environment ^ self root browserEnvironment! ! !OREnvironmentBrowser methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:21'! open self signalRefresh. super open! ! !OREnvironmentBrowser methodsFor: 'updating' stamp: 'lr 2/10/2008 12:56'! selectionChanged: anAnnouncement | interval | interval := self environment selectionIntervalFor: self definitionPanel text. interval isNil ifFalse: [ self definitionPanel selection: interval ]! ! !OREnvironmentBrowser methodsFor: 'initializing' stamp: 'lr 2/10/2008 12:56'! setMetaNode: aMetaNode node: aNode super setMetaNode: aMetaNode node: aNode. announcer observe: OBSelectionChanged send: #selectionChanged: to: self! ! OREnvironmentBrowser subclass: #ORMethodBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORMethodBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 10:17'! defaultMetaNode | class method | class := OBMetaNode named: 'Class'. method := OBMetaNode named: 'Method'. class childAt: #methods put: method; addFilter: OBClassSortFilter new. method displaySelector: #fullName. ^ class! ! !ORMethodBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 01:36'! paneCount ^ 1! ! OREnvironmentBrowser subclass: #ORMultiBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORMultiBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 11:46'! defaultMetaNode | multi envi method | multi := OBMetaNode named: 'MultiEnvironment'. envi := OBMetaNode named: 'Environment'. method := OBMetaNode named: 'Method'. multi childAt: #environments put: envi. envi childAt: #methods put: method; addFilter: OBClassSortFilter new. method displaySelector: #fullName. ^ multi! ! !ORMultiBrowser class methodsFor: 'configuration' stamp: 'lr 2/9/2008 11:46'! paneCount ^ 2! ! OREnvironmentBrowser subclass: #ORPackageBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORPackageBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 13:12'! defaultMetaNode | root extensionCategory packageCategory | root := OBMetaNode named: 'Environment'. extensionCategory := OBMetaNode named: 'ExtensionCategory'. packageCategory := OBMetaNode named: 'PackageCategory'. root childAt: #packageExtensionCategory put: extensionCategory. root childAt: #packageCategories put: packageCategory. self buildMetagraphOn: extensionCategory. extensionCategory ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: packageCategory. packageCategory ancestrySelector: #isDescendantOfClassCat:. ^ root! ! !ORPackageBrowser methodsFor: 'initializing' stamp: 'lr 2/11/2008 22:23'! setMetaNode: aMetaNode node: aNode | filter | filter := ORHightlightEnvironmentFilter on: aNode browserEnvironment. aMetaNode withAllChildrenDo: [ :each | (self unfilteredNames includes: each name) ifFalse: [ each addFilter: filter ] ]. super setMetaNode: aMetaNode node: aNode! ! !ORPackageBrowser methodsFor: 'configuration' stamp: 'lr 2/10/2008 13:19'! unfilteredNames ^ #('Environment')! ! OREnvironmentBrowser subclass: #ORSystemBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORSystemBrowser class methodsFor: 'configuration' stamp: 'lr 2/10/2008 12:41'! defaultMetaNode | root cat | root := OBMetaNode named: 'Environment'. cat := OBMetaNode named: 'Class Category'. root childAt: #categories put: cat. cat ancestrySelector: #isDescendantOfClassCat:. self buildMetagraphOn: cat. ^ root! ! !ORSystemBrowser class methodsFor: 'configuration' stamp: 'lr 2/11/2008 22:06'! defaultRootNode ^ OREnvironmentNode onEnvironment: BrowserEnvironment new! ! !ORSystemBrowser methodsFor: 'commands' stamp: 'lr 2/9/2008 13:57'! cmdToggleContainment ^ ORCmdToggleContainment! ! !ORSystemBrowser methodsFor: 'initialization' stamp: 'lr 2/11/2008 22:23'! setMetaNode: aMetaNode node: aNode | filter | filter := ORHightlightEnvironmentFilter on: aNode selectorEnvironment. aMetaNode withAllChildrenDo: [ :each | each addFilter: filter ]. super setMetaNode: aMetaNode node: aNode! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 13:54'! addToEnvironment: anEnvironment self classes do: [ :each | each addToEnvironment: anEnvironment ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 9/26/2008 12:15'! containingPackage ^ PackageOrganizer default packages detect: [ :each | each includesSystemCategory: self name ] ifNone: [ super containingPackage ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 13:55'! removeFromEnvironment: anEnvironment self classes do: [ :each | each removeFromEnvironment: anEnvironment ]! ! !OBClassCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:12'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesCategory: self name! ! OBClassCategoryNode subclass: #ORPackageExtensionNode instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 2/10/2008 12:15'! classes ^ environment package extensionClasses collect: [ :each | each asNode ]! ! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 2/10/2008 13:18'! comments ^ environment package extensionClasses collect: [ :each | each asCommentNode ]! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:11'! definition ^ self! ! !ORPackageExtensionNode methodsFor: 'navigating' stamp: 'lr 2/10/2008 12:15'! metaclasses ^ environment package extensionClasses collect: [ :each | each asClassSideNode ]! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:11'! name ^ '*Extensions'! ! !ORPackageExtensionNode methodsFor: 'displaying' stamp: 'lr 2/10/2008 12:12'! text ^ nil! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 08:54'! allNonMetaClasses | classes | classes := Set new. self classesDo: [ :each | classes add: each theNonMetaClass ]. ^ classes! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:34'! browserClass ^ ORMethodBrowser! ! !BrowserEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 16:08'! browserInstance ^ self browserClass on: self! ! !PackageEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/10/2008 11:56'! browserClass ^ ORPackageBrowser! ! !RefactoryChange methodsFor: '*ob-refactory-changes' stamp: 'lr 3/12/2008 09:16'! asNode ^ ORChangeNode on: self! ! !RefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 17:28'! browserClass ^ ORChangesBrowser! ! !RefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 17:28'! browserInstance ^ self browserClass change: self! ! !RefactoryChange methodsFor: '*ob-refactory' stamp: 'lr 3/12/2008 10:18'! changeClass ^ nil! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:10'! addToEnvironment: anEnvironment self methods do: [ :each | each addToEnvironment: anEnvironment ]! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 9/26/2008 12:16'! containingPackage ^ PackageOrganizer default packages detect: [ :each | each includesMethodCategory: self name ofClass: self theClass ] ifNone: [ super containingPackage ]! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment self methods do: [ :each | each removeFromEnvironment: anEnvironment ]! ! !OBMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:12'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesProtocol: self name in: self theClass! ! !CompositeLintRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/7/2008 17:29'! asNode ^ ORCompositeLintNode on: self! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 5/21/2007 13:24'! filters ^ filters! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 2/11/2008 22:22'! withAllChildrenDo: aBlock self withAllChildrenDo: aBlock seen: IdentitySet new! ! !OBMetaNode methodsFor: '*ob-refactory' stamp: 'lr 2/11/2008 23:20'! withAllChildrenDo: aBlock seen: aSet (aSet includes: self) ifTrue: [ ^ self ]. aSet add: self. aBlock value: self. self edges do: [ :each | each metaNode withAllChildrenDo: aBlock seen: aSet ]! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:10'! addToEnvironment: anEnvironment anEnvironment addClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 9/26/2008 12:13'! containingPackage ^ PackageOrganizer default packageOfMethod: self reference ifNone: [ super containingPackage ]! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:09'! removeFromEnvironment: anEnvironment anEnvironment removeClass: self theClass selector: self selector! ! !OBMethodNode methodsFor: '*ob-refactory' stamp: 'lr 5/20/2007 09:04'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesSelector: self selector in: self theClass! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:29'! addToEnvironment: anEnvironment anEnvironment addClass: self theNonMetaClass; addClass: self theMetaClass! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 9/26/2008 12:12'! containingPackage ^ PackageOrganizer default packageOfClass: self theClass ifNone: [ super containingPackage ]! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 21:29'! removeFromEnvironment: anEnvironment anEnvironment removeClass: self theNonMetaClass; removeClass: self theMetaClass! ! !OBClassAwareNode methodsFor: '*ob-refactory' stamp: 'lr 8/8/2007 22:00'! withinBrowserEnvironment: anEnvironment ^ anEnvironment includesClass: self theClass! ! !TransformationRule methodsFor: '*ob-refactory-lint' stamp: 'lr 10/22/2008 12:14'! asNode ^ ORTransformationLintNode on: self! ! !TransformationRule methodsFor: '*ob-refactory-lint' stamp: 'lr 2/9/2008 17:29'! browserInstance | change | change := CompositeRefactoryChange named: self name. change changes: self changes. ^ change browserInstance! ! OBNode subclass: #ORLintNode instanceVariableNames: 'rule problemCount' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! ORLintNode subclass: #ORBasicLintNode instanceVariableNames: 'result' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORBasicLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 13:55'! open self result browserInstance open! ! !ORBasicLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:05'! result ^ result! ! !ORBasicLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:20'! text ^ super text , (String streamContents: [ :stream | self result classesAndSelectorsDo: [ :class :selector | stream nextPutAll: class name; nextPutAll: '>>'; print: selector; cr ] ])! ! !ORBasicLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:16'! update: anEnvironment result := rule result & anEnvironment. result label: rule result label. problemCount := result problemCount! ! ORLintNode subclass: #ORCompositeLintNode instanceVariableNames: 'rules' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 10/22/2008 13:48'! compositeRules ^ self rules select: [ :each | each isComposite ]! ! !ORCompositeLintNode methodsFor: 'initialization' stamp: 'lr 2/7/2008 16:46'! initializeOn: aRule super initializeOn: aRule. self update! ! !ORCompositeLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ true! ! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 10/22/2008 13:48'! leafRules ^ self rules reject: [ :each | each isComposite ]! ! !ORCompositeLintNode methodsFor: 'navigation' stamp: 'lr 2/7/2008 15:30'! rules ^ rules! ! !ORCompositeLintNode methodsFor: 'actions' stamp: 'lr 5/29/2008 14:41'! update rules := rule rules collect: [ :each | each asNode ]! ! !ORCompositeLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:22'! update: anEnvironment self rules do: [ :each | each update: anEnvironment ]. problemCount := self rules inject: 0 into: [ :result :each | result + each problemCount ]! ! !ORLintNode class methodsFor: 'instance-creation' stamp: 'lr 2/7/2008 15:21'! on: aRule ^ self new initializeOn: aRule! ! !ORLintNode methodsFor: 'initialization' stamp: 'lr 10/22/2008 14:16'! initializeOn: aRule rule := aRule. problemCount := 0! ! !ORLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 15:58'! isComposite ^ false! ! !ORLintNode methodsFor: 'testing' stamp: 'lr 2/7/2008 16:00'! isEditable ^ false! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:23'! name ^ rule name! ! !ORLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 13:58'! open! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:16'! problemCount ^ problemCount! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 13:50'! rationale ^ self rule rationale! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 2/7/2008 15:22'! rule ^ rule! ! !ORLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:19'! text ^ self rationale asText allBold , ((self problemCount > 0 and: [ self rationale isEmpty not ]) ifTrue: [ String cr , String cr ] ifFalse: [ String new ])! ! !ORLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:04'! update: anEnvironment! ! ORLintNode subclass: #ORTransformationLintNode instanceVariableNames: 'changes' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORTransformationLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:09'! changes ^ changes! ! !ORTransformationLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 12:29'! open self changes browserInstance open! ! !ORTransformationLintNode methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:25'! text ^ super text , (String streamContents: [ :stream | self changes changes do: [ :each | stream nextPutAll: each displayString; cr ] ])! ! !ORTransformationLintNode methodsFor: 'actions' stamp: 'lr 10/22/2008 14:17'! update: anEnvironment changes := CompositeRefactoryChange named: self name. changes changes: self rule changes. problemCount := changes problemCount! ! !OBAllMethodCategoryNode methodsFor: '*ob-refactory' stamp: 'lr 2/10/2008 13:21'! withinBrowserEnvironment: anEnvironment ^ self methods anySatisfy: [ :each | each withinBrowserEnvironment: anEnvironment ] ! ! OBEnvironmentNode subclass: #OREnvironmentNode instanceVariableNames: 'browserEnvironment' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !OREnvironmentNode class methodsFor: 'instance-creation' stamp: 'lr 2/10/2008 13:01'! onEnvironment: aBrowserEnvironment ^ self forImage setBrowserEnvironment: aBrowserEnvironment! ! !OREnvironmentNode methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:00'! browserEnvironment ^ browserEnvironment! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:09'! classes ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:09'! comments ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asCommentNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! environments | selectorEnvironment | ^ self browserEnvironment environments asArray collect: [ :each | selectorEnvironment := self browserEnvironment environmentNamed: each. self class onEnvironment: (selectorEnvironment label: each) ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! metaclasses ^ self browserEnvironment allNonMetaClasses collect: [ :each | each asClassSideNode ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! methods | result | result := OrderedCollection new. self browserEnvironment classesAndSelectorsDo: [ :class :selector | result add: (MethodReference class: class selector: selector) asNode ]. ^ result! ! !OREnvironmentNode methodsFor: 'accessing' stamp: 'lr 2/11/2008 22:09'! name ^ self browserEnvironment name! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! packageCategories ^ self browserEnvironment package systemCategories collect: [ :each | OBClassCategoryNode on: each ]! ! !OREnvironmentNode methodsFor: 'navigation' stamp: 'lr 2/11/2008 22:10'! packageExtensionCategory ^ Array with: (ORPackageExtensionNode on: '*Extensions' inEnvironment: self browserEnvironment) ! ! !OREnvironmentNode methodsFor: 'public' stamp: 'lr 2/10/2008 13:30'! selectorEnvironment "Make sure that the receiver is a selector environment." | selectorEnvironment | selectorEnvironment := SelectorEnvironment new. browserEnvironment classesAndSelectorsDo: [ :class :selector | selectorEnvironment addClass: class selector: selector ]. ^ browserEnvironment := selectorEnvironment! ! !OREnvironmentNode methodsFor: 'initializing' stamp: 'lr 2/10/2008 13:00'! setBrowserEnvironment: anEnvironment browserEnvironment := anEnvironment! ! !ClassEnvironment methodsFor: '*ob-refactory' stamp: 'lr 2/9/2008 11:35'! browserClass ^ ORClassBrowser! ! !AddMethodChange methodsFor: '*ob-refactory-changes' stamp: 'lr 2/7/2008 18:30'! asNode ^ ORAddMethodChangeNode on: self! ! !RBMethodName methodsFor: '*ob-refactory' stamp: 'lr 3/12/2008 16:23'! printOn: aStream | argumentStream | self selector isNil ifTrue: [ self selector: (#value numArgs: self arguments size) ]. argumentStream := self arguments readStream. self selector keywords keysAndValuesDo: [ :key :part | key = 1 ifFalse: [ aStream space ]. aStream nextPutAll: part. (self selector isUnary or: [ argumentStream atEnd ]) ifTrue: [ ^ self ]. aStream space; nextPutAll: argumentStream next ]! ! OBCommand subclass: #ORCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! ORCommand subclass: #ORCmdChangeCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! ORCmdChangeCommand subclass: #ORCmdAcceptChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdAcceptChanges methodsFor: 'execution' stamp: 'lr 2/7/2008 20:22'! execute self performChange: self browser root change. self browser close! ! !ORCmdAcceptChanges methodsFor: 'accessing' stamp: 'lr 3/12/2008 09:08'! group ^ #action! ! !ORCmdAcceptChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 20:45'! keystroke ^ $s! ! !ORCmdAcceptChanges methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:23'! label ^ 'accept'! ! !ORCmdAcceptChanges methodsFor: 'testing' stamp: 'lr 2/7/2008 19:05'! wantsButton ^ true! ! ORCmdChangeCommand subclass: #ORCmdBrowseChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdBrowseChange methodsFor: 'execution' stamp: 'lr 3/24/2008 11:51'! execute target browse! ! !ORCmdBrowseChange methodsFor: 'testing' stamp: 'lr 3/24/2008 11:54'! isEnabled ^ target change changeClass notNil! ! !ORCmdBrowseChange methodsFor: 'accessing' stamp: 'lr 3/24/2008 11:51'! keystroke ^ $b! ! !ORCmdBrowseChange methodsFor: 'accessing' stamp: 'lr 3/24/2008 11:51'! label ^ 'browse'! ! ORCmdChangeCommand subclass: #ORCmdCancelChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdCancelChanges methodsFor: 'execution' stamp: 'lr 2/7/2008 19:06'! execute self browser close! ! !ORCmdCancelChanges methodsFor: 'accessing' stamp: 'lr 3/12/2008 09:09'! group ^ #action! ! !ORCmdCancelChanges methodsFor: 'accessing' stamp: 'lr 2/8/2008 09:23'! keystroke ^ $l! ! !ORCmdCancelChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:06'! label ^ 'cancel'! ! !ORCmdCancelChanges methodsFor: 'testing' stamp: 'lr 2/7/2008 19:05'! wantsButton ^ true! ! ORCmdChangeCommand subclass: #ORCmdFileInChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdFileInChange methodsFor: 'execution' stamp: 'lr 3/12/2008 10:21'! execute self performChange: target change. self refresh! ! !ORCmdFileInChange methodsFor: 'accessing' stamp: 'lr 3/12/2008 09:07'! label ^ 'file in'! ! ORCmdChangeCommand subclass: #ORCmdFileOutChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdFileOutChanges methodsFor: 'execution' stamp: 'lr 2/7/2008 21:37'! execute | changes | changes := String streamContents: [ :stream | stream header; timeStamp. self browser root changes do: [ :each | stream cr; cr; print: each change ] ]. FileStream writeSourceCodeFrom: changes readStream baseName: self browser root change name isSt: true useHtml: false! ! !ORCmdFileOutChanges methodsFor: 'accessing' stamp: 'lr 2/7/2008 21:06'! label ^ 'file out'! ! ORCmdChangeCommand subclass: #ORCmdRemoveChange instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdRemoveChange methodsFor: 'execution' stamp: 'lr 3/12/2008 10:19'! execute target remove. self refresh! ! !ORCmdRemoveChange methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:14'! keystroke ^ $x! ! !ORCmdRemoveChange methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:13'! label ^ 'remove'! ! ORCmdChangeCommand subclass: #ORCmdRemoveClassChanges instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Changes'! !ORCmdRemoveClassChanges methodsFor: 'execution' stamp: 'lr 3/12/2008 10:20'! execute self browser root changes do: [ :each | (target change changeClass = each change changeClass) ifTrue: [ each remove ] ]. self refresh! ! !ORCmdRemoveClassChanges methodsFor: 'testing' stamp: 'lr 3/12/2008 10:19'! isEnabled ^ target change changeClass notNil! ! !ORCmdRemoveClassChanges methodsFor: 'accessing' stamp: 'lr 3/12/2008 10:13'! label ^ 'remove class'! ! ORCommand subclass: #ORCmdEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdEnvironment subclass: #ORCmdCategoryEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdCategoryEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 15:59'! environment ^ super environment forCategories: (Array with: target name)! ! !ORCmdCategoryEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:11'! isActive ^ super isActive and: [ target isKindOf: OBClassCategoryNode ]! ! !ORCmdCategoryEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:03'! label ^ 'category'! ! ORCmdEnvironment subclass: #ORCmdClassEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:01'! environment ^ super environment forClasses: (Array with: target theNonMetaClass)! ! !ORCmdClassEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdClassEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'class'! ! ORCmdEnvironment subclass: #ORCmdClassHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:26'! environment | classes | classes := Set new addAll: target theNonMetaClass withAllSuperclasses; addAll: target theNonMetaClass allSubclasses; yourself. ^ (super environment forClasses: classes) label: 'Hierarchy of ' , target theNonMetaClassName! ! !ORCmdClassHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdClassHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'class hierarchy'! ! ORCmdEnvironment subclass: #ORCmdClassVarRefsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdClassVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:18'! environment | binding | binding := target theNonMetaClass bindingOf: (self chooseFrom: self classVariables). ^ super environment referencesTo: binding in: target theNonMetaClass! ! !ORCmdClassVarRefsEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:50'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBClassVariableNode ] ]! ! !ORCmdClassVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:54'! label ^ 'class variable references'! ! ORCmdEnvironment subclass: #ORCmdEditableEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdEditableEnvironment methodsFor: 'execution' stamp: 'lr 2/9/2008 13:52'! execute | browser | browser := ORSystemBrowser on: self environment. browser jumpTo: target. browser open! ! !ORCmdEditableEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:43'! group ^ #noble! ! !ORCmdEditableEnvironment methodsFor: 'accessing' stamp: 'lr 6/13/2008 14:19'! label ^ 'manual'! ! !ORCmdEnvironment methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'open environment'! ! !ORCmdEnvironment methodsFor: 'execution' stamp: 'lr 2/9/2008 16:37'! execute [ self openEnvironment: self environment ] on: ORUICancellationError do: [ ^ self ]! ! ORCmdEnvironment subclass: #ORCmdImplementorEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:27'! environment ^ super environment implementorsOf: target selector! ! !ORCmdImplementorEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:22'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdImplementorEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'implementors'! ! ORCmdEnvironment subclass: #ORCmdInstVarReaderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarReaderEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:36'! environment ^ super environment instVarReadersTo: (self chooseFrom: self instanceVariables) in: target theClass! ! !ORCmdInstVarReaderEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:26'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarReaderEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable reader'! ! ORCmdEnvironment subclass: #ORCmdInstVarRefsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:28'! environment ^ super environment instVarRefsTo: (self chooseFrom: self instanceVariables) in: target theClass! ! !ORCmdInstVarRefsEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:26'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarRefsEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable references'! ! ORCmdEnvironment subclass: #ORCmdInstVarWriterEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:28'! environment ^ super environment instVarWritersTo: (self chooseFrom: self instanceVariables) in: target theClass! ! !ORCmdInstVarWriterEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:26'! isActive ^ super isActive and: [ (target isKindOf: OBClassNode) or: [ target isKindOf: OBInstanceVariableNode ] ]! ! !ORCmdInstVarWriterEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:53'! label ^ 'instance variable writer'! ! ORCmdEnvironment subclass: #ORCmdInverseEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdInverseEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:29'! environment ^ super environment not! ! !ORCmdInverseEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:43'! group ^ #noble! ! !ORCmdInverseEnvironment methodsFor: 'testing' stamp: 'lr 11/14/2007 10:33'! isActive ^ super isActive and: [ self environment isSystem not ]! ! !ORCmdInverseEnvironment methodsFor: 'accessing' stamp: 'lr 6/13/2008 14:18'! label ^ 'inverse'! ! ORCmdEnvironment subclass: #ORCmdMatchesEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:31'! environment | literal | literal := self request: 'Literals matching:'. ^ (super environment matches: literal) label: 'Literals matching ' , literal printString! ! !ORCmdMatchesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:31'! label ^ 'literal matches...'! ! ORCmdEnvironment subclass: #ORCmdPackageEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! ORCmdPackageEnvironment subclass: #ORCmdBrowsePackageEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:55'! cluster ^ nil! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:53'! group ^ #navigation! ! !ORCmdBrowsePackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:53'! label ^ 'browse package'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 13:38'! environment | package | ^ (super environment forPackage: (package := self package)) label: package packageName! ! !ORCmdPackageEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 15:53'! isEnabled ^ self package notNil! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'package'! ! !ORCmdPackageEnvironment methodsFor: 'accessing' stamp: 'lr 9/26/2008 12:16'! package ^ target containingPackage! ! ORCmdEnvironment subclass: #ORCmdPragmaEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 7/21/2008 10:29'! environment ^ super environment forPragmas: (Array with: target selector)! ! !ORCmdPragmaEnvironment methodsFor: 'testing' stamp: 'lr 7/21/2008 10:23'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdPragmaEnvironment methodsFor: 'accessing' stamp: 'lr 7/21/2008 10:23'! label ^ 'pragmas'! ! ORCmdEnvironment subclass: #ORCmdProtocolEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdProtocolEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:45'! environment ^ super environment forClass: target theClass protocols: (Array with: target name)! ! !ORCmdProtocolEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:12'! isActive ^ super isActive and: [ target isKindOf: OBMethodCategoryNode ]! ! !ORCmdProtocolEnvironment methodsFor: 'accessing' stamp: 'lr 1/4/2008 16:14'! label ^ 'protocol'! ! ORCmdEnvironment subclass: #ORCmdReferencesEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdReferencesEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:28'! environment ^ (super environment referencesTo: target theNonMetaClass binding) label: 'References to ' , target theNonMetaClassName! ! !ORCmdReferencesEnvironment methodsFor: 'testing' stamp: 'lr 2/9/2008 16:48'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdReferencesEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:48'! label ^ 'references'! ! ORCmdEnvironment subclass: #ORCmdSelectMethodsEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelectMethodsEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:24'! environment | condition | condition := self request: 'Select methods:' initialAnswer: '[ :each | false ]'. ^ (super environment selectMethods: (self class evaluatorClass evaluate: condition)) label: 'Methods matching ' , condition.! ! !ORCmdSelectMethodsEnvironment methodsFor: 'accessing' stamp: 'lr 2/9/2008 16:55'! label ^ 'select methods...'! ! ORCmdEnvironment subclass: #ORCmdSelfSendEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSelfSendEnvironment methodsFor: 'accessing' stamp: 'lr 6/22/2008 14:45'! environment | parent environment matcher | parent := super environment. environment := ParseTreeEnvironment onEnvironment: parent. environment label: 'Self-Sends'; matcher: (matcher := ParseTreeSearcher new). matcher matches: 'self `@message: ``@args' do: [ :node :answer | node ]. parent classesAndSelectorsDo: [ :class :selector | (matcher executeTree: (class compiledMethodAt: selector) parseTree initialAnswer: nil) notNil ifTrue: [ environment addClass: class selector: selector ] ]. ^ environment! ! !ORCmdSelfSendEnvironment methodsFor: 'accessing' stamp: 'lr 6/22/2008 14:15'! label ^ 'self-sends'! ! ORCmdEnvironment subclass: #ORCmdSenderEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:22'! environment ^ (super environment referencesTo: target selector) label: 'Senders of ' , target selector printString! ! !ORCmdSenderEnvironment methodsFor: 'testing' stamp: 'lr 5/19/2007 09:22'! isActive ^ super isActive and: [ target hasSelector ]! ! !ORCmdSenderEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'senders'! ! ORCmdEnvironment subclass: #ORCmdSubclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:27'! environment ^ (super environment forClasses: target theNonMetaClass allSubclasses) label: 'Subclasses of ' , target theNonMetaClassName! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdSubclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'subclasses'! ! ORCmdEnvironment subclass: #ORCmdSuperSendEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperSendEnvironment methodsFor: 'accessing' stamp: 'lr 6/22/2008 14:46'! environment | parent environment matcher | parent := super environment. environment := ParseTreeEnvironment onEnvironment: parent. environment label: 'Super-Sends'; matcher: (matcher := ParseTreeSearcher new). matcher matches: 'super `@message: ``@args' do: [ :node :answer | node ]. parent classesAndSelectorsDo: [ :class :selector | (matcher executeTree: (class compiledMethodAt: selector) parseTree initialAnswer: nil) notNil ifTrue: [ environment addClass: class selector: selector ] ]. ^ environment! ! !ORCmdSuperSendEnvironment methodsFor: 'accessing' stamp: 'lr 6/22/2008 14:15'! label ^ 'super-sends'! ! ORCmdEnvironment subclass: #ORCmdSuperclassesHierarchyEnvironment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 2/10/2008 10:27'! environment ^ (super environment forClasses: target theNonMetaClass allSuperclasses) label: 'Superclasses of ' , target theNonMetaClassName! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'testing' stamp: 'lr 1/4/2008 16:06'! isActive ^ super isActive and: [ target isKindOf: OBClassNode ]! ! !ORCmdSuperclassesHierarchyEnvironment methodsFor: 'accessing' stamp: 'lr 11/14/2007 10:41'! label ^ 'superclasses'! ! ORCommand subclass: #ORCmdLintCommand instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! ORCmdLintCommand subclass: #ORCmdOpenResult instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdOpenResult methodsFor: 'execution' stamp: 'lr 10/22/2008 14:22'! execute target open! ! !ORCmdOpenResult methodsFor: 'testing' stamp: 'lr 7/10/2008 07:50'! isActive ^ super isActive and: [ requestor browser isSearching not ]! ! !ORCmdOpenResult methodsFor: 'testing' stamp: 'lr 10/22/2008 12:16'! isEnabled ^ target isComposite not and: [ target isEmpty not ]! ! !ORCmdOpenResult methodsFor: 'accessing' stamp: 'lr 10/22/2008 13:34'! keystroke ^ $o! ! !ORCmdOpenResult methodsFor: 'accessing' stamp: 'lr 10/22/2008 13:34'! label ^ 'open'! ! !ORCmdOpenResult methodsFor: 'testing' stamp: 'lr 2/7/2008 17:57'! wantsButton ^ true! ! ORCmdLintCommand subclass: #ORCmdRefreshRules instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Lint'! !ORCmdRefreshRules methodsFor: 'execution' stamp: 'lr 8/29/2008 12:06'! execute self browser search! ! !ORCmdRefreshRules methodsFor: 'testing' stamp: 'lr 8/29/2008 12:04'! isActive ^ (requestor isSelected: target) and: [ requestor browser isSearching not ]! ! !ORCmdRefreshRules methodsFor: 'accessing' stamp: 'lr 8/29/2008 12:04'! keystroke ^ $r! ! !ORCmdRefreshRules methodsFor: 'accessing' stamp: 'lr 10/22/2008 14:24'! label ^ 'refresh'! ! !ORCmdRefreshRules methodsFor: 'testing' stamp: 'lr 8/29/2008 12:04'! wantsButton ^ true! ! ORCommand subclass: #ORCmdOpen instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpen methodsFor: 'accessing' stamp: 'cwp 9/30/2007 22:04'! cluster ^ #open! ! !ORCmdOpen methodsFor: 'private' stamp: 'lr 5/30/2008 10:15'! definition: aDefinition requestor announce: (OBDefinitionChanged definition: aDefinition)! ! ORCmdOpen subclass: #ORCmdOpenLint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenLint methodsFor: 'execution' stamp: 'lr 3/1/2008 17:59'! execute ORLintBrowser openRule: CompositeLintRule allRules environment: self environment! ! !ORCmdOpenLint methodsFor: 'accessing' stamp: 'lr 5/30/2008 10:11'! label ^ 'code critics'! ! ORCmdOpen subclass: #ORCmdOpenRewriter instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenRewriter methodsFor: 'execution' stamp: 'lr 5/30/2008 10:14'! execute self definition: (ORRewriterDefinition on: self environment)! ! !ORCmdOpenRewriter methodsFor: 'accessing' stamp: 'lr 6/6/2008 16:57'! label ^ 'rewrite code'! ! ORCmdOpen subclass: #ORCmdOpenSearcher instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdOpenSearcher methodsFor: 'execution' stamp: 'lr 5/30/2008 10:15'! execute self definition: (ORSearcherDefinition on: self environment)! ! !ORCmdOpenSearcher methodsFor: 'accessing' stamp: 'lr 6/6/2008 16:57'! label ^ 'search code'! ! ORCommand subclass: #ORCmdPrettyPrint instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Commands'! !ORCmdPrettyPrint class methodsFor: 'testing' stamp: 'lr 6/14/2007 19:49'! takesText ^ true! ! !ORCmdPrettyPrint methodsFor: 'execution' stamp: 'lr 6/18/2007 18:49'! execute "Now this is utterly ugly, but unfortunately I see no better way doing this." | panel definition morph source | panel := requestor browser panels detect: [ :each | each isKindOf: OBDefinitionPanel ] ifNone: [ ^ self ]. definition := panel getDefinition ifNil: [ ^ self ]. morph := OBPluggableTextMorph allSubInstances detect: [ :each | each model == panel ] ifNone: [ ^ self ]. source := morph text asString. (definition prettyPrint: source) = source ifTrue: [ ^ self ]. requestor browser announce: definition. morph hasUnacceptedEdits: true! ! !ORCmdPrettyPrint methodsFor: 'accessing' stamp: 'lr 10/3/2007 20:11'! group ^ #general! ! !ORCmdPrettyPrint methodsFor: 'testing' stamp: 'lr 6/18/2007 18:45'! isActive ^ (target isKindOf: OBTextSelection) or: [ (target isKindOf: OBMethodNode) and: [ (target isKindOf: OBMethodVersionNode) not and: [ requestor isSelected: target ] ] ] ! ! !ORCmdPrettyPrint methodsFor: 'accessing' stamp: 'lr 6/18/2007 18:44'! keystroke ^ $r! ! !ORCmdPrettyPrint methodsFor: 'accessing' stamp: 'lr 6/14/2007 19:13'! label ^ 'pretty print'! ! ORCommand subclass: #ORCmdRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdRefactoring subclass: #ORCmdClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdClassRefactoring subclass: #ORCmdAccessorClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:35'! label ^ 'accessors'! ! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:35'! longDescription ^ 'Creates getter and setter methods for all variables.'! ! !ORCmdAccessorClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:55'! refactoring ^ ORAccessorClassRefactoring className: self currentNode theClass name! ! !ORCmdClassRefactoring class methodsFor: 'testing' stamp: 'lr 3/15/2008 09:23'! takesText ^ true! ! !ORCmdClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor class'! ! !ORCmdClassRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 09:22'! isActive ^ super isActive and: [ self currentNode isKindOf: OBClassAwareNode ]! ! ORCmdClassRefactoring subclass: #ORCmdCreateSubclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdCreateSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2008 10:35'! label ^ 'create subclass'! ! !ORCmdCreateSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:57'! longDescription ^ 'This refactoring allows you to insert a new class into an existing hierarchy.'! ! !ORCmdCreateSubclassRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2008 10:50'! refactoring | class subclassName | class := self currentNode theNonMetaClass. subclassName := self request: 'Enter new subclass name:'. ^ AddClassRefactoring addClass: subclassName superclass: class subclasses: ((OBMultipleChoiceRequest prompt: 'Select subclasses of ' , subclassName , ':' labels: (class subclasses collect: [ :each | each name ]) values: class subclasses) ifNil: [ ^ nil ]) category: class category! ! ORCmdClassRefactoring subclass: #ORCmdCreateSuperclassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdCreateSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:36'! label ^ 'create superclass'! ! !ORCmdCreateSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:00'! longDescription ^ 'This refactoring allows you to insert a new class into an existing hierarchy.'! ! !ORCmdCreateSuperclassRefactoring methodsFor: 'accessing' stamp: 'lr 4/5/2008 10:50'! refactoring | class superclassName | class := self currentNode theNonMetaClass. superclassName := self request: 'Enter new superclass name:'. ^ ChildrenToSiblingsRefactoring name: superclassName class: class subclasses: ((OBMultipleChoiceRequest prompt: 'Select subclasses of ' , superclassName , ':' labels: (class subclasses collect: [ :each | each name ]) values: class subclasses) ifNil: [ ^ nil ])! ! ORCmdClassRefactoring subclass: #ORCmdRealizeClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/17/2007 20:20'! label ^ 'realize'! ! !ORCmdRealizeClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/18/2008 08:39'! refactoring ^ ORRealizeClassRefactoring className: self currentNode theNonMetaClass name! ! ORCmdClassRefactoring subclass: #ORCmdRemoveClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:04'! label ^ 'remove'! ! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:14'! longDescription ^ 'This refactoring checks for references to a class, and if there are no references, it will remove the class.'! ! !ORCmdRemoveClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:55'! refactoring ^ RemoveClassRefactoring classNames: (Array with: self currentNode theNonMetaClass name)! ! ORCmdClassRefactoring subclass: #ORCmdRenameClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/17/2007 20:20'! label ^ 'rename'! ! !ORCmdRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:14'! longDescription ^ 'This refactoring renames a class and also renames every reference to the class in the code. Even symbols with the same name as the class will also be renamed.'! ! !ORCmdRenameClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/15/2008 09:22'! refactoring ^ RenameClassRefactoring rename: self currentNode theNonMetaClass to: (self request: 'Enter new class name:' initialAnswer: self currentNode theNonMetaClass name)! ! ORCmdClassRefactoring subclass: #ORCmdSplitClassRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdSplitClassRefactoring methodsFor: 'accessing' stamp: 'lr 10/17/2007 20:20'! label ^ 'split'! ! !ORCmdSplitClassRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:55'! refactoring ^ SplitClassRefactoring class: self currentNode theNonMetaClass instanceVariables: #() newClassName: (self request: 'Enter new class name:') referenceVariableName: (self request: 'Enter new variable name where requests will be forwarded:')! ! ORCmdRefactoring subclass: #ORCmdClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdClassVarRefactoring subclass: #ORCmdAbstractClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:48'! label ^ 'abstract'! ! !ORCmdAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:37'! longDescription ^ 'Performs the create accessors refactoring and then converts all direct variable to use the accessor methods.'! ! !ORCmdAbstractClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:36'! refactoring ^ self classAndVariable: [ :class :variable | AbstractClassVariableRefactoring variable: variable class: class ]! ! ORCmdClassVarRefactoring subclass: #ORCmdAccessorClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:36'! label ^ 'accessors'! ! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Creates getter and setter methods for a variable.'! ! !ORCmdAccessorClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:36'! refactoring ^ self classAndVariable: [ :class :variable | CreateAccessorsForVariableRefactoring variable: variable class: class classVariable: true ]! ! ORCmdClassVarRefactoring subclass: #ORCmdAddClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:49'! label ^ 'add'! ! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Add a variable to the class.'! ! !ORCmdAddClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/15/2008 09:18'! refactoring ^ AddClassVariableRefactoring variable: (self request: 'Enter the new variable name:' initialAnswer: (self selection ifNil: [ 'Var' ])) class: self currentNode theNonMetaClass! ! !ORCmdClassVarRefactoring class methodsFor: 'testing' stamp: 'lr 3/14/2008 23:18'! takesText ^ true! ! !ORCmdClassVarRefactoring methodsFor: 'private' stamp: 'lr 3/14/2008 23:35'! classAndVariable: aBlock | variable class | variable := self chooseFrom: self classVariables. class := self currentNode theNonMetaClass whichClassDefinesClassVar: variable. ^ aBlock value: class value: variable! ! !ORCmdClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor class variable'! ! !ORCmdClassVarRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 09:21'! isActive ^ super isActive and: [ self currentNode isKindOf: OBClassAwareNode ]! ! !ORCmdClassVarRefactoring methodsFor: 'testing' stamp: 'lr 3/14/2008 23:29'! isEnabled (self class = ORCmdAddClassVarRefactoring or: [ target isKindOf: OBClassAwareNode ]) ifTrue: [ ^ true ]. ^ self currentNode theNonMetaClass allClassVarNames includes: self selection! ! ORCmdClassVarRefactoring subclass: #ORCmdPullUpClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:49'! label ^ 'pull up'! ! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Move a variable definition from the currently selected class into the superclass.'! ! !ORCmdPullUpClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:37'! refactoring ^ self classAndVariable: [ :class :variable | PullUpClassVariableRefactoring variable: variable class: class superclass ]! ! ORCmdClassVarRefactoring subclass: #ORCmdPushDownClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:49'! label ^ 'push down'! ! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:33'! longDescription ^ 'Moves a variable definition from the currently selected class to only those subclasses that use the variable.'! ! !ORCmdPushDownClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:37'! refactoring ^ self classAndVariable: [ :class :variable | PushDownClassVariableRefactoring variable: variable class: class ]! ! ORCmdClassVarRefactoring subclass: #ORCmdRemoveClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'remove'! ! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Removes a variable only if it is not referenced.'! ! !ORCmdRemoveClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:37'! refactoring ^ self classAndVariable: [ :class :variable | RemoveClassVariableRefactoring variable: variable class: class ]! ! ORCmdClassVarRefactoring subclass: #ORCmdRenameClassVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'rename'! ! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:30'! longDescription ^ 'Renames a variable and all references to the variable.'! ! !ORCmdRenameClassVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:39'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RenameClassVariableRefactoring rename: variable to: name in: class ]! ! ORCmdRefactoring subclass: #ORCmdInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdInstVarRefactoring subclass: #ORCmdAbstractInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:48'! label ^ 'abstract'! ! !ORCmdAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:37'! longDescription ^ 'Performs the create accessors refactoring and then converts all direct variable to use the accessor methods.'! ! !ORCmdAbstractInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:42'! refactoring ^ self classAndVariable: [ :class :variable | AbstractInstanceVariableRefactoring variable: variable class: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdAccessorInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:36'! label ^ 'accessors'! ! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Creates getter and setter methods for a variable.'! ! !ORCmdAccessorInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:42'! refactoring ^ self classAndVariable: [ :class :variable | CreateAccessorsForVariableRefactoring variable: variable class: class classVariable: false ]! ! ORCmdInstVarRefactoring subclass: #ORCmdAddInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'add'! ! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Add a variable to the class.'! ! !ORCmdAddInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/15/2008 09:20'! refactoring ^ AddInstanceVariableRefactoring variable: (self request: 'Enter the new variable name:' initialAnswer: (self selection ifNil: [ 'var' ])) class: self currentNode theClass! ! !ORCmdInstVarRefactoring class methodsFor: 'testing' stamp: 'lr 3/14/2008 23:11'! takesText ^ true! ! !ORCmdInstVarRefactoring methodsFor: 'private' stamp: 'lr 3/14/2008 23:41'! classAndVariable: aBlock | variable class | variable := self chooseFrom: self instanceVariables. class := self currentNode theClass whichClassDefinesInstVar: variable. ^ aBlock value: class value: variable! ! !ORCmdInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor instance variable'! ! !ORCmdInstVarRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 09:13'! isActive ^ super isActive and: [ self currentNode isKindOf: OBClassAwareNode ]! ! !ORCmdInstVarRefactoring methodsFor: 'testing' stamp: 'lr 3/14/2008 23:28'! isEnabled (self class = ORCmdAddInstVarRefactoring or: [ target isKindOf: OBClassAwareNode ]) ifTrue: [ ^ true ]. ^ self currentNode theClass allInstVarNames includes: self selection! ! ORCmdInstVarRefactoring subclass: #ORCmdProtectInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'protect'! ! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:38'! longDescription ^ 'Converts all variable accessor sends to direct variable references. If the accessor is no longer used then it will be removed.'! ! !ORCmdProtectInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | ProtectInstanceVariableRefactoring variable: variable class: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdPullUpInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'pull up'! ! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:34'! longDescription ^ 'Move a variable definition from the currently selected class into the superclass.'! ! !ORCmdPullUpInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | PullUpInstanceVariableRefactoring variable: variable class: class superclass ]! ! ORCmdInstVarRefactoring subclass: #ORCmdPushDownInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:50'! label ^ 'push down'! ! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:33'! longDescription ^ 'Moves a variable definition from the currently selected class to only those subclasses that use the variable.'! ! !ORCmdPushDownInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | PushDownInstanceVariableRefactoring variable: variable class: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdRemoveInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:51'! label ^ 'remove'! ! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:31'! longDescription ^ 'Removes a variable only if it is not referenced.'! ! !ORCmdRemoveInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:43'! refactoring ^ self classAndVariable: [ :class :variable | RemoveInstanceVariableRefactoring remove: variable from: class ]! ! ORCmdInstVarRefactoring subclass: #ORCmdRenameInstVarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 16:51'! label ^ 'rename'! ! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:30'! longDescription ^ 'Renames a variable and all references to the variable.'! ! !ORCmdRenameInstVarRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 23:55'! refactoring | name | ^ self classAndVariable: [ :class :variable | name := self request: 'Enter the new variable name:' initialAnswer: variable. RenameInstanceVariableRefactoring rename: variable to: name in: class ]! ! ORCmdRefactoring subclass: #ORCmdMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdMethodRefactoring subclass: #ORCmdAddParameterMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdAddParameterMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:04'! label ^ 'add parameter'! ! !ORCmdAddParameterMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:50'! longDescription ^ 'Adds a default parameter to all implementors of the method.'! ! !ORCmdAddParameterMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring | initializer newSelector initialAnswer | initialAnswer := self currentNode selector numArgs = 0 ifTrue: [ self currentNode selector , ':' ] ifFalse: [ self currentNode selector ]. newSelector := self request: 'Enter new selector:' initialAnswer: initialAnswer. newSelector isEmpty ifTrue: [ ^ nil ]. initializer := self request: 'Enter default value for parameter:' initialAnswer: 'nil'. initializer isEmpty ifTrue: [ ^ nil ]. ^ AddParameterRefactoring addParameterToMethod: self currentNode selector in: self currentNode theClass newSelector: newSelector asSymbol initializer: initializer! ! ORCmdMethodRefactoring subclass: #ORCmdInlineParameterRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 09:57'! label ^ 'inline parameter'! ! !ORCmdInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:54'! longDescription ^ 'Remove a parameter from the method, and adds an assignment at the beginning of the method. This can only be performed if all senders of the method have the same value for the parameter.'! ! !ORCmdInlineParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ InlineParameterRefactoring inlineParameter: (self chooseFrom: self arguments) in: self currentNode theClass selector: self currentNode selector! ! ORCmdMethodRefactoring subclass: #ORCmdInlineSelfSendsMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/22/2007 09:07'! label ^ 'inline self sends'! ! !ORCmdInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:51'! longDescription ^ 'Inlines all senders within the class of the method. If there are no more senders after all inlines have been performed, then it will remove the method.'! ! !ORCmdInlineSelfSendsMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ InlineAllSendersRefactoring sendersOf: self currentNode selector in: self currentNode theClass! ! !ORCmdMethodRefactoring class methodsFor: 'testing' stamp: 'lr 3/14/2008 22:48'! takesText ^ true! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 11:31'! arguments | parser | parser := RBParser new. parser errorBlock: [ :error :position | ^ #() ]. parser initializeParserWith: self source type: #on:errorBlock:. ^ parser parseMessagePattern argumentNames! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor method'! ! !ORCmdMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/14/2008 22:59'! isActive ^ super isActive and: [ self currentNode hasSelector ]! ! !ORCmdMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:51'! source ^ self currentNode source! ! ORCmdMethodRefactoring subclass: #ORCmdMoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:00'! label ^ 'move'! ! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:49'! longDescription ^ 'Moves a method to another object (defined by an argument or instance variable).'! ! !ORCmdMoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ MoveMethodRefactoring selector: self currentNode selector class: self currentNode theClass variable: (self chooseFrom: self instanceVariables)! ! ORCmdMethodRefactoring subclass: #ORCmdPushDownMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:01'! label ^ 'push down'! ! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:51'! longDescription ^ 'Pushes a method down into all subclasses that don''t implement the method. This can only be allowed if the class is abstract.'! ! !ORCmdPushDownMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ PushDownMethodRefactoring pushDown: (Array with: self currentNode selector) from: self currentNode theClass! ! ORCmdMethodRefactoring subclass: #ORCmdPushUpMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:01'! label ^ 'push up'! ! !ORCmdPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:51'! longDescription ^ 'Pushes a method up into the superclass. If the superclass is abstract and already defines the method, then the superclass'' method will be copied down into the other subclasses (assuming they don''t already define the method).'! ! !ORCmdPushUpMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ PushUpMethodRefactoring pushUp: (Array with: self currentNode selector) from: self currentNode theClass! ! ORCmdMethodRefactoring subclass: #ORCmdRemoveMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:01'! label ^ 'remove'! ! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:50'! longDescription ^ 'Removes a method if there are no senders of the method or there are no symbol that reference the method name. Also, it will remove a method if it is equivalent to the superclass'' definition.'! ! !ORCmdRemoveMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ RemoveMethodRefactoring removeMethods: (Array with: self currentNode selector) from: self currentNode theClass! ! ORCmdMethodRefactoring subclass: #ORCmdRemoveParameterRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 10:09'! label ^ 'remove parameter'! ! !ORCmdRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:53'! longDescription ^ 'Removes an unused parameter from all implementors of the method, and removes it from the message sends.'! ! !ORCmdRemoveParameterRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ RemoveParameterRefactoring removeParameter: (self chooseFrom: self arguments) in: self currentNode theClass selector: self currentNode selector! ! ORCmdMethodRefactoring subclass: #ORCmdRenameMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 10/3/2007 17:01'! label ^ 'rename'! ! !ORCmdRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:53'! longDescription ^ 'Renames all implementors of a method, all senders, and all symbols references. In addition to strict renaming, it also allows you to rearrange the parameters.'! ! !ORCmdRenameMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring | oldMethodName newMethodName oldArguments argumentPermutation | oldArguments := (RBParser parseMethod: (self currentNode theClass methodHeaderFor: self currentNode selector)) argumentNames. oldMethodName := RBMethodName selector: self currentNode selector arguments: oldArguments. (newMethodName := self requestMethodNameFor: oldMethodName) ifNil: [ ^ nil ]. argumentPermutation := newMethodName arguments collect: [ :each | oldArguments indexOf: each ]. ^ RenameMethodRefactoring renameMethod: self currentNode selector in: self currentNode theClass to: newMethodName selector permutation: argumentPermutation! ! ORCmdMethodRefactoring subclass: #ORCmdSwapMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! label ^ self currentNode theClass isMeta ifTrue: [ 'move to instance side' ] ifFalse: [ 'move to class side' ]! ! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 11:17'! longDescription ^ 'Move the method from instance- to class-side or vice-versa.'! ! !ORCmdSwapMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/14/2008 22:52'! refactoring ^ ORSwapMethodRefactoring swapMethod: self currentNode selector in: self currentNode theClass! ! !ORCmdRefactoring methodsFor: 'execution' stamp: 'lr 3/15/2008 00:00'! execute | refactoring | refactoring := [ self refactoring ] on: ORUICancellationError do: [ ^ self ]. refactoring ifNil: [ ^ self ]. refactoring model environment: self environment. [ self handleError: [ self performRefactoring: refactoring ] ] on: ORUICancellationError do: [ ^ self ]! ! !ORCmdRefactoring methodsFor: 'accessing' stamp: 'lr 3/16/2007 16:02'! refactoring self subclassResponsibility! ! ORCmdRefactoring subclass: #ORCmdSourceRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdSourceRefactoring subclass: #ORCmdExtractMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdExtractMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !ORCmdExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:06'! label ^ 'extract method'! ! !ORCmdExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:52'! longDescription ^ 'Extracts the selected code as a separate method. This refactoring determines what temporary variables are needed in the new method, and prompts for a selector that takes these arguments.'! ! !ORCmdExtractMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:03'! refactoring ^ ExtractMethodRefactoring extract: self interval from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdExtractMethodToComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:06'! label ^ 'extract method to component'! ! !ORCmdExtractMethodToComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:03'! refactoring ^ ExtractMethodToComponentRefactoring extract: self interval from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdExtractToTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdExtractToTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:12'! isEnabled ^ self isExtractableSelected! ! !ORCmdExtractToTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:05'! label ^ 'extract to temporary'! ! !ORCmdExtractToTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:55'! longDescription ^ 'Extracts a message into an assignment statement.'! ! !ORCmdExtractToTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:04'! refactoring ^ ExtractToTemporaryRefactoring extract: self interval to: (self request: 'Enter the new variable name:') from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdInlineMethodFromComponentRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:16'! isEnabled ^ self isNonSelfSendSelected! ! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline method from component'! ! !ORCmdInlineMethodFromComponentRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:49'! refactoring ^ InlineMethodFromComponentRefactoring inline: self interval inMethod: self selector forClass: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdInlineMethodRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdInlineMethodRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:16'! isEnabled ^ self isSelfSendSelected! ! !ORCmdInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline method'! ! !ORCmdInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:55'! longDescription ^ 'Inlines a message send. If there are multiple implementors of the message, it will prompt for the implementation that should be inlined.'! ! !ORCmdInlineMethodRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 12:48'! refactoring ^ InlineMethodRefactoring inline: self interval inMethod: self selector forClass: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdInlineTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdInlineTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:21'! isEnabled ^ self isAssignmentSelected! ! !ORCmdInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'inline temporary'! ! !ORCmdInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:52'! longDescription ^ 'Removes the assignment of a variable and replaces all references to the variable with the right hand side of the assignment.'! ! !ORCmdInlineTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:23'! refactoring ^ InlineTemporaryRefactoring inline: self interval from: self selector in: self theClass! ! ORCmdSourceRefactoring subclass: #ORCmdMoveVariableDefinitionRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:26'! isEnabled ^ self isVariableSelected! ! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:07'! label ^ 'move variable definition'! ! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:54'! longDescription ^ 'Moves a temporary variable definition into the tightest scope that contains both the variable assignment and references.'! ! !ORCmdMoveVariableDefinitionRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:25'! refactoring ^ MoveVariableDefinitionRefactoring bindTight: self interval in: self theClass selector: self selector! ! ORCmdSourceRefactoring subclass: #ORCmdRenameTemporaryRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRenameTemporaryRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:31'! isEnabled ^ self isVariableSelected! ! !ORCmdRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:10'! label ^ 'rename temporary'! ! !ORCmdRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:54'! longDescription ^ 'Renames a temporary variable.'! ! !ORCmdRenameTemporaryRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:32'! refactoring ^ RenameTemporaryRefactoring renameTemporaryFrom: self interval to: (self request: 'Enter the new variable name:' initialAnswer: self selection) in: self theClass selector: self selector! ! !ORCmdSourceRefactoring class methodsFor: 'testing' stamp: 'lr 3/17/2007 10:42'! takesNodes ^ false! ! !ORCmdSourceRefactoring class methodsFor: 'testing' stamp: 'lr 3/17/2007 10:41'! takesText ^ true! ! !ORCmdSourceRefactoring methodsFor: 'accessing' stamp: 'lr 1/28/2008 22:48'! cluster ^ #'refactor source'! ! !ORCmdSourceRefactoring methodsFor: 'testing-private' stamp: 'lr 3/17/2007 13:00'! ifNodeSelected: aBlock "Answer the result of evaluating aBlock with the currently selected parse tree node as argument or false, if there is no valid selection." | node | self interval isEmpty ifTrue: [ ^ false ]. (node := self node) isNil ifTrue: [ ^ false ]. ^ aBlock value: node! ! !ORCmdSourceRefactoring methodsFor: 'testing-private' stamp: 'lr 3/17/2007 13:18'! ifSendSelected: aBlock ^ self ifNodeSelected: [ :node | node isMessage and: [ aBlock value: node ] ]! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 12:03'! interval ^ target instVarNamed: 'selection'! ! !ORCmdSourceRefactoring methodsFor: 'testing' stamp: 'lr 3/15/2008 00:04'! isActive ^ super isActive and: [ self currentNode hasSelector ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:22'! isAssignmentSelected ^ self ifNodeSelected: [ :node | node isAssignment ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:12'! isExtractableSelected ^ self ifNodeSelected: [ :node | node isMethod not and: [ node isVariable not ] ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:09'! isNonSelfSendSelected ^ self ifSendSelected: [ :node | node receiver isVariable not or: [ node receiver name ~= 'self' ] ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:04'! isSelfSendSelected ^ self ifSendSelected: [ :node | node receiver isVariable and: [ node receiver name = 'self' ] ]! ! !ORCmdSourceRefactoring methodsFor: 'testing-selection' stamp: 'lr 3/17/2007 13:26'! isVariableSelected ^ self ifNodeSelected: [ :node | node isVariable ]! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:33'! node ^ RBParser parseExpression: self selection onError: [ :str :pos | ^ nil ]! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:42'! selection ^ target text asString! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 11:44'! selector ^ RBParser parseMethodPattern: self text! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 13:42'! text ^ target fullText asString! ! !ORCmdSourceRefactoring methodsFor: 'accessing-selection' stamp: 'lr 3/17/2007 10:50'! theClass ^ requestor selectedClass! ! ORCmdSourceRefactoring subclass: #ORCmdTemporaryToInstvarRefactoring instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'testing' stamp: 'lr 3/17/2007 13:39'! isEnabled ^ self isVariableSelected! ! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 10:10'! label ^ 'temporary to instvar'! ! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 1/20/2008 10:52'! longDescription ^ 'Converts a temporary into an instance variable.'! ! !ORCmdTemporaryToInstvarRefactoring methodsFor: 'accessing' stamp: 'lr 3/17/2007 13:39'! refactoring ^ TemporaryToInstanceVariableRefactoring class: self theClass selector: self selector variable: self selection! ! ORCommand subclass: #ORCmdRefactoringTool instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! ORCmdRefactoringTool subclass: #ORCmdRefactoringRedo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:58'! change ^ self changeManager redoChange! ! !ORCmdRefactoringRedo methodsFor: 'execution' stamp: 'lr 3/31/2007 13:33'! execute self changeManager redoOperation! ! !ORCmdRefactoringRedo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasRedoableOperations! ! !ORCmdRefactoringRedo methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:56'! label ^ 'redo' , super label! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:56'! change self subclassResponsibility! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 3/31/2007 13:16'! changeManager ^ RefactoryChangeManager instance! ! !ORCmdRefactoringTool methodsFor: 'accessing' stamp: 'lr 2/9/2008 01:02'! label ^ String streamContents: [ :stream | self isEnabled ifTrue: [ stream nextPutAll: ': '; nextPutAll: self change name. stream position > 20 ifTrue: [ stream position: 20; nextPutAll: '...' ] ] ]! ! ORCmdRefactoringTool subclass: #ORCmdRefactoringUndo instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Refactoring'! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:58'! change ^ self changeManager undoChange! ! !ORCmdRefactoringUndo methodsFor: 'execution' stamp: 'lr 3/31/2007 13:33'! execute self changeManager undoOperation! ! !ORCmdRefactoringUndo methodsFor: 'testing' stamp: 'lr 3/31/2007 13:17'! isEnabled ^ self changeManager hasUndoableOperations! ! !ORCmdRefactoringUndo methodsFor: 'accessing' stamp: 'lr 2/9/2008 00:56'! label ^ 'undo' , super label! ! ORCommand subclass: #ORCmdToggleContainment instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Refactory-Browsers'! !ORCmdToggleContainment methodsFor: 'execution' stamp: 'lr 3/12/2008 10:21'! execute (target withinBrowserEnvironment: self environment) ifTrue: [ target removeFromEnvironment: self environment ] ifFalse: [ target addToEnvironment: self environment ]. requestor refresh! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 5/21/2007 21:27'! keystroke ^ $/! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 2/9/2008 12:49'! label ^ 'toggle'! ! !ORCmdToggleContainment methodsFor: 'accessing' stamp: 'lr 2/9/2008 12:49'! order ^ '0'! ! !ORCommand class methodsFor: 'initialization' stamp: 'lr 3/1/2008 22:51'! initialize Preferences addPreference: #promptOnRefactoring categories: #('refactoring') default: true balloonHelp: 'Show the changes before applying a refactoring.'. Refactoring refactoringOptions at: #implementorToInline put: [ :ref :imps | self new requestImplementorToInline: imps ]; at: #methodName put: [ :ref :string | self new requestMethodNameFor: string ]; at: #selfArgumentName put: [ :ref | self new requestSelfArgumentName ]; at: #selectVariableToMoveTo put: [ :ref :class :selector | self new selectVariableToMoveMethodTo: selector class: class ]; at: #extractAssignment put: [ :ref :string | self new shouldExtractAssignmentTo: string ]; at: #inlineExpression put: [ :ref :string | self new shouldInlineExpression: string ]; at: #alreadyDefined put: [ :ref :class :selector | self new shouldOverride: selector in: class ]; at: #useExistingMethod put: [ :ref :selector | self new shouldUseExistingMethod: selector ]; at: #openBrowser put: [ :ref :env | self new openEnvironment: env ]! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:17'! browser ^ requestor browser! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:20'! chooseFrom: anArray ^ self chooseFrom: anArray title: nil! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 3/1/2008 21:58'! chooseFrom: anArray title: aString ^ self chooseFrom: anArray title: aString lines: #()! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 3/1/2008 21:58'! chooseFrom: anArray title: aString lines: aCollection anArray isEmpty ifTrue: [ self uiCancellationError ]. anArray size = 1 ifTrue: [ ^ anArray first ]. ^ (OBChoiceRequest prompt: aString labels: anArray values: anArray lines: aCollection) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 3/15/2008 09:03'! classVariables | variables | variables := self currentNode theNonMetaClass allClassVarNames asSortedArray. ^ (variables includes: self selection) ifTrue: [ Array with: self selection ] ifFalse: [ (target isKindOf: OBClassVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ variables ] ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:21'! confirm: aString ^ (OBConfirmationRequest prompt: aString confirm: 'Yes' cancel: 'No') ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 3/15/2008 09:08'! currentNode ^ self browser currentOrRootNode! ! !ORCommand methodsFor: 'accessing' stamp: 'lr 2/7/2008 19:20'! environment ^ self browser environment! ! !ORCommand methodsFor: 'accessing' stamp: 'cwp 9/30/2007 22:03'! group ^ #refactory! ! !ORCommand methodsFor: 'private' stamp: 'lr 3/14/2008 23:56'! handleError: aBlock ^ aBlock on: Refactoring preconditionSignal do: [ :ex | ex isResumable ifTrue: [ (self confirm: (ex messageText last = $? ifTrue: [ ex messageText ] ifFalse: [ ex messageText , '\Do you want to proceed?' withCRs ])) ifTrue: [ ex resume ] ] ifFalse: [ ex parameter notNil ifTrue: [ (self confirm: ex messageText) ifTrue: [ ex parameter value ] ] ifFalse: [ self inform: ex messageText ] ]. ex return: nil ]! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 2/9/2008 16:13'! inform: aString ^ OBInformRequest message: aString! ! !ORCommand methodsFor: 'accessing-variables' stamp: 'lr 3/15/2008 09:02'! instanceVariables | variables | variables := self currentNode theClass allInstVarNames asSortedArray. ^ (variables includes: self selection) ifTrue: [ Array with: self selection ] ifFalse: [ (target isKindOf: OBInstanceVariableNode) ifTrue: [ Array with: target name ] ifFalse: [ variables ] ]! ! !ORCommand methodsFor: 'testing' stamp: 'lr 3/14/2008 22:57'! isActive (self class takesText and: [ target isKindOf: OBTextSelection ]) ifTrue: [ ^ true ]. (self class takesNodes and: [ requestor isSelected: target ]) ifTrue: [ ^ true ]. ^ false! ! !ORCommand methodsFor: 'actions' stamp: 'lr 5/14/2008 13:21'! openEnvironment: anEnvironment anEnvironment isSystem ifTrue: [ ^ target browse ]. anEnvironment isEmpty ifTrue: [ ^ self inform: 'Empty environment' ]. self waitWhile: [ | instance | instance := anEnvironment browserInstance. [ instance jumpTo: target ] ifError: [ instance jumpToRoot ]. instance open ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 5/14/2008 13:23'! performChange: aChange self waitWhile: [ RefactoryChangeManager instance performChange: aChange ]! ! !ORCommand methodsFor: 'private' stamp: 'lr 10/21/2008 12:06'! performRefactoring: aRefactoring self waitWhile: [ Preferences promptOnRefactoring ifFalse: [ aRefactoring execute ] ifTrue: [ aRefactoring primitiveExecute. ORChangesBrowser openChange: (aRefactoring changes name: aRefactoring name; yourself) ] ]! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/12/2008 10:20'! refresh ^ self browser signalRefresh! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:20'! request: aString ^ self request: aString initialAnswer: String new! ! !ORCommand methodsFor: 'accessing-conveniance' stamp: 'lr 10/15/2007 09:21'! request: aString initialAnswer: aTemplateString ^ (OBTextRequest prompt: aString template: aTemplateString) ifNil: [ self uiCancellationError ]! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 22:54'! requestImplementorToInline: aCollection ^ Smalltalk classNamed: (self chooseFrom: (aCollection collect: [ :each | each name ]) title: 'Which implementation should be inlined?')! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 22:49'! requestMethodNameFor: aMethodName | string pattern | string := self request: 'Selector Name:' initialAnswer: aMethodName asString. pattern := RBParser new errorBlock: [ :error :position | ^ nil ]; initializeParserWith: string type: #on:errorBlock:; parseMessagePattern. ^ RBMethodName selector: pattern selector arguments: pattern argumentNames! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 22:55'! requestSelfArgumentName ^ self request: 'Enter name for argument to refer to "self" in extracted method'! ! !ORCommand methodsFor: 'actions' stamp: 'lr 3/1/2008 21:59'! selectVariableToMoveMethodTo: aSelector class: aClass | parseTree nameList | parseTree := aClass parseTreeFor: aSelector. parseTree isNil ifTrue: [ parseTree := RBMethodNode selector: #value body: (RBSequenceNode statements: #()) ]. nameList := OrderedCollection new. nameList addAll: parseTree argumentNames asSortedCollection; addAll: aClass allInstanceVariableNames asSortedCollection. ^ self chooseFrom: nameList title: 'Select variable to move method into:' lines: (Array with: parseTree argumentNames size)! ! !ORCommand methodsFor: '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 initialize!