SystemBrowser.st
branchjv
changeset 16459 85d703589d34
parent 16445 6bc184e74f9c
parent 16451 50d4e491a50e
child 16570 dc5e958a20dc
equal deleted inserted replaced
16445:6bc184e74f9c 16459:85d703589d34
  2592 ! !
  2592 ! !
  2593 
  2593 
  2594 !SystemBrowser class methodsFor:'special search startup'!
  2594 !SystemBrowser class methodsFor:'special search startup'!
  2595 
  2595 
  2596 allCallsOn:aSelectorString
  2596 allCallsOn:aSelectorString
  2597     "return a collection of methods which send aSelector."
  2597     "return a collection of methods which send aSelector.
       
  2598      This takes some time, because source code is parsed to see
       
  2599      if there is really a message send inside (and not just a symbol reference)"
  2598 
  2600 
  2599     ^ self 
  2601     ^ self 
  2600         allCallsOn:aSelectorString 
  2602         allCallsOn:aSelectorString 
  2601         in:(Smalltalk allClasses) 
  2603         in:(Smalltalk allClasses) 
  2602         ignoreCase:false 
  2604         ignoreCase:false 
  2603         match:false
  2605         match:false
  2604 
  2606 
  2605     "
  2607     "
  2606      SystemBrowser allCallsOn:#at:put:
  2608      Time millisecondsToRun:[
       
  2609          SystemBrowser allCallsOn:#at:put:
       
  2610      ].            
  2607     "
  2611     "
  2608 
  2612 
  2609     "Created: 24.1.1997 / 19:42:57 / cg"
  2613     "Created: 24.1.1997 / 19:42:57 / cg"
  2610 !
  2614 !
  2611 
  2615 
  5664     ].
  5668     ].
  5665 
  5669 
  5666     "Modified: / 24-07-2011 / 09:50:30 / cg"
  5670     "Modified: / 24-07-2011 / 09:50:30 / cg"
  5667 !
  5671 !
  5668 
  5672 
  5669 searchBlockForString:aString ignoreCase:ignoreCase match:doMatch
  5673 searchBlockForString:aString ignoreCase:ignoreCase match:doMatchArg
  5670     "return a block to search for a string."
  5674     "return a block to search for a string."
  5671 
  5675 
  5672     |searchBlock s lcString|
  5676     |checkBlock pattern doMatch|
  5673 
  5677 
  5674     (doMatch and:[ aString includesMatchCharacters ]) ifTrue:[
  5678     doMatch := doMatchArg.
  5675         s := '*' , aString , '*'.
  5679     aString includesMatchCharacters ifFalse:[
       
  5680         doMatch := false.
       
  5681     ].    
       
  5682     doMatch ifTrue:[
  5676         "a matchString"
  5683         "a matchString"
  5677         searchBlock := [:c :m :sel | 
  5684         pattern := aString.    
  5678                             |src|       
  5685         aString first == $* ifFalse:[
  5679                             src := m source.
  5686             pattern := '*',pattern
  5680                             src isNil ifTrue:[
  5687         ].    
  5681                                 ('Browser [info]: no source for ' , m printString) infoPrintCR.
  5688         aString last == $* ifFalse:[
  5682                                 false
  5689             pattern := pattern,'*'
  5683                             ] ifFalse:[
  5690         ].
  5684                                 s match:src caseSensitive:ignoreCase not
  5691         ignoreCase ifTrue:[
  5685                             ]
  5692             checkBlock := [:src | pattern match:src caseSensitive:false]
  5686                        ]
  5693         ] ifFalse:[    
       
  5694             checkBlock := [:src | pattern match:src caseSensitive:true]
       
  5695         ]
  5687     ] ifFalse:[
  5696     ] ifFalse:[
  5688         ignoreCase ifTrue:[
  5697         ignoreCase ifTrue:[
  5689             lcString := aString asLowercase.
  5698             checkBlock := [:src | src includesString:aString caseSensitive:false]
  5690             searchBlock := 
       
  5691                 [:c :m :sel | 
       
  5692                     |src|
       
  5693 
       
  5694                     src := m source.
       
  5695                     src isNil ifTrue:[
       
  5696                         ('Browser [info]: no source for ' , m printString) infoPrintCR.
       
  5697                         false
       
  5698                     ] ifFalse:[
       
  5699                         (src asLowercase findString:lcString caseSensitive:true) ~~ 0
       
  5700                     ]
       
  5701                ]
       
  5702         ] ifFalse:[
  5699         ] ifFalse:[
  5703             searchBlock := 
  5700             checkBlock := [:src | src includesString:aString caseSensitive:true]
  5704                 [:c :m :sel | 
  5701         ].    
  5705                     |src|
  5702     ].
  5706 
  5703     ^ [:cls :mthd :sel | 
  5707                     src := m source.
  5704         |src|
  5708                     src isNil ifTrue:[
  5705 
  5709                         ('Browser [info]: no source for ' , m printString) infoPrintCR.
  5706         src := mthd source.
  5710                         false
  5707         src isNil ifTrue:[
  5711                     ] ifFalse:[
  5708             ('Browser [info]: no source for ' , mthd printString) infoPrintCR.
  5712                         (src findString:aString caseSensitive:ignoreCase not) ~~ 0
  5709             false
  5713                     ]
  5710         ] ifFalse:[
  5714                ]
  5711             checkBlock value:src
       
  5712         ]
       
  5713       ]
       
  5714 
       
  5715     "
       
  5716      SystemBrowser findString:'should'   in:(Array with:Object) ignoreCase:false
       
  5717     "
       
  5718 !
       
  5719 
       
  5720 searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatchArg
       
  5721     "return a block to search for a string-literal."
       
  5722 
       
  5723     |pattern s doMatch checkLiteral|
       
  5724 
       
  5725     aString isEmpty ifTrue:[^ [:cls :mthd :sel | true ]].
       
  5726     
       
  5727     doMatch := doMatchArg.
       
  5728     (aString includesMatchCharacters) ifFalse:[
       
  5729         doMatch := false
       
  5730     ].
       
  5731     doMatch ifTrue:[
       
  5732         "a matchString"
       
  5733         pattern := aString.    
       
  5734         aString first == $* ifFalse:[
       
  5735             pattern := '*',pattern
       
  5736         ].    
       
  5737         aString last == $* ifFalse:[
       
  5738             pattern := pattern,'*'
  5715         ].
  5739         ].
  5716     ].
  5740         checkLiteral := 
  5717     ^ searchBlock.
  5741             [:lit |
  5718 
  5742                 lit isString
  5719     "
  5743                 and:[lit isSymbol not
  5720      SystemBrowser findString:'should'   in:(Array with:Object) ignoreCase:false
  5744                 and:[s match:lit caseSensitive:ignoreCase not]]
  5721     "
  5745             ]
  5722 !
       
  5723 
       
  5724 searchBlockForStringLiteral:aString ignoreCase:ignoreCase match:doMatch
       
  5725     "return a block to search for a string-literal."
       
  5726 
       
  5727     |searchBlock s|
       
  5728 
       
  5729     (doMatch and:[ aString includesMatchCharacters]) ifTrue:[
       
  5730         s := '*' , aString , '*'.
       
  5731         "a matchString"
       
  5732         searchBlock := [:c :m :sel | 
       
  5733                             |lits|       
       
  5734                             lits := m literals ? #().
       
  5735                             lits contains:[:lit |
       
  5736                                 lit isString
       
  5737                                 and:[lit isSymbol not
       
  5738                                 and:[s match:lit caseSensitive:ignoreCase not]]
       
  5739                             ]
       
  5740                        ]
       
  5741     ] ifFalse:[
  5746     ] ifFalse:[
  5742         ignoreCase ifTrue:[
  5747         ignoreCase ifTrue:[
  5743             s := aString asLowercase.
  5748             checkLiteral :=
  5744             searchBlock := [:c :m :sel | 
  5749                 [:lit |
  5745                                 |lits|       
  5750                     lit isString
  5746                                 lits := m literals ? #().
  5751                     and:[lit isSymbol not
  5747                                 lits contains:[:lit |
  5752                     and:[lit includesString:aString caseSensitive:true]]
  5748                                     lit isString
  5753                 ]
  5749                                     and:[lit isSymbol not
       
  5750                                     and:[s = lit asLowercase]]
       
  5751                                 ]
       
  5752                            ]
       
  5753         ] ifFalse:[
  5754         ] ifFalse:[
  5754             searchBlock := [:c :m :sel | 
  5755             checkLiteral :=
  5755                                 |lits|       
  5756                 [:lit |
  5756                                 lits := m literals ? #().
  5757                     lit isString
  5757                                 lits contains:[:lit |
  5758                     and:[lit isSymbol not
  5758                                     lit isString
  5759                     and:[lit includesString:aString]]
  5759                                     and:[lit isSymbol not
  5760                 ]
  5760                                     and:[s = lit]]
  5761         ].    
  5761                                 ]
  5762     ].
  5762                            ]
  5763         
  5763         ].
  5764     ^ [:cls :mthd :sel | 
  5764     ].
  5765         (mthd literalsDetect:checkLiteral ifNone:[nil]) notNil
  5765     ^ searchBlock.
  5766       ]
  5766 
  5767 
  5767     "
  5768     "
  5768      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
  5769      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:true
  5769      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
  5770      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:true match:false
  5770      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:false match:true
  5771      SystemBrowser findStringLiteral:'error' in:(Array with:Object) ignoreCase:false match:true
  6278 
  6279 
  6279 findMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock
  6280 findMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock
  6280     "return all instance- (if wantInst is true) and/or classmethods (if wantClass is true) 
  6281     "return all instance- (if wantInst is true) and/or classmethods (if wantClass is true) 
  6281      from classes in aCollectionOfClasses, where aBlock evaluates to true."
  6282      from classes in aCollectionOfClasses, where aBlock evaluates to true."
  6282 
  6283 
  6283     |list checkedClasses checkBlock nClasses nClassesDone oldPercentage newPercentage|
  6284     |list checkedClasses checkBlock nClasses 
       
  6285      nClassesDone oldPercentage newPercentage nClassesSinceLastPercentage bulkSize|
  6284 
  6286 
  6285     checkedClasses := IdentitySet new.
  6287     checkedClasses := IdentitySet new.
  6286     list := OrderedCollection new.
  6288     list := OrderedCollection new.
  6287 
  6289 
  6288     checkBlock := [:cls |
  6290     checkBlock := [:cls |
  6309     ].
  6311     ].
  6310 
  6312 
  6311     nClasses := aCollectionOfClasses size.
  6313     nClasses := aCollectionOfClasses size.
  6312     nClassesDone := 0.
  6314     nClassesDone := 0.
  6313     oldPercentage := 0.
  6315     oldPercentage := 0.
       
  6316     nClassesSinceLastPercentage := 0.
       
  6317     bulkSize := (nClasses // 30) max:10. "/ roughly every 3%.
  6314     
  6318     
  6315     aCollectionOfClasses do:[:aClass |
  6319     aCollectionOfClasses do:[:aClass |
  6316         (aClass notNil and:[aClass isObsolete not]) ifTrue:[
  6320         (aClass notNil and:[aClass isObsolete not]) ifTrue:[
       
  6321             nClassesSinceLastPercentage := nClassesSinceLastPercentage + 1.
       
  6322             
  6317             "
  6323             "
  6318              output disabled - it slows down things too much (when searching for
  6324              output disabled - it slows down things too much (when searching for
  6319              implementors or senders)
  6325              implementors or senders)
  6320             "
  6326             "
  6321             wantInst ifTrue:[
  6327             wantInst ifTrue:[
  6324             ].
  6330             ].
  6325             wantClass ifTrue:[
  6331             wantClass ifTrue:[
  6326 "/                Transcript show:'searching '; show:aClass class name; showCR:' ...'; endEntry.
  6332 "/                Transcript show:'searching '; show:aClass class name; showCR:' ...'; endEntry.
  6327                 checkBlock value:(aClass class)
  6333                 checkBlock value:(aClass class)
  6328             ].
  6334             ].
  6329             nClassesDone > 5 ifTrue:[
  6335             nClassesSinceLastPercentage > bulkSize ifTrue:[
  6330                 "/ Processor yield
  6336                 "/ Processor yield
  6331                 newPercentage := nClassesDone * 100 // nClasses.
  6337                 newPercentage := nClassesDone * 100 // nClasses.
  6332                 newPercentage ~= oldPercentage ifTrue:[
  6338                 newPercentage ~= oldPercentage ifTrue:[
  6333                     ProgressNotification progressPercentage:newPercentage.
  6339                     ProgressNotification progressPercentage:newPercentage.
  6334                     oldPercentage := newPercentage.
  6340                     oldPercentage := newPercentage.
  6335                 ].
  6341                 ].
       
  6342                 nClassesSinceLastPercentage := 0.
  6336             ].
  6343             ].
  6337         ].
  6344         ].
  6338         nClassesDone := nClassesDone + 1.
  6345         nClassesDone := nClassesDone + 1.
  6339     ].
  6346     ].
  6340     ^ list
  6347     ^ list