Mercurial Mercurial > hg > stx-libbasic / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Class.st
changeset 155 edd7fc34e104
parent 153 22f4c4bcc93f
child 168 3c7266ecf04c 
--- a/Class.st	Mon Oct 10 01:20:00 1994 +0100
+++ b/Class.st	Mon Oct 10 01:22:47 1994 +0100
@@ -21,7 +21,7 @@
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
 
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.19 1994-09-29 20:38:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.20 1994-10-10 00:22:30 claus Exp $
 '!
 
 !Class class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.19 1994-09-29 20:38:11 claus Exp $
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.20 1994-10-10 00:22:30 claus Exp $
 "
 !
 
@@ -646,7 +646,7 @@
 !
 
 changesStream
-    "return a Stream for the changes file"
+    "return a Stream for the changes file - or nil if no update is wanted"
 
     |aStream|
 
@@ -655,7 +655,7 @@
 	aStream isNil ifTrue:[
 	    aStream := FileStream newFileNamed:'changes'.
 	    aStream isNil ifTrue:[
-		self error:'cannot update changes file'.
+		self warning:'cannot create/update changes file'.
 		^ nil
 	    ]
 	].
@@ -665,7 +665,7 @@
 !
 
 sourcesStream
-    "return a Stream for the sources file"
+    "return a stream for the sources file"
 
     |aStream|
 
@@ -683,16 +683,115 @@
     ^ aStream
 !
 
-addChangeRecordForMethod:aMethod
-    "add a method-change-record to the changes file"
+writingChangeDo:aBlock
+    "common helper to write a change record.
+     Opens the changefile and executes aBlock passing the stream
+     as argument. WriteErrors are cought and will lead to a warning."
 
     |aStream|
 
     aStream := self changesStream.
     aStream notNil ifTrue:[
-	self fileOutMethod:aMethod on:aStream.
-	aStream cr.
-	aStream close.
+	FileStream writeErrorSignal handle:[:ex |
+	    self warning:('could not update the changes-file\\' , ex errorString) withCRs.
+	    ex return
+	] do:[
+	    aBlock value:aStream
+	].
+	aStream close
+    ]
+!
+
+addChangeRecordForMethod:aMethod to:aStream
+    "append a method-change-record to aStream"
+
+    self fileOutMethod:aMethod on:aStream.
+    aStream cr.
+!
+
+addChangeRecordForRemoveSelector:aSelector to:aStream
+    "append a method-remove-record to aStream"
+
+    self printClassNameOn:aStream.
+    aStream nextPutAll:(' removeSelector:#' , aSelector).
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForClass:aClass to:aStream
+    "append a class-definition-record to aStream"
+
+    aClass fileOutDefinitionOn:aStream.
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForClassInstvars:aClass to:aStream
+    "append a class-instvars-record to aStream"
+
+    aClass fileOutClassInstVarDefinitionOn:aStream.
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForClassComment:aClass to:aStream
+    "append a class-comment-record to aStream"
+
+    aClass fileOutCommentOn:aStream.
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForClassRename:oldName to:newName to:aStream
+    "append a class-rename-record to aStream"
+
+    aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForClassRemove:oldName to:aStream
+    "append a class-remove-record to aStream"
+
+    aStream nextPutAll:('Smalltalk removeClass:' , oldName).
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream
+    "append a category-rename record to aStream"
+
+    self printClassNameOn:aStream.
+    aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
+    aStream nextPutAll:(' to:' , newCategory storeString).
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForChangeCategoryTo:aStream
+    "append a category change record to aStream"
+
+    self printClassNameOn:aStream.
+    aStream nextPutAll:(' category:' , category storeString).
+    aStream nextPut:(aStream class chunkSeparator).
+    aStream cr.
+!
+
+addChangeRecordForSnapshot:aFileName to:aStream
+    "append a snapshot-record to aStream"
+
+    aStream nextPutAll:('''---- snapshot ' , aFileName , ' ',
+			Date today printString , ' ' ,
+			Time now printString ,
+			' ----''!!').
+    aStream cr.
+!
+
+addChangeRecordForMethod:aMethod
+    "add a method-change-record to the changes file"
+
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForMethod:aMethod to:aStream.
 
 	"this test allows a smalltalk without Projects/ChangeSets"
 	Project notNil ifTrue:[
@@ -704,132 +803,72 @@
 addChangeRecordForRemoveSelector:aSelector
     "add a method-remove-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	self printClassNameOn:aStream.
-	aStream nextPutAll:(' removeSelector:#' , aSelector).
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForRemoveSelector:aSelector to:aStream
     ]
 !
 
 addChangeRecordForClass:aClass
     "add a class-definition-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	aClass fileOutDefinitionOn:aStream.
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForClass:aClass to:aStream
     ]
 !
 
 addChangeRecordForClassInstvars:aClass
     "add a class-instvars-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	aClass fileOutClassInstVarDefinitionOn:aStream.
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForClassInstvars:aClass to:aStream
     ]
 !
 
 addChangeRecordForClassComment:aClass
     "add a class-comment-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	aClass fileOutCommentOn:aStream.
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForClassComment:aClass to:aStream
     ]
 !
 
 addChangeRecordForClassRename:oldName to:newName
     "add a class-rename-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForClassRename:oldName to:newName to:aStream
     ]
 !
 
 addChangeRecordForClassRemove:oldName
     "add a class-remove-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	aStream nextPutAll:('Smalltalk removeClass:' , oldName).
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForClassRemove:oldName to:aStream
     ]
 !
 
 addChangeRecordForRenameCategory:oldCategory to:newCategory
     "add a category-rename record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	self printClassNameOn:aStream.
-	aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
-	aStream nextPutAll:(' to:' , newCategory storeString).
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream.
     ]
 !
 
 addChangeRecordForChangeCategory
     "add a category change record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	self printClassNameOn:aStream.
-	aStream nextPutAll:(' category:' , category storeString).
-	aStream nextPut:(aStream class chunkSeparator).
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForChangeCategoryTo:aStream.
     ]
 !
 
 addChangeRecordForSnapshot:aFileName
     "add a snapshot-record to the changes file"
 
-    |aStream|
-
-    aStream := self changesStream.
-    aStream notNil ifTrue:[
-	aStream nextPutAll:('''---- snapshot ' , aFileName , ' ',
-			    Date today printString , ' ' ,
-			    Time now printString ,
-			    ' ----''!!').
-	aStream cr.
-	aStream close
+    self writingChangeDo:[:aStream |
+	self addChangeRecordForSnapshot:aFileName to:aStream 
     ]
 ! !
 
@@ -1636,45 +1675,29 @@
     ]
 !
 
-printOutSourceProtocol:aString on:aPrintStream
+printOutSourceProtocol:aMethod on:aPrintStream
     "given the source in aString, print the methods message specification
      and any method comments - without source; used to generate documentation
      pages"
 
-    |text line nQuote index|
+    |text|
 
-    text := aString asText.
+    text := aMethod source asText.
     (text size < 1) ifTrue:[^self].
     aPrintStream bold.
     aPrintStream nextPutAll:(text at:1).
     aPrintStream cr.
     (text size >= 2) ifTrue:[
 	aPrintStream italic.
-	line := (text at:2).
-	nQuote := line occurrencesOf:(Character doubleQuote).
-	(nQuote == 2) ifTrue:[
-	    aPrintStream nextPutAll:line.
-	    aPrintStream cr
-	] ifFalse:[
-	    (nQuote == 1) ifTrue:[
-		aPrintStream nextPutAll:line.
-		aPrintStream cr.
-		index := 3.
-		line := text at:index.
-		nQuote := line occurrencesOf:(Character doubleQuote).
-		[nQuote ~~ 1] whileTrue:[
-		    aPrintStream nextPutAll:line.
-		    aPrintStream cr.
-		    index := index + 1.
-		    line := text at:index.
-		    nQuote := line occurrencesOf:(Character doubleQuote)
-		].
-		aPrintStream nextPutAll:(text at:index).
-		aPrintStream cr
-	     ]
-	 ]
+	aPrintStream spaces:((text at:2) indexOfNonSeparatorStartingAt:1).
+	aPrintStream nextPutAll:aMethod comment.
+	aPrintStream cr.
     ].
     aPrintStream normal
+
+    "
+      Float printOutProtocolOn:Stdout 
+    "
 !
 
 printOutSource:aString on:aPrintStream
@@ -1791,7 +1814,7 @@
 	    aPrintStream cr.
 	    methodArray do:[:aMethod |
 		(aCategory = aMethod category) ifTrue:[
-		    self printOutSourceProtocol:(aMethod source) 
+		    self printOutSourceProtocol:aMethod
 					     on:aPrintStream.
 		    aPrintStream cr.
 		    aPrintStream cr
hg/stx-libbasic