SystemBrowser.st
changeset 5256 c37bc91f2460
parent 5254 f3cbb68eb847
child 5270 d72d63a6dfac
equal deleted inserted replaced
5255:ef766aac9271 5256:c37bc91f2460
  2115 
  2115 
  2116     "Created: 10.7.1996 / 10:25:49 / cg"
  2116     "Created: 10.7.1996 / 10:25:49 / cg"
  2117     "Modified: 24.1.1997 / 19:49:34 / cg"
  2117     "Modified: 24.1.1997 / 19:49:34 / cg"
  2118 !
  2118 !
  2119 
  2119 
  2120 browseAllCallsOn:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase title:title
  2120 browseAllCallsOn:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase title:titleArg
  2121     "launch a browser for all senders of aSelector in aCollectionOfClasses"
  2121     "launch a browser for all senders of aSelector in aCollectionOfClasses"
  2122 
  2122 
  2123     |list browser|
  2123     |list list2 browser selWithColon title rs|
       
  2124 
       
  2125     title := titleArg.
  2124 
  2126 
  2125     list := self allCallsOn:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase match:true.
  2127     list := self allCallsOn:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase match:true.
  2126     list isEmpty ifTrue:[
  2128     list isEmpty ifTrue:[
  2127         self showNoneFound:title.
  2129         aSelectorString numArgs == 0 ifTrue:[
  2128         ^ nil
  2130             selWithColon := aSelectorString , ':'.
       
  2131             selWithColon knownAsSymbol ifTrue:[
       
  2132                 list2 := self allCallsOn:selWithColon in:aCollectionOfClasses ignoreCase:ignoreCase match:true.
       
  2133             ].            
       
  2134         ].
       
  2135         list2 size == 0 ifTrue:[
       
  2136             self showNoneFound:title.
       
  2137             ^ nil
       
  2138         ].
       
  2139         rs := self classResources.
       
  2140         (Dialog confirm:((rs string:title) , 
       
  2141                          (rs string:'...\\... none found.') ,
       
  2142                          (rs string:'\\But I found %1 sends of the "%2" message (with colon).\\Browse those ?'
       
  2143                              with:list2 size
       
  2144                              with:selWithColon allBold)) withCRs) ifFalse:[
       
  2145             ^ nil
       
  2146         ].
       
  2147         list := list2.
       
  2148         title := title , ':'.
  2129     ].
  2149     ].
  2130 
  2150 
  2131     browser := self browseMethods:list title:title.
  2151     browser := self browseMethods:list title:title.
  2132     browser notNil ifTrue:[
  2152     browser notNil ifTrue:[
  2133         |s|
  2153         |s|
  2785 
  2805 
  2786     "Created: / 10.7.1996 / 10:20:59 / cg"
  2806     "Created: / 10.7.1996 / 10:20:59 / cg"
  2787     "Modified: / 5.11.2001 / 17:30:43 / cg"
  2807     "Modified: / 5.11.2001 / 17:30:43 / cg"
  2788 !
  2808 !
  2789 
  2809 
  2790 browseImplementorsOf:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase title:title
  2810 browseImplementorsOf:aSelectorString in:aCollectionOfClasses ignoreCase:ignoreCase title:titleArg
  2791     "launch a browser for all implementors of aSelector in
  2811     "launch a browser for all implementors of aSelector in
  2792      the classes contained in aCollectionOfClasses and its metaclasses"
  2812      the classes contained in aCollectionOfClasses and its metaclasses"
  2793 
  2813 
  2794     |list|
  2814     |list list2 rs selWithColon title|
  2795 
  2815 
       
  2816     title := titleArg.
  2796     list := self 
  2817     list := self 
  2797                 findImplementorsOf:aSelectorString 
  2818                 findImplementorsOf:aSelectorString 
  2798                 in:aCollectionOfClasses 
  2819                 in:aCollectionOfClasses 
  2799                 ignoreCase:ignoreCase.
  2820                 ignoreCase:ignoreCase.
  2800 
  2821 
  2801     list size == 0 ifTrue:[
  2822     list size == 0 ifTrue:[
  2802         self showNoneFound:title.
  2823         aSelectorString numArgs == 0 ifTrue:[
  2803         ^ nil
  2824             selWithColon := aSelectorString , ':'.
       
  2825             selWithColon knownAsSymbol ifTrue:[
       
  2826                 list2 := self findImplementorsOf:selWithColon in:aCollectionOfClasses ignoreCase:ignoreCase.
       
  2827             ].            
       
  2828         ].
       
  2829         list2 size == 0 ifTrue:[
       
  2830             self showNoneFound:title.
       
  2831             ^ nil
       
  2832         ].
       
  2833         rs := self classResources.
       
  2834         (Dialog confirm:((rs string:title) , 
       
  2835                          (rs string:'...\\... none found.') ,
       
  2836                          (rs string:'\\But I found %1 implementor(s) of the "%2" message (with colon).\\Browse those ?'
       
  2837                              with:list2 size
       
  2838                              with:selWithColon allBold)) withCRs) ifFalse:[
       
  2839             ^ nil
       
  2840         ].
       
  2841         list := list2.
       
  2842         title := title , ':'.
       
  2843 
  2804     ].
  2844     ].
  2805 
  2845 
  2806     ^ self browseMethods:list asOrderedCollection title:title
  2846     ^ self browseMethods:list asOrderedCollection title:title
  2807 
  2847 
  2808     "
  2848     "
  4148 !
  4188 !
  4149 
  4189 
  4150 searchBlockForCode:aCodeString isMethod:isMethod
  4190 searchBlockForCode:aCodeString isMethod:isMethod
  4151     "return a block to search for a pice of code (intelligent search)."
  4191     "return a block to search for a pice of code (intelligent search)."
  4152 
  4192 
  4153     |errAction searchTree searcher variables messages searchBlock foundMatch|
  4193     |rule rslt errAction searchTree searcher variables messages searchBlock foundMatch|
       
  4194 
       
  4195 "/self halt.
       
  4196 "/rule := ParseTreeLintRule 
       
  4197 "/    createParseTreeRule: (Array with: aCodeString)
       
  4198 "/    method: isMethod
       
  4199 "/    name: 'Search for: ' , aCodeString.
       
  4200 "/self halt.
       
  4201 "/
       
  4202 "/    searchBlock := [:c :m :sel | 
       
  4203 "/        rslt := SmalllintChecker
       
  4204 "/            runRule:rule
       
  4205 "/            onEnvironment: (ClassEnvironment onEnvironment:(BrowserEnvironment new) classes:(Array with:c)).
       
  4206 "/        
       
  4207 "/        self halt.
       
  4208 "/    ].
       
  4209 "/^ searchBlock.
  4154 
  4210 
  4155     errAction := [:str :pos | 
  4211     errAction := [:str :pos | 
  4156                     Dialog warn:'Error during parse: ' , str , ' (position ' , pos printString , ')'.
  4212                     Dialog warn:'Error during parse: ' , str , ' (position ' , pos printString , ')'.
  4157                     ^ nil
  4213                     ^ nil
  4158                  ].
  4214                  ].
  4176                                 and:[ Smalltalk includesKey: node name asSymbol ]
  4232                                 and:[ Smalltalk includesKey: node name asSymbol ]
  4177                            ]   
  4233                            ]   
  4178                     thenCollect:[:node | node name asSymbol]. 
  4234                     thenCollect:[:node | node name asSymbol]. 
  4179 
  4235 
  4180     searcher := ParseTreeSearcher new.
  4236     searcher := ParseTreeSearcher new.
  4181     searcher 
  4237     isMethod ifTrue:[
  4182         matchesTree:searchTree
  4238         searcher 
  4183         do:[:aNode :answer | foundMatch := true].
  4239             matchesMethod:searchTree
       
  4240             do:[:aNode :answer | foundMatch := true].
       
  4241     ] ifFalse:[
       
  4242         searcher 
       
  4243             matchesTree:searchTree
       
  4244             do:[:aNode :answer | foundMatch := true].
       
  4245     ]..
  4184 
  4246 
  4185     messages size > 0 ifTrue:[
  4247     messages size > 0 ifTrue:[
  4186         "/ can speedup the search, by filtering for sent messages first...
  4248         "/ can speedup the search, by filtering for sent messages first...
  4187 
  4249 
  4188         searchBlock := [:c :m :sel | 
  4250         searchBlock := [:c :m :sel | 
  4206                                         parseTree := RBParser 
  4268                                         parseTree := RBParser 
  4207                                                         parseSearchMethod:src 
  4269                                                         parseSearchMethod:src 
  4208                                                         onError: [:str :pos | Transcript showCR:str. Transcript showCR:pos. nil].
  4270                                                         onError: [:str :pos | Transcript showCR:str. Transcript showCR:pos. nil].
  4209 
  4271 
  4210                                         foundMatch := false.
  4272                                         foundMatch := false.
  4211                                         rslt := searcher executeTree:parseTree.
  4273                                         false "isMethod" ifTrue:[
       
  4274                                             rslt := searcher executeMethod:parseTree.
       
  4275                                         ] ifFalse:[
       
  4276                                             rslt := searcher executeTree:parseTree.
       
  4277                                         ].
  4212                                         foundMatch.
  4278                                         foundMatch.
  4213                                     ]
  4279                                     ]
  4214                                 ]
  4280                                 ]
  4215                             ]
  4281                             ]
  4216                        ].
  4282                        ].
  4225                                 parseTree := RBParser 
  4291                                 parseTree := RBParser 
  4226                                                 parseSearchMethod:src 
  4292                                                 parseSearchMethod:src 
  4227                                                 onError: [:str :pos | Transcript showCR:str. Transcript showCR:pos. nil].
  4293                                                 onError: [:str :pos | Transcript showCR:str. Transcript showCR:pos. nil].
  4228 
  4294 
  4229                                 foundMatch := false.
  4295                                 foundMatch := false.
  4230                                 rslt := searcher executeTree:parseTree.
  4296                                 false "isMethod" ifTrue:[
       
  4297                                     rslt := searcher executeMethod:parseTree.
       
  4298                                 ] ifFalse:[
       
  4299                                     rslt := searcher executeTree:parseTree.
       
  4300                                 ].
  4231                                 foundMatch.
  4301                                 foundMatch.
  4232                             ]
  4302                             ]
  4233                        ].
  4303                        ].
  4234     ].
  4304     ].
  4235     ^ searchBlock.
  4305     ^ searchBlock.
  5133 ! !
  5203 ! !
  5134 
  5204 
  5135 !SystemBrowser class methodsFor:'documentation'!
  5205 !SystemBrowser class methodsFor:'documentation'!
  5136 
  5206 
  5137 version
  5207 version
  5138     ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.200 2003-10-08 16:27:26 cg Exp $'
  5208     ^ '$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.201 2003-10-09 09:28:40 cg Exp $'
  5139 ! !
  5209 ! !
  5140 
  5210 
  5141 SystemBrowser initialize!
  5211 SystemBrowser initialize!