Behavior.st
changeset 3053 d6aad366397f
parent 3044 a0bbac91639b
child 3069 9a25834a3ef7
--- a/Behavior.st	Tue Oct 28 19:31:50 1997 +0100
+++ b/Behavior.st	Tue Oct 28 19:33:50 1997 +0100
@@ -10,8 +10,6 @@
  hereby transferred.
 "
 
-'From Smalltalk/X, Version:3.2.1 on 17-oct-1997 at 4:16:14 pm'                  !
-
 Object subclass:#Behavior
 	instanceVariableNames:'superclass flags methodDictionary otherSuperclasses instSize'
 	classVariableNames:'SubclassInfo'
@@ -1422,18 +1420,30 @@
 allSubclassesDo:aBlock
     "evaluate aBlock for all of my subclasses.
      There is no specific order, in which the entries are enumerated.
-     This will only enumerate globally known classes - for anonymous
-     behaviors, you have to walk over all instances of Behavior."
-
-    Smalltalk allBehaviorsDo:[:aClass |
-	(aClass isSubclassOf:self) ifTrue:[
-	    aBlock value:aClass
-	]
+     Warning:
+        This will only enumerate globally known classes - for anonymous
+        behaviors, you have to walk over all instances of Behavior."
+
+    self isMeta ifTrue:[
+        "/ metaclasses are not found via Smalltalk allBehaviorsDo:
+        "/ here, walk over classes and enumerate corresponding metas.
+        self soleInstance allSubclassesDo:[:aSubClass |
+            aBlock value:(aSubClass class)
+        ].
+    ] ifFalse:[
+        Smalltalk allBehaviorsDo:[:aClass |
+            (aClass isSubclassOf:self) ifTrue:[
+                aBlock value:aClass
+            ]
+        ]
     ]
 
     "
      Collection allSubclassesDo:[:c | Transcript showCR:(c name)]
+     Collection class allSubclassesDo:[:c | Transcript showCR:(c name)]
     "
+
+    "Modified: / 25.10.1997 / 21:17:13 / cg"
 !
 
 allSubclassesInOrderDo:aBlock
@@ -1470,6 +1480,12 @@
     "
 !
 
+selectorsAndMethodsDo:aTwoArgBlock
+    methodDictionary keysAndValuesDo:aTwoArgBlock
+
+    "Created: / 27.10.1997 / 14:09:27 / cg"
+!
+
 subclassesDo:aBlock
     "evaluate the argument, aBlock for all immediate subclasses.
      This will only enumerate globally known classes - for anonymous
@@ -2713,23 +2729,40 @@
     "return the method for given selector aSelector or nil.
      Only methods in the receiver - not in the superclass chain are tested."
 
-    |dict|
-
-    dict := self methodDictionary.
-    dict isNil ifTrue:[
-	('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
-	^ nil
-    ].
-
-    ^ dict at:aSelector ifAbsent:[nil]
+    ^ self compiledMethodAt:aSelector ifAbsent:nil
 
     "
      Object compiledMethodAt:#==
      (Object compiledMethodAt:#==) category
     "
 
-    "Modified: 7.6.1996 / 14:43:32 / stefan"
-    "Modified: 10.1.1997 / 17:27:21 / cg"
+    "Modified: / 7.6.1996 / 14:43:32 / stefan"
+    "Modified: / 27.10.1997 / 20:18:55 / cg"
+!
+
+compiledMethodAt:aSelector ifAbsent:exceptionValue
+    "return the method for given selector aSelector or the value
+     of exceptionValue if not present.
+     Only methods in the receiver - not in the superclass chain are tested."
+
+    |dict|
+
+    dict := self methodDictionary.
+    dict isNil ifTrue:[
+        ('Behavior [warning]: nil methodDictionary in ' , self name printString) errorPrintCR.
+        ^ exceptionValue value
+    ].
+
+    ^ dict at:aSelector ifAbsent:exceptionValue
+
+    "
+     Object compiledMethodAt:#==
+     (Object compiledMethodAt:#==) category
+    "
+
+    "Modified: / 7.6.1996 / 14:43:32 / stefan"
+    "Modified: / 10.1.1997 / 17:27:21 / cg"
+    "Created: / 27.10.1997 / 20:18:28 / cg"
 !
 
 containsMethod:aMethod
@@ -3592,6 +3625,29 @@
     "
 !
 
+whichSelectorsReferTo:someLiteralConstant
+    "return a collection of selectors of methods which refer to the argument.
+     Search the literal arrays of my methods to do this."
+
+    |setOfSelectors|
+
+    setOfSelectors := IdentitySet new.
+    methodDictionary keysAndValuesDo:[:sel :mthd |
+        (mthd referencesLiteral:someLiteralConstant) ifTrue:[
+            setOfSelectors add:sel
+        ].
+    ].
+
+    ^ setOfSelectors
+
+    "
+     String whichSelectorsReferTo:#at:  
+     String whichSelectorsReferTo:CharacterArray 
+    "
+
+    "Modified: / 28.10.1997 / 13:13:18 / cg"
+!
+
 withAllSubclasses
     "return a collection containing the receiver and 
      all subclasses (direct AND indirect) of the receiver"
@@ -3649,5 +3705,5 @@
 !Behavior class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.121 1997-10-21 17:40:47 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.122 1997-10-28 18:33:50 cg Exp $'
 ! !