598 ! |
598 ! |
599 |
599 |
600 addChangeRecordForMethod:aMethod |
600 addChangeRecordForMethod:aMethod |
601 "add a method-change-record to the changes file" |
601 "add a method-change-record to the changes file" |
602 |
602 |
603 |aStream p| |
603 |aStream| |
604 |
604 |
605 aStream := self changesStream. |
605 aStream := self changesStream. |
606 aStream notNil ifTrue:[ |
606 aStream notNil ifTrue:[ |
607 p := aStream position. |
|
608 self fileOutMethod:aMethod on:aStream. |
607 self fileOutMethod:aMethod on:aStream. |
609 aStream cr. |
608 aStream cr. |
610 aStream close. |
609 aStream close. |
611 |
610 |
612 "this test allows a smalltalk without Projects/ChangeSets" |
611 "this test allows a smalltalk without Projects/ChangeSets" |
613 (Project notNil and:[Project current notNil]) ifTrue:[ |
612 Project notNil ifTrue:[ |
614 Project current changeSet addMethodChange:aMethod in:self |
613 Project addMethodChange:aMethod in:self |
615 ] |
614 ] |
616 ] |
615 ] |
617 ! |
616 ! |
618 |
617 |
619 addChangeRecordForRemoveSelector:aSelector |
618 addChangeRecordForRemoveSelector:aSelector |
1081 methodArray do:[:aMethod | |
1080 methodArray do:[:aMethod | |
1082 (aCategory = aMethod category) ifTrue:[ |
1081 (aCategory = aMethod category) ifTrue:[ |
1083 nMethods := nMethods + 1 |
1082 nMethods := nMethods + 1 |
1084 ] |
1083 ] |
1085 ]. |
1084 ]. |
1086 sep := aStream class chunkSeparator. |
1085 sep := aStream class chunkSeparator. |
1087 (nMethods ~~ 0) ifTrue:[ |
1086 (nMethods ~~ 0) ifTrue:[ |
1088 aStream nextPut:sep. |
1087 aStream nextPut:sep. |
1089 self printClassNameOn:aStream. |
1088 self printClassNameOn:aStream. |
1090 aStream nextPutAll:' methodsFor:'''. |
1089 aStream nextPutAll:' methodsFor:'''. |
1091 aCategory notNil ifTrue:[ |
1090 aCategory notNil ifTrue:[ |
1115 "file out the method, aMethod onto aStream" |
1114 "file out the method, aMethod onto aStream" |
1116 |
1115 |
1117 |cat sep| |
1116 |cat sep| |
1118 |
1117 |
1119 methodArray notNil ifTrue:[ |
1118 methodArray notNil ifTrue:[ |
1120 sep := aStream class chunkSeparator. |
1119 sep := aStream class chunkSeparator. |
1121 aStream nextPut:sep. |
1120 aStream nextPut:sep. |
1122 self printClassNameOn:aStream. |
1121 self printClassNameOn:aStream. |
1123 aStream nextPutAll:' methodsFor:'''. |
1122 aStream nextPutAll:' methodsFor:'''. |
1124 cat := aMethod category. |
1123 cat := aMethod category. |
1125 cat notNil ifTrue:[ |
1124 cat notNil ifTrue:[ |
1234 fileOutCategory:aCategory |
1233 fileOutCategory:aCategory |
1235 "create a file 'class-category.st' consisting of all methods in aCategory. |
1234 "create a file 'class-category.st' consisting of all methods in aCategory. |
1236 If the current project is not nil, create the file in the projects |
1235 If the current project is not nil, create the file in the projects |
1237 directory." |
1236 directory." |
1238 |
1237 |
1239 |aStream fileName project| |
1238 |aStream fileName| |
1240 |
1239 |
1241 fileName := name , '-' , aCategory , '.st'. |
1240 fileName := name , '-' , aCategory , '.st'. |
1242 fileName replaceAll:(Character space) by:$_. |
1241 fileName replaceAll:(Character space) by:$_. |
|
1242 |
|
1243 " |
|
1244 this test allows a smalltalk to be built without Projects/ChangeSets |
|
1245 " |
1243 Project notNil ifTrue:[ |
1246 Project notNil ifTrue:[ |
1244 project := Project current. |
1247 fileName := Project currentProjectDirectory , fileName. |
1245 project notNil ifTrue:[ |
|
1246 fileName := project directory , Filename separator asString , fileName. |
|
1247 ]. |
|
1248 ]. |
1248 ]. |
1249 aStream := FileStream newFileNamed:fileName. |
1249 aStream := FileStream newFileNamed:fileName. |
1250 self fileOutCategory:aCategory on:aStream. |
1250 self fileOutCategory:aCategory on:aStream. |
1251 aStream close |
1251 aStream close |
1252 ! |
1252 ! |
1254 fileOutMethod:aMethod |
1254 fileOutMethod:aMethod |
1255 "create a file 'class-method.st' consisting of the method, aMethod. |
1255 "create a file 'class-method.st' consisting of the method, aMethod. |
1256 If the current project is not nil, create the file in the projects |
1256 If the current project is not nil, create the file in the projects |
1257 directory." |
1257 directory." |
1258 |
1258 |
1259 |aStream fileName selector project| |
1259 |aStream fileName selector| |
1260 |
1260 |
1261 selector := self selectorForMethod:aMethod. |
1261 selector := self selectorForMethod:aMethod. |
1262 selector notNil ifTrue:[ |
1262 selector notNil ifTrue:[ |
1263 fileName := name , '-' , selector, '.st'. |
1263 fileName := name , '-' , selector, '.st'. |
1264 fileName replaceAll:$: by:$_. |
1264 fileName replaceAll:$: by:$_. |
|
1265 " |
|
1266 this test allows a smalltalk to be built without Projects/ChangeSets |
|
1267 " |
1265 Project notNil ifTrue:[ |
1268 Project notNil ifTrue:[ |
1266 project := Project current. |
1269 fileName := Project currentProjectDirectory , fileName. |
1267 project notNil ifTrue:[ |
|
1268 fileName := project directory , Filename separator asString , fileName. |
|
1269 ]. |
|
1270 ]. |
1270 ]. |
1271 aStream := FileStream newFileNamed:fileName. |
1271 aStream := FileStream newFileNamed:fileName. |
1272 self fileOutMethod:aMethod on:aStream. |
1272 self fileOutMethod:aMethod on:aStream. |
1273 aStream close |
1273 aStream close |
1274 ] |
1274 ] |
1277 fileOut |
1277 fileOut |
1278 "create a file 'class.st' consisting of all methods in myself. |
1278 "create a file 'class.st' consisting of all methods in myself. |
1279 If the current project is not nil, create the file in the projects |
1279 If the current project is not nil, create the file in the projects |
1280 directory." |
1280 directory." |
1281 |
1281 |
1282 |aStream fileName project| |
1282 |aStream fileName| |
1283 |
1283 |
1284 fileName := (Smalltalk fileNameForClass:self name) , '.st'. |
1284 fileName := (Smalltalk fileNameForClass:self name) , '.st'. |
|
1285 " |
|
1286 this test allows a smalltalk to be built without Projects/ChangeSets |
|
1287 " |
1285 Project notNil ifTrue:[ |
1288 Project notNil ifTrue:[ |
1286 project := Project current. |
1289 fileName := Project currentProjectDirectory , fileName. |
1287 project notNil ifTrue:[ |
|
1288 fileName := project directory , Filename separator asString , fileName. |
|
1289 ]. |
|
1290 ]. |
1290 ]. |
1291 aStream := FileStream newFileNamed:fileName. |
1291 aStream := FileStream newFileNamed:fileName. |
1292 aStream isNil ifTrue:[ |
1292 aStream isNil ifTrue:[ |
1293 ^ self error:('cannot create source file:', fileName) |
1293 ^ self error:('cannot create source file:', fileName) |
1294 ]. |
1294 ]. |
1296 aStream close |
1296 aStream close |
1297 ! |
1297 ! |
1298 |
1298 |
1299 fileOutIn:aFileDirectory |
1299 fileOutIn:aFileDirectory |
1300 "create a file 'class.st' consisting of all methods in self in |
1300 "create a file 'class.st' consisting of all methods in self in |
1301 directory aFileDirectory" |
1301 directory aFileDirectory (ignoring any directory setting in |
|
1302 the current porject)." |
1302 |
1303 |
1303 |aStream fileName| |
1304 |aStream fileName| |
1304 |
1305 |
1305 fileName := (Smalltalk fileNameForClass:self name) , '.st'. |
1306 fileName := (Smalltalk fileNameForClass:self name) , '.st'. |
1306 aStream := FileStream newFileNamed:fileName |
1307 aStream := FileStream newFileNamed:fileName in:aFileDirectory. |
1307 in:aFileDirectory. |
|
1308 aStream isNil ifTrue:[ |
1308 aStream isNil ifTrue:[ |
1309 ^ self error:('cannot create source file:', fileName) |
1309 ^ self error:('cannot create source file:', fileName) |
1310 ]. |
1310 ]. |
1311 self fileOutOn:aStream. |
1311 self fileOutOn:aStream. |
1312 aStream close |
1312 aStream close |
1381 XXbinaryFileOut |
1381 XXbinaryFileOut |
1382 "create a file 'class.sb' consisting of all methods in myself. |
1382 "create a file 'class.sb' consisting of all methods in myself. |
1383 If the current project is not nil, create the file in the projects |
1383 If the current project is not nil, create the file in the projects |
1384 directory." |
1384 directory." |
1385 |
1385 |
1386 |aStream fileName project| |
1386 |aStream fileName| |
1387 |
1387 |
1388 fileName := (Smalltalk fileNameForClass:self name) , '.sb'. |
1388 fileName := (Smalltalk fileNameForClass:self name) , '.sb'. |
1389 project := Project current. |
1389 Project notNil ifTrue:[ |
1390 project notNil ifTrue:[ |
1390 fileName := Project currentProjectDirectory , fileName. |
1391 fileName := project directory , Filename separator asString , fileName. |
|
1392 ]. |
1391 ]. |
1393 aStream := FileStream newFileNamed:fileName. |
1392 aStream := FileStream newFileNamed:fileName. |
1394 aStream isNil ifTrue:[ |
1393 aStream isNil ifTrue:[ |
1395 ^ self error:('cannot create class file:', fileName) |
1394 ^ self error:('cannot create class file:', fileName) |
1396 ]. |
1395 ]. |