changed: #readAspects:from:
no need for change messages when reading aspect values
"{ Package: 'cvut:stx/goodies/libtool3' }"
"{ NameSpace: Tools }"
ApplicationModel subclass:#MethodRewriter
instanceVariableNames:'replaceTextView classes searchTextView actionInProgresHolder
infoHolder progressHolder templateSearchPatternHolder
templateReplacePatternHolder selectedTemplateIndex templates
selectedTabIndex selectedClassesHolder'
classVariableNames:''
poolDictionaries:''
category:'Interface-Method rewriter'
!
!MethodRewriter class methodsFor:'examples'!
templateReplaceAtIfAbsentByAtAifAbsentPut
^Array
with:'Replace Dictionary>>#at:ifAbsent: by #at:ifAbsentPut:'
with: '``@dictionary
at: ``@key
ifAbsent:
[| `@temps |
`@.statements.
``@dictionary at: ``@key put: ``@object]'
with:'``@dictionary
at: ``@key
ifAbsentPut:
[| `@temps |
`@.statements.
``@object]'
"Created: / 12-12-2007 / 11:08:01 / janfrog"
"Modified: / 17-02-2008 / 08:35:17 / janfrog"
!
templateReplaceSelfHaltBySelfError
^Array
with:'Replace self halt by self error:''was: self halt'''
with: 'self halt'
with: 'self error:''was: self error'''
"Created: / 12-12-2007 / 11:29:51 / janfrog"
"Modified: / 17-02-2008 / 08:35:09 / janfrog"
!
templates
|templateSelectors|
templateSelectors :=
(self class selectors select:[:e|(e startsWith:'template')
and:[e ~= #templates and:[e ~= #templatesSpec]]]).
^templateSelectors
collect:[:e|self perform:e]
"
self templates
"
"Created: / 12-12-2007 / 11:03:32 / janfrog"
! !
!MethodRewriter class methodsFor:'interface specs'!
classesSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::MethodRewriter andSelector:#classesSpec
Tools::MethodRewriter new openInterface:#classesSpec
"
<resource: #canvas>
^
#(FullSpec
name: classesSpec
window:
(WindowSpec
label: 'Classes'
name: 'Classes'
min: (Point 10 10)
bounds: (Rectangle 0 0 300 300)
)
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Hint: drag''n''drop classes from browser'
name: 'HintLabel'
layout: (LayoutFrame 0 0 0 0 0 1 30 0)
translateLabel: true
adjust: left
)
(SelectionInListModelViewSpec
name: 'ClassesList'
layout: (LayoutFrame 0 0 30 0 0 1 -30 1)
model: selectedClassesHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
listModel: classes
multipleSelectOk: true
useIndex: false
highlightMode: line
properties:
(PropertyListDictionary
dragArgument: nil
dropArgument: nil
canDropSelector: canDropClasses:
dropSelector: doDropClasses:
)
)
(ActionButtonSpec
label: 'Remove selected classes'
name: 'RemoveClassesButton'
layout: (LayoutFrame 5 0 -25 1 -5 1 -5 1)
translateLabel: true
model: removeSeletedClassesAction
)
)
)
)
"Modified: / 12-12-2007 / 12:07:17 / janfrog"
!
searchAndReplaceSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::MethodRewriter andSelector:#searchAndReplaceSpec
Tools::MethodRewriter new openInterface:#searchAndReplaceSpec
"
<resource: #canvas>
^
#(FullSpec
name: searchAndReplaceSpec
window:
(WindowSpec
label: 'Method Rewriter'
name: 'Method Rewriter'
min: (Point 10 10)
bounds: (Rectangle 0 0 418 294)
)
component:
(SpecCollection
collection: (
(VariableVerticalPanelSpec
name: 'FindAndReplacePanel'
layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
showHandle: true
snapMode: both
component:
(SpecCollection
collection: (
(ViewSpec
name: 'FindBox'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Find:'
name: 'FindLabel'
layout: (LayoutFrame 0 0 0 0 0 1 20 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'FindText'
layout: (LayoutFrame 0 0 20 0 0 1 0 1)
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
postBuildCallback: postBuildFindTextView:
)
)
)
)
(ViewSpec
name: 'ReplaceBox'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Replace with:'
name: 'ReplaceLabel'
layout: (LayoutFrame 0 0 0 0 0 1 20 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'ReplaceText'
layout: (LayoutFrame 0 0 20 0 0 1 0 1)
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
postBuildCallback: postBuildReplaceTextView:
)
)
)
)
)
)
handles: (Any 0.5 1.0)
)
(LabelSpec
label: 'Enjoy'
name: 'InfoLabel'
layout: (LayoutFrame 5 0 -25 1 205 0 -5 1)
visibilityChannel: actionInProgresHolder
translateLabel: true
labelChannel: infoHolder
adjust: left
)
(ProgressIndicatorSpec
name: 'ProgressIndicator'
layout: (LayoutFrame 210 0 -25 1 -215 1 -5 1)
visibilityChannel: actionInProgresHolder
model: progressHolder
)
(ActionButtonSpec
label: 'Search'
name: 'SearchButton'
layout: (LayoutFrame -210 1 -25 1 -110 1 -5 1)
translateLabel: true
model: doSearchAction
)
(ActionButtonSpec
label: 'Rewrite'
name: 'RewriteButton'
layout: (LayoutFrame -105 1 -25 1 -5 1 -5 1)
translateLabel: true
model: doRewriteAction
)
)
)
)
"Modified: / 12-12-2007 / 11:15:58 / janfrog"
!
templatesSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::MethodRewriter andSelector:#templatesSpec
Tools::MethodRewriter new openInterface:#templatesSpec
"
<resource: #canvas>
^
#(FullSpec
name: templatesSpec
window:
(WindowSpec
label: 'Method Rewriter'
name: 'Method Rewriter'
min: (Point 10 10)
bounds: (Rectangle 0 0 472 354)
)
component:
(SpecCollection
collection: (
(VariableVerticalPanelSpec
name: 'FindAndReplacePanel'
layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
showHandle: true
snapMode: both
component:
(SpecCollection
collection: (
(SelectionInListModelViewSpec
name: 'SelectionInListModelView1'
model: selectedTemplateIndex
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
listModel: templateNameList
highlightMode: line
)
(ViewSpec
name: 'FindBox'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Find:'
name: 'FindLabel'
layout: (LayoutFrame 0 0 0 0 0 1 20 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'FindText'
layout: (LayoutFrame 0 0 20 0 0 1 0 1)
model: templateSearchPatternHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
)
)
)
)
(ViewSpec
name: 'ReplaceBox'
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Replace with:'
name: 'ReplaceLabel'
layout: (LayoutFrame 0 0 0 0 0 1 20 0)
translateLabel: true
adjust: left
)
(TextEditorSpec
name: 'ReplaceText'
layout: (LayoutFrame 0 0 20 0 0 1 0 1)
model: templateReplacePatternHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
)
)
)
)
)
)
handles: (Any 0.2 0.6 1.0)
)
(ActionButtonSpec
label: 'Use as template'
name: 'UseAsTemplateButton'
layout: (LayoutFrame 0 0 -25 1 -5 1 -5 1)
translateLabel: true
model: useAsTemplateAction
)
)
)
)
"Modified: / 12-12-2007 / 11:23:34 / janfrog"
!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::MethodRewriter andSelector:#windowSpec
Tools::MethodRewriter new openInterface:#windowSpec
Tools::MethodRewriter open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'Method Rewriter'
name: 'Method Rewriter'
min: (Point 10 10)
bounds: (Rectangle 0 0 658 490)
)
component:
(SpecCollection
collection: (
(NoteBookViewSpec
name: 'NoteBook'
layout: (LayoutFrame 0 0 0 0 0 1 0 1)
model: selectedTabIndex
menu: tabList
useIndex: true
fitLastRow: false
)
)
)
)
"Modified: / 12-12-2007 / 11:39:31 / janfrog"
! !
!MethodRewriter class methodsFor:'list specs'!
tabList
"This resource specification was automatically generated
by the TabListEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the TabListEditor may not be able to read the specification."
"
TabListEditor new openOnClass: self andSelector:#tabList
"
<resource: #tabList>
^ #(
(TabItem
label: 'Search and Replace'
createNewBuilder: false
minorKey: searchAndReplaceSpec
)
(TabItem
label: 'Classes'
createNewBuilder: false
minorKey: classesSpec
)
(TabItem
label: 'Templates'
createNewBuilder: false
minorKey: templatesSpec
)
)
collect:[:aTab| TabItem new fromLiteralArrayEncoding:aTab ]
"Modified: / 12-12-2007 / 11:21:27 / janfrog"
! !
!MethodRewriter methodsFor:'accessing'!
actionInProgress: aBoolean
^self actionInProgresHolder value: aBoolean
"Created: / 12-12-2007 / 10:06:16 / janfrog"
!
classes
^ classes ifNil:[classes := List new]
"Created: / 20-07-2007 / 16:31:18 / janfrog"
!
classes: aCollection
classes := (aCollection collect:[:cls|cls theNonMetaclass]) asList
"Created: / 20-07-2007 / 16:31:18 / janfrog"
"Modified: / 12-12-2007 / 09:47:01 / janfrog"
!
info: aString
self infoHolder value: aString
"Created: / 12-12-2007 / 10:00:50 / janfrog"
!
progress: anInteger
self progressHolder value: anInteger
"Created: / 12-12-2007 / 10:01:03 / janfrog"
!
replacePattern
^ replaceTextView contents trimSeparators
"Created: / 21-07-2007 / 06:29:22 / janfrog"
!
replacePattern: pattern
^ replaceTextView contents: pattern trimSeparators
"Created: / 12-12-2007 / 11:38:22 / janfrog"
!
searchPattern
^ searchTextView contents trimSeparators
"Created: / 20-07-2007 / 16:51:49 / janfrog"
"Modified: / 21-07-2007 / 06:29:29 / janfrog"
!
searchPattern: pattern
^ searchTextView contents: pattern trimSeparators
"Created: / 12-12-2007 / 11:38:12 / janfrog"
!
selectedClasses
^self selectedClassesHolder value
"Created: / 12-12-2007 / 12:02:03 / janfrog"
!
selectedTemplate
^self templates at:self selectedTemplateIndex value
"Created: / 12-12-2007 / 11:20:32 / janfrog"
!
templates
templates isNil ifTrue:[
templates := self class templates.
].
^ templates
"Created: / 12-12-2007 / 11:17:55 / janfrog"
! !
!MethodRewriter methodsFor:'actions'!
doRewrite
| methodsMatching |
methodsMatching := self methodsMatching.
methodsMatching isNilOrEmptyCollection ifTrue:[^Dialog warn:'No methods matching'].
methodsMatching do:
[:mth|
| newTree |
newTree := ParseTreeRewriter new
replace: self searchPattern with: self replacePattern;
executeTree: mth parseTree;
tree.
mth mclass
compile: newTree formattedCode
classified: mth category
].
"Created: / 20-07-2007 / 16:03:47 / janfrog"
"Modified: / 21-07-2007 / 06:55:42 / janfrog"
!
doRewriteAction
self
doSearch: self searchPattern
withResultDo:
[:methodsMatching|
self
withMethods:methodsMatching
do:
[:mth|
| newTree |
newTree := ParseTreeRewriter new
replace: self searchPattern with: self replacePattern;
executeTree: mth parseTree;
tree.
mth mclass ifNotNil:
[mth mclass
compile: newTree formattedCode
classified: mth category]]
finallyDo:[]]
"Created: / 12-12-2007 / 11:14:19 / janfrog"
!
doSearch
|methods|
methods := self methodsMatching.
methods isEmpty
ifTrue:
[Dialog warn:'Nothing found']
ifFalse:
[self showMethods:methods
title:'Methods matching ' , self searchPattern]
"Created: / 20-07-2007 / 16:08:08 / janfrog"
"Modified: / 21-07-2007 / 06:51:58 / janfrog"
!
doSearchAction
self
doSearch: self searchPattern
withResultDo:
[:matchingMethods|
matchingMethods isEmpty
ifTrue:[Dialog warn:'No methods found']
ifFalse:
[self
showMethods: matchingMethods asArray
title: 'Methods matching ', self searchPattern]]
"Created: / 12-12-2007 / 11:14:25 / janfrog"
!
removeSeletedClassesAction
self classes removeAll: self selectedClasses
"Created: / 12-12-2007 / 12:05:15 / janfrog"
!
useAsTemplateAction
self searchPattern: self templateSearchPatternHolder value.
self replacePattern: self templateReplacePatternHolder value.
self selectedTabIndex value:1
"Created: / 12-12-2007 / 11:14:15 / janfrog"
! !
!MethodRewriter methodsFor:'aspects'!
actionInProgresHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
actionInProgresHolder isNil ifTrue:[
actionInProgresHolder := true asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ actionInProgresHolder addDependent:self.
"/ actionInProgresHolder onChangeSend:#actionInProgresHolderChanged to:self.
].
^ actionInProgresHolder.
"Created: / 12-12-2007 / 10:00:05 / janfrog"
!
infoHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
infoHolder isNil ifTrue:[
infoHolder := 'Really cool tool!!' asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ infoHolder addDependent:self.
"/ infoHolder onChangeSend:#infoHolderChanged to:self.
].
^ infoHolder.
"Created: / 12-12-2007 / 10:00:05 / janfrog"
"Modified: / 12-12-2007 / 11:40:17 / janfrog"
!
progressHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
progressHolder isNil ifTrue:[
progressHolder := 0 asValue
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ progressHolder addDependent:self.
"/ progressHolder onChangeSend:#progressHolderChanged to:self.
].
^ progressHolder.
"Created: / 12-12-2007 / 10:00:05 / janfrog"
!
selectedClassesHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedClassesHolder isNil ifTrue:[
selectedClassesHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedClassesHolder addDependent:self.
"/ selectedClassesHolder onChangeSend:#selectedClassesHolderChanged to:self.
].
^ selectedClassesHolder.
"Created: / 12-12-2007 / 12:01:40 / janfrog"
!
selectedTabIndex
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
selectedTabIndex isNil ifTrue:[
selectedTabIndex := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ selectedTabIndex addDependent:self.
"/ selectedTabIndex onChangeSend:#selectedTabIndexChanged to:self.
].
^ selectedTabIndex.
"Created: / 12-12-2007 / 11:39:29 / janfrog"
!
selectedTemplateIndex
selectedTemplateIndex isNil ifTrue:[
selectedTemplateIndex := ValueHolder new.
selectedTemplateIndex onChangeSend:#selectedTemplateIndexChanged to:self.
].
^ selectedTemplateIndex.
"Created: / 12-12-2007 / 11:17:16 / janfrog"
!
tabList
"Generated by the TabListEditor"
|list|
(list := builder bindingAt:#tabList) isNil ifTrue:[
builder aspectAt:#tabList put:(list := self class tabList).
].
^ list
"Created: / 20-07-2007 / 16:54:27 / janfrog"
!
templateNameList
^self templates collect:[:tmpl|tmpl first]
"Created: / 12-12-2007 / 11:17:16 / janfrog"
!
templateReplacePatternHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
templateReplacePatternHolder isNil ifTrue:[
templateReplacePatternHolder := '' asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ templateReplacePatternHolder addDependent:self.
"/ templateReplacePatternHolder onChangeSend:#templateReplacePatternHolderChanged to:self.
].
^ templateReplacePatternHolder.
"Created: / 12-12-2007 / 11:17:16 / janfrog"
!
templateSearchPatternHolder
"automatically generated by UIPainter ..."
"*** the code below creates a default model when invoked."
"*** (which may not be the one you wanted)"
"*** Please change as required and accept it in the browser."
"*** (and replace this comment by something more useful ;-)"
templateSearchPatternHolder isNil ifTrue:[
templateSearchPatternHolder := '' asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/ templateSearchPatternHolder addDependent:self.
"/ templateSearchPatternHolder onChangeSend:#templateSearchPatternHolderChanged to:self.
].
^ templateSearchPatternHolder.
"Created: / 12-12-2007 / 11:17:16 / janfrog"
! !
!MethodRewriter methodsFor:'change & update'!
selectedTemplateIndexChanged
self templateSearchPatternHolder value: self selectedTemplate second.
self templateReplacePatternHolder value: self selectedTemplate third.
"Created: / 12-12-2007 / 11:20:16 / janfrog"
! !
!MethodRewriter methodsFor:'drag & drop'!
canDropClasses: dropContext
^dropContext dropObjects allSatisfy: [:obj|obj isClassObject]
"Created: / 20-07-2007 / 16:58:13 / janfrog"
!
doDropClasses: dropContext
| newClasses |
newClasses := dropContext dropObjects
select:[:obj|obj isClassObject]
thenCollect:[:obj|obj theObject].
newClasses := newClasses reject:[:cls|self classes includes:cls].
self classes
addAll: newClasses;
changed:#content
"Created: / 20-07-2007 / 16:58:16 / janfrog"
! !
!MethodRewriter methodsFor:'hooks'!
postBuildFindTextView: scrollableView
searchTextView := scrollableView scrolledView
"Created: / 20-07-2007 / 15:55:16 / janfrog"
!
postBuildReplaceTextView: scrollableView
replaceTextView := scrollableView scrolledView
"Created: / 20-07-2007 / 15:55:29 / janfrog"
! !
!MethodRewriter methodsFor:'private'!
doSearch: pattern withResultDo: block
| matchingMethods |
matchingMethods := Set new.
self
withMethodsDo:
[:mth|
(ParseTreeSearcher new)
matches:self searchPattern do:[:aNode :answer | matchingMethods add:mth ];
executeTree:mth parseTree]
finallyDo:
[block value: matchingMethods]
"Created: / 12-12-2007 / 10:34:50 / janfrog"
!
methods
^self methodsFor: classes
"Modified: / 21-07-2007 / 06:24:07 / janfrog"
!
methodsFor: aColletion
^classes
inject: Set new
into:
[:methods :cls|
methods
addAll: cls methodDictionary values;
addAll: cls class methodDictionary values;
yourself]
"Created: / 21-07-2007 / 06:25:42 / janfrog"
!
methodsMatching
^self methodsMatching: self searchPattern
"Created: / 21-07-2007 / 06:26:44 / janfrog"
!
methodsMatching: searchPattern
|matchingMethods|
matchingMethods := OrderedCollection new.
self methods do:[:mth |
(ParseTreeSearcher new)
matches:searchPattern do:[:aNode :answer | matchingMethods add:mth ];
executeTree:mth parseTree.
].
^ matchingMethods
"Created: / 21-07-2007 / 06:26:19 / janfrog"
!
showMethods: methods title: title
NewSystemBrowser
browseMethods:methods
title:title
sort:true
"Created: / 21-07-2007 / 06:51:36 / janfrog"
!
withMethods: methods do: methodBlock finallyDo: finallyBlock
[
self actionInProgress: true.
methods asArray keysAndValuesDo:
[:idx :mth|
self info: mth selector storeString.
methodBlock value: mth.
self progress: ((100 / methods size) * idx) rounded].
finallyBlock value
] ensure:[
"/self actionInProgress: false.
self progress: 0.
self info: ''
]
"Created: / 12-12-2007 / 10:32:16 / janfrog"
!
withMethodsDo: methodBlock finallyDo: finallyBlock
^self
withMethods: self methods asArray
do: methodBlock
finallyDo: finallyBlock
"Modified: / 12-12-2007 / 10:32:48 / janfrog"
! !
!MethodRewriter methodsFor:'testing method'!
testXXX
self halt:'Was halt'
"Created: / 21-07-2007 / 07:55:24 / janfrog"
"Modified: / 12-12-2007 / 10:45:20 / janfrog"
! !
!MethodRewriter class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__MethodRewriter.st,v 1.3 2009-09-30 12:09:31 fm Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools__MethodRewriter.st,v 1.3 2009-09-30 12:09:31 fm Exp $'
!
version_CVS_jvrany
^ 'Header: /opt/data/cvs/stx/goodies/libtool3/Tools__MethodRewriter.st,v 1.3 2008-02-17 10:12:04 vranyj1 Exp '
! !