--- a/SystemBrowser.st Thu Jul 11 20:16:29 2019 +0200
+++ b/SystemBrowser.st Fri Jul 12 12:14:40 2019 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -120,7 +122,7 @@
openInClass:aClass selector:aSelector
"launch a standard browser which immediately switches
- to aClass » aSelector. Returns the browser"
+ to aClass » aSelector. Returns the browser"
|brwsr classesName|
@@ -5166,8 +5168,7 @@
findSpecMethodsFor:specSymbol
withString:aString
in:aCollectionOfClasses
- ignoreCase:ignoreCase
- match:true
+ ignoreCase:ignoreCase match:true
!
findSpecMethodsFor:specSymbol withString:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch
@@ -5183,7 +5184,8 @@
|resources|
((resources := m resources) size > 0
- and:[resources includesKey:specSymbol]) ifTrue:[
+ and:[resources includesKey:specSymbol]
+ ) ifTrue:[
innerSearchBlock value:c value:m value:sel
]
].
@@ -5199,8 +5201,8 @@
^ self
findString:aString
in:aCollectionOfClasses
- ignoreCase:ignoreCase
- match:true
+ ignoreCase:ignoreCase match:true fullWordsOnly:false
+ resourceMethodsOnly:false
"
SystemBrowser findString:'should' in:(Array with:Object) ignoreCase:false
@@ -5212,7 +5214,11 @@
containing a string in their source.
This may be slow, since source-code has to be scanned."
- ^ self findString:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ ^ self
+ findString:aString
+ in:aCollectionOfClasses
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ resourceMethodsOnly:false
"
SystemBrowser
@@ -5227,14 +5233,29 @@
containing a string in their source.
This may be slow, since source-code has to be scanned."
+ ^ self
+ findString:aString
+ in:aCollectionOfClasses
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:false
+
+ "
+ SystemBrowser findString:'should' in:(Array with:Object) ignoreCase:false
+ "
+!
+
+findString:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly resourceMethodsOnly:resourceMethodsOnly
+ "return a collection of all methods in aCollectionOfClasses
+ containing a string in their source.
+ This may be slow, since source-code has to be scanned."
+
|searchBlock|
searchBlock :=
self
searchBlockForString:aString
- ignoreCase:ignoreCase
- match:doMatch
- fullWordsOnly:fullWordsOnly.
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:resourceMethodsOnly.
^ self findMethodsIn:aCollectionOfClasses where:searchBlock.
"
@@ -5247,7 +5268,11 @@
containing a string in their source.
This may be slow, since source-code has to be scanned."
- ^ self findString:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ ^ self
+ findString:aString
+ inMethods:aCollectionOfMethods
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ resourceMethodsOnly:false
!
findString:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
@@ -5255,9 +5280,24 @@
containing a string in their source.
This may be slow, since source-code has to be scanned."
+ ^ self
+ findString:aString
+ inMethods:aCollectionOfMethods
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:false
+!
+
+findString:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly resourceMethodsOnly:resourceMethodsOnly
+ "return a collection of all methods in aCollectionOfClasses
+ containing a string in their source.
+ This may be slow, since source-code has to be scanned."
+
|searchBlock|
- searchBlock := self searchBlockForString:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
+ searchBlock := self
+ searchBlockForString:aString
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:resourceMethodsOnly.
^ aCollectionOfMethods select:[:m | searchBlock value:m mclass value:m value:m selector].
!
@@ -5266,8 +5306,10 @@
containing a string in any of their string-literals."
^ self
- findStringLiteral:aString in:aCollectionOfClasses
- ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ findStringLiteral:aString
+ in:aCollectionOfClasses
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ resourceMethodsOnly:false
"
SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
@@ -5278,9 +5320,27 @@
"return a collection of all methods in aCollectionOfClasses
containing a string in any of their string-literals."
+ ^ self
+ findStringLiteral:aString
+ in:aCollectionOfClasses
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:false.
+
+ "
+ SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
+ "
+!
+
+findStringLiteral:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly resourceMethodsOnly:resourceMethodsOnly
+ "return a collection of all methods in aCollectionOfClasses
+ containing a string in any of their string-literals."
+
|searchBlock|
- searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
+ searchBlock := self
+ searchBlockForStringLiteral:aString
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:resourceMethodsOnly.
^ self findMethodsIn:aCollectionOfClasses where:searchBlock.
"
@@ -5295,15 +5355,31 @@
^ self
findStringLiteral:aString inMethods:aCollectionOfMethods
ignoreCase:ignoreCase match:doMatch fullWordsOnly:false
+ resourceMethodsOnly:false
!
findStringLiteral:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
"return a collection of all methods in aCollectionOfClasses
containing a string in any of their string-literals."
+ ^ self
+ findStringLiteral:aString inMethods:aCollectionOfMethods
+ ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:false
+!
+
+findStringLiteral:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly resourceMethodsOnly:resourceMethodsOnly
+ "return a collection of all methods in aCollectionOfClasses
+ containing a string in any of their string-literals."
+
|searchBlock|
- searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
+ searchBlock := self
+ searchBlockForStringLiteral:aString
+ ignoreCase:ignoreCase
+ match:doMatch
+ fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:resourceMethodsOnly.
^ aCollectionOfMethods select:[:m | searchBlock value:m mclass value:m value:m selector].
!
@@ -5335,6 +5411,18 @@
"Created: / 11-05-2010 / 16:20:12 / cg"
!
+resourceMethodSearchBlockFor:aStringSearchBlock
+ ^ [:c :m :sel |
+ |resources|
+
+ (m hasAnyResource:Method resourceTypes) ifTrue:[
+ aStringSearchBlock value:c value:m value:sel
+ ] ifFalse:[
+ false
+ ]
+ ].
+!
+
searchBlockForAllCallsOn:aSelectorString ignoreCase:ignoreCase
^ self searchBlockForAllCallsOn:aSelectorString ignoreCase:ignoreCase match:true
!
@@ -5865,6 +5953,7 @@
ignoreCase:ignoreCase
match:doMatchArg
fullWordsOnly:false
+ resourceMethodsOnly:false
"
SystemBrowser
@@ -5877,8 +5966,23 @@
searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
"return a block to search for a string."
+ ^ self
+ searchBlockForString:aString
+ ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:false
+
+ "
+ SystemBrowser findString:'should' in:(Array with:Object) ignoreCase:false
+ "
+
+ "Modified: / 05-06-2019 / 17:02:24 / Claus Gittinger"
+!
+
+searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly resourceMethodsOnly:resourceMethodsOnly
+ "return a block to search for a string."
+
|checkBlock lineCheckBlock pattern doMatch
- quickCheckString firstMatchIndex lastMatchIndex|
+ quickCheckString firstMatchIndex lastMatchIndex stringSearchBlock|
doMatch := doMatchArg.
aString includesMatchCharacters ifFalse:[
@@ -5921,45 +6025,51 @@
checkBlock := [:src | src includesString:aString caseSensitive:ignoreCase not]
].
- ^ [:cls :mthd :sel |
- |src found idx1 reallyFound ch1 ch2|
-
- found := false.
- src := mthd source.
- src isNil ifTrue:[
- ('Browser [info]: no source for ' , mthd printString) infoPrintCR.
- ] ifFalse:[
- found := checkBlock value:src.
- (fullWordsOnly and:[found]) ifTrue:[
- self halt.
- doMatch ifTrue:[
-
- ] ifFalse:[
- reallyFound := false.
- idx1 := 0.
- [
- reallyFound not
- and:[
- idx1 := src indexOfSubCollection:aString startingAt:idx1+1 ifAbsent:0 caseSensitive:ignoreCase not.
- idx1 ~~ 0]
- ] whileTrue:[
- "/ see if it is a free-standing word
- reallyFound := true.
- idx1 > 1 ifTrue:[
- ch1 := src at:idx1-1.
- (ch1 isLetterOrUnderline) ifTrue:[ reallyFound := false].
+ stringSearchBlock :=
+ [:cls :mthd :sel |
+ |src found idx1 reallyFound ch1 ch2|
+
+ found := false.
+ src := mthd source.
+ src isNil ifTrue:[
+ ('Browser [info]: no source for ' , mthd printString) infoPrintCR.
+ ] ifFalse:[
+ found := checkBlock value:src.
+ (fullWordsOnly and:[found]) ifTrue:[
+ self halt.
+ doMatch ifTrue:[
+
+ ] ifFalse:[
+ reallyFound := false.
+ idx1 := 0.
+ [
+ reallyFound not
+ and:[
+ idx1 := src indexOfSubCollection:aString startingAt:idx1+1 ifAbsent:0 caseSensitive:ignoreCase not.
+ idx1 ~~ 0]
+ ] whileTrue:[
+ "/ see if it is a free-standing word
+ reallyFound := true.
+ idx1 > 1 ifTrue:[
+ ch1 := src at:idx1-1.
+ (ch1 isLetterOrUnderline) ifTrue:[ reallyFound := false].
+ ].
+ (idx1+aString size-1) < src size ifTrue:[
+ ch2 := src at:idx1+aString size.
+ (ch2 isLetterOrUnderline) ifTrue:[ reallyFound := false].
+ ].
].
- (idx1+aString size-1) < src size ifTrue:[
- ch2 := src at:idx1+aString size.
- (ch2 isLetterOrUnderline) ifTrue:[ reallyFound := false].
- ].
- ].
- found := reallyFound
+ found := reallyFound
+ ].
].
- ].
+ ].
+ found
].
- found
- ]
+
+ resourceMethodsOnly ifTrue:[
+ ^ self resourceMethodSearchBlockFor:stringSearchBlock
+ ].
+ ^ stringSearchBlock
"
SystemBrowser findString:'should' in:(Array with:Object) ignoreCase:false
@@ -5972,8 +6082,9 @@
"return a block to search for a string-literal."
^ self
- searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
- fullWordsOnly:false
+ searchBlockForStringLiteral:aString
+ ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:false
+ resourceMethodsOnly:false
"
SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
@@ -5986,93 +6097,119 @@
searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
"return a block to search for a string-literal."
+ ^ self
+ searchBlockForStringLiteral:aString
+ ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
+ resourceMethodsOnly:false
+
+ "
+ SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
+ SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
+ SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:false match:true
+ SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:false match:false
+ "
+
+ "Modified: / 20-04-2017 / 11:28:05 / stefan"
+!
+
+searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly resourceMethodsOnly:resourceMethodsOnly
+ "return a block to search for a string-literal."
+
|pattern doMatch checkLiteral checkSource
- quickCheckString firstMatchIndex lastMatchIndex|
-
- aString isEmpty ifTrue:[^ [:cls :mthd :sel | true ]].
-
- doMatch := doMatchArg.
- (aString includesMatchCharacters) ifFalse:[
- doMatch := false
- ].
- doMatch ifTrue:[
- "a matchString"
- pattern := aString.
- aString first == $* ifFalse:[
- pattern := '*',pattern
- ].
- aString last == $* ifFalse:[
- pattern := pattern,'*'
+ quickCheckString firstMatchIndex lastMatchIndex stringSearchBlock|
+
+ aString isEmpty ifTrue:[
+ stringSearchBlock := [:cls :mthd :sel | true ].
+ ] ifFalse:[
+ doMatch := doMatchArg.
+ (aString includesMatchCharacters) ifFalse:[
+ doMatch := false
].
- checkLiteral := [:lit | pattern match:lit caseSensitive:ignoreCase not].
- firstMatchIndex := aString indexOfAny:'*#['.
- lastMatchIndex := aString lastIndexOfAny:'*#['.
- "/ which is longer - left or right part?
- firstMatchIndex-1 "nleft" > (aString size-lastMatchIndex) "nright" ifTrue:[
- "/ use left part as quickSearch
- quickCheckString := aString copyTo:firstMatchIndex-1
- ] ifFalse:[
- "/ use right part as quickSearch
- quickCheckString := aString copyFrom:lastMatchIndex+1
- ].
- quickCheckString size > 1 ifTrue:[
- checkSource := [:src | src includesString:quickCheckString caseSensitive:ignoreCase not]
+ doMatch ifTrue:[
+ "a matchString"
+ pattern := aString.
+ aString first == $* ifFalse:[
+ pattern := '*',pattern
+ ].
+ aString last == $* ifFalse:[
+ pattern := pattern,'*'
+ ].
+ checkLiteral := [:lit | pattern match:lit caseSensitive:ignoreCase not].
+ firstMatchIndex := aString indexOfAny:'*#['.
+ lastMatchIndex := aString lastIndexOfAny:'*#['.
+ "/ which is longer - left or right part?
+ firstMatchIndex-1 "nleft" > (aString size-lastMatchIndex) "nright" ifTrue:[
+ "/ use left part as quickSearch
+ quickCheckString := aString copyTo:firstMatchIndex-1
+ ] ifFalse:[
+ "/ use right part as quickSearch
+ quickCheckString := aString copyFrom:lastMatchIndex+1
+ ].
+ quickCheckString size > 1 ifTrue:[
+ checkSource := [:src | src includesString:quickCheckString caseSensitive:ignoreCase not]
+ ] ifFalse:[
+ checkSource := [:src | true]. "/ not worth the effort
+ ].
] ifFalse:[
- checkSource := [:src | true]. "/ not worth the effort
- ].
- ] ifFalse:[
- ignoreCase ifTrue:[
- checkLiteral := [:lit | lit includesString:aString caseSensitive:true].
- checkSource := [:src | src includesString:aString caseSensitive:true].
- ] ifFalse:[
- checkLiteral := [:lit | lit includesString:aString].
- checkSource := [:src | src includesString:aString].
- ].
- ].
-
- ^ [:cls :methodArg :sel |
- "/ sorry: the following does not work, because stc does not place string-constants
- "/ into the literals.
- "/ (mthd literalsDetect:[:lit |
- "/ lit isString
- "/ and:[ lit isSymbol not
- "/ and:[ checkLiteral value:lit ]]
- "/ ] ifNone:[nil])
- "/ notNil
- "/ so we must parse here (sigh)
-
- |method src skip tree found|
-
- skip := found := false.
- method := methodArg originalMethodIfWrapped.
- method isLazyMethod ifTrue:[
- src := method source.
- (src notNil) ifTrue:[
- method makeRealMethod.
+ ignoreCase ifTrue:[
+ checkLiteral := [:lit | lit includesString:aString caseSensitive:true].
+ checkSource := [:src | src includesString:aString caseSensitive:true].
] ifFalse:[
- skip := true
+ checkLiteral := [:lit | lit includesString:aString].
+ checkSource := [:src | src includesString:aString].
].
].
- skip ifFalse:[
- src := method source.
- src isNil ifTrue:[
- ('SystemBrowser: [warning]: no source for method: ',methodArg printString) errorPrintCR.
- ].
- (src notNil and:[src includes:$']) ifTrue:[ "/ eliminates many
- (checkSource value:src) ifTrue:[
- tree := cls parseTreeFor:sel.
- "/ walk
- found :=
- tree notNil
- and:[tree usedLiterals contains:[:lit |
- lit isString
- and:[ lit isSymbol not
- and:[ checkLiteral value:lit ]]]]
- ].
- ].
- ].
- found
- ]
+
+ stringSearchBlock :=
+ [:cls :methodArg :sel |
+ "/ sorry: the following does not work, because stc does not place string-constants
+ "/ into the literals.
+ "/ (mthd literalsDetect:[:lit |
+ "/ lit isString
+ "/ and:[ lit isSymbol not
+ "/ and:[ checkLiteral value:lit ]]
+ "/ ] ifNone:[nil])
+ "/ notNil
+ "/ so we must parse here (sigh)
+
+ |method src skip tree found|
+
+ skip := found := false.
+ method := methodArg originalMethodIfWrapped.
+ method isLazyMethod ifTrue:[
+ src := method source.
+ (src notNil) ifTrue:[
+ method makeRealMethod.
+ ] ifFalse:[
+ skip := true
+ ].
+ ].
+ skip ifFalse:[
+ src := method source.
+ src isNil ifTrue:[
+ ('SystemBrowser: [warning]: no source for method: ',methodArg printString) errorPrintCR.
+ ].
+ (src notNil and:[src includes:$']) ifTrue:[ "/ eliminates many
+ (checkSource value:src) ifTrue:[
+ tree := cls parseTreeFor:sel.
+ "/ walk
+ found :=
+ tree notNil
+ and:[tree usedLiterals contains:[:lit |
+ lit isString
+ and:[ lit isSymbol not
+ and:[ checkLiteral value:lit ]]]]
+ ].
+ ].
+ ].
+ found
+ ].
+ ].
+
+ resourceMethodsOnly ifTrue:[
+ ^ self resourceMethodSearchBlockFor:stringSearchBlock
+ ].
+ ^ stringSearchBlock
"
SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
@@ -7202,8 +7339,8 @@
('*>>*' match:sel) ifTrue:[
sep := $>
] ifFalse:[
- ('*»*' match:sel) ifTrue:[
- sep := $»
+ ('*»*' match:sel) ifTrue:[
+ sep := $»
] ifFalse:[
('* *' match:sel) ifTrue:[
sep := Character space
@@ -7242,7 +7379,7 @@
aString isEmptyOrNil ifTrue:[^ nil].
- (idx := aString indexOf:$») ~~ 0 ifTrue:[
+ (idx := aString indexOf:$») ~~ 0 ifTrue:[
s := (aString copyFrom:idx+1) withoutSeparators.
s isEmpty ifTrue:[^ nil].
] ifFalse:[
@@ -7292,7 +7429,7 @@
self extractSelectorFrom:'self at:something put:someValue'
self extractSelectorFrom:'(self at:something put:someValue)'
self extractSelectorFrom:'[self at:something put:someValue] value'
- self extractSelectorFrom:'Array » at:put:'
+ self extractSelectorFrom:'Array » at:put:'
self extractSelectorFrom:'Array>>at:put:'
self extractSelectorFrom:'Array>>#at:put:'
self extractSelectorFrom:'Array>>#''at:put:'''
@@ -7466,7 +7603,7 @@
].
selector notNil ifTrue:[
aGCOrStream
- nextPutAll:' » ';
+ nextPutAll:' » ';
bold;
nextPutAll:selector;
normal.