--- a/Tools__MethodRewriter.st Thu Nov 14 22:58:29 2019 +0100
+++ b/Tools__MethodRewriter.st Sun Nov 17 15:33:47 2019 +0100
@@ -30,8 +30,8 @@
"{ NameSpace: Tools }"
ApplicationModel subclass:#MethodRewriter
- instanceVariableNames:'replaceTextView methods classes packages searchTextView
- actionInProgressHolder infoHolder progressHolder
+ instanceVariableNames:'replaceTextView methods classes packages additionalMethods
+ searchTextView actionInProgressHolder infoHolder progressHolder
templateSearchPatternHolder templateReplacePatternHolder
selectedTemplateIndex templates selectedTabIndex
selectedClassesHolder selectedRuleIndex rules
@@ -73,6 +73,58 @@
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.
"
+!
+
+documentation
+"
+ documentation to be added.
+
+ class:
+ <a short class summary here, describing what instances represent>
+
+ responsibilities:
+ <describing what my main role is>
+
+ collaborators:
+ <describing with whom and how I talk to>
+
+ API:
+ <public api and main messages>
+
+ example:
+ <a one-line examples on how to use - can also be in a separate example method>
+
+ implementation:
+ <implementation points>
+
+ [author:]
+ exept MBP
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+!
+
+examples
+"
+ Notice that everything between [exBegin] and [exEnd] is extracted by the html-doc generator
+ to create nicely formatted and clickable executable examples in the generated html-doc.
+ (see the browser's class-documentation menu items for more)
+
+ opening the application:
+ [exBegin]
+ Tools::MethodRewriter open
+ [exEnd]
+
+ opening the application on some model:
+ [exBegin]
+ Tools::MethodRewriter openOn:aModel
+ [exEnd]
+"
! !
!MethodRewriter class methodsFor:'example templates'!
@@ -1190,7 +1242,7 @@
].
self withMethods: methodsMatching do:[:mth|
- | rewriter newTree change |
+ | rewriter newTree change newSource |
rewriter := ParseTreeSourceRewriter new.
(self isMethodPatternHolder value) ifTrue:[
@@ -1201,8 +1253,12 @@
newTree := rewriter
executeTree: mth parseTree;
tree.
-
- change := InteractiveAddMethodChange compile: newTree newSource in:(mth mclass ? mth getMclass) classified:mth category.
+ newSource := newTree source.
+ "/ was: newSource := newTree newSource
+ change := InteractiveAddMethodChange
+ compile: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.
@@ -1522,7 +1578,7 @@
ifTrue:['%1 class / %2 method(s)']
ifFalse:['%1 classes / %2 methods'])
bindWith:classes size
- with:self methods size)
+ with:(self methods size + additionalMethods size))
!
selectedRuleIndexChanged
@@ -1577,36 +1633,42 @@
doDropClasses: dropContext
"I accept classes, methods and packages"
- | droppedProjects droppedClasses newClasses classesAlready|
+ | droppedProjects droppedClasses droppedMethods
+ newClasses classesAlready newMethods methodsAlready |
droppedProjects := dropContext dropObjects
- select:[:obj| obj isProjectObject]
- thenCollect:[:obj | obj theObject].
+ select:[:obj| obj isProjectObject]
+ thenCollect:[:obj | obj theObject].
+
+ droppedMethods := dropContext dropObjects
+ select:[:obj| obj isMethodObject]
+ thenCollect:[:obj| obj theObject].
droppedClasses := dropContext dropObjects
- select:[:obj| obj isClassObject or:[obj isMethodObject]]
- thenCollect:[:obj|
- |clsOrMethod|
-
- clsOrMethod := obj theObject.
- clsOrMethod isMethod ifTrue:[
- clsOrMethod containingClass
- ] ifFalse:[
- clsOrMethod
- ]
- ] as:IdentitySet.
+ select:[:obj| obj isClassObject]
+ thenCollect:[:obj| obj theObject].
droppedProjects do:[:eachPackage |
- droppedClasses addAll:(Smalltalk allClassesInPackage:eachPackage)
+ droppedClasses addAll:(Smalltalk allClassesInPackage:eachPackage)
+ ].
+ droppedClasses do:[:eachClass |
+ droppedMethods := droppedMethods reject:[:m | m containingClass = eachClass].
].
classesAlready := self classes asSet.
newClasses := droppedClasses reject:[:cls | classesAlready includes:cls].
+ newClasses notEmpty ifTrue:[
+ self classes addAll: newClasses; sortBySelector:#name.
+ self classesChanged
+ ].
- self classes
- addAll: newClasses;
- sortBySelector:#name.
- self classesChanged
+ additionalMethods := (additionalMethods ? #()) asSet.
+ methodsAlready := additionalMethods.
+ newMethods := droppedMethods reject:[:mthd | methodsAlready includes:mthd].
+ newMethods notEmpty ifTrue:[
+ additionalMethods addAll: newMethods.
+ self classesChanged
+ ].
"Created: / 20-07-2007 / 16:58:16 / janfrog"
! !
@@ -1809,10 +1871,12 @@
methodsToSearchOrAbortIfNone
(methods := self methods) isEmptyOrNil ifTrue:[
- Dialog warn:(resources stringWithCRs:'No methods or classes defined for search.\(go to the classes tab and select some)').
- AbortSignal raise.
+ additionalMethods isEmptyOrNil ifTrue:[
+ Dialog warn:(resources stringWithCRs:'No methods or classes defined for search.\(go to the classes tab and select some)').
+ AbortSignal raise.
+ ].
].
- ^ methods
+ ^ (methods ? #()) , (additionalMethods ? #())
"Modified: / 24-05-2018 / 14:46:29 / Claus Gittinger"
!