--- a/SystemBrowser.st Fri Nov 30 14:25:59 2012 +0000
+++ b/SystemBrowser.st Fri Nov 30 17:23:39 2012 +0000
@@ -803,6 +803,26 @@
"Modified: / 20-07-2007 / 09:15:37 / cg"
!
+breakPointedIcon
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self breakPointedIcon inspect
+ ImageEditor openOnClass:self andSelector:#breakPointedIcon
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^Icon
+ constantNamed:'SystemBrowser breakPointedIcon'
+ ifAbsentPut:[(Depth4Image new) width: 13; height: 11; photometric:(#palette); bitsPerSample:(#[4]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@P@@L3@@@@$@L@@@L@@H@@@C@@@@APL@DQ@C@@@C@1DS@0@B@0@QD@L@@@@@@0@@@@@@L@@@L@@@@@@3L@@@@ @@@@@@@@ b') ; colorMapFromArray:#[255 0 0 255 255 255 0 0 0 255 199 199]; mask:((Depth1Image new) width: 13; height: 11; photometric:(#blackIs0); bitsPerSample:(#(1)); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@N@C>@O8A?0G?@_<@? C>@C @@@@@a') ; yourself); yourself]
+!
+
canvasIcon
"This resource specification was automatically generated
by the ImageEditor of ST/X."
@@ -3562,7 +3582,8 @@
filterToSearchRefsTo:varName
instVars:(classVars not)
classVars:classVars
- globals:false
+ globals:false
+ poolVars:false
access:accessType
!
@@ -3578,12 +3599,25 @@
filterToSearchRefsTo:varName instVars:doInstVars classVars:doClassVars globals:doGlobals access:accessType
"return a searchblock for variable references"
- |searchBlock|
+ ^ self
+ filterToSearchRefsTo:varName instVars:doInstVars classVars:doClassVars globals:doGlobals
+ poolVars:false access:accessType
+!
+
+filterToSearchRefsTo:varName instVars:doInstVars classVars:doClassVars globals:doGlobals poolVars:doPoolVars access:accessType
+ "return a searchblock for variable references"
+
+ |searchBlock needMatch baseVarName|
+
+ needMatch := varName includesMatchCharacters.
+ (varName includes:$:) ifTrue:[
+ baseVarName := varName copyFrom:(varName lastIndexOf:$:)+1
+ ] ifFalse:[
+ baseVarName := varName
+ ].
searchBlock := [:c :m :s |
- |src result parser vars instVars classVars globals needMatch|
-
- needMatch := varName includesMatchCharacters.
+ |src result parser vars instVars classVars poolVars globals|
result := false.
@@ -3594,11 +3628,7 @@
before doing a slow parse, quickly scan the
method's source for the variable's name ...
"
- (varName includes:$:) ifTrue:[
- result := (src findString:(varName copyFrom:(varName lastIndexOf:$:)+1)) ~~ 0.
- ] ifFalse:[
- result := (src findString:varName) ~~ 0.
- ].
+ result := (src findString:baseVarName) ~~ 0.
] ifTrue:[
result := true.
].
@@ -3636,6 +3666,18 @@
].
vars addAll:classVars.
].
+ doPoolVars ifTrue:[
+ accessType == #read ifTrue:[
+ poolVars := parser readPoolVars
+ ] ifFalse:[
+ accessType == #write ifTrue:[
+ poolVars := parser modifiedPoolVars
+ ] ifFalse:[
+ poolVars := parser usedPoolVars
+ ]
+ ].
+ vars addAll:poolVars.
+ ].
doGlobals ifTrue:[
accessType == #read ifTrue:[
globals := parser readGlobals
@@ -4085,6 +4127,20 @@
match:doMatch
!
+findPoolVarRefsTo:aString inClass:aClass access:accessType
+ "return all methods in aClass where the pool variable named aString is referenced;
+ if modsOnly is true, browse only methods where the classvar is modified"
+
+ |filter|
+
+ filter := self
+ filterToSearchRefsTo:aString
+ instVars:false classVars:false globals:false poolVars:true
+ access:accessType.
+
+ ^ self findMethodsIn:(Array with:aClass) inst:true class:true where:filter.
+!
+
findRefsTo:varName classVars:classVars in:aCollectionOfClasses access:accessType
"return a list of all methods in aCollectionOfClasses where the instVar/classVar named
varName is referenced;
@@ -4566,6 +4622,7 @@
"/ extract messages sent by the pattern
Error handle:[:ex |
+self halt.
] do:[
sentMessages := searchTree sentMessages.
].
@@ -4594,15 +4651,12 @@
]
].
- usedSymbols := searchTree usedSymbols.
- usedStrings := searchTree usedLiterals select:[:lit | lit isString].
-
"/ sorry:
"/ cannot use literals to speedup the search, because stc does not store
- "/ constants in the literal-array.
- "/ otherwise, add:
- "/ literalsUsed := searchTree usedLiterals.
- "/ literalsUsed := literalsUsed select:[:lit | lit isString].
+ "/ constants in the literal-array. However, we can do a string search on
+ "/ them, to avoid parsing.
+ usedSymbols := searchTree usedSymbols.
+ usedStrings := searchTree usedLiterals select:[:lit | lit isString].
searcher := ParseTreeSearcher new.
isMethod ifTrue:[
@@ -4616,7 +4670,7 @@
].
searchBlock := [:c :m :sel |
- |allSelectorsInLiteralArray allMessagesSent
+ |isSTCCompiled allSelectorsInLiteralArray allMessagesSent
allGlobalsReferenced allUsedSymbolsInLiteralArray allStringsInLiteralArray
allSent src rslt parseTree
literalsInMethod|
@@ -4633,15 +4687,22 @@
m makeRealMethod.
].
].
- "/ can speedup the search, by filtering for sent messages and used globals first...
+ "/ can speedup the search, by filtering for sent messages...
literalsInMethod := m literals.
allSelectorsInLiteralArray := sentMessages isEmptyOrNil or:[ literalsInMethod includesAll:sentMessages ].
allSelectorsInLiteralArray ifTrue:[
+ "/ and used symbols/globals first...
allUsedSymbolsInLiteralArray := usedSymbols isEmptyOrNil or:[ literalsInMethod includesAll:usedSymbols ].
allUsedSymbolsInLiteralArray ifTrue:[
"/ not true, but I am lazy: if ANY string is in match, ANY string must be in method
- allStringsInLiteralArray := usedStrings isEmptyOrNil
- or:[ literalsInMethod contains:[:lit | lit isString] ].
+ "/ that does not work for stc compiled code, because it does not put strings into the literal array
+ isSTCCompiled := m byteCode isNil.
+ isSTCCompiled ifTrue:[
+ allStringsInLiteralArray := true. "/ stc-compiled: don't know
+ ] ifFalse:[
+ allStringsInLiteralArray := usedStrings isEmptyOrNil
+ or:[ literalsInMethod includesAll:usedStrings "literalsInMethod contains:[:lit | lit isString]" ].
+ ].
allStringsInLiteralArray ifTrue:[
allGlobalsReferenced := globalVariablesUsed conform:[:varNames | varNames contains:[:varName | m referencesGlobal:varName]].
allGlobalsReferenced ifTrue:[
@@ -4652,21 +4713,29 @@
src := m source.
src isNil ifTrue:[
('Browser [info]: no source for ' , m printString) infoPrintCR.
- false
] ifFalse:[
- "/ the rest is done by the slower RB-match process...
- parseTree := RBParser
- parseSearchMethod:src
- onError: [:str :pos |
- "/ self halt.
- Transcript show:'Error during search in '; showCR:m.
- Transcript showCR:str.
- Transcript showCR:pos.
- nil].
-
- parseTree notNil ifTrue:[
- searcher executeTree:parseTree.
- "/ notice: searcher sets foundMatch !!
+ isSTCCompiled ifTrue:[
+ usedStrings notEmptyOrNil ifTrue:[
+ "/ now that we have the source, scan the source for the literal strings,
+ "/ before doing a slow parse
+ allStringsInLiteralArray := usedStrings conform:[:eachString | src includesString:eachString].
+ ]
+ ].
+ allStringsInLiteralArray ifTrue:[
+ "/ the rest is done by the slower RB-match process...
+ parseTree := RBParser
+ parseSearchMethod:src
+ onError: [:str :pos |
+ "/ self halt.
+ Transcript show:'Error during search in '; showCR:m.
+ Transcript showCR:str.
+ Transcript showCR:pos.
+ nil].
+
+ parseTree notNil ifTrue:[
+ searcher executeTree:parseTree.
+ "/ notice: searcher sets foundMatch !!
+ ].
].
]
]
@@ -4749,8 +4818,7 @@
globalsPlainName := aGlobalName.
(idx := globalsPlainName lastIndexOf:$:) ~~ 0 ifTrue:[
globalsPlainName := globalsPlainName copyFrom:idx+1.
- (globalsPlainName size == 0
- or:[globalsPlainName = '*']) ifTrue:[
+ (globalsPlainName size == 0 or:[globalsPlainName = '*']) ifTrue:[
globalsPlainName := aGlobalName
]
].
@@ -4763,6 +4831,9 @@
(sym1 isNil and:[ sym2 isNil ]) ifTrue:[
^ [:cls :mthd :sel | false ].
].
+ "/ if any is nil, search for the same
+ sym1 := sym1 ? sym2.
+ sym2 := sym2 ? sym1.
^ [:cls :mthd :sel |
|mSource ok m usedGlobals|
@@ -4772,11 +4843,12 @@
mthd isLazyMethod ifTrue:[
mSource := mthd source.
(mSource notNil) ifTrue:[
- (mSource includesString:sym2) ifTrue:[
- (mthd usedGlobals includes:sym1) ifTrue:[
+ (mSource includesString:(sym2)) ifTrue:[
+ usedGlobals := mthd usedGlobals.
+ (usedGlobals includes:sym1) ifTrue:[
ok := true
] ifFalse:[
- (mthd usedGlobals includes:sym2) ifTrue:[
+ (sym1 ~= sym2 and:[usedGlobals includes:sym2]) ifTrue:[
ok := true
]
]
@@ -4787,9 +4859,9 @@
m := m originalMethod.
].
- ((m refersToLiteral:sym1) or:[ (m refersToLiteral:sym2) ]) ifTrue:[
+ ((m refersToLiteral:sym1) or:[ sym1 ~= sym2 and:[m refersToLiteral:sym2] ]) ifTrue:[
usedGlobals := m usedGlobals.
- ok := (usedGlobals includes:sym1) or:[ (usedGlobals includes:sym2) ]
+ ok := (usedGlobals includes:sym1) or:[ sym1 ~= sym2 and:[usedGlobals includes:sym2] ]
].
].
ok
@@ -5410,10 +5482,18 @@
(cls isObsolete and:[cls isLoaded]) ifTrue:[
Transcript showCR:'Browser method search: 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)
- ]
+ aBlock numArgs == 1 ifTrue:[
+ cls methodDictionary keysAndValuesDo:[:sel :method |
+ (aBlock value:method) ifTrue:[
+ list add:method "/ (cls name , ' ' , sel)
+ ]
+ ].
+ ] ifFalse:[
+ cls methodDictionary keysAndValuesDo:[:sel :method |
+ (aBlock value:cls value:method value:sel) ifTrue:[
+ list add:method "/ (cls name , ' ' , sel)
+ ]
+ ].
].
checkedClasses add:cls.
]
@@ -5852,11 +5932,11 @@
!SystemBrowser class methodsFor:'documentation'!
version_CVS
- ^ '§Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.302 2012/07/20 17:32:10 cg Exp §'
+ ^ '§Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.307 2012/11/09 20:12:53 cg Exp §'
!
version_SVN
- ^ '$Id: SystemBrowser.st 8022 2012-07-25 09:51:30Z vranyj1 $'
+ ^ '$Id: SystemBrowser.st 8074 2012-11-30 17:23:39Z vranyj1 $'
! !
SystemBrowser initialize!