--- a/SystemBrowser.st Fri Jun 10 07:10:24 2016 +0200
+++ b/SystemBrowser.st Tue Jun 14 07:09:40 2016 +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|
@@ -5110,9 +5112,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:false
+
+ "
+ SystemBrowser
+ findString:'should'
+ in:(Array with:Object)
+ ignoreCase:false
+ "
+!
+
+findString:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ "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.
+ searchBlock :=
+ self
+ searchBlockForString:aString
+ ignoreCase:ignoreCase
+ match:doMatch
+ fullWordsOnly:fullWordsOnly.
^ self findMethodsIn:aCollectionOfClasses where:searchBlock.
"
@@ -5125,9 +5147,17 @@
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
+!
+
+findString:aString inMethods:aCollectionOfMethods ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ "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.
+ searchBlock := self searchBlockForString:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
^ aCollectionOfMethods select:[:m | searchBlock value:m mclass value:m value:m selector].
!
@@ -5135,9 +5165,22 @@
"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:false
+
+ "
+ SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
+ "
+!
+
+findStringLiteral:aString in:aCollectionOfClasses ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly
+ "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.
+ searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
^ self findMethodsIn:aCollectionOfClasses where:searchBlock.
"
@@ -5149,9 +5192,18 @@
"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: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."
+
|searchBlock|
- searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch.
+ searchBlock := self searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch fullWordsOnly:fullWordsOnly.
^ aCollectionOfMethods select:[:m | searchBlock value:m mclass value:m value:m selector].
!
@@ -5705,6 +5757,23 @@
searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg
"return a block to search for a string."
+ ^ self
+ searchBlockForString:aString
+ ignoreCase:ignoreCase
+ match:doMatchArg
+ fullWordsOnly:false
+
+ "
+ SystemBrowser
+ findString:'should'
+ in:(Array with:Object)
+ ignoreCase:false
+ "
+!
+
+searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
+ "return a block to search for a string."
+
|checkBlock lineCheckBlock pattern doMatch
quickCheckString firstMatchIndex lastMatchIndex|
@@ -5734,45 +5803,59 @@
pattern := pattern,'*'
].
"/ when doing a match, be careful to not match acrosss lines
- ignoreCase ifTrue:[
- lineCheckBlock := [:line | pattern match:line caseSensitive:false]
- ] ifFalse:[
- lineCheckBlock := [:line | pattern match:line caseSensitive:true]
- ].
+ lineCheckBlock := [:line | pattern match:line caseSensitive:ignoreCase not].
quickCheckString size > 1 ifTrue:[
- ignoreCase ifTrue:[
- checkBlock := [:src |
- (src includesString:quickCheckString caseSensitive:false)
- and:[ (lineCheckBlock value:src)
- and:[ src asStringCollection contains:lineCheckBlock ]]].
- ] ifFalse:[
- checkBlock := [:src |
- (src includesString:quickCheckString caseSensitive:true)
- and:[ (lineCheckBlock value:src)
- and:[ src asStringCollection contains:lineCheckBlock ]]].
- ]
+ checkBlock := [:src |
+ (src includesString:quickCheckString caseSensitive:ignoreCase not)
+ and:[ (lineCheckBlock value:src)
+ and:[ src asStringCollection contains:lineCheckBlock ]]].
] ifFalse:[
checkBlock := [:src |
(lineCheckBlock value:src)
and:[ src asStringCollection contains:lineCheckBlock ]].
].
] ifFalse:[
- ignoreCase ifTrue:[
- checkBlock := [:src | src includesString:aString caseSensitive:false]
- ] ifFalse:[
- checkBlock := [:src | src includesString:aString caseSensitive:true]
- ].
+ checkBlock := [:src | src includesString:aString caseSensitive:ignoreCase not]
].
+
^ [:cls :mthd :sel |
- |src|
-
+ |src found idx1 reallyFound ch1 ch2|
+
+ found := false.
src := mthd source.
src isNil ifTrue:[
('Browser [info]: no source for ' , mthd printString) infoPrintCR.
- false
] ifFalse:[
- checkBlock value:src
- ]
+ 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 isLetter or:[ch1 == $_]) ifTrue:[ reallyFound := false].
+ ].
+ (idx1+aString size-1) < src size ifTrue:[
+ ch2 := src at:idx1+aString size.
+ (ch2 isLetter or:[ch2 == $_]) ifTrue:[ reallyFound := false].
+ ].
+ ].
+ found := reallyFound
+ ].
+ ].
+ ].
+ found
]
"
@@ -5783,6 +5866,21 @@
searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
"return a block to search for a string-literal."
+ ^ self
+ searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
+ fullWordsOnly: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
+ "
+!
+
+searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg fullWordsOnly:fullWordsOnly
+ "return a block to search for a string-literal."
+
|pattern doMatch checkLiteral checkSource
quickCheckString firstMatchIndex lastMatchIndex|
@@ -6992,8 +7090,8 @@
('*>>*' match:sel) ifTrue:[
sep := $>
] ifFalse:[
- ('*»*' match:sel) ifTrue:[
- sep := $»
+ ('*»*' match:sel) ifTrue:[
+ sep := $»
] ifFalse:[
('* *' match:sel) ifTrue:[
sep := Character space
@@ -7032,7 +7130,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:[
@@ -7082,7 +7180,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:'''
@@ -7255,7 +7353,7 @@
].
selector notNil ifTrue:[
aGCOrStream
- nextPutAll:' » ';
+ nextPutAll:' » ';
emphasis:#bold;
nextPutAll:selector;
emphasis:nil.