hg/stx-libtool: comparison Tools_

equal deleted inserted replaced

-:1adff41f5fd0
+:fb1ac619f9c3
+"{ Encoding: utf8 }"
 "
 Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague
 Copyright (c) 2009-2010 eXept Software AG
 Permission is hereby granted, free of charge, to any person
 "{ NameSpace: Tools }"
 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'!
 copyright
 "
 self templates
 "
 "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
 translateLabel: true
 adjust: left
 )
 (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
 listModel: classes
 multipleSelectOk: true
 canDropSelector: canDropClasses:
 dropArgument: nil
 dropSelector: doDropClasses:
 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)
 horizontalLayout: center
 bounds: (Rectangle 0 0 418 294)
 )
 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
 component:
 (SpecCollection
 )
 handles: (Any 0.5 1.0)
 )
 (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
 collection: (
 (LabelSpec
 (SpecCollection
 collection: (
 (LabelSpec
 label: 'Enjoy'
 name: 'Label1'
-layout: (LayoutFrame 5 0 -25 1 205 0 -5 1)
+layout: (LayoutFrame 5 0 -25 1 255 0 -5 1)
-visibilityChannel: actionInProgresHolder
+xxvisibilityChannel: actionInProgressHolder
 translateLabel: true
 labelChannel: infoHolder
 adjust: left
 )
 (ProgressIndicatorSpec
 name: 'ProgressIndicator1'
-layout: (LayoutFrame 210 0 -25 1 -215 1 -5 1)
+layout: (LayoutFrame 260 0 -25 1 -215 1 -5 1)
-visibilityChannel: actionInProgresHolder
+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
 )
 )
 "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])
+self classes contents:((aCollection collect:[:cls|cls theNonMetaclass])
-sort:[:a :b | a className < b className]) asList
+sortBySelector:#name).
+self classesChanged
 "Created: / 20-07-2007 / 16:31:18 / janfrog"
 "Modified: / 12-12-2007 / 09:47:01 / janfrog"
 !
 "Created: / 12-12-2007 / 10:00:50 / janfrog"
 !
 progress: anInteger
+self actionInProgressHolder value:true.
 self progressHolder value: anInteger
 "Created: / 12-12-2007 / 10:01:03 / janfrog"
 !
 changes := ChangeSet new name:'Rewrite Changes'.
 methodsMatching isEmptyOrNil ifTrue:[^Dialog warn:'No methods matching'].
 self withMethods: methodsMatching do:[:mth|
-| newTree newSource change |
+| rewriter newTree newSource change |
-newTree := ParseTreeSourceRewriter new
+rewriter := ParseTreeSourceRewriter new.
-replace: self searchPattern
+(self isMethodPatternHolder value) ifTrue:[
-with: self replacePattern;
+rewriter replace: self searchPattern with: self replacePattern
-executeTree: mth parseTree;
+] ifFalse:[
-tree.
+rewriter replaceMethod: self searchPattern with: self replacePattern
+].
-change := InteractiveAddMethodChange compile: newTree newSource in:mth mclass classified:mth category.
+newTree := rewriter
+executeTree: mth parseTree;
+tree.
+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.
 "/        mth mclass
 "Created: / 12-12-2007 / 11:14:25 / janfrog"
 !
 removeSeletedClassesAction
-self classes removeAll: self selectedClasses
+self classes removeAll: self selectedClasses.
+classes changed:#content.
+self classesChanged.
 "Created: / 12-12-2007 / 12:05:15 / janfrog"
 !
 useAsRuleAction
 "Created: / 12-12-2007 / 11:14:15 / janfrog"
 ! !
 !MethodRewriter methodsFor:'aspects'!
-actionInProgresHolder
+actionInProgressHolder
-actionInProgresHolder isNil ifTrue:[
+actionInProgressHolder isNil ifTrue:[
-actionInProgresHolder := true asValue.
+actionInProgressHolder := false asValue.
 ].
-^ actionInProgresHolder.
+^ actionInProgressHolder.
 "Created: / 12-12-2007 / 10:00:05 / janfrog"
 !
 adHocFindAndReplaceVisibleHolder
 adHocFindAndReplaceVisibleHolder := true asValue.
 ].
 ^ adHocFindAndReplaceVisibleHolder.
 !
+classesInfoTextHolder
+classesInfoTextHolder isNil ifTrue:[
+classesInfoTextHolder := '' asValue.
+].
+^ classesInfoTextHolder.
+!
 howToUseRewriteToolURL
 ^ HTMLDocumentFrame documentFileFor:'help/Browser/RewriteToolHelp.html'
 !
 infoHolder
 "Created: / 12-12-2007 / 10:00:05 / janfrog"
 "Modified: / 12-12-2007 / 11:40:17 / janfrog"
 !
+isMethodPatternHolder
+isMethodPatternHolder isNil ifTrue:[
+isMethodPatternHolder := false asValue
+].
+^ isMethodPatternHolder.
+!
 progressHolder
 progressHolder isNil ifTrue:[
 progressHolder := 0 asValue
 ].
 ^ progressHolder.
 ].
 ^ holder.
 ! !
 !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|
 selectedRuleSpec := self selectedRuleSpec.
 !
 doDropClasses: dropContext
 "I accept classes, methods and packages"
-| droppedProjects droppedClasses newClasses |
+| droppedProjects droppedClasses newClasses classesAlready|
 droppedProjects := dropContext dropObjects
 select:[:obj| obj isProjectObject]
 thenCollect:[:obj | obj theObject].
 droppedProjects do:[:eachPackage |
 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"
 ! !
 !MethodRewriter methodsFor:'hooks'!
 "Created: / 20-07-2007 / 15:55:29 / janfrog"
 ! !
 !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 |
 ].
 matchingMethods := Set new.
 self
 withMethodsDo:[:mthd|
-| tree |
+| tree searcher |
 tree := mthd parseTree.
 tree
 ifNil:[
 Transcript showCR:'MethodRewriter: parse tree error in ',mthd whoString.
 self breakPoint: #jv
 ]
 ifNotNil:[
-(ParseTreeSearcher new)
+searcher := ParseTreeSearcher new.
-matches:pattern do:[:aNode :answer | matchingMethods add:mthd ];
+(self isMethodPatternHolder value)
-executeTree: tree
+ifTrue:[
+searcher matchesMethod:pattern do:[:aNode :answer | matchingMethods add:mthd ]
+]
+ifFalse:[
+searcher matches:pattern do:[:aNode :answer | matchingMethods add:mthd ]
+].
+searcher executeTree: tree
 ]
 ]
 finallyDo:[
 block value: matchingMethods
 ]
 !
 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
+methodsForClasses
+cachedMethodsFromClasses isNil ifTrue:[
-^classes
+cachedMethodsFromClasses :=
-inject: Set new
+(classes
-into:
+inject: OrderedCollection new
-[:methods :cls|
+into:[:methods :cls|
 methods
 addAll: cls methodDictionary values;
 addAll: cls class methodDictionary values;
 yourself]
+) asArray.
-"Created: / 21-07-2007 / 06:25:42 / janfrog"
+].
+^ cachedMethodsFromClasses
 !
 methodsMatchingPattern: searchPattern
 |methods matchingMethods|
 !
 withMethods: methods do: methodBlock finallyDo: finallyBlock
 [
+|numMethods|
+numMethods := methods size.
 self actionInProgress: true.
-methods asArray keysAndValuesDo:
+self progress: 0.
-[:idx :mth|
-self info: mth selector storeString.
+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.
 self progress: 0.
 self info: ''
 "Modified: / 12-12-2007 / 10:45:20 / janfrog"
 ! !
 !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 $'
 ! !

branch	jv
changeset 15634	fb1ac619f9c3
parent 15566	184cea584be5
parent 15631	b034f8b18413
child 15665	86f15e4dcebf