--- a/Tools__MethodRewriter.st Sun May 10 06:57:28 2015 +0200
+++ b/Tools__MethodRewriter.st Tue May 12 06:57:16 2015 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
Copyright (c) 2009-2010 eXept Software AG
@@ -29,16 +31,18 @@
ApplicationModel subclass:#MethodRewriter
instanceVariableNames:'replaceTextView methods classes packages searchTextView
- actionInProgresHolder infoHolder progressHolder
+ actionInProgressHolder infoHolder progressHolder
templateSearchPatternHolder templateReplacePatternHolder
selectedTemplateIndex templates selectedTabIndex
selectedClassesHolder selectedRuleIndex rules
ruleReplacePatternHolder ruleSearchPatternHolder
ruleSearchAndReplacePatternHolder ruleForRewriteOrNilForAdHoc
- adHocFindAndReplaceVisibleHolder ruleNameHolder'
+ adHocFindAndReplaceVisibleHolder ruleNameHolder
+ isMethodPatternHolder classesInfoTextHolder
+ cachedMethodsFromClasses'
classVariableNames:''
poolDictionaries:''
- category:'Interface-MethodRewriter'
+ category:'Interface-Tools'
!
!MethodRewriter class methodsFor:'documentation'!
@@ -169,6 +173,35 @@
"Created: / 12-12-2007 / 11:03:32 / janfrog"
! !
+!MethodRewriter class methodsFor:'help specs'!
+
+flyByHelpSpec
+ "This resource specification was automatically generated
+ by the UIHelpTool of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIHelpTool may not be able to read the specification."
+
+ "
+ UIHelpTool openOnClass:Tools::MethodRewriter
+ "
+
+ <resource: #help>
+
+ ^ super helpSpec addPairsFrom:#(
+
+#isMethodPattern
+'The patterns are applied to the method''s whole source (including selector)\as opposed to the code''s syntax tree nodes.\(read the pattern help on this)'
+
+#doSearchAction
+'Searches for matching methods and opens a browser on those.'
+
+#doReplaceAction
+'Searches for matching methods, generates the new code and presents a list of changes.\This list allows for inspection and individual selection of changes to be applied'
+
+)
+! !
+
!MethodRewriter class methodsFor:'interface specs'!
classesSpec
@@ -207,7 +240,7 @@
)
(SelectionInListModelViewSpec
name: 'ClassesList'
- layout: (LayoutFrame 0 0 30 0 0 1 -30 1)
+ layout: (LayoutFrame 0 0 30 0 0 1 -60 1)
model: selectedClassesHolder
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
@@ -223,6 +256,13 @@
dragArgument: nil
)
)
+ (LabelSpec
+ name: 'ClassInfoLabel'
+ layout: (LayoutFrame 0 0 -60 1 0 1 -30 1)
+ translateLabel: true
+ labelChannel: classesInfoTextHolder
+ adjust: left
+ )
(HorizontalPanelViewSpec
name: 'HorizontalPanel1'
layout: (LayoutFrame 0 0 -30 1 -16 1 0 1)
@@ -419,9 +459,27 @@
component:
(SpecCollection
collection: (
+ (ViewSpec
+ name: 'MethodPatternBox'
+ layout: (LayoutFrame 0 0 0 0 0 1 30 0)
+ component:
+ (SpecCollection
+ collection: (
+ (CheckBoxSpec
+ label: 'Method Pattern'
+ name: 'CheckBox1'
+ layout: (LayoutFrame 0 0 8 0 136 0 30 0)
+ activeHelpKey: isMethodPattern
+ model: isMethodPatternHolder
+ translateLabel: true
+ )
+ )
+
+ )
+ )
(VariableVerticalPanelSpec
name: 'FindAndReplacePanel'
- layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
+ layout: (LayoutFrame 0 0 30 0 0 1 -30 1)
visibilityChannel: adHocFindAndReplaceVisibleHolder
showHandle: true
snapMode: both
@@ -483,7 +541,7 @@
)
(ViewSpec
name: 'ExecuteRuleBox'
- layout: (LayoutFrame 0 0 0 0 0 1 -30 1)
+ layout: (LayoutFrame 0 0 30 0 0 1 -30 1)
visibilityChannel: ruleExecutionVisibleHolder
component:
(SpecCollection
@@ -523,29 +581,31 @@
(LabelSpec
label: 'Enjoy'
name: 'Label1'
- layout: (LayoutFrame 5 0 -25 1 205 0 -5 1)
- visibilityChannel: actionInProgresHolder
+ layout: (LayoutFrame 5 0 -25 1 255 0 -5 1)
+ xxvisibilityChannel: actionInProgressHolder
translateLabel: true
labelChannel: infoHolder
adjust: left
)
(ProgressIndicatorSpec
name: 'ProgressIndicator1'
- layout: (LayoutFrame 210 0 -25 1 -215 1 -5 1)
- visibilityChannel: actionInProgresHolder
+ layout: (LayoutFrame 260 0 -25 1 -215 1 -5 1)
+ xxvisibilityChannel: actionInProgressHolder
model: progressHolder
)
(ActionButtonSpec
label: 'Search'
name: 'Button2'
layout: (LayoutFrame -210 1 -26 1 -110 1 -5 1)
+ activeHelpKey: doSearchAction
translateLabel: true
model: doSearchAction
)
(ActionButtonSpec
- label: 'Rewrite'
+ label: 'Rewrite...'
name: 'Button1'
layout: (LayoutFrame -105 1 -25 1 -5 1 -5 1)
+ activeHelpKey: doRewriteAction
translateLabel: true
model: doRewriteAction
)
@@ -825,13 +885,6 @@
!MethodRewriter methodsFor:'accessing'!
-actionInProgress: aBoolean
-
- ^self actionInProgresHolder value: aBoolean
-
- "Created: / 12-12-2007 / 10:06:16 / janfrog"
-!
-
classes
^ classes ifNil:[classes := List new]
@@ -839,8 +892,10 @@
!
classes: aCollection
- classes := ((aCollection collect:[:cls|cls theNonMetaclass])
- sort:[:a :b | a className < b className]) asList
+ self classes contents:((aCollection collect:[:cls|cls theNonMetaclass])
+ sortBySelector:#name).
+ self classesChanged
+
"Created: / 20-07-2007 / 16:31:18 / janfrog"
"Modified: / 12-12-2007 / 09:47:01 / janfrog"
@@ -854,7 +909,7 @@
!
progress: anInteger
-
+ self actionInProgressHolder value:true.
self progressHolder value: anInteger
"Created: / 12-12-2007 / 10:01:03 / janfrog"
@@ -988,15 +1043,19 @@
methodsMatching isEmptyOrNil ifTrue:[^Dialog warn:'No methods matching'].
self withMethods: methodsMatching do:[:mth|
- | newTree newSource change |
+ | rewriter newTree newSource change |
- newTree := ParseTreeSourceRewriter new
- replace: self searchPattern
- with: self replacePattern;
- executeTree: mth parseTree;
- tree.
+ rewriter := ParseTreeSourceRewriter new.
+ (self isMethodPatternHolder value) ifTrue:[
+ rewriter replace: self searchPattern with: self replacePattern
+ ] ifFalse:[
+ rewriter replaceMethod: self searchPattern with: self replacePattern
+ ].
+ newTree := rewriter
+ executeTree: mth parseTree;
+ tree.
- change := InteractiveAddMethodChange compile: newTree newSource in:mth mclass classified:mth category.
+ change := InteractiveAddMethodChange compile: newTree newSource in:(mth mclass ? mth getMclass) classified:mth category.
"/ collect in order to have only one change in the undo-list (instead of many)
changes add: change.
@@ -1080,7 +1139,9 @@
removeSeletedClassesAction
- self classes removeAll: self selectedClasses
+ self classes removeAll: self selectedClasses.
+ classes changed:#content.
+ self classesChanged.
"Created: / 12-12-2007 / 12:05:15 / janfrog"
!
@@ -1105,11 +1166,11 @@
!MethodRewriter methodsFor:'aspects'!
-actionInProgresHolder
- actionInProgresHolder isNil ifTrue:[
- actionInProgresHolder := true asValue.
+actionInProgressHolder
+ actionInProgressHolder isNil ifTrue:[
+ actionInProgressHolder := false asValue.
].
- ^ actionInProgresHolder.
+ ^ actionInProgressHolder.
"Created: / 12-12-2007 / 10:00:05 / janfrog"
!
@@ -1121,6 +1182,13 @@
^ adHocFindAndReplaceVisibleHolder.
!
+classesInfoTextHolder
+ classesInfoTextHolder isNil ifTrue:[
+ classesInfoTextHolder := '' asValue.
+ ].
+ ^ classesInfoTextHolder.
+!
+
howToUseRewriteToolURL
^ HTMLDocumentFrame documentFileFor:'help/Browser/RewriteToolHelp.html'
!
@@ -1135,6 +1203,13 @@
"Modified: / 12-12-2007 / 11:40:17 / janfrog"
!
+isMethodPatternHolder
+ isMethodPatternHolder isNil ifTrue:[
+ isMethodPatternHolder := false asValue
+ ].
+ ^ isMethodPatternHolder.
+!
+
progressHolder
progressHolder isNil ifTrue:[
progressHolder := 0 asValue
@@ -1267,6 +1342,16 @@
!MethodRewriter methodsFor:'change & update'!
+classesChanged
+ cachedMethodsFromClasses := nil. "/ flush
+ methods := nil.
+
+ self classesInfoTextHolder
+ value:(((classes size == 1) ifTrue:['%1 class / %2 method(s)'] ifFalse:['%1 classes / %2 methods'])
+ bindWith:classes size
+ with:self methods size)
+!
+
selectedRuleIndexChanged
|selectedRuleSpec|
@@ -1319,7 +1404,7 @@
doDropClasses: dropContext
"I accept classes, methods and packages"
- | droppedProjects droppedClasses newClasses |
+ | droppedProjects droppedClasses newClasses classesAlready|
droppedProjects := dropContext dropObjects
select:[:obj| obj isProjectObject]
@@ -1342,10 +1427,13 @@
droppedClasses addAll:(Smalltalk allClassesInPackage:eachPackage)
].
- newClasses := droppedClasses reject:[:cls | self classes includes:cls].
+ classesAlready := self classes asSet.
+ newClasses := droppedClasses reject:[:cls | classesAlready includes:cls].
+
self classes
addAll: newClasses;
- changed:#content.
+ sortBySelector:#name.
+ self classesChanged
"Created: / 20-07-2007 / 16:58:16 / janfrog"
! !
@@ -1368,6 +1456,14 @@
!MethodRewriter methodsFor:'private'!
+actionInProgress: aBoolean
+
+ self actionInProgressHolder value: aBoolean.
+ self windowGroup processEvents.
+
+ "Created: / 12-12-2007 / 10:06:16 / janfrog"
+!
+
doSearchPattern: pattern withResultDo: block
| matchingMethods |
@@ -1380,7 +1476,7 @@
matchingMethods := Set new.
self
withMethodsDo:[:mthd|
- | tree |
+ | tree searcher |
tree := mthd parseTree.
tree
ifNil:[
@@ -1388,9 +1484,15 @@
self breakPoint: #jv
]
ifNotNil:[
- (ParseTreeSearcher new)
- matches:pattern do:[:aNode :answer | matchingMethods add:mthd ];
- executeTree: tree
+ searcher := ParseTreeSearcher new.
+ (self isMethodPatternHolder value)
+ ifTrue:[
+ searcher matchesMethod:pattern do:[:aNode :answer | matchingMethods add:mthd ]
+ ]
+ ifFalse:[
+ searcher matches:pattern do:[:aNode :answer | matchingMethods add:mthd ]
+ ].
+ searcher executeTree: tree
]
]
finallyDo:[
@@ -1448,30 +1550,33 @@
methods
methods notEmptyOrNil ifTrue:[^ methods].
- ^self methodsFor: classes
+ ^self methodsForClasses
"Modified: / 21-07-2007 / 06:24:07 / janfrog"
"Modified: / 05-07-2011 / 14:50:43 / cg"
!
methods:aCollection
+ "to explicitly set the set of methods to be processed"
+
methods := aCollection
"Created: / 05-07-2011 / 14:50:52 / cg"
!
-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"
+methodsForClasses
+ cachedMethodsFromClasses isNil ifTrue:[
+ cachedMethodsFromClasses :=
+ (classes
+ inject: OrderedCollection new
+ into:[:methods :cls|
+ methods
+ addAll: cls methodDictionary values;
+ addAll: cls class methodDictionary values;
+ yourself]
+ ) asArray.
+ ].
+ ^ cachedMethodsFromClasses
!
methodsMatchingPattern: searchPattern
@@ -1543,12 +1648,22 @@
withMethods: methods do: methodBlock finallyDo: finallyBlock
[
+ |numMethods|
+
+ numMethods := methods size.
+
self actionInProgress: true.
- methods asArray keysAndValuesDo:
- [:idx :mth|
- self info: mth selector storeString.
+ self progress: 0.
+
+ self methods asArray keysAndValuesDo:[:idx :mth|
+ numMethods > 100 ifTrue:[
+ self info: mth mclass name.
+ ] ifFalse:[
+ self info: mth selector storeString.
+ ].
methodBlock value: mth.
- self progress: ((100 / methods size) * idx) rounded].
+ self progress: ((100 / methods size) * idx) rounded
+ ].
finallyBlock value
] ensure:[
"/self actionInProgress: false.
@@ -1580,11 +1695,15 @@
!MethodRewriter class methodsFor:'documentation'!
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__MethodRewriter.st,v 1.25 2015-05-11 15:25:48 cg Exp $'
+!
+
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__MethodRewriter.st,v 1.23 2015-02-24 18:13:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__MethodRewriter.st,v 1.25 2015-05-11 15:25:48 cg Exp $'
!
version_SVN
- ^ '$Id: Tools__MethodRewriter.st,v 1.23 2015-02-24 18:13:14 cg Exp $'
+ ^ '$Id: Tools__MethodRewriter.st,v 1.25 2015-05-11 15:25:48 cg Exp $'
! !
--- a/VersionDiffBrowser.st Sun May 10 06:57:28 2015 +0200
+++ b/VersionDiffBrowser.st Tue May 12 06:57:16 2015 +0200
@@ -605,6 +605,13 @@
itemValue: includeCategoryChanges:
indication: includeCategoryChangesHolder
)
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ label: 'Show Log Messages'
+ itemValue: showLogMessages
+ )
)
nil
nil
@@ -1295,6 +1302,17 @@
]
"Modified: / 15-08-2010 / 21:35:00 / cg"
+!
+
+showLogMessages
+ "the UI shows code-diffs if any change is selected, and version log entries otherwise.
+ But there is no way to deselect any of the method-change-lists, to go back to log-messages,
+ once a method has been looked at.
+ This view-menu entry helps."
+
+ methodsOnlyInASelection value:nil.
+ methodsOnlyInBSelection value:nil.
+ methodsChangedSelection value:nil.
! !
!VersionDiffBrowser methodsFor:'aspects'!
@@ -2960,10 +2978,10 @@
!VersionDiffBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.124 2015-05-08 10:02:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.126 2015-05-11 16:35:49 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.124 2015-05-08 10:02:18 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/VersionDiffBrowser.st,v 1.126 2015-05-11 16:35:49 cg Exp $'
! !