876 |
875 |
877 |nm| |
876 |nm| |
878 |
877 |
879 self wasAutoloaded ifFalse:[ |
878 self wasAutoloaded ifFalse:[ |
880 |
879 |
881 " |
880 " |
882 can it be done ? |
881 can it be done ? |
883 " |
882 " |
884 self methodArray do:[:aMethod | |
883 self methodArray do:[:aMethod | |
885 aMethod source isNil ifTrue:[^false]. |
884 aMethod source isNil ifTrue:[^false]. |
886 aMethod hasPrimitiveCode ifTrue:[^ false]. |
885 aMethod hasPrimitiveCode ifTrue:[^ false]. |
887 ]. |
886 ]. |
888 ]. |
887 ]. |
889 |
888 |
890 self allSubclassesDo:[:aClass | |
889 self allSubclassesDo:[:aClass | |
891 aClass unload |
890 aClass unload |
892 ]. |
891 ]. |
893 Transcript showCr:'unloading ' , name. |
892 Transcript showCr:'unloading ' , name , ' ...'. |
894 |
893 |
895 Autoload removeClass:self. |
894 Autoload removeClass:self. |
896 nm := name. |
895 nm := name. |
897 Smalltalk at:nm put:nil. |
896 Smalltalk at:nm put:nil. |
898 name := nm , ' (leftover)'. |
897 "/ name := (nm , ' (leftover)') asSymbol. |
899 ObjectMemory flushInlineCaches. |
898 ObjectMemory flushInlineCaches. |
900 ObjectMemory flushMethodCache. |
899 ObjectMemory flushMethodCache. |
901 Autoload addClass:nm inCategory:category. |
900 Autoload addClass:nm inCategory:category. |
|
901 "/ category := #unloaded. |
|
902 Smalltalk flushCachedClasses. |
902 ^ true |
903 ^ true |
903 |
904 |
904 " |
905 " |
905 Clock open. |
906 Clock open. |
906 Clock unload. |
907 Clock unload. |
907 ClockView unload. |
908 ClockView unload. |
908 Clock open |
909 Clock open |
909 " |
910 " |
|
911 |
|
912 "Modified: 7.2.1996 / 15:05:39 / cg" |
910 ! ! |
913 ! ! |
911 |
914 |
912 !Class methodsFor:'binary storage'! |
915 !Class methodsFor:'binary storage'! |
913 |
916 |
914 addGlobalsTo: globalDictionary manager: manager |
917 addGlobalsTo: globalDictionary manager: manager |
917 classPool associationsDo: [:assoc| |
920 classPool associationsDo: [:assoc| |
918 globalDictionary at: assoc put: self |
921 globalDictionary at: assoc put: self |
919 ] |
922 ] |
920 ] |
923 ] |
921 " |
924 " |
922 ! |
|
923 |
|
924 storeBinaryDefinitionOf: anAssociation on: stream manager: manager |
|
925 "not usable at the moment - there are no classpools currently" |
|
926 |
|
927 | string | |
|
928 |
|
929 string := self name, ' classPool at: ', anAssociation key storeString. |
|
930 stream nextNumber: 2 put: string size. |
|
931 string do: [:char| stream nextPut: char asciiValue] |
|
932 ! |
|
933 |
|
934 storeBinaryDefinitionOn: stream manager: manager |
|
935 "classes only store the name, signature and instvar names. |
|
936 They restore by looking for that name in the Smalltalk dictionary. |
|
937 However, using the signature, a check for being valid is made at |
|
938 restore time. |
|
939 This avoids a full recursive store of a class in the normal binary |
|
940 storage - however, it also means that a classes semantics cannot |
|
941 be stored with the basic storeBinary operation |
|
942 (we depend on the class being present at binaryLoad time. |
|
943 To store classes, use #storeBinaryClassOn:manager: or BOSS>>nextPutClasses:." |
|
944 |
|
945 |varnames n sz| |
|
946 |
|
947 " |
|
948 output the signature |
|
949 " |
|
950 stream nextNumber:4 put:self signature. |
|
951 |
|
952 " |
|
953 output the instance variable name string |
|
954 " |
|
955 varnames := self allInstVarNames. |
|
956 n := varnames size. |
|
957 n == 0 ifTrue:[ |
|
958 sz := 0 |
|
959 ] ifFalse:[ |
|
960 sz := varnames inject:0 into:[:sum :nm | sum + nm size]. |
|
961 sz := sz + n - 1. |
|
962 ]. |
|
963 stream nextNumber:2 put:sz. |
|
964 varnames keysAndValuesDo:[:i :nm | |
|
965 nm do:[:c | |
|
966 stream nextPut:c asciiValue |
|
967 ]. |
|
968 i ~~ n ifTrue:[stream nextPut:(Character space asciiValue)] |
|
969 ]. |
|
970 |
|
971 " |
|
972 output my name |
|
973 " |
|
974 stream nextNumber:2 put:name size. |
|
975 name do:[:c| |
|
976 stream nextPut:c asciiValue |
|
977 ] |
|
978 |
|
979 " |
|
980 |s| |
|
981 s := WriteStream on:ByteArray new. |
|
982 Rectangle storeBinaryOn:s. |
|
983 Object readBinaryFrom:(ReadStream on:s contents) |
|
984 " |
|
985 ! |
|
986 |
|
987 storeBinaryClassOn:stream manager:manager |
|
988 "store a classes complete description (i.e. including methods). |
|
989 However, the superclass chain is not stored - at load time, that must |
|
990 be either present or autoloadable." |
|
991 |
|
992 |nSel s selectors| |
|
993 |
|
994 stream nextPut: manager codeForClass. |
|
995 |
|
996 "/ the following order must correlate to |
|
997 "/ the storing in #binaryDefinitionFrom:manager: |
|
998 |
|
999 "/ store |
|
1000 "/ superclasses name, |
|
1001 "/ name, |
|
1002 "/ typeSymbol, |
|
1003 "/ instVarNames |
|
1004 "/ classVarNames |
|
1005 "/ category |
|
1006 "/ classInstVarNames |
|
1007 "/ comment |
|
1008 "/ package |
|
1009 |
|
1010 superclass isNil ifTrue:[ |
|
1011 s := nil |
|
1012 ] ifFalse:[ |
|
1013 s := superclass name |
|
1014 ]. |
|
1015 s storeBinaryOn:stream manager:manager. |
|
1016 name storeBinaryOn:stream manager:manager. |
|
1017 flags storeBinaryOn:stream manager:manager. |
|
1018 (instvars notNil and:[instvars isEmpty]) ifTrue:[ |
|
1019 s := nil |
|
1020 ] ifFalse:[ |
|
1021 s := instvars |
|
1022 ]. |
|
1023 s storeBinaryOn:stream manager:manager. |
|
1024 |
|
1025 (classvars notNil and:[classvars isEmpty]) ifTrue:[ |
|
1026 s := nil |
|
1027 ] ifFalse:[ |
|
1028 s := classvars |
|
1029 ]. |
|
1030 s storeBinaryOn:stream manager:manager. |
|
1031 |
|
1032 category storeBinaryOn:stream manager:manager. |
|
1033 s := self class instanceVariableString. |
|
1034 (s notNil and:[s isEmpty]) ifTrue:[ |
|
1035 s := nil |
|
1036 ]. |
|
1037 s storeBinaryOn:stream manager:manager. |
|
1038 |
|
1039 s := comment. |
|
1040 manager sourceMode == #discard ifTrue:[ |
|
1041 s := nil |
|
1042 ]. |
|
1043 s storeBinaryOn:stream manager:manager. |
|
1044 package storeBinaryOn:stream manager:manager. |
|
1045 |
|
1046 "/ store |
|
1047 "/ number of class methods |
|
1048 selectors := self class selectorArray copy. |
|
1049 selectors storeBinaryOn:stream manager:manager. |
|
1050 |
|
1051 "/ store |
|
1052 "/ class methods |
|
1053 selectors do:[:sel | |
|
1054 |m m2| |
|
1055 |
|
1056 m := self class compiledMethodAt:sel. |
|
1057 m isLazyMethod ifTrue:[ |
|
1058 m2 := m makeRealMethod. |
|
1059 m2 notNil ifTrue:[ |
|
1060 m := m2 |
|
1061 ] ifFalse:[ |
|
1062 ('failed to compile: ' , m displayString) errorPrintNL |
|
1063 ] |
|
1064 ]. |
|
1065 |
|
1066 m storeFullBinaryDefinitionOn:stream manager:manager |
|
1067 ]. |
|
1068 |
|
1069 "/ store |
|
1070 "/ number of inst methods |
|
1071 |
|
1072 selectors := selectorArray copy. |
|
1073 selectors storeBinaryOn:stream manager:manager. |
|
1074 |
|
1075 "/ store |
|
1076 "/ inst methods |
|
1077 selectors do:[:sel | |
|
1078 |m| |
|
1079 |
|
1080 m := self compiledMethodAt:sel. |
|
1081 m isLazyMethod ifTrue:[ |
|
1082 m := m makeRealMethod |
|
1083 ]. |
|
1084 |
|
1085 m storeFullBinaryDefinitionOn:stream manager:manager |
|
1086 ]. |
|
1087 |
|
1088 " |
|
1089 |bos| |
|
1090 |
|
1091 bos := BinaryObjectStorage onNew: (Filename named: 'FBrowser.cls') writeStream. |
|
1092 bos nextPutClasses:(Array with:FileBrowser). |
|
1093 bos close. |
|
1094 " |
|
1095 " |
|
1096 |bos cls| |
|
1097 |
|
1098 bos := BinaryObjectStorage onOld: (Filename named: 'FBrowser.cls') readStream. |
|
1099 cls := bos next. |
|
1100 bos close. |
|
1101 cls open. |
|
1102 " |
|
1103 |
|
1104 "Modified: 16.1.1996 / 17:01:05 / cg" |
|
1105 ! |
925 ! |
1106 |
926 |
1107 binaryClassDefinitionFrom:stream manager:manager |
927 binaryClassDefinitionFrom:stream manager:manager |
1108 "retrieve a class as stored previously with |
928 "retrieve a class as stored previously with |
1109 #storeBinaryClassOn:manager:" |
929 #storeBinaryClassOn:manager:" |
1218 newClass selectors:selectors methods:methods. |
1038 newClass selectors:selectors methods:methods. |
1219 newClass class selectors:cselectors methods:cmethods. |
1039 newClass class selectors:cselectors methods:cmethods. |
1220 ^ newClass |
1040 ^ newClass |
1221 |
1041 |
1222 "Modified: 22.1.1996 / 13:22:08 / cg" |
1042 "Modified: 22.1.1996 / 13:22:08 / cg" |
|
1043 ! |
|
1044 |
|
1045 storeBinaryClassOn:stream manager:manager |
|
1046 "store a classes complete description (i.e. including methods). |
|
1047 However, the superclass chain is not stored - at load time, that must |
|
1048 be either present or autoloadable." |
|
1049 |
|
1050 |nSel s selectors| |
|
1051 |
|
1052 stream nextPut: manager codeForClass. |
|
1053 |
|
1054 "/ the following order must correlate to |
|
1055 "/ the storing in #binaryDefinitionFrom:manager: |
|
1056 |
|
1057 "/ store |
|
1058 "/ superclasses name, |
|
1059 "/ name, |
|
1060 "/ typeSymbol, |
|
1061 "/ instVarNames |
|
1062 "/ classVarNames |
|
1063 "/ category |
|
1064 "/ classInstVarNames |
|
1065 "/ comment |
|
1066 "/ package |
|
1067 |
|
1068 superclass isNil ifTrue:[ |
|
1069 s := nil |
|
1070 ] ifFalse:[ |
|
1071 s := superclass name |
|
1072 ]. |
|
1073 s storeBinaryOn:stream manager:manager. |
|
1074 name storeBinaryOn:stream manager:manager. |
|
1075 flags storeBinaryOn:stream manager:manager. |
|
1076 (instvars notNil and:[instvars isEmpty]) ifTrue:[ |
|
1077 s := nil |
|
1078 ] ifFalse:[ |
|
1079 s := instvars |
|
1080 ]. |
|
1081 s storeBinaryOn:stream manager:manager. |
|
1082 |
|
1083 (classvars notNil and:[classvars isEmpty]) ifTrue:[ |
|
1084 s := nil |
|
1085 ] ifFalse:[ |
|
1086 s := classvars |
|
1087 ]. |
|
1088 s storeBinaryOn:stream manager:manager. |
|
1089 |
|
1090 category storeBinaryOn:stream manager:manager. |
|
1091 s := self class instanceVariableString. |
|
1092 (s notNil and:[s isEmpty]) ifTrue:[ |
|
1093 s := nil |
|
1094 ]. |
|
1095 s storeBinaryOn:stream manager:manager. |
|
1096 |
|
1097 s := comment. |
|
1098 manager sourceMode == #discard ifTrue:[ |
|
1099 s := nil |
|
1100 ]. |
|
1101 s storeBinaryOn:stream manager:manager. |
|
1102 package storeBinaryOn:stream manager:manager. |
|
1103 |
|
1104 "/ store |
|
1105 "/ number of class methods |
|
1106 selectors := self class selectorArray copy. |
|
1107 selectors storeBinaryOn:stream manager:manager. |
|
1108 |
|
1109 "/ store |
|
1110 "/ class methods |
|
1111 selectors do:[:sel | |
|
1112 |m m2| |
|
1113 |
|
1114 m := self class compiledMethodAt:sel. |
|
1115 m isLazyMethod ifTrue:[ |
|
1116 m2 := m makeRealMethod. |
|
1117 m2 notNil ifTrue:[ |
|
1118 m := m2 |
|
1119 ] ifFalse:[ |
|
1120 ('failed to compile: ' , m displayString) errorPrintNL |
|
1121 ] |
|
1122 ]. |
|
1123 |
|
1124 m storeFullBinaryDefinitionOn:stream manager:manager |
|
1125 ]. |
|
1126 |
|
1127 "/ store |
|
1128 "/ number of inst methods |
|
1129 |
|
1130 selectors := selectorArray copy. |
|
1131 selectors storeBinaryOn:stream manager:manager. |
|
1132 |
|
1133 "/ store |
|
1134 "/ inst methods |
|
1135 selectors do:[:sel | |
|
1136 |m| |
|
1137 |
|
1138 m := self compiledMethodAt:sel. |
|
1139 m isLazyMethod ifTrue:[ |
|
1140 m := m makeRealMethod |
|
1141 ]. |
|
1142 |
|
1143 m storeFullBinaryDefinitionOn:stream manager:manager |
|
1144 ]. |
|
1145 |
|
1146 " |
|
1147 |bos| |
|
1148 |
|
1149 bos := BinaryObjectStorage onNew: (Filename named: 'FBrowser.cls') writeStream. |
|
1150 bos nextPutClasses:(Array with:FileBrowser). |
|
1151 bos close. |
|
1152 " |
|
1153 " |
|
1154 |bos cls| |
|
1155 |
|
1156 bos := BinaryObjectStorage onOld: (Filename named: 'FBrowser.cls') readStream. |
|
1157 cls := bos next. |
|
1158 bos close. |
|
1159 cls open. |
|
1160 " |
|
1161 |
|
1162 "Modified: 16.1.1996 / 17:01:05 / cg" |
|
1163 ! |
|
1164 |
|
1165 storeBinaryDefinitionOf: anAssociation on: stream manager: manager |
|
1166 "not usable at the moment - there are no classpools currently" |
|
1167 |
|
1168 | string | |
|
1169 |
|
1170 string := self name, ' classPool at: ', anAssociation key storeString. |
|
1171 stream nextNumber: 2 put: string size. |
|
1172 string do: [:char| stream nextPut: char asciiValue] |
|
1173 ! |
|
1174 |
|
1175 storeBinaryDefinitionOn: stream manager: manager |
|
1176 "classes only store the name, signature and instvar names. |
|
1177 They restore by looking for that name in the Smalltalk dictionary. |
|
1178 However, using the signature, a check for being valid is made at |
|
1179 restore time. |
|
1180 This avoids a full recursive store of a class in the normal binary |
|
1181 storage - however, it also means that a classes semantics cannot |
|
1182 be stored with the basic storeBinary operation |
|
1183 (we depend on the class being present at binaryLoad time. |
|
1184 To store classes, use #storeBinaryClassOn:manager: or BOSS>>nextPutClasses:." |
|
1185 |
|
1186 |varnames n sz| |
|
1187 |
|
1188 " |
|
1189 output the signature |
|
1190 " |
|
1191 stream nextNumber:4 put:self signature. |
|
1192 |
|
1193 " |
|
1194 output the instance variable name string |
|
1195 " |
|
1196 varnames := self allInstVarNames. |
|
1197 n := varnames size. |
|
1198 n == 0 ifTrue:[ |
|
1199 sz := 0 |
|
1200 ] ifFalse:[ |
|
1201 sz := varnames inject:0 into:[:sum :nm | sum + nm size]. |
|
1202 sz := sz + n - 1. |
|
1203 ]. |
|
1204 stream nextNumber:2 put:sz. |
|
1205 varnames keysAndValuesDo:[:i :nm | |
|
1206 nm do:[:c | |
|
1207 stream nextPut:c asciiValue |
|
1208 ]. |
|
1209 i ~~ n ifTrue:[stream nextPut:(Character space asciiValue)] |
|
1210 ]. |
|
1211 |
|
1212 " |
|
1213 output my name |
|
1214 " |
|
1215 stream nextNumber:2 put:name size. |
|
1216 name do:[:c| |
|
1217 stream nextPut:c asciiValue |
|
1218 ] |
|
1219 |
|
1220 " |
|
1221 |s| |
|
1222 s := WriteStream on:ByteArray new. |
|
1223 Rectangle storeBinaryOn:s. |
|
1224 Object readBinaryFrom:(ReadStream on:s contents) |
|
1225 " |
1223 ! ! |
1226 ! ! |
1224 |
1227 |
1225 !Class methodsFor:'c function interfacing'! |
1228 !Class methodsFor:'c function interfacing'! |
1226 |
1229 |
1227 cInterfaceFunction:selector calling:cFunctionNameString args:argTypeArray returning:returnType |
1230 cInterfaceFunction:selector calling:cFunctionNameString args:argTypeArray returning:returnType |
1982 browsable." |
1985 browsable." |
1983 |
1986 |
1984 self binaryFileOutWithSourceMode:#reference |
1987 self binaryFileOutWithSourceMode:#reference |
1985 ! |
1988 ! |
1986 |
1989 |
|
1990 binaryFileOutOn:aStream |
|
1991 "append a binary representation of myself to aStream" |
|
1992 |
|
1993 self binaryFileOutOn:aStream sourceMode:#reference |
|
1994 ! |
|
1995 |
|
1996 binaryFileOutOn:aStream sourceMode:sourceMode |
|
1997 "append a binary representation of myself to aStream in |
|
1998 a portable binary format. |
|
1999 The argument controls how sources are to be saved: |
|
2000 #keep - include the source |
|
2001 #reference - include a reference to the sourceFile |
|
2002 #discard - dont save sources. |
|
2003 |
|
2004 With #reference, the sourceFile needs to be present after reload |
|
2005 in order to be browsable." |
|
2006 |
|
2007 |bos| |
|
2008 |
|
2009 bos := BinaryObjectStorage onNew:aStream. |
|
2010 bos sourceMode:sourceMode. |
|
2011 bos nextPutClasses:(Array with:self). |
|
2012 bos close. |
|
2013 ! |
|
2014 |
1987 binaryFileOutWithSourceMode:sourceMode |
2015 binaryFileOutWithSourceMode:sourceMode |
1988 "create a file 'class.cls' consisting of all methods in myself |
2016 "create a file 'class.cls' consisting of all methods in myself |
1989 in a portable binary format. |
2017 in a portable binary format. |
1990 The argument controls how sources are to be saved: |
2018 The argument controls how sources are to be saved: |
1991 #keep - include the source |
2019 #keep - include the source |
3128 in the versionString. |
3131 in the versionString. |
3129 |
3132 |
3130 The info returned consists of a dictionary |
3133 The info returned consists of a dictionary |
3131 filled with (at least) values at: #module, #directory and #library. |
3134 filled with (at least) values at: #module, #directory and #library. |
3132 If no such info is present in the class, nil is returned. |
3135 If no such info is present in the class, nil is returned. |
3133 (this happens with autoloaded and filed0in classes) |
3136 (this happens with autoloaded and filed-in classes) |
|
3137 Auotloaded classes set their package from the revisionInfo, if present. |
3134 |
3138 |
3135 By convention, this info is encoded in the classes package |
3139 By convention, this info is encoded in the classes package |
3136 string (which is given as argument to stc) as the last word in parenthesis. |
3140 string (which is given as argument to stc) as the last word in parenthesis. |
3137 The info consists of 1 to 3 subcomponents, separated by colons. |
3141 The info consists of 1 to 3 subcomponents, separated by colons. |
3138 The first defines the classes module (i.e. some application identifier), |
3142 The first defines the classes module (i.e. some application identifier), |
3142 the directory info defaults to library name. |
3146 the directory info defaults to library name. |
3143 The library name may not be left blank. |
3147 The library name may not be left blank. |
3144 (this is done for backward compatibility,) |
3148 (this is done for backward compatibility,) |
3145 |
3149 |
3146 For example: |
3150 For example: |
3147 '....(libbasic)' -> module: stx directory: libbasic library: libbasic |
3151 '....(libbasic)' -> module: stx directory: libbasic library: libbasic |
3148 '....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic |
3152 '....(stx:libbasic)' -> module: stx directory: libbasic library: libbasic |
3149 '....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface |
3153 '....(aeg:libIECInterface)' -> module: aeg directory: libIECInterface library:libIECInterface |
3150 '....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase |
3154 '....(stx:goodies/persistency:libdbase)' -> module: stx directory: goodies/persistency library:libdbase |
3151 |
3155 |
3152 The way how the sourceCodeManager uses this to find the source location |
3156 The way how the sourceCodeManager uses this to find the source location |
3153 depends on the scheme used. For CVS, the module is taken as the -d arg, |
3157 depends on the scheme used. For CVS, the module is taken as the -d arg, |
3154 while the directory is prepended to the file name. |
3158 while the directory is prepended to the file name. |
3155 Other schemes may do things differently - these are not yet specified. |
3159 Other schemes may do things differently - these are not yet specified. |
3156 |
3160 |
3157 Caveat: |
3161 Caveat: |
3158 Encoding this info in the package string seems somewhat kludgy. |
3162 Encoding this info in the package string seems somewhat kludgy. |
3159 " |
3163 " |
3160 |
3164 |
3161 |sourceInfo packageString idx1 idx2 |
3165 |sourceInfo packageString idx1 idx2 |
3162 moduleString directoryString libraryString components| |
3166 moduleString directoryString libraryString components| |
3163 |
3167 |
3164 package isNil ifTrue:[^ nil]. |
3168 package isNil ifTrue:[^ nil]. |
3165 |
3169 |
3166 packageString := package asString. |
3170 packageString := package asString. |
3167 idx1 := packageString lastIndexOf:$(. |
3171 idx1 := packageString lastIndexOf:$(. |
3168 idx1 ~~ 0 ifTrue:[ |
3172 idx1 ~~ 0 ifTrue:[ |
3169 idx2 := packageString indexOf:$) startingAt:idx1+1. |
3173 idx2 := packageString indexOf:$) startingAt:idx1+1. |
3170 idx2 ~~ 0 ifTrue:[ |
3174 idx2 ~~ 0 ifTrue:[ |
3171 sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1 |
3175 sourceInfo := packageString copyFrom:idx1 + 1 to:idx2 - 1 |
3172 ] |
3176 ] |
3173 ]. |
3177 ]. |
3174 sourceInfo isNil ifTrue:[^ nil]. |
3178 sourceInfo isNil ifTrue:[^ nil]. |
3175 components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:. |
3179 components := sourceInfo asCollectionOfSubstringsSeparatedBy:$:. |
3176 components size == 0 ifTrue:[ |
3180 components size == 0 ifTrue:[ |
3177 moduleString := 'stx'. |
3181 moduleString := 'stx'. |
3178 directoryString := libraryString := ''. |
3182 directoryString := libraryString := ''. |
3179 ^ nil |
3183 ^ nil |
3180 ] ifFalse:[ |
3184 ] ifFalse:[ |
3181 components size == 1 ifTrue:[ |
3185 components size == 1 ifTrue:[ |
3182 "/ a single name given - the module becomes 'stx', |
3186 "/ a single name given - the module becomes 'stx', |
3183 "/ if the component includes slashes, its the directory |
3187 "/ if the component includes slashes, its the directory |
3184 "/ otherwise the library |
3188 "/ otherwise the library |
3185 "/ |
3189 "/ |
3186 moduleString := 'stx'. |
3190 moduleString := 'stx'. |
3187 directoryString := libraryString := components at:1. |
3191 directoryString := libraryString := components at:1. |
3188 (libraryString includes:$/) ifTrue:[ |
3192 (libraryString includes:$/) ifTrue:[ |
3189 libraryString := libraryString asFilename baseName |
3193 libraryString := libraryString asFilename baseName |
3190 ] |
3194 ] |
3191 ] ifFalse:[ |
3195 ] ifFalse:[ |
3192 components size == 2 ifTrue:[ |
3196 components size == 2 ifTrue:[ |
3193 "/ two components - assume its the directory and the library |
3197 "/ two components - assume its the module and the directory; |
3194 moduleString := 'stx'. |
3198 "/ the library is assumed to be named after the directory |
3195 directoryString := components at:1. |
3199 "/ except, if slashes are in the name; then the libraryname |
3196 libraryString := components at:2. |
3200 "/ is the last component. |
3197 ] ifFalse:[ |
3201 "/ |
3198 "/ all components given |
3202 moduleString := components at:1. |
3199 moduleString := components at:1. |
3203 directoryString := libraryString := components at:2. |
3200 directoryString := components at:2. |
3204 (libraryString includes:$/) ifTrue:[ |
3201 libraryString := components at:3. |
3205 libraryString := libraryString asFilename baseName |
3202 ] |
3206 ] |
3203 ] |
3207 ] ifFalse:[ |
|
3208 "/ all components given |
|
3209 moduleString := components at:1. |
|
3210 directoryString := components at:2. |
|
3211 libraryString := components at:3. |
|
3212 ] |
|
3213 ] |
3204 ]. |
3214 ]. |
3205 libraryString isEmpty ifTrue:[ |
3215 libraryString isEmpty ifTrue:[ |
3206 directoryString notEmpty ifTrue:[ |
3216 directoryString notEmpty ifTrue:[ |
3207 libraryString := directoryString asFilename baseName |
3217 libraryString := directoryString asFilename baseName |
3208 ]. |
3218 ]. |
3209 libraryString isEmpty ifTrue:[ |
3219 libraryString isEmpty ifTrue:[ |
3210 "/ lets extract the library from the liblist file ... |
3220 "/ lets extract the library from the liblist file ... |
3211 libraryString := Smalltalk libraryFileNameOfClass:self. |
3221 libraryString := Smalltalk libraryFileNameOfClass:self. |
3212 libraryString isNil ifTrue:[^ nil]. |
3222 libraryString isNil ifTrue:[^ nil]. |
3213 ] |
3223 ] |
3214 ]. |
3224 ]. |
3215 |
3225 |
3216 moduleString isEmpty ifTrue:[ |
3226 moduleString isEmpty ifTrue:[ |
3217 moduleString := 'stx'. |
3227 moduleString := 'stx'. |
3218 ]. |
3228 ]. |
3219 directoryString isEmpty ifTrue:[ |
3229 directoryString isEmpty ifTrue:[ |
3220 directoryString := libraryString. |
3230 directoryString := libraryString. |
3221 ]. |
3231 ]. |
3222 |
3232 |
3223 ^ IdentityDictionary |
3233 ^ IdentityDictionary |
3224 with:(#module->moduleString) |
3234 with:(#module->moduleString) |
3225 with:(#directory->directoryString) |
3235 with:(#directory->directoryString) |
3226 with:(#library->libraryString) |
3236 with:(#library->libraryString) |
3227 |
3237 |
3228 " |
3238 " |
3229 Object packageSourceCodeInfo |
3239 Object packageSourceCodeInfo |
3230 View packageSourceCodeInfo |
3240 View packageSourceCodeInfo |
3231 Model packageSourceCodeInfo |
3241 Model packageSourceCodeInfo |
3376 (and optionally: extracting the required sourcefile from the rcs source)" |
3386 (and optionally: extracting the required sourcefile from the rcs source)" |
3377 |
3387 |
3378 revision := aString |
3388 revision := aString |
3379 |
3389 |
3380 "Created: 9.12.1995 / 17:05:17 / cg" |
3390 "Created: 9.12.1995 / 17:05:17 / cg" |
|
3391 ! |
|
3392 |
|
3393 setPackageFromRevision |
|
3394 "set my package from the info found in the revisionString if present. |
|
3395 This is used to set some useful packageInfo after autoloading |
|
3396 (otherwise, autoloaded classes/methods would go into your current |
|
3397 package - which is probably not a good idea)" |
|
3398 |
|
3399 |info mgr dir lib mod p| |
|
3400 |
|
3401 mgr := self sourceCodeManager. |
|
3402 mgr notNil ifTrue:[ |
|
3403 info := mgr sourceInfoOfClass:self |
|
3404 ]. |
|
3405 |
|
3406 info notNil ifTrue:[ |
|
3407 mod := info at:#module ifAbsent:nil. "/ stx, aeg, <your-organization> |
|
3408 dir := info at:#directory ifAbsent:nil. "/ libbasic, libtool ... |
|
3409 lib := info at:#library ifAbsent:dir. |
|
3410 |
|
3411 p := ''. |
|
3412 mod notNil ifTrue:[ |
|
3413 mod ~= 'stx' ifTrue:[ |
|
3414 p := p , mod |
|
3415 ] |
|
3416 ]. |
|
3417 dir notNil ifTrue:[ |
|
3418 p notEmpty ifTrue:[p := p , ':']. |
|
3419 p := p , dir. |
|
3420 ]. |
|
3421 lib notNil ifTrue:[ |
|
3422 lib ~= dir ifTrue:[ |
|
3423 p notEmpty ifTrue:[p := p , ':']. |
|
3424 p := p , lib. |
|
3425 ] |
|
3426 ]. |
|
3427 p notEmpty ifTrue:[ |
|
3428 p := '(' , p , ')'. |
|
3429 |
|
3430 package notNil ifTrue:[ |
|
3431 (name , ': changing packageID to ''' , p , '''') infoPrintNL. |
|
3432 ]. |
|
3433 package := p. |
|
3434 |
|
3435 methodArray do:[:aMethod | |
|
3436 aMethod package isNil ifTrue:[ |
|
3437 aMethod package:p |
|
3438 ] |
|
3439 ] |
|
3440 ]. |
|
3441 ]. |
|
3442 ^ self |
|
3443 |
|
3444 " |
|
3445 MemoryMonitor autoload. |
|
3446 MemoryMonitor setPackageFromRevision |
|
3447 " |
|
3448 |
|
3449 "Modified: 7.2.1996 / 14:36:48 / cg" |
3381 ! |
3450 ! |
3382 |
3451 |
3383 sourceStream |
3452 sourceStream |
3384 "return an open stream on my sourcefile, nil if that is not available" |
3453 "return an open stream on my sourcefile, nil if that is not available" |
3385 |
3454 |