SystemBrowser.st
changeset 16462 b6190d4c7f4c
parent 16451 50d4e491a50e
child 16468 3df3e4d3ea9d
equal deleted inserted replaced
16461:a3f5e981e592 16462:b6190d4c7f4c
  5167      specialized blocks are returned, depending on whether a selector-match or casesensitive
  5167      specialized blocks are returned, depending on whether a selector-match or casesensitive
  5168      search is wanted 
  5168      search is wanted 
  5169      (these operations are executed a zillion times in an inner loop,
  5169      (these operations are executed a zillion times in an inner loop,
  5170       therefore, the speedup is noticable)"
  5170       therefore, the speedup is noticable)"
  5171      
  5171      
  5172     |doMatch sel lcString quickSearch idx|
  5172     |doMatch sel quickSearch idx|
  5173 
  5173 
  5174     doMatch := doMatchArg.
  5174     doMatch := doMatchArg.
  5175     (doMatch and:[aSelectorString = '*']) ifTrue:[
  5175     (doMatch and:[aSelectorString = '*']) ifTrue:[
  5176         "a trivial block, which matches everything"
  5176         "a trivial block, which matches everything"
  5177         ^ [:class :method :s | true].
  5177         ^ [:class :method :s | true].
  5181         doMatch := false
  5181         doMatch := false
  5182     ].
  5182     ].
  5183     
  5183     
  5184     (doMatch or:[ignoreCase]) ifTrue:[
  5184     (doMatch or:[ignoreCase]) ifTrue:[
  5185         "/ a matchString or ignoreCase - need string matching procedure
  5185         "/ a matchString or ignoreCase - need string matching procedure
  5186 
       
  5187         ignoreCase ifTrue:[
       
  5188             lcString := aSelectorString asLowercase.
       
  5189         ] ifFalse:[
       
  5190             lcString := aSelectorString.
       
  5191         ].
       
  5192 
  5186 
  5193         quickSearch := aSelectorString.
  5187         quickSearch := aSelectorString.
  5194         (quickSearch startsWith:'*') ifTrue:[
  5188         (quickSearch startsWith:'*') ifTrue:[
  5195             quickSearch := quickSearch copyButFirst
  5189             quickSearch := quickSearch copyButFirst
  5196         ].
  5190         ].
  5205         ].
  5199         ].
  5206         
  5200         
  5207         (ignoreCase and:[quickSearch includesMatchCharacters not]) ifTrue:[
  5201         (ignoreCase and:[quickSearch includesMatchCharacters not]) ifTrue:[
  5208             doMatch ifFalse:[
  5202             doMatch ifFalse:[
  5209                 ^ [:class :methodArg :s |
  5203                 ^ [:class :methodArg :s |
  5210                     |method src inLiterals lcQuickSearch skip|
  5204                     |method src inLiterals skip|
  5211 
  5205 
  5212                     inLiterals := skip := false.
  5206                     inLiterals := skip := false.
  5213                     method := methodArg originalMethodIfWrapped.
  5207                     method := methodArg originalMethodIfWrapped.
  5214                     method isLazyMethod ifTrue:[
  5208                     method isLazyMethod ifTrue:[
  5215                         src := method source.
  5209                         src := method source.
  5218                         ] ifFalse:[
  5212                         ] ifFalse:[
  5219                             skip := true
  5213                             skip := true
  5220                         ].    
  5214                         ].    
  5221                     ].
  5215                     ].
  5222                     skip ifFalse:[
  5216                     skip ifFalse:[
  5223                         inLiterals := (method 
  5217                         inLiterals := 
  5224                                             literalsDetect:[:aLiteral|
  5218                             (method 
  5225                                                 (aLiteral isMemberOf:Symbol) 
  5219                                 literalsDetect:[:aLiteral|
  5226                                                 and:[(aLiteral sameAs:aSelectorString)]] 
  5220                                     (aLiteral isMemberOf:Symbol) 
  5227                                             ifNone:nil) notNil
  5221                                     and:[(aLiteral sameAs:aSelectorString)]] 
       
  5222                                 ifNone:nil) notNil
  5228                     ].
  5223                     ].
  5229 
  5224 
  5230                     inLiterals 
  5225                     inLiterals 
  5231                     and:[
  5226                     and:[
  5232                         method messagesSent contains:[:msg | msg sameAs:aSelectorString ]
  5227                         method messagesSent contains:[:msg | msg sameAs:aSelectorString ]
  5233                     ]
  5228                     ]
  5234                ].
  5229                ].
  5235             ].
  5230             ].
  5236             
  5231             
  5237             ^ [:class :methodArg :s |
  5232             ^ [:class :methodArg :s |
  5238                 |method src inLiterals lcQuickSearch skip|
  5233                 |method src inLiterals skip|
  5239 
  5234 
  5240                 inLiterals := skip := false.
  5235                 inLiterals := skip := false.
  5241                 method := methodArg originalMethodIfWrapped.
  5236                 method := methodArg originalMethodIfWrapped.
  5242                 method isLazyMethod ifTrue:[
  5237                 method isLazyMethod ifTrue:[
  5243                     src := method source.
  5238                     src := method source.
  5246                     ] ifFalse:[
  5241                     ] ifFalse:[
  5247                         skip := true
  5242                         skip := true
  5248                     ].
  5243                     ].
  5249                 ].    
  5244                 ].    
  5250                 skip ifFalse:[
  5245                 skip ifFalse:[
  5251                     inLiterals := (method 
  5246                     inLiterals := 
  5252                                         literalsDetect:[:aLiteral|
  5247                         (method 
  5253                                             (aLiteral isMemberOf:Symbol) 
  5248                             literalsDetect:[:aLiteral|
  5254                                             and:[(aLiteral includesString:quickSearch caseSensitive:false)
  5249                                 (aLiteral isMemberOf:Symbol) 
  5255                                             and:[(lcString match:aLiteral caseSensitive:false)]]] 
  5250                                 and:[(aLiteral includesString:quickSearch caseSensitive:false)
  5256                                         ifNone:nil) notNil
  5251                                 and:[(aSelectorString match:aLiteral caseSensitive:false)]]] 
       
  5252                             ifNone:nil) notNil
  5257                 ].
  5253                 ].
  5258       
  5254       
  5259                 inLiterals 
  5255                 inLiterals 
  5260                 and:[
  5256                 and:[
  5261                     method messagesSent contains:[:sel | aSelectorString match:aSelectorString caseSensitive:false]
  5257                     method messagesSent 
       
  5258                         contains:[:sel | aSelectorString match:aSelectorString caseSensitive:false]
  5262                 ]
  5259                 ]
  5263            ].
  5260            ].
  5264         ].
  5261         ].
  5265         
  5262         
  5266         (ignoreCase or:[quickSearch includesMatchCharacters]) ifFalse:[
  5263         (ignoreCase or:[quickSearch includesMatchCharacters]) ifFalse:[
  5276                     ] ifFalse:[
  5273                     ] ifFalse:[
  5277                         skip := true
  5274                         skip := true
  5278                     ].    
  5275                     ].    
  5279                 ].    
  5276                 ].    
  5280                 skip ifFalse:[
  5277                 skip ifFalse:[
  5281                     inLiterals := (method 
  5278                     inLiterals := 
  5282                                         literalsDetect:[:aLiteral|
  5279                         (method 
  5283                                             (aLiteral isMemberOf:Symbol) 
  5280                             literalsDetect:[:aLiteral|
  5284                                             and:[(lcString includesString:quickSearch)
  5281                                 (aLiteral isMemberOf:Symbol) 
  5285                                             and:[(lcString match:aLiteral)]]] 
  5282                                 and:[(aLiteral includesString:quickSearch)
  5286                                         ifNone:nil) notNil
  5283                                 and:[(aSelectorString match:aLiteral)]]] 
       
  5284                             ifNone:nil) notNil
  5287                 ].
  5285                 ].
  5288                 inLiterals and:[ method messagesSent includes:aSelectorString]
  5286                 inLiterals and:[ method messagesSent includes:aSelectorString]
  5289            ].
  5287            ].
  5290         ]. 
  5288         ]. 
  5291         ^ [:class :methodArg :s |
  5289         ^ [:class :methodArg :s |
  5301                 ] ifFalse:[
  5299                 ] ifFalse:[
  5302                     skip := true.
  5300                     skip := true.
  5303                 ].
  5301                 ].
  5304             ].    
  5302             ].    
  5305             skip ifFalse:[
  5303             skip ifFalse:[
  5306                 inLiterals := (method literalsDetect:[:aLiteral|
  5304                 inLiterals := 
  5307                                         (aLiteral isMemberOf:Symbol) 
  5305                     (method literalsDetect:[:aLiteral|
  5308                                         and:[(ignoreCase and:[lcString match:aLiteral asLowercase])
  5306                         (aLiteral isMemberOf:Symbol) 
  5309                                             or:[ignoreCase not and:[lcString match:aLiteral]]]] 
  5307                         and:[ aSelectorString match:aLiteral asLowercase caseSensitive:ignoreCase not]
  5310                                     ifNone:nil) notNil
  5308                     ] ifNone:nil) notNil
  5311             ].
  5309             ].
  5312             inLiterals 
  5310             inLiterals 
  5313             and:[ 
  5311             and:[ 
  5314                 method messagesSent 
  5312                 method messagesSent 
  5315                     contains:[:anySelector | 
  5313                     contains:[:anySelector | 
  5718 !
  5716 !
  5719 
  5717 
  5720 searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
  5718 searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
  5721     "return a block to search for a string-literal."
  5719     "return a block to search for a string-literal."
  5722 
  5720 
  5723     |pattern s doMatch checkLiteral|
  5721     |pattern doMatch checkLiteral checkSource quickCheckString firstMatchIndex lastMatchIndex|
  5724 
  5722 
  5725     aString isEmpty ifTrue:[^ [:cls :mthd :sel | true ]].
  5723     aString isEmpty ifTrue:[^ [:cls :mthd :sel | true ]].
  5726     
  5724     
  5727     doMatch := doMatchArg.
  5725     doMatch := doMatchArg.
  5728     (aString includesMatchCharacters) ifFalse:[
  5726     (aString includesMatchCharacters) ifFalse:[
  5735             pattern := '*',pattern
  5733             pattern := '*',pattern
  5736         ].    
  5734         ].    
  5737         aString last == $* ifFalse:[
  5735         aString last == $* ifFalse:[
  5738             pattern := pattern,'*'
  5736             pattern := pattern,'*'
  5739         ].
  5737         ].
  5740         checkLiteral := 
  5738         checkLiteral := [:lit | pattern match:lit caseSensitive:ignoreCase not].
  5741             [:lit |
  5739         firstMatchIndex := aString indexOfAny:'*#['.
  5742                 lit isString
  5740         lastMatchIndex := aString lastIndexOfAny:'*#['.
  5743                 and:[lit isSymbol not
  5741         "/ which is longer - left or right part
  5744                 and:[s match:lit caseSensitive:ignoreCase not]]
  5742         firstMatchIndex-1 "nleft" > (aString size-lastMatchIndex) "nright" ifTrue:[
  5745             ]
  5743             "/ use left part as quickSearch
       
  5744             quickCheckString := aString copyTo:firstMatchIndex-1
       
  5745         ] ifFalse:[
       
  5746             "/ use right part as quickSearch
       
  5747             quickCheckString := aString copyFrom:lastMatchIndex+1            
       
  5748         ].    
       
  5749         quickCheckString size > 1 ifTrue:[
       
  5750             checkSource := [:src | src includesString:quickCheckString caseSensitive:ignoreCase not]
       
  5751         ] ifFalse:[
       
  5752             checkSource := [:src | true]. "/ not worth the effort
       
  5753         ].    
  5746     ] ifFalse:[
  5754     ] ifFalse:[
  5747         ignoreCase ifTrue:[
  5755         ignoreCase ifTrue:[
  5748             checkLiteral :=
  5756             checkLiteral := [:lit | lit includesString:aString caseSensitive:true].
  5749                 [:lit |
  5757             checkSource := [:src | src includesString:aString caseSensitive:true].
  5750                     lit isString
       
  5751                     and:[lit isSymbol not
       
  5752                     and:[lit includesString:aString caseSensitive:true]]
       
  5753                 ]
       
  5754         ] ifFalse:[
  5758         ] ifFalse:[
  5755             checkLiteral :=
  5759             checkLiteral := [:lit | lit includesString:aString].
  5756                 [:lit |
  5760             checkSource := [:src | src includesString:aString].
  5757                     lit isString
       
  5758                     and:[lit isSymbol not
       
  5759                     and:[lit includesString:aString]]
       
  5760                 ]
       
  5761         ].    
  5761         ].    
  5762     ].
  5762     ].
  5763         
  5763         
  5764     ^ [:cls :mthd :sel | 
  5764     ^ [:cls :methodArg :sel | 
  5765         (mthd literalsDetect:checkLiteral ifNone:[nil]) notNil
  5765         "/ sorry: the following does not work, because stc does not place string-constants
       
  5766         "/ into the literals.
       
  5767         "/        (mthd literalsDetect:[:lit |
       
  5768         "/            lit isString
       
  5769         "/            and:[ lit isSymbol not
       
  5770         "/            and:[ checkLiteral value:lit ]]
       
  5771         "/        ] ifNone:[nil]) 
       
  5772         "/            notNil
       
  5773         "/ so we must parse here (sigh)
       
  5774         
       
  5775         |method src skip tree found|
       
  5776 
       
  5777         skip := found := false.
       
  5778         method := methodArg originalMethodIfWrapped.
       
  5779         method isLazyMethod ifTrue:[
       
  5780             src := method source.
       
  5781             (src notNil) ifTrue:[
       
  5782                 method makeRealMethod.
       
  5783             ] ifFalse:[
       
  5784                 skip := true
       
  5785             ].    
       
  5786         ].
       
  5787         skip ifFalse:[
       
  5788             src := method source.
       
  5789             (src includes:$') ifTrue:[ "/ eliminates many
       
  5790                 (checkSource value:src) ifTrue:[
       
  5791                     tree := cls parseTreeFor:sel.
       
  5792                     "/ walk
       
  5793                     found :=
       
  5794                         tree usedLiterals contains:[:lit |
       
  5795                             lit isString
       
  5796                             and:[ lit isSymbol not
       
  5797                             and:[ checkLiteral value:lit ]]]
       
  5798                 ].        
       
  5799             ].        
       
  5800         ].
       
  5801         found
  5766       ]
  5802       ]
  5767 
  5803 
  5768     "
  5804     "
  5769      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
  5805      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
  5770      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
  5806      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false