# HG changeset patch
# User Claus Gittinger <cg@exept.de>
# Date 972411818 -7200
# Node ID 7466259d8bb5e85280c57c06ad26209ff524ec32
# Parent  28d6026fe30cd7786252803d7f0eb26e68f4c6cb
checkin from browser

diff -r 28d6026fe30c -r 7466259d8bb5 SnapShotImage.st
--- a/SnapShotImage.st	Tue Oct 24 13:17:22 2000 +0200
+++ b/SnapShotImage.st	Tue Oct 24 20:23:38 2000 +0200
@@ -1,5 +1,3 @@
-'From Smalltalk/X, Version:4.1.1 on 24-Okt-2000 at 12:50:49'                    !
-
 "{ Package: 'cg:private' }"
 
 Object subclass:#SnapShotImage
@@ -34,8 +32,8 @@
 
 for:aFilename
     memory := SnapShotImageMemory for:aFilename.
-    memory readHeader
-! !
+    memory image:self.
+    memory readHeader! !
 
 !SnapShotImage methodsFor:'smalltalk protocol'!
 
@@ -55,6 +53,29 @@
     ].
 !
 
+allClassesInCategory:aCategory
+    |coll|
+
+    coll := OrderedCollection new.
+    self allClassesInCategory:aCategory do:[:aClass |
+        coll add:aClass
+    ].
+    ^ coll!
+
+allClassesInCategory:aCategory do:aBlock
+    "evaluate the argument, aBlock for all classes in the aCategory;
+     The order of the classes is not defined."
+
+    aCategory notNil ifTrue:[
+        self allClassesDo:[:aClass |
+            aClass isMeta ifFalse:[
+                (aClass category = aCategory) ifTrue:[
+                    aBlock value:aClass
+                ]
+            ]
+        ]
+    ]!
+
 at:aKey
     globals isNil ifTrue:[
         self fetchGlobals
@@ -62,6 +83,12 @@
     ^ globals at:aKey
 !
 
+at:aKey ifAbsent:exceptionValue
+    globals isNil ifTrue:[
+        self fetchGlobals
+    ].
+    ^ globals at:aKey ifAbsent:exceptionValue!
+
 keysAndValuesDo:aTwoArgBlock
     globals isNil ifTrue:[
         self fetchGlobals