--- a/Tools__NewSystemBrowser.st Tue Dec 11 16:44:19 2012 +0100
+++ b/Tools__NewSystemBrowser.st Wed Dec 12 12:56:13 2012 +0100
@@ -31404,62 +31404,18 @@
spawnClassOrSubclassReferencesBrowserFor:aCollectionOfClasses in:openHow
"add a buffer/open a new browser showing references to selected classes and their subclasses"
- |lbl searchBlock cachedList brwsr singleClassName|
-
- aCollectionOfClasses size == 1 ifTrue:[
- singleClassName := aCollectionOfClasses first theNonMetaclass name.
- lbl := 'References to ' , singleClassName , ' and its subclasses'
- ] ifFalse:[
- lbl := 'References to classes and their subclasses'
- ].
-
- searchBlock := [
- |allRefs|
-
- cachedList notNil ifTrue:[
- allRefs := cachedList.
- cachedList := nil.
- ] ifFalse:[
- allRefs := IdentitySet new.
- aCollectionOfClasses do:[:eachClassInQuestion |
- |syms refsHere|
-
- syms := eachClassInQuestion theNonMetaclass withAllSubclasses collect:[:cls | cls name].
- refsHere := self class
- findMethodsIn:(Smalltalk allClasses)
- where:[:cls :mthd :sel | |mSource|
- "/ kludge: Lazy methods do not include symbols in the literal array - sigh
- mthd isLazyMethod ifTrue:[
- mSource := mthd source.
- (mSource notNil
- and:[(syms contains:[:sym | (mSource includesString:sym)])
- and:[|usedGlobals|
- usedGlobals := mthd usedGlobals.
- syms contains:[:sym | usedGlobals includes:sym]]])
- ] ifFalse:[
- ((syms contains:[:sym | mthd referencesLiteral:sym])
- and:[|usedGlobals|
- usedGlobals := mthd usedGlobals.
- syms contains:[:sym | usedGlobals includes:sym]])
- ]
- ].
- allRefs addAll:refsHere.
- ].
- ].
- allRefs
- ].
-
- (cachedList := searchBlock value) isEmpty ifTrue:[
- self information:(lbl , ' - none found').
- ^ self
- ].
-
- brwsr := self spawnMethodBrowserForSearch:searchBlock sortBy:#class in:openHow label:lbl.
- brwsr notNil ifTrue:[
- singleClassName notNil ifTrue:[
- brwsr autoSearchPattern:singleClassName ignoreCase:false.
- ]
- ].
+ |numClasses lbl classes|
+
+ (numClasses := aCollectionOfClasses size) == 1 ifTrue:[
+ lbl := 'References to %1 and its subclasses' bindWith:aCollectionOfClasses first theNonMetaclass.
+ ] ifFalse:[
+ lbl := 'References to %1 classes and their subclasses' bindWith:numClasses
+ ].
+ classes := Set new.
+ aCollectionOfClasses do:[:eachClassInQuestion |
+ classes addAll:(eachClassInQuestion theNonMetaclass withAllSubclasses)
+ ].
+ ^ self spawnClassReferencesBrowserFor:(classes asOrderedCollection) label:lbl in:openHow
!
spawnClassProjectsBrowserFor:aCollectionOfClasses in:openHow
@@ -31480,99 +31436,110 @@
spawnClassReferencesBrowserFor:aCollectionOfClasses in:openHow
"add a buffer/open a new browser showing references to selected classes"
- |lbl searchBlock cachedList brwsr singleClassName|
-
- aCollectionOfClasses size == 1 ifTrue:[
- singleClassName := aCollectionOfClasses first theNonMetaclass name.
- lbl := 'References to ' , singleClassName
- ] ifFalse:[
- lbl := 'References to classes'
- ].
+ |lbl numClasses|
+
+ (numClasses := aCollectionOfClasses size) == 1 ifTrue:[
+ lbl := 'References to ' , aCollectionOfClasses first name
+ ] ifFalse:[
+ lbl := 'References to any of %1 classes' bindWith:numClasses
+ ].
+ ^ self spawnClassReferencesBrowserFor:aCollectionOfClasses label:lbl in:openHow
+!
+
+spawnClassReferencesBrowserFor:aCollectionOfClasses label:lbl in:openHow
+ "add a buffer/open a new browser showing references to selected classes"
+
+ |searchBlock brwsr patternsForCodeSearch|
searchBlock := [
|allRefs|
- cachedList notNil ifTrue:[
- allRefs := cachedList.
- cachedList := nil.
- ] ifFalse:[
- allRefs := IdentitySet new.
- aCollectionOfClasses do:[:eachClassInQuestion |
- |findRefs sym classesNameSpace symInsideNamespace symInsideOwner refsHere|
-
- sym := eachClassInQuestion theNonMetaclass name.
- classesNameSpace := eachClassInQuestion theNonMetaclass nameSpace.
-
- findRefs :=
- [:setOfClasses |
- self class
- findMethodsIn:setOfClasses
- where:[:cls :mthdIn :sel |
- |mthd mSource isCandidate isReference usedGlobals|
-
- mthd := mthdIn.
- mthd isWrapped ifTrue:[ mthd := mthd originalMethod ].
-
- "/ kludge: Lazy methods do not include symbols in the literal array - sigh
- mthd isLazyMethod ifTrue:[
- mSource := mthd source.
- isCandidate := mSource notNil and:[ mSource includesString:sym].
- ] ifFalse:[
- isCandidate := mthd referencesLiteral:sym
- ].
- isReference := false.
- isCandidate ifTrue:[
- usedGlobals := mthd usedGlobals.
- isReference := (usedGlobals includes:sym).
+ allRefs := IdentitySet new.
+ aCollectionOfClasses do:[:eachClassInQuestion |
+ |findRefs classesNameSpace symOutsideNamespace symInsideNamespace symInsideOwner refsHere|
+
+ classesNameSpace := eachClassInQuestion theNonMetaclass nameSpace.
+
+ findRefs :=
+ [:setOfClasses :sym|
+ self class
+ findMethodsIn:setOfClasses
+ where:[:cls :mthdIn :sel |
+ |mthd mSource isCandidate isReference usedGlobals|
+
+ mthd := mthdIn.
+ mthd isWrapped ifTrue:[ mthd := mthd originalMethod ].
+
+ "/ kludge: Lazy methods do not include symbols in the literal array - sigh
+ mthd isLazyMethod ifTrue:[
+ mSource := mthd source.
+ isCandidate := mSource notNil and:[ mSource includesString:sym].
+ ] ifFalse:[
+ isCandidate := (mthd referencesLiteral:sym)
+ ].
+ isReference := false.
+ isCandidate ifTrue:[
+ usedGlobals := mthd usedGlobals.
+ isReference := (usedGlobals includes:sym).
+ isReference ifFalse:[
+ (mthd referencesLiteral:classesNameSpace name) ifTrue:[
+ isReference := mthd sendsAny:#(#'at:' #'at:ifAbsent:' #'classNamed:')
+ ].
isReference ifFalse:[
- (mthd referencesLiteral:classesNameSpace name) ifTrue:[
- isReference := mthd sendsAny:#(#'at:' #'at:ifAbsent:' #'classNamed:')
- ].
- isReference ifFalse:[
- classesNameSpace ~= Smalltalk ifTrue:[
- (mthd referencesLiteral:#Smalltalk) ifTrue:[
- isReference := mthd sendsAny:#(#'at:' #'at:ifAbsent:' #'classNamed:')
- ].
- ]
+ classesNameSpace ~= Smalltalk ifTrue:[
+ (mthd referencesLiteral:#Smalltalk) ifTrue:[
+ isReference := mthd sendsAny:#(#'at:' #'at:ifAbsent:' #'classNamed:')
+ ].
]
]
- ].
- isReference
+ ]
].
- ].
-
- refsHere := findRefs value:(Smalltalk allClasses).
+ isReference
+ ].
+ ].
+
+ symOutsideNamespace := eachClassInQuestion theNonMetaclass name.
+
+ refsHere := findRefs value:(Smalltalk allClasses) value:symOutsideNamespace.
+ allRefs addAll:refsHere.
+
+ (eachClassInQuestion nameSpace notNil
+ and:[ eachClassInQuestion nameSpace ~~ Smalltalk ]) ifTrue:[
+ symInsideNamespace := eachClassInQuestion theNonMetaclass nameWithoutNameSpacePrefix asSymbol.
+ refsHere := findRefs
+ value:(eachClassInQuestion topNameSpace allClassesWithAllPrivateClasses)
+ value:symInsideNamespace.
allRefs addAll:refsHere.
-
- (eachClassInQuestion nameSpace notNil
- and:[ eachClassInQuestion nameSpace ~~ Smalltalk ]) ifTrue:[
- symInsideNamespace := eachClassInQuestion theNonMetaclass nameWithoutNameSpacePrefix asSymbol.
- refsHere := findRefs value:(eachClassInQuestion topNameSpace allClassesWithAllPrivateClasses).
- allRefs addAll:refsHere.
- ].
- (eachClassInQuestion owningClass notNil) ifTrue:[
- symInsideOwner := eachClassInQuestion theNonMetaclass nameWithoutPrefix asSymbol.
- refsHere := findRefs value:(Array with:eachClassInQuestion owningClass).
- allRefs addAll:refsHere.
- ].
+ ].
+ (eachClassInQuestion owningClass notNil) ifTrue:[
+ symInsideOwner := eachClassInQuestion theNonMetaclass nameWithoutPrefix asSymbol.
+ refsHere := findRefs
+ value:(Array with:eachClassInQuestion owningClass)
+ value:symInsideOwner.
+ allRefs addAll:refsHere.
].
].
allRefs
].
- self withSearchCursorDo:[
- cachedList := searchBlock value.
- ].
- cachedList isEmpty ifTrue:[
- self information:(lbl , ' - none found').
- ^ self
- ].
-
brwsr := self spawnMethodBrowserForSearch:searchBlock sortBy:#class in:openHow label:lbl.
brwsr notNil ifTrue:[
- singleClassName notNil ifTrue:[
- brwsr autoSearchPattern:singleClassName ignoreCase:false.
- ]
+ "/ setup an autosearch action - when selected, the codeView automatically searches
+ "/ the refactory-searcher is not aware of namespaces (simply compares globals by name);
+ "/ therefore, we setup a multiple pattern search here (sigh)
+ patternsForCodeSearch := OrderedCollection new.
+ aCollectionOfClasses do:[:each |
+ |nm nm2 nm3|
+
+ nm := each theNonMetaclass name.
+ nm2 := each theNonMetaclass nameWithoutPrefix.
+ nm3 := each theNonMetaclass nameWithoutNameSpacePrefix.
+ patternsForCodeSearch add:nm.
+ nm2 ~= nm ifTrue:[ patternsForCodeSearch add:nm2 ].
+ nm3 ~= nm ifTrue:[ patternsForCodeSearch add:nm3 ].
+ ].
+
+ brwsr autoSearchCodePatterns:patternsForCodeSearch "autoSearchPattern:singleClassName ignoreCase:false".
].
"Modified (format): / 25-11-2011 / 14:02:17 / cg"
@@ -45489,8 +45456,10 @@
|spec theMethodList|
- theMethodList := searchBlock value.
- theMethodList size == 0 ifTrue:[
+ self withWaitCursorDo:[
+ theMethodList := searchBlock value.
+ ].
+ theMethodList isEmptyOrNil ifTrue:[
self information:(lbl , ' - none found').
^ self.
].
@@ -50125,15 +50094,20 @@
!
autoSearchCodePattern:codePattern
+ ^ self autoSearchCodePatterns:(Array with:codePattern)
+!
+
+autoSearchCodePatterns:codePatterns
|searchAction codeView|
- codePattern notNil ifTrue:[
+ codePatterns notEmptyOrNil ifTrue:[
codeView := self codeView.
searchAction :=
[:direction :startLine :startCol :foundBlock :notFoundBlock|
self
- searchForCodePattern:codePattern direction:direction
+ searchForCodePatterns:codePatterns
+ direction:direction
startLine:(codeView cursorLine ? startLine) startCol:(codeView cursorCol ? startCol)
ifFound:[:charPos1 :charPos2 |
codeView
@@ -50311,13 +50285,22 @@
searchForCodePattern:codePattern direction:direction startLine:startLine startCol:startCol
ifFound:foundBlock ifNotFound:notFoundBlock
+ ^ self
+ searchForCodePatterns:(Array with:codePattern)
+ direction:direction startLine:startLine startCol:startCol
+ ifFound:foundBlock ifNotFound:notFoundBlock
+!
+
+searchForCodePatterns:codePatterns direction:direction
+ startLine:startLine startCol:startCol
+ ifFound:foundBlock ifNotFound:notFoundBlock
|searcher|
self parseTreeSearcherAvailable ifFalse:[ ^ self ].
searcher := ParseTreeSearcher new.
searcher
- matches: codePattern
+ matchesAnyOf: codePatterns
do:[:aNode :answer | answer add:aNode. answer ].
^ self
@@ -58062,11 +58045,11 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1823 2012-12-06 16:16:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1824 2012-12-12 11:56:13 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1823 2012-12-06 16:16:00 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1824 2012-12-12 11:56:13 cg Exp $'
!
version_SVN