Class.st
changeset 356 6c5ce0e1e7a8
parent 355 2d96938a5081
child 357 82091a50055d
--- a/Class.st	Fri May 19 15:33:11 1995 +0200
+++ b/Class.st	Wed May 24 14:44:58 1995 +0200
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.43 1995-05-19 13:33:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.44 1995-05-24 12:41:53 claus Exp $
 '!
 
 !Class class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.43 1995-05-19 13:33:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.44 1995-05-24 12:41:53 claus Exp $
 "
 !
 
@@ -114,18 +114,6 @@
     ^ FileOutErrorSignal
 ! !
 
-!Class class methodsFor:'creating new classes'!
-
-new
-    "creates and returs a new class"
-
-    |newClass|
-
-    newClass := super new.
-"/    newClass setComment:(self comment) category:(self category).
-    ^ newClass
-! !
-
 !Class class methodsFor:'enumeration '!
 
 allClassesInCategory:aCategory do:aBlock
@@ -1819,7 +1807,7 @@
 fileOutOn:aStream
     "file out my definition and all methods onto aStream"
 
-    |collectionOfCategories copyrightText sep comment|
+    |collectionOfCategories copyrightText sep comment cls|
 
     "
      if there is a copyright method, add a copyright comment
@@ -1830,12 +1818,12 @@
      copyright string at the beginning be preserved .... even if the
      code was edited in the browser and filedOut.
     "
-    (self class selectorArray includes:#copyright) ifTrue:[
+    ((cls := self class) selectorArray includes:#copyright) ifTrue:[
 	"
 	 get the copyright methods source,
 	 and insert at beginning.
 	"
-	copyrightText := (self class compiledMethodAt:#copyright) source.
+	copyrightText := (cls  compiledMethodAt:#copyright) source.
 	copyrightText isNil ifTrue:[
 	    "
 	     no source available - trigger an error
@@ -1966,8 +1954,9 @@
     ].
     aStream := FileStream newFileNamed:fileName.
     aStream isNil ifTrue:[
-	^ FileOutErrorSignal raiseRequestWith:fileName
-				  errorString:('cannot create file:', fileName)
+	^ FileOutErrorSignal 
+		raiseRequestWith:fileName
+		errorString:('cannot create file:', fileName)
     ].
     self fileOutCategory:aCategory on:aStream.
     aStream close
@@ -1999,8 +1988,9 @@
 	].
 	aStream := FileStream newFileNamed:fileName.
 	aStream isNil ifTrue:[
-	    ^ FileOutErrorSignal raiseRequestWith:fileName
-				      errorString:('cannot create file:', fileName)
+	    ^ FileOutErrorSignal 
+		raiseRequestWith:fileName
+		errorString:('cannot create file:', fileName)
 	].
 	self fileOutMethod:aMethod on:aStream.
 	aStream close
@@ -2011,14 +2001,16 @@
     "create a file 'class.st' consisting of all methods in myself.
      If the current project is not nil, create the file in the projects
      directory. Care is taken, to not clobber any existing file in
-     case of errors (for example: disk full). Also, since the classes
-     methods need a valid sourcefile, the current sourceFile cannot be rewritten,
-     but must be kept around until the fileOut is finished."
-
-    |aStream baseName dirName fileName newFileName needRename|
+     case of errors (for example: disk full). 
+     Also, since the classes methods need a valid sourcefile, the current 
+     sourceFile may not be rewritten."
+
+    |aStream baseName dirName fileName newFileName needRename
+     mySourceFileName sameFile|
 
     baseName := (Smalltalk fileNameForClass:self name).
     fileName := baseName , '.st'.
+
     "
      this test allows a smalltalk to be built without Projects/ChangeSets
     "
@@ -2028,12 +2020,31 @@
 	dirName := ''
     ].
     fileName := dirName , fileName.
+
     "
      if file exists, copy the existing to a .sav-file,
      create the new file as XXX.new-file,
      and, if that worked rename afterwards ...
     "
     fileName asFilename exists ifTrue:[
+	"
+	 check for overwriting my current source file
+	 this is not allowed, since it would clobber my methods source
+	 file ... you have to save it to some other place.
+	 This happens if you ask for a fileOut into the source-directory
+	 (from which my methods get their source)
+	"
+	mySourceFileName := Smalltalk getSourceFileName:classFilename. 
+	sameFile := (fileName = mySourceFileName).
+	sameFile ifFalse:[
+	    sameFile := (fileName asFilename info at:#id) == (mySourceFileName asFilename info at:#id)
+	].
+	sameFile ifTrue:[
+	    ^ FileOutErrorSignal 
+		raiseRequestWith:fileName
+		errorString:('may not overwrite sourcefile:', fileName)
+	].
+
 	fileName asFilename copyTo:('/tmp/' , baseName , '.sav').
 	newFileName := dirName , baseName , '.new'.
 	needRename := true
@@ -2044,8 +2055,9 @@
 
     aStream := FileStream newFileNamed:newFileName.
     aStream isNil ifTrue:[
-	^ FileOutErrorSignal raiseRequestWith:newFileName
-				  errorString:('cannot create file:', newFileName)
+	^ FileOutErrorSignal 
+		raiseRequestWith:newFileName
+		errorString:('cannot create file:', newFileName)
     ].
     self fileOutOn:aStream.
     aStream close.
@@ -2080,7 +2092,9 @@
     fileName := (Smalltalk fileNameForClass:self name) , '.st'.
     aStream := FileStream newFileNamed:fileName in:aFileDirectory.
     aStream isNil ifTrue:[
-	^ self error:('cannot create source file:', fileName)
+	^ FileOutErrorSignal 
+		raiseRequestWith:fileName
+		errorString:('cannot create file:', fileName)
     ].
     self fileOutOn:aStream.
     aStream close