--- a/SystemBrowser.st Fri Jan 24 23:45:12 1997 +0100
+++ b/SystemBrowser.st Fri Jan 24 23:46:27 1997 +0100
@@ -211,6 +211,118 @@
!SystemBrowser class methodsFor:'special search startup'!
+allCallsOn:aSelectorString
+ "return a collection of methods which send aSelector."
+
+ ^ self allCallsOn:#at:put: in:(Smalltalk allClasses)
+
+ "
+ SystemBrowser allCallsOn:#at:put:
+ "
+
+ "Created: 24.1.1997 / 19:42:57 / cg"
+!
+
+allCallsOn:aSelectorString in:aCollectionOfClasses
+ "return a collection of methods which send aSelector.
+ Methods from classes in aCollectionOfClasses are searched only."
+
+ |sel searchBlock|
+
+ ((aSelectorString ~= '*')
+ and:[aSelectorString includesMatchCharacters]) ifTrue:[
+ "/ a matchString - need string matching procedure
+
+ searchBlock := [:class :method :s |
+ (method literalsDetect:[:aLiteral|
+ (aLiteral isMemberOf:Symbol)
+ and:[aSelectorString match:aLiteral]
+ ] ifNone:nil) notNil
+ ].
+ ] ifFalse:[
+ "/ no matchString - can do it much faster
+
+ sel := aSelectorString asSymbolIfInterned.
+ sel isNil ifTrue:[
+ ^ nil "/ none
+ ].
+ searchBlock := [:class :method :s | method sends:sel].
+ ].
+ ^ self allMethodsIn:aCollectionOfClasses where:searchBlock
+
+ "
+ SystemBrowser allCallsOn:#at:put: in:(Smalltalk allClasses)
+ "
+
+ "Modified: 24.1.1997 / 19:42:23 / cg"
+!
+
+allMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock
+ "return a collection of methods which pass the given test.
+ wantInst/wantClass control if instMethods and/or classMethods are to be
+ considered.
+ Only classes in aCollectionOfClasses are inspected in the search"
+
+ |list|
+
+ "
+ since this may take a long time, lower my priority ...
+ "
+ Processor activeProcess withLowerPriorityDo:[
+ |checkedClasses checkBlock|
+
+ checkedClasses := IdentitySet new.
+ list := OrderedCollection new.
+
+ checkBlock := [:cls |
+ (checkedClasses includes:cls) ifFalse:[
+ cls isObsolete ifTrue:[
+ Transcript showCR:'skipping obsolete class: ' , cls displayString
+ ] ifFalse:[
+ cls methodDictionary keysAndValuesDo:[:sel :method |
+ (aBlock value:cls value:method value:sel) ifTrue:[
+ list add:method "/ (cls name , ' ' , sel)
+ ]
+ ].
+ checkedClasses add:cls.
+ ]
+ ]
+ ].
+
+ aCollectionOfClasses do:[:aClass |
+ "
+ output disabled - it slows down things too much (when searching for
+ implementors or senders)
+ "
+ wantInst ifTrue:[
+"/ Transcript show:'searching '; show:aClass name; showCR:' ...'; endEntry.
+ checkBlock value:aClass
+ ].
+ wantClass ifTrue:[
+"/ Transcript show:'searching '; show:aClass class name; showCR:' ...'; endEntry.
+ checkBlock value:(aClass class)
+ ].
+ Processor yield
+ ]
+ ].
+ ^ list
+
+ "Created: 24.1.1997 / 19:41:12 / cg"
+!
+
+allMethodsIn:aCollectionOfClasses where:aBlock
+ "return a collection of methods which pass the given test.
+ Only classes in aCollectionOfClasses are inspected in the search"
+
+ ^ self
+ allMethodsIn:aCollectionOfClasses
+ inst:true
+ class:true
+ where:aBlock
+
+ "Created: 24.1.1997 / 19:41:49 / cg"
+!
+
aproposSearch:aString
"browse all methods, which have aString in their selector or
in the methods comment.
@@ -285,45 +397,27 @@
browseAllCallsOn:aSelectorString in:aSetOfClasses
"launch a browser for all senders of aSelector"
- ^ self browseAllCallsOn:aSelectorString
- in:aSetOfClasses
- title:(self classResources string:'senders of: %1' with:aSelectorString)
+ ^ self
+ browseAllCallsOn:aSelectorString
+ in:aSetOfClasses
+ title:(self classResources string:'senders of: %1' with:aSelectorString)
"
SystemBrowser browseAllCallsOn:#+ in:(Number withAllSubclasses)
"
- "Modified: 9.12.1995 / 18:10:57 / cg"
"Created: 10.7.1996 / 10:25:49 / cg"
+ "Modified: 24.1.1997 / 19:49:34 / cg"
!
browseAllCallsOn:aSelectorString in:aCollectionOfClasses title:title
"launch a browser for all senders of aSelector in aCollectionOfClasses"
- |sel browser searchBlock|
+ |browser|
- ((aSelectorString ~= '*') and:[aSelectorString includesMatchCharacters]) ifTrue:[
- "a matchString"
- searchBlock := [:class :method :s |
- (method literalsDetect:[:aLiteral|
- (aLiteral isMemberOf:Symbol)
- and:[aSelectorString match:aLiteral]
- ] ifNone:nil) notNil
- ].
- ] ifFalse:[
- sel := aSelectorString asSymbolIfInterned.
- sel isNil ifTrue:[
-"
- Transcript showCR:'none found.'.
-"
- self showNoneFound:title.
- ^ nil
- ].
- searchBlock := [:class :method :s | method sends:sel].
- ].
- browser := self browseMethodsIn:aCollectionOfClasses
- where:searchBlock
- title:title.
+ browser := self
+ browseMethods:(self allCallsOn:aSelectorString in:aCollectionOfClasses)
+ title:title.
browser notNil ifTrue:[
|s|
@@ -340,25 +434,33 @@
].
^ browser
- "Modified: 24.6.1996 / 14:35:01 / stefan"
- "Modified: 30.6.1996 / 16:45:57 / cg"
+ "
+ SystemBrowser
+ browseAllCallsOn:#+
+ in:(Number withAllSubclasses)
+ title:'just a test'
+ "
+
+ "Modified: 24.1.1997 / 19:48:54 / cg"
!
browseCallsOn:aSelectorString under:aClass
"launch a browser for all senders of aSelector in aClass and subclasses"
- ^ self browseAllCallsOn:aSelectorString
- in:(aClass withAllSubclasses)
- title:(self classResources string:'senders of: %1 (in and below %2)'
- with:aSelectorString
- with:aClass name)
+ ^ self
+ browseAllCallsOn:aSelectorString
+ in:(aClass withAllSubclasses)
+ title:(self classResources
+ string:'senders of: %1 (in and below %2)'
+ with:aSelectorString
+ with:aClass name)
"
SystemBrowser browseCallsOn:#+ under:Number
"
"Created: 9.12.1995 / 17:59:57 / cg"
- "Modified: 9.12.1995 / 18:11:10 / cg"
+ "Modified: 24.1.1997 / 19:50:33 / cg"
!
browseClassRefsTo:aString in:aCollectionOfClasses modificationsOnly:modsOnly
@@ -1231,33 +1333,45 @@
browseAllSelect:aBlock
"launch a browser for all methods where aBlock returns true.
- The block is called with 3 arguments, class, method and seelctor."
+ The block is called with 3 arguments, class, method and selector."
- ^ self browseMethodsWhere:aBlock title:'selected messages'
+ ^ self
+ browseMethodsWhere:aBlock
+ title:'selected messages'
"
SystemBrowser browseAllSelect:[:aClass :aMethod :selector | selector numArgs == 3]
"
+
+ "Modified: 24.1.1997 / 19:45:05 / cg"
!
browseClass:aClass
"launch a browser for aClass"
^ self
- newWithLabel:aClass name
- setupSelector:#setupForClass:
- arg:aClass
+ newWithLabel:aClass name
+ setupSelector:#setupForClass:
+ arg:aClass
- "SystemBrowser browseClass:Object"
+ "
+ SystemBrowser browseClass:Object
+ "
+
+ "Modified: 24.1.1997 / 19:45:16 / cg"
!
browseClass:aClass methodCategory:aCategory
"launch a browser for all methods under aCategory in aClass"
^ self newWithLabel:(aClass name , ' ' , aCategory)
- setupBlock:[:browser | browser setupForClass:aClass methodCategory:aCategory]
+ setupBlock:[:browser | browser setupForClass:aClass methodCategory:aCategory]
- "SystemBrowser browseClass:String methodCategory:'copying'"
+ "
+ SystemBrowser browseClass:String methodCategory:'copying'
+ "
+
+ "Modified: 24.1.1997 / 19:45:23 / cg"
!
browseClass:aClass selector:selector
@@ -1276,11 +1390,15 @@
"launch a browser for all classes under aCategory"
^ self
- newWithLabel:aClassCategory
- setupSelector:#setupForClassCategory:
- arg:aClassCategory
+ newWithLabel:aClassCategory
+ setupSelector:#setupForClassCategory:
+ arg:aClassCategory
- "SystemBrowser browseClassCategory:'Kernel-Objects'"
+ "
+ SystemBrowser browseClassCategory:'Kernel-Objects'
+ "
+
+ "Modified: 24.1.1997 / 19:45:32 / cg"
!
browseClassHierarchy:aClass
@@ -1357,22 +1475,39 @@
"launch a browser for all instance methods in aClass and all subclasses
where aBlock evaluates to true"
- ^ self browseMethodsIn:(aClass withAllSubclasses) inst:true class:false where:aBlock title:title
+ ^ self
+ browseMethodsIn:(aClass withAllSubclasses)
+ inst:true
+ class:false
+ where:aBlock
+ title:title
+
+ "Modified: 24.1.1997 / 19:44:45 / cg"
!
browseInstMethodsIn:aCollectionOfClasses where:aBlock title:title
"launch a browser for all instance methods of all classes in
aCollectionOfClasses where aBlock evaluates to true"
- ^ self browseMethodsIn:aCollectionOfClasses inst:true class:false
- where:aBlock title:title
+ ^ self
+ browseMethodsIn:aCollectionOfClasses
+ inst:true class:false
+ where:aBlock title:title
+
+ "Modified: 24.1.1997 / 19:43:41 / cg"
!
browseInstMethodsOf:aClass where:aBlock title:title
"launch a browser for all instance methods in aClass
where aBlock evaluates to true"
- ^ self browseMethodsIn:(Array with:aClass) inst:true class:false where:aBlock title:title
+ ^ self
+ browseMethodsIn:(Array with:aClass)
+ inst:true
+ class:false
+ where:aBlock title:title
+
+ "Modified: 24.1.1997 / 19:43:50 / cg"
!
browseMethodCategory:aCategory
@@ -1452,7 +1587,12 @@
and all its subclasses where aBlock evaluates to true.
The block is called with 3 arguments, class, method and seelctor."
- ^ self browseMethodsIn:(aClass withAllSubclasses) where:aBlock title:title
+ ^ self
+ browseMethodsIn:(aClass withAllSubclasses)
+ where:aBlock
+ title:title
+
+ "Modified: 24.1.1997 / 19:44:00 / cg"
!
browseMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock title:title
@@ -1515,8 +1655,14 @@
all classes in aCollectionOfClasses where aBlock evaluates to true.
The block is called with 3 arguments, class, method and seelctor."
- ^ self browseMethodsIn:aCollectionOfClasses inst:true class:true where:aBlock title:title
+ ^ self
+ browseMethodsIn:aCollectionOfClasses
+ inst:true
+ class:true
+ where:aBlock
+ title:title
+ "Modified: 24.1.1997 / 19:44:17 / cg"
!
browseMethodsOf:aClass where:aBlock title:title
@@ -1531,7 +1677,12 @@
"launch a browser for all methods where aBlock returns true.
The block is called with 3 arguments, class, method and seelctor."
- ^ self browseMethodsIn:(Smalltalk allClasses) where:aBlock title:title
+ ^ self
+ browseMethodsIn:(Smalltalk allClasses)
+ where:aBlock
+ title:title
+
+ "Modified: 24.1.1997 / 19:44:30 / cg"
! !
!SystemBrowser class methodsFor:'startup with query'!
@@ -1592,6 +1743,6 @@
!SystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.71 1997-01-09 11:45:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.72 1997-01-24 22:46:27 cg Exp $'
! !
SystemBrowser initialize!