--- a/Class.st Mon Oct 14 21:47:07 1996 +0200
+++ b/Class.st Mon Oct 14 22:18:45 1996 +0200
@@ -15,7 +15,7 @@
classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal
CatchMethodRedefinitions MethodRedefinitionSignal
UpdateChangeFileQuerySignal TryLocalSourceFirst
- ChangeFileAccessLock'
+ ChangeFileAccessLock NameSpaceQuerySignal'
poolDictionaries:''
category:'Kernel-Classes'
!
@@ -148,10 +148,15 @@
UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'.
UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges].
+ NameSpaceQuerySignal := QuerySignal new mayProceed:true.
+ NameSpaceQuerySignal nameClass:self message:#updateChangeFileQuerySignal.
+ NameSpaceQuerySignal notifierString:'asking for nameSpace'.
+ NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk currentNameSpace].
+
ChangeFileAccessLock := Semaphore forMutualExclusion.
]
- "Modified: 21.3.1996 / 16:31:30 / cg"
+ "Modified: 14.10.1996 / 21:00:34 / cg"
! !
!Class class methodsFor:'Signal constants'!
@@ -173,6 +178,19 @@
^ MethodRedefinitionSignal
!
+nameSpaceQuerySignal
+ "return the signal used as an upQuery for the current nameSpace.
+ Will be used when filing in code"
+
+ ^ NameSpaceQuerySignal
+
+ "
+ Class nameSpaceQuerySignal raise
+ "
+
+ "Modified: 14.10.1996 / 21:01:30 / cg"
+!
+
updateChangeFileQuerySignal
"return the signal used as an upQuery if the changeFile should be updated.
If unhandled, the value of UpdatingChanges is returned by the signals
@@ -180,6 +198,11 @@
^ UpdateChangeFileQuerySignal
+ "
+ Class updateChangeFileQuerySignal raise
+ "
+
+ "Modified: 14.10.1996 / 21:01:43 / cg"
! !
!Class class methodsFor:'accessing - flags'!
@@ -959,26 +982,20 @@
binaryClassDefinitionFrom:stream manager:manager
"retrieve a class as stored previously with
- #storeBinaryClassOn:manager:"
-
- ^ self
- binaryClassDefinitionFrom:stream manager:manager in:Smalltalk
-
- "Modified: 8.10.1996 / 17:57:26 / cg"
-!
-
-binaryClassDefinitionFrom:stream manager:manager in:anEnvironment
- "retrieve a class as stored previously with
- #storeBinaryClassOn:manager: and store it in anEnvironment (may be nil)"
+ #storeBinaryClassOn:manager:
+ The namespace, where the class is to be installed is queries via the
+ NameSpaceQuerySignal - it should answer with nil, to suppress installation."
|superclassName name flags instvars classvars category classInstVars
comment package superclassSig
- newClass superClass methods cmethods|
+ newClass superClass methods cmethods formatID environment
+ nPrivate privateClass|
"/ the following order must correlate to
"/ the storing in #storeBinaryClassOn:manager:
"/ retrieve
+ "/ formatID
"/ superclasses name,
"/ superclasses signature
"/ name,
@@ -989,8 +1006,18 @@
"/ classInstVarNames
"/ comment
"/ package
-
- superclassName := manager nextObject.
+ "/ classes methodDictionary
+ "/ methodDictionary
+ "/ number of private classes
+ "/ private classes
+
+ formatID := manager nextObject.
+ formatID isInteger ifFalse:[ "/ backward compatibilty
+ formatID := nil.
+ superclassName := formatID
+ ] ifTrue:[
+ superclassName := manager nextObject.
+ ].
superclassSig := manager nextObject.
superclassName notNil ifTrue:[
@@ -1036,9 +1063,11 @@
"/ ('create class: ' , name ) printNL.
(superClass notNil or:[superclassName isNil]) ifTrue:[
+ environment := Class nameSpaceQuerySignal raise.
+
newClass := superClass class
name:name asSymbol
- in:anEnvironment
+ in:environment
subclassOf:superClass
instanceVariableNames:instvars
variable:false
@@ -1058,6 +1087,18 @@
"/ retrieve inst methods
methods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager.
+ formatID == 1 ifTrue:[
+ "/ privateClasses
+ nPrivate := manager nextObject.
+ nPrivate timesRepeat:[
+ Class nameSpaceQuerySignal
+ answer:newClass
+ do:[
+ privateClass := manager nextObject
+ ]
+ ]
+ ].
+
(superClass isNil and:[superclassName notNil]) ifTrue:[^ nil].
newClass isNil ifTrue:[
^ nil
@@ -1068,9 +1109,9 @@
newClass class methodDictionary:cmethods.
^ newClass
- "Modified: 26.5.1996 / 11:55:15 / cg"
"Modified: 7.6.1996 / 13:43:06 / stefan"
"Created: 8.10.1996 / 17:57:02 / cg"
+ "Modified: 14.10.1996 / 21:16:58 / cg"
!
storeBinaryClassOn:stream manager:manager
@@ -1078,7 +1119,7 @@
However, the superclass chain is not stored - at load time, that must
be either present or autoloadable."
- |s sig|
+ |s sig privateClasses|
stream nextPut: manager codeForClass.
@@ -1086,9 +1127,10 @@
"/ the storing in #binaryDefinitionFrom:manager:
"/ store
- "/ superclasses name,
+ "/ format ID
+ "/ superclasses name
"/ superclasses signature
- "/ name,
+ "/ name
"/ typeSymbol,
"/ instVarNames
"/ classVarNames
@@ -1096,6 +1138,12 @@
"/ classInstVarNames
"/ comment
"/ package
+ "/ classes methodDictionary
+ "/ methodDictionary
+ "/ # of privateClass names
+ "/ privateClasses
+
+ 1 storeBinaryOn:stream manager:manager. "/ formatID
superclass isNil ifTrue:[
s := nil.
@@ -1137,15 +1185,22 @@
s storeBinaryOn:stream manager:manager.
package storeBinaryOn:stream manager:manager.
-
"/
"/ store class method dictionary and methods
"/
-
self class methodDictionary storeFullBinaryDefinitionOn:stream manager:manager.
"/ store inst method dictionary and methods
self methodDictionary storeFullBinaryDefinitionOn:stream manager:manager.
+ "/
+ "/ names of private classes
+ "/
+ (privateClasses := self privateClasses) notNil ifTrue:[
+ privateClasses size storeBinaryOn:stream manager:manager.
+ privateClasses do:[:aClass |
+ aClass storeBinaryClassOn:stream manager:manager
+ ]
+ ].
"
|bos|
@@ -1163,8 +1218,8 @@
cls open.
"
- "Modified: 7.2.1996 / 20:03:31 / cg"
"Modified: 7.6.1996 / 13:39:02 / stefan"
+ "Modified: 14.10.1996 / 20:54:30 / cg"
!
storeBinaryDefinitionOf: anAssociation on: stream manager: manager
@@ -3852,6 +3907,6 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.183 1996-10-14 19:47:07 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.184 1996-10-14 20:18:45 cg Exp $'
! !
Class initialize!