517 (methodComment endsWith:',') ifTrue:[ methodComment := methodComment copyButLast:1]. |
517 (methodComment endsWith:',') ifTrue:[ methodComment := methodComment copyButLast:1]. |
518 methodComment := methodComment withoutSeparators. |
518 methodComment := methodComment withoutSeparators. |
519 (lines size > 1) ifTrue:[ |
519 (lines size > 1) ifTrue:[ |
520 methodComment := methodComment , ' ...' |
520 methodComment := methodComment , ' ...' |
521 ]. |
521 ]. |
522 ^ ('"' , methodComment , '"') colorizeAllWith:(UserPreferences current commentColor). |
522 ^ ('"' , methodComment , '"') withColor:(UserPreferences current commentColor). |
523 |
523 |
524 "Created: / 14-09-2006 / 14:11:58 / cg" |
524 "Created: / 14-09-2006 / 14:11:58 / cg" |
525 "Modified (comment): / 30-04-2016 / 16:17:18 / cg" |
525 "Modified (comment): / 30-04-2016 / 16:17:18 / cg" |
526 ! |
526 ! |
527 |
527 |
895 doc := doc asStringCollection. |
895 doc := doc asStringCollection. |
896 doc size > 25 ifTrue:[ |
896 doc size > 25 ifTrue:[ |
897 doc := doc copyTo:25. |
897 doc := doc copyTo:25. |
898 doc add:''; add:' ... <more documentation cut off>'. |
898 doc add:''; add:' ... <more documentation cut off>'. |
899 ]. |
899 ]. |
900 doc := doc asString colorizeAllWith:(UserPreferences current commentColor). |
900 doc := doc asString withColor:(UserPreferences current commentColor). |
901 explanation := explanation,'\\' withCRs,val name,'''s documentation:\'withCRs, doc |
901 explanation := explanation,'\\' withCRs,val name,'''s documentation:\'withCRs, doc |
902 ]. |
902 ]. |
903 ^ explanation. |
903 ^ explanation. |
904 ]. |
904 ]. |
905 |
905 |
2146 asLink:aString to:action |
2146 asLink:aString to:action |
2147 ^ (aString actionForAll:action) |
2147 ^ (aString actionForAll:action) |
2148 withColor:(Color blue) |
2148 withColor:(Color blue) |
2149 ! |
2149 ! |
2150 |
2150 |
2151 infoStringForClasses:aCollectionOfClasses withPrefix:prefix |
|
2152 "get a nice user readable list for some classes. |
|
2153 Up to 4 are named, otherwise the count is presented. |
|
2154 The prefix can be sth like ' other', ' sub', ' super', |
|
2155 ' implementing' etc. Or it can be an empty string. |
|
2156 To be shown in the info line at the bottom." |
|
2157 |
|
2158 |nClassNames classes sortedByName classNames |
|
2159 link1 link2 link3 link4| |
|
2160 |
|
2161 aCollectionOfClasses isEmpty ifTrue:[ |
|
2162 ^ 'No %1classes' bindWith:prefix. |
|
2163 ]. |
|
2164 |
|
2165 classes := aCollectionOfClasses asIdentitySet asOrderedCollection. |
|
2166 classNames := classes collect:[:each | each theNonMetaclass name]. |
|
2167 |
|
2168 nClassNames := classNames size. |
|
2169 |
|
2170 nClassNames <= 4 ifTrue:[ |
|
2171 sortedByName := classNames sortWith:classes. |
|
2172 |
|
2173 link1 := self asLink:classNames first "allBold" to:(self actionToBrowseClass:classes first). |
|
2174 nClassNames == 1 ifTrue:[ |
|
2175 ^ '%2' "'1 %1class: %2'" |
|
2176 bindWith:prefix |
|
2177 with:link1. |
|
2178 ]. |
|
2179 link2 := self asLink:classNames second "allBold" to:(self actionToBrowseClass:classes second). |
|
2180 nClassNames == 2 ifTrue:[ |
|
2181 ^ '%2 and %3' "'2 %1classes: %2 and %3'" |
|
2182 bindWith:prefix |
|
2183 with:link1 |
|
2184 with:link2. |
|
2185 ]. |
|
2186 link3 := self asLink:classNames third "allBold" to:(self actionToBrowseClass:classes third). |
|
2187 nClassNames == 3 ifTrue:[ |
|
2188 ^ '%2, %3 and %4' "'3 %1classes: %2, %3 and %4'" |
|
2189 bindWith:prefix |
|
2190 with:link1 |
|
2191 with:link2 |
|
2192 with:link3. |
|
2193 ]. |
|
2194 link4 := self asLink:classNames fourth "allBold" to:(self actionToBrowseClass:classes fourth). |
|
2195 nClassNames == 4 ifTrue:[ |
|
2196 ^ '%2, %3, %4 and %5' "'4 %1classes: %2, %3, %4 and %5'" |
|
2197 bindWith:prefix |
|
2198 with:link1 |
|
2199 with:link2 |
|
2200 with:link3 |
|
2201 with:link4. |
|
2202 ]. |
|
2203 ]. |
|
2204 ^ self asLink:('%1 %2classes' bindWith:(nClassNames printString "allBold") with:prefix) |
|
2205 to:(self actionToBrowseClasses:classes) |
|
2206 |
|
2207 "Modified: / 27-07-2006 / 10:09:02 / cg" |
|
2208 ! |
|
2209 |
|
2210 infoStringForMethods:aCollectionOfMethods withPrefix:prefix |
2151 infoStringForMethods:aCollectionOfMethods withPrefix:prefix |
2211 "get a nice user readable list for some methods. |
2152 "get a nice user readable list for some methods. |
2212 Up to 3 are named, otherwise the count is presented. |
2153 Up to 3 are named, otherwise the count is presented. |
2213 The prefix can be sth like ' other', ' sender', ' implementor', |
2154 The prefix can be sth like ' other', ' sender', ' implementor', |
2214 Or it can be an empty string. |
2155 Or it can be an empty string. |
2259 self infoStringForMethods:(SystemBrowser allCallsOn:#'actionToBrowseClasses:') withPrefix:'' |
2200 self infoStringForMethods:(SystemBrowser allCallsOn:#'actionToBrowseClasses:') withPrefix:'' |
2260 ]. |
2201 ]. |
2261 " |
2202 " |
2262 ! |
2203 ! |
2263 |
2204 |
2264 methodImplementorsInfoFor:aMethod inEnvironment:environment |
|
2265 "get something about the implementors of aMethod |
|
2266 to be shown in the info line at the bottom" |
|
2267 |
|
2268 |implementors msg senders msg2| |
|
2269 |
|
2270 implementors := SystemBrowser |
|
2271 findImplementorsOf:aMethod selector |
|
2272 in:(environment allClasses) |
|
2273 ignoreCase:false. |
|
2274 |
|
2275 implementors notEmpty ifTrue:[ |
|
2276 msg := 'Only implemented here.'. |
|
2277 implementors remove:aMethod ifAbsent:nil. |
|
2278 implementors notEmpty ifTrue:[ |
|
2279 implementors := implementors collect:[:mthd | mthd mclass ? mthd getMclass]. |
|
2280 implementors notEmpty ifTrue:[ |
|
2281 msg := 'Also implemented in '. |
|
2282 msg := msg , (self infoStringForClasses:implementors withPrefix:'other '). |
|
2283 msg := msg , '.'. |
|
2284 ] |
|
2285 ]. |
|
2286 ]. |
|
2287 |
|
2288 false ifTrue:[ "/ too slow |
|
2289 senders := SystemBrowser |
|
2290 findSendersOf:aMethod selector |
|
2291 in:(environment allClasses) |
|
2292 ignoreCase:false. |
|
2293 senders notEmpty ifTrue:[ |
|
2294 msg2 := 'Sent from ' , senders size printString, ' methods.'. |
|
2295 ] ifFalse:[ |
|
2296 msg2 := 'No senders.'. |
|
2297 ]. |
|
2298 msg := msg , '/' , msg2 |
|
2299 ]. |
|
2300 |
|
2301 ^ msg |
|
2302 ! |
|
2303 |
|
2304 methodInheritanceInfoFor:aMethod |
|
2305 |methodsSuperclass inheritedClass msg methodsClass selector mthd selectorString| |
|
2306 |
|
2307 methodsClass := aMethod mclass. |
|
2308 methodsClass isNil ifTrue:[^ nil]. |
|
2309 |
|
2310 methodsSuperclass := methodsClass superclass. |
|
2311 methodsSuperclass isNil ifTrue:[^ nil]. |
|
2312 |
|
2313 selector := aMethod selector. |
|
2314 selector isNil ifTrue:[^ nil]. |
|
2315 |
|
2316 inheritedClass := methodsSuperclass whichClassIncludesSelector:selector. |
|
2317 inheritedClass isNil ifTrue:[^ nil]. |
|
2318 |
|
2319 mthd := inheritedClass compiledMethodAt:selector. |
|
2320 |
|
2321 (mthd sends:#'subclassResponsibility') ifTrue:[ |
|
2322 msg := '%1 overrides subclassResponsibility in %2'. |
|
2323 ] ifFalse:[ |
|
2324 msg := '%1 overrides implementation in %2'. |
|
2325 ]. |
|
2326 selectorString := selector contractTo:30. |
|
2327 ^ msg |
|
2328 bindWith:(self asLink:selectorString "allBold" to:(self actionToOpenMethodFinderFor:selector)) |
|
2329 with:(self asLink:inheritedClass name "allBold" |
|
2330 to:(self actionToBrowseClass:inheritedClass selector:selector)) |
|
2331 ! |
|
2332 |
|
2333 methodRedefinitionInfoFor:aMethod |
|
2334 "return a user readable string telling in how many subclasses |
|
2335 a method is redefined. |
|
2336 To be shown in the info line of a browser" |
|
2337 |
|
2338 |redefiningClasses msg cls| |
|
2339 |
|
2340 cls := aMethod mclass. |
|
2341 cls isNil ifTrue:[^ nil]. |
|
2342 |
|
2343 redefiningClasses := cls allSubclasses select:[:cls | cls includesSelector:aMethod selector. ]. |
|
2344 redefiningClasses size > 0 ifTrue:[ |
|
2345 msg := 'redefined in '. |
|
2346 msg := msg , (self infoStringForClasses:redefiningClasses withPrefix:'sub'). |
|
2347 msg := msg , '.'. |
|
2348 ]. |
|
2349 |
|
2350 ^ msg |
|
2351 ! |
|
2352 |
|
2353 methodSendersInfoFor:selector inEnvironment:environment |
2205 methodSendersInfoFor:selector inEnvironment:environment |
2354 "get something about the senders of a message. |
2206 "get something about the senders of a message. |
2355 to be shown in the info line at the bottom. |
2207 to be shown in the info line at the bottom. |
2356 This may be slow; so think about doing it in background..." |
2208 This may be slow; so think about doing it in background..." |
2357 |
2209 |
2366 senders notEmpty ifTrue:[ |
2218 senders notEmpty ifTrue:[ |
2367 ^ 'Sent from ' , senders size printString, ' methods.'. |
2219 ^ 'Sent from ' , senders size printString, ' methods.'. |
2368 ] ifFalse:[ |
2220 ] ifFalse:[ |
2369 ^ 'No senders.'. |
2221 ^ 'No senders.'. |
2370 ]. |
2222 ]. |
2371 ! |
|
2372 |
|
2373 methodSpecialInfoFor:aMethod |
|
2374 "handles special cases - such as documentation methods" |
|
2375 |
|
2376 |cls sel| |
|
2377 |
|
2378 (cls := aMethod mclass) isNil ifTrue:[^ nil]. |
|
2379 (sel := aMethod selector) isNil ifTrue:[^ nil]. |
|
2380 |
|
2381 cls isMeta ifTrue:[ |
|
2382 (AbstractSourceCodeManager isVersionMethodSelector:sel) ifTrue:[ |
|
2383 ^ 'The version method is required for the source code repository - do not modify.'. |
|
2384 ]. |
|
2385 sel == #documentation ifTrue:[ |
|
2386 ^ 'ST/X stores documentation in this method (not in comment slots)'. |
|
2387 ]. |
|
2388 ]. |
|
2389 ^ nil |
|
2390 ! |
2223 ! |
2391 |
2224 |
2392 thisOrNewBrowserInto:aTwoArgBlock |
2225 thisOrNewBrowserInto:aTwoArgBlock |
2393 "if I am invoked by a browser, |
2226 "if I am invoked by a browser, |
2394 invoke the twoArgBlock withit and an #newBuffer arg. |
2227 invoke the twoArgBlock withit and an #newBuffer arg. |