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