251 category:''' , aCategoryString , '''' |
251 category:''' , aCategoryString , '''' |
252 |
252 |
253 "Created: / 19.6.1998 / 02:09:06 / cg" |
253 "Created: / 19.6.1998 / 02:09:06 / cg" |
254 ! ! |
254 ! ! |
255 |
255 |
|
256 !Class class methodsFor:'private'! |
|
257 |
|
258 flushSubclassInfo |
|
259 "throw away (forget) the cached subclass information, as created |
|
260 by #subclassInfo. |
|
261 This is private protocol" |
|
262 |
|
263 SubclassInfo := nil. |
|
264 |
|
265 " |
|
266 Class flushSubclassInfo |
|
267 " |
|
268 |
|
269 "Modified: 22.1.1997 / 18:39:36 / cg" |
|
270 ! |
|
271 |
|
272 subclassInfo |
|
273 "build & return a dictionary, containing the set of subclass |
|
274 for each class. This information is kept until explicitely flushed |
|
275 by #flushSubclassInfo. |
|
276 This cache is used internally, for enumerators like #allSubclasses |
|
277 or #allSubclassesDo:, to avoid repeated recursive walks over the class |
|
278 hierarchy. |
|
279 This is private protocol." |
|
280 |
|
281 |d| |
|
282 |
|
283 SubclassInfo notNil ifTrue:[^ SubclassInfo]. |
|
284 |
|
285 d := IdentityDictionary new. |
|
286 Smalltalk allClassesDo:[:aClass | |
|
287 |superCls setToAddSubclass| |
|
288 |
|
289 superCls := aClass superclass. |
|
290 superCls notNil ifTrue:[ |
|
291 setToAddSubclass := d at:superCls ifAbsent:nil. |
|
292 setToAddSubclass isNil ifTrue:[ |
|
293 d at:superCls put:(Set with:aClass). |
|
294 ] ifFalse:[ |
|
295 setToAddSubclass add:aClass |
|
296 ] |
|
297 ] |
|
298 ]. |
|
299 SubclassInfo := d. |
|
300 ^ d |
|
301 |
|
302 " |
|
303 Class subclassInfo |
|
304 " |
|
305 |
|
306 "Modified: 22.1.1997 / 18:44:59 / cg" |
|
307 ! ! |
|
308 |
256 !Class class methodsFor:'queries'! |
309 !Class class methodsFor:'queries'! |
257 |
310 |
258 isBuiltInClass |
311 isBuiltInClass |
259 "return true if this class is known by the run-time-system. |
312 "return true if this class is known by the run-time-system. |
260 Here, true is returned for myself, false for subclasses." |
313 Here, true is returned for myself, false for subclasses." |
1972 privateClassesDo:aBlock |
2025 privateClassesDo:aBlock |
1973 "evaluate aBlock on all of my (immediate) private classes (if any). |
2026 "evaluate aBlock on all of my (immediate) private classes (if any). |
1974 Evaluation is in no particular order." |
2027 Evaluation is in no particular order." |
1975 |
2028 |
1976 self privateClasses do:aBlock |
2029 self privateClasses do:aBlock |
|
2030 ! |
|
2031 |
|
2032 subclassesDo:aBlock |
|
2033 "evaluate the argument, aBlock for all immediate subclasses. |
|
2034 This will only enumerate globally known classes - for anonymous |
|
2035 behaviors, you have to walk over all instances of Behavior." |
|
2036 |
|
2037 |coll| |
|
2038 |
|
2039 "/ use cached information (avoid class hierarchy search) |
|
2040 "/ if possible |
|
2041 |
|
2042 SubclassInfo isNil ifTrue:[ |
|
2043 Class subclassInfo |
|
2044 ]. |
|
2045 SubclassInfo notNil ifTrue:[ |
|
2046 coll := SubclassInfo at:self ifAbsent:nil. |
|
2047 coll notNil ifTrue:[ |
|
2048 coll do:aBlock. |
|
2049 ]. |
|
2050 ^ self |
|
2051 ]. |
|
2052 |
|
2053 Smalltalk allClassesDo:[:aClass | |
|
2054 (aClass superclass == self) ifTrue:[ |
|
2055 aBlock value:aClass |
|
2056 ] |
|
2057 ] |
|
2058 |
|
2059 " |
|
2060 Collection subclassesDo:[:c | Transcript showCR:(c name)] |
|
2061 " |
|
2062 |
|
2063 "Modified: 22.1.1997 / 18:44:01 / cg" |
1977 ! |
2064 ! |
1978 |
2065 |
1979 withAllPrivateClassesDo:aBlock |
2066 withAllPrivateClassesDo:aBlock |
1980 "evaluate aBlock on myself and all of my private classes (if any). |
2067 "evaluate aBlock on myself and all of my private classes (if any). |
1981 This recurses into private classes of private classes. |
2068 This recurses into private classes of private classes. |
3498 "{ Pragma: +optSpace }" |
3585 "{ Pragma: +optSpace }" |
3499 |
3586 |
3500 "set the primitiveVariable string (no change notifications)" |
3587 "set the primitiveVariable string (no change notifications)" |
3501 |
3588 |
3502 ^ self setAttribute:#primitiveVariables to:aString |
3589 ^ self setAttribute:#primitiveVariables to:aString |
|
3590 ! |
|
3591 |
|
3592 setSuperclass:aClass |
|
3593 "set the superclass of the receiver. |
|
3594 this method is for special uses only - there will be no recompilation |
|
3595 and no change record written here. Also, if the receiver class has |
|
3596 already been in use, future operation of the system is not guaranteed to |
|
3597 be correct, since no caches are flushed. |
|
3598 Therefore: do NOT use it; use Behavior>>superclass: (or flush the caches, at least). |
|
3599 |
|
3600 Redefined here to take care of subclass caching" |
|
3601 |
|
3602 |info| |
|
3603 |
|
3604 SubclassInfo notNil ifTrue:[ |
|
3605 "/ flush/update the subclass information |
|
3606 |
|
3607 "/ if my class is already contained |
|
3608 (info := SubclassInfo at:aClass ifAbsent:nil) notNil ifTrue:[ |
|
3609 info add:self |
|
3610 ] ifFalse:[ |
|
3611 SubclassInfo := nil. "/ flush it |
|
3612 ] |
|
3613 ]. |
|
3614 super setSuperclass:aClass |
3503 ! ! |
3615 ! ! |
3504 |
3616 |
3505 !Class methodsFor:'private-changes management'! |
3617 !Class methodsFor:'private-changes management'! |
3506 |
3618 |
3507 addChangeRecordForChangeCategory:category to:aStream |
3619 addChangeRecordForChangeCategory:category to:aStream |
3722 " |
3834 " |
3723 Class rootsOfTheWorld |
3835 Class rootsOfTheWorld |
3724 " |
3836 " |
3725 |
3837 |
3726 "Modified: 18.4.1997 / 20:55:34 / cg" |
3838 "Modified: 18.4.1997 / 20:55:34 / cg" |
|
3839 ! |
|
3840 |
|
3841 subclasses |
|
3842 "return a collection of the direct subclasses of the receiver" |
|
3843 |
|
3844 |newColl| |
|
3845 |
|
3846 "/ use cached information (avoid class hierarchy search) |
|
3847 "/ if possible |
|
3848 |
|
3849 SubclassInfo notNil ifTrue:[ |
|
3850 newColl := SubclassInfo at:self ifAbsent:nil. |
|
3851 newColl notNil ifTrue:[^ newColl asOrderedCollection] |
|
3852 ]. |
|
3853 |
|
3854 newColl := OrderedCollection new. |
|
3855 self subclassesDo:[:aClass | |
|
3856 newColl add:aClass |
|
3857 ]. |
|
3858 SubclassInfo notNil ifTrue:[ |
|
3859 SubclassInfo at:self put:newColl. |
|
3860 ]. |
|
3861 ^ newColl |
|
3862 |
|
3863 " |
|
3864 Class flushSubclassInfo. |
|
3865 Collection subclasses |
|
3866 " |
|
3867 |
|
3868 "Modified: 22.1.1997 / 18:43:52 / cg" |
3727 ! |
3869 ! |
3728 |
3870 |
3729 wasAutoloaded |
3871 wasAutoloaded |
3730 "return true, if this class came into the system via an |
3872 "return true, if this class came into the system via an |
3731 autoload; false otherwise. |
3873 autoload; false otherwise. |