13 ClassDescription subclass:#Class |
13 ClassDescription subclass:#Class |
14 instanceVariableNames:'classvars comment subclasses classFilename package revision hook' |
14 instanceVariableNames:'classvars comment subclasses classFilename package revision hook' |
15 classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal |
15 classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal |
16 CatchMethodRedefinitions MethodRedefinitionSignal |
16 CatchMethodRedefinitions MethodRedefinitionSignal |
17 UpdateChangeFileQuerySignal TryLocalSourceFirst |
17 UpdateChangeFileQuerySignal TryLocalSourceFirst |
18 ChangeFileAccessLock' |
18 ChangeFileAccessLock NameSpaceQuerySignal' |
19 poolDictionaries:'' |
19 poolDictionaries:'' |
20 category:'Kernel-Classes' |
20 category:'Kernel-Classes' |
21 ! |
21 ! |
22 |
22 |
23 !Class class methodsFor:'documentation'! |
23 !Class class methodsFor:'documentation'! |
146 UpdateChangeFileQuerySignal := QuerySignal new mayProceed:true. |
146 UpdateChangeFileQuerySignal := QuerySignal new mayProceed:true. |
147 UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal. |
147 UpdateChangeFileQuerySignal nameClass:self message:#updateChangeFileQuerySignal. |
148 UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'. |
148 UpdateChangeFileQuerySignal notifierString:'asking if changeFile update is wanted'. |
149 UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges]. |
149 UpdateChangeFileQuerySignal handlerBlock:[:ex | ex proceedWith:UpdatingChanges]. |
150 |
150 |
|
151 NameSpaceQuerySignal := QuerySignal new mayProceed:true. |
|
152 NameSpaceQuerySignal nameClass:self message:#updateChangeFileQuerySignal. |
|
153 NameSpaceQuerySignal notifierString:'asking for nameSpace'. |
|
154 NameSpaceQuerySignal handlerBlock:[:ex | ex proceedWith:Smalltalk currentNameSpace]. |
|
155 |
151 ChangeFileAccessLock := Semaphore forMutualExclusion. |
156 ChangeFileAccessLock := Semaphore forMutualExclusion. |
152 ] |
157 ] |
153 |
158 |
154 "Modified: 21.3.1996 / 16:31:30 / cg" |
159 "Modified: 14.10.1996 / 21:00:34 / cg" |
155 ! ! |
160 ! ! |
156 |
161 |
157 !Class class methodsFor:'Signal constants'! |
162 !Class class methodsFor:'Signal constants'! |
158 |
163 |
159 fileOutErrorSignal |
164 fileOutErrorSignal |
171 methods to be overwritten or redefined by incompatible methods" |
176 methods to be overwritten or redefined by incompatible methods" |
172 |
177 |
173 ^ MethodRedefinitionSignal |
178 ^ MethodRedefinitionSignal |
174 ! |
179 ! |
175 |
180 |
|
181 nameSpaceQuerySignal |
|
182 "return the signal used as an upQuery for the current nameSpace. |
|
183 Will be used when filing in code" |
|
184 |
|
185 ^ NameSpaceQuerySignal |
|
186 |
|
187 " |
|
188 Class nameSpaceQuerySignal raise |
|
189 " |
|
190 |
|
191 "Modified: 14.10.1996 / 21:01:30 / cg" |
|
192 ! |
|
193 |
176 updateChangeFileQuerySignal |
194 updateChangeFileQuerySignal |
177 "return the signal used as an upQuery if the changeFile should be updated. |
195 "return the signal used as an upQuery if the changeFile should be updated. |
178 If unhandled, the value of UpdatingChanges is returned by the signals |
196 If unhandled, the value of UpdatingChanges is returned by the signals |
179 static handler." |
197 static handler." |
180 |
198 |
181 ^ UpdateChangeFileQuerySignal |
199 ^ UpdateChangeFileQuerySignal |
182 |
200 |
|
201 " |
|
202 Class updateChangeFileQuerySignal raise |
|
203 " |
|
204 |
|
205 "Modified: 14.10.1996 / 21:01:43 / cg" |
183 ! ! |
206 ! ! |
184 |
207 |
185 !Class class methodsFor:'accessing - flags'! |
208 !Class class methodsFor:'accessing - flags'! |
186 |
209 |
187 catchMethodRedefinitions |
210 catchMethodRedefinitions |
957 " |
980 " |
958 ! |
981 ! |
959 |
982 |
960 binaryClassDefinitionFrom:stream manager:manager |
983 binaryClassDefinitionFrom:stream manager:manager |
961 "retrieve a class as stored previously with |
984 "retrieve a class as stored previously with |
962 #storeBinaryClassOn:manager:" |
985 #storeBinaryClassOn:manager: |
963 |
986 The namespace, where the class is to be installed is queries via the |
964 ^ self |
987 NameSpaceQuerySignal - it should answer with nil, to suppress installation." |
965 binaryClassDefinitionFrom:stream manager:manager in:Smalltalk |
|
966 |
|
967 "Modified: 8.10.1996 / 17:57:26 / cg" |
|
968 ! |
|
969 |
|
970 binaryClassDefinitionFrom:stream manager:manager in:anEnvironment |
|
971 "retrieve a class as stored previously with |
|
972 #storeBinaryClassOn:manager: and store it in anEnvironment (may be nil)" |
|
973 |
988 |
974 |superclassName name flags instvars classvars category classInstVars |
989 |superclassName name flags instvars classvars category classInstVars |
975 comment package superclassSig |
990 comment package superclassSig |
976 newClass superClass methods cmethods| |
991 newClass superClass methods cmethods formatID environment |
|
992 nPrivate privateClass| |
977 |
993 |
978 "/ the following order must correlate to |
994 "/ the following order must correlate to |
979 "/ the storing in #storeBinaryClassOn:manager: |
995 "/ the storing in #storeBinaryClassOn:manager: |
980 |
996 |
981 "/ retrieve |
997 "/ retrieve |
|
998 "/ formatID |
982 "/ superclasses name, |
999 "/ superclasses name, |
983 "/ superclasses signature |
1000 "/ superclasses signature |
984 "/ name, |
1001 "/ name, |
985 "/ typeSymbol, |
1002 "/ typeSymbol, |
986 "/ instVarNames |
1003 "/ instVarNames |
987 "/ classVarNames |
1004 "/ classVarNames |
988 "/ category |
1005 "/ category |
989 "/ classInstVarNames |
1006 "/ classInstVarNames |
990 "/ comment |
1007 "/ comment |
991 "/ package |
1008 "/ package |
992 |
1009 "/ classes methodDictionary |
993 superclassName := manager nextObject. |
1010 "/ methodDictionary |
|
1011 "/ number of private classes |
|
1012 "/ private classes |
|
1013 |
|
1014 formatID := manager nextObject. |
|
1015 formatID isInteger ifFalse:[ "/ backward compatibilty |
|
1016 formatID := nil. |
|
1017 superclassName := formatID |
|
1018 ] ifTrue:[ |
|
1019 superclassName := manager nextObject. |
|
1020 ]. |
994 superclassSig := manager nextObject. |
1021 superclassSig := manager nextObject. |
995 |
1022 |
996 superclassName notNil ifTrue:[ |
1023 superclassName notNil ifTrue:[ |
997 superClass := Smalltalk at:superclassName ifAbsent:nil. |
1024 superClass := Smalltalk at:superclassName ifAbsent:nil. |
998 |
1025 |
1034 "/ 'got classInstvars: ' print. classInstVars printNL. |
1061 "/ 'got classInstvars: ' print. classInstVars printNL. |
1035 |
1062 |
1036 "/ ('create class: ' , name ) printNL. |
1063 "/ ('create class: ' , name ) printNL. |
1037 |
1064 |
1038 (superClass notNil or:[superclassName isNil]) ifTrue:[ |
1065 (superClass notNil or:[superclassName isNil]) ifTrue:[ |
|
1066 environment := Class nameSpaceQuerySignal raise. |
|
1067 |
1039 newClass := superClass class |
1068 newClass := superClass class |
1040 name:name asSymbol |
1069 name:name asSymbol |
1041 in:anEnvironment |
1070 in:environment |
1042 subclassOf:superClass |
1071 subclassOf:superClass |
1043 instanceVariableNames:instvars |
1072 instanceVariableNames:instvars |
1044 variable:false |
1073 variable:false |
1045 words:false |
1074 words:false |
1046 pointers:true |
1075 pointers:true |
1056 "/ retrieve class methods |
1085 "/ retrieve class methods |
1057 cmethods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager. |
1086 cmethods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager. |
1058 "/ retrieve inst methods |
1087 "/ retrieve inst methods |
1059 methods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager. |
1088 methods := MethodDictionary binaryFullDefinitionFrom:stream manager:manager. |
1060 |
1089 |
|
1090 formatID == 1 ifTrue:[ |
|
1091 "/ privateClasses |
|
1092 nPrivate := manager nextObject. |
|
1093 nPrivate timesRepeat:[ |
|
1094 Class nameSpaceQuerySignal |
|
1095 answer:newClass |
|
1096 do:[ |
|
1097 privateClass := manager nextObject |
|
1098 ] |
|
1099 ] |
|
1100 ]. |
|
1101 |
1061 (superClass isNil and:[superclassName notNil]) ifTrue:[^ nil]. |
1102 (superClass isNil and:[superclassName notNil]) ifTrue:[^ nil]. |
1062 newClass isNil ifTrue:[ |
1103 newClass isNil ifTrue:[ |
1063 ^ nil |
1104 ^ nil |
1064 ]. |
1105 ]. |
1065 |
1106 |
1066 newClass package:package. |
1107 newClass package:package. |
1067 newClass methodDictionary:methods. |
1108 newClass methodDictionary:methods. |
1068 newClass class methodDictionary:cmethods. |
1109 newClass class methodDictionary:cmethods. |
1069 ^ newClass |
1110 ^ newClass |
1070 |
1111 |
1071 "Modified: 26.5.1996 / 11:55:15 / cg" |
|
1072 "Modified: 7.6.1996 / 13:43:06 / stefan" |
1112 "Modified: 7.6.1996 / 13:43:06 / stefan" |
1073 "Created: 8.10.1996 / 17:57:02 / cg" |
1113 "Created: 8.10.1996 / 17:57:02 / cg" |
|
1114 "Modified: 14.10.1996 / 21:16:58 / cg" |
1074 ! |
1115 ! |
1075 |
1116 |
1076 storeBinaryClassOn:stream manager:manager |
1117 storeBinaryClassOn:stream manager:manager |
1077 "store a classes complete description (i.e. including methods). |
1118 "store a classes complete description (i.e. including methods). |
1078 However, the superclass chain is not stored - at load time, that must |
1119 However, the superclass chain is not stored - at load time, that must |
1079 be either present or autoloadable." |
1120 be either present or autoloadable." |
1080 |
1121 |
1081 |s sig| |
1122 |s sig privateClasses| |
1082 |
1123 |
1083 stream nextPut: manager codeForClass. |
1124 stream nextPut: manager codeForClass. |
1084 |
1125 |
1085 "/ the following order must correlate to |
1126 "/ the following order must correlate to |
1086 "/ the storing in #binaryDefinitionFrom:manager: |
1127 "/ the storing in #binaryDefinitionFrom:manager: |
1087 |
1128 |
1088 "/ store |
1129 "/ store |
1089 "/ superclasses name, |
1130 "/ format ID |
|
1131 "/ superclasses name |
1090 "/ superclasses signature |
1132 "/ superclasses signature |
1091 "/ name, |
1133 "/ name |
1092 "/ typeSymbol, |
1134 "/ typeSymbol, |
1093 "/ instVarNames |
1135 "/ instVarNames |
1094 "/ classVarNames |
1136 "/ classVarNames |
1095 "/ category |
1137 "/ category |
1096 "/ classInstVarNames |
1138 "/ classInstVarNames |
1097 "/ comment |
1139 "/ comment |
1098 "/ package |
1140 "/ package |
|
1141 "/ classes methodDictionary |
|
1142 "/ methodDictionary |
|
1143 "/ # of privateClass names |
|
1144 "/ privateClasses |
|
1145 |
|
1146 1 storeBinaryOn:stream manager:manager. "/ formatID |
1099 |
1147 |
1100 superclass isNil ifTrue:[ |
1148 superclass isNil ifTrue:[ |
1101 s := nil. |
1149 s := nil. |
1102 sig := 0. |
1150 sig := 0. |
1103 ] ifFalse:[ |
1151 ] ifFalse:[ |
1135 s := nil |
1183 s := nil |
1136 ]. |
1184 ]. |
1137 s storeBinaryOn:stream manager:manager. |
1185 s storeBinaryOn:stream manager:manager. |
1138 package storeBinaryOn:stream manager:manager. |
1186 package storeBinaryOn:stream manager:manager. |
1139 |
1187 |
1140 |
|
1141 "/ |
1188 "/ |
1142 "/ store class method dictionary and methods |
1189 "/ store class method dictionary and methods |
1143 "/ |
1190 "/ |
1144 |
|
1145 self class methodDictionary storeFullBinaryDefinitionOn:stream manager:manager. |
1191 self class methodDictionary storeFullBinaryDefinitionOn:stream manager:manager. |
1146 "/ store inst method dictionary and methods |
1192 "/ store inst method dictionary and methods |
1147 self methodDictionary storeFullBinaryDefinitionOn:stream manager:manager. |
1193 self methodDictionary storeFullBinaryDefinitionOn:stream manager:manager. |
1148 |
1194 |
|
1195 "/ |
|
1196 "/ names of private classes |
|
1197 "/ |
|
1198 (privateClasses := self privateClasses) notNil ifTrue:[ |
|
1199 privateClasses size storeBinaryOn:stream manager:manager. |
|
1200 privateClasses do:[:aClass | |
|
1201 aClass storeBinaryClassOn:stream manager:manager |
|
1202 ] |
|
1203 ]. |
1149 |
1204 |
1150 " |
1205 " |
1151 |bos| |
1206 |bos| |
1152 |
1207 |
1153 bos := BinaryObjectStorage onNew: (Filename named: 'FBrowser.cls') writeStream. |
1208 bos := BinaryObjectStorage onNew: (Filename named: 'FBrowser.cls') writeStream. |