hg/stx-libbasic: comparison Class.st

equal deleted inserted replaced

-:b28609c73839
+:15df4adc5b70
 ! !
 !Class class methodsFor:'helpers'!
 revisionInfoFromString:aString
+"{ Pragma: +optSpace }"
 "return a dictionary filled with revision info.
 This extracts the relevant info from aString.
 For now, this is a bad design - should always ask the
 SCM to extract the parts (knowing about the details of RCS headers
 here is a bad design ...)"
 "Created: 15.11.1995 / 14:58:35 / cg"
 "Modified: 13.12.1995 / 17:11:28 / cg"
 !
 revisionStringFromSource:aMethodSourceString
+"{ Pragma: +optSpace }"
 "extract a revision string from a methods source string"
 |lines line|
 lines := aMethodSourceString asCollectionOfLines.
 Object comment
 "
 !
 comment:aString
+"{ Pragma: +optSpace }"
 "set the comment of the class to be the argument, aString;
 create a change record and notify dependents."
 |oldComment newComment|
 package := aStringOrSymbol
 !
 primitiveDefinitions:aString
+"{ Pragma: +optSpace }"
 "set the primitiveDefinition string"
 self setPrimitiveSpecsAt:1 to:aString.
 self addChangeRecordForPrimitiveDefinitions:self.
 "Created: 29.10.1995 / 19:41:39 / cg"
 !
 primitiveDefinitionsString
+"{ Pragma: +optSpace }"
 "return the primitiveDefinition string or nil"
 ^ self getPrimitiveSpecsAt:1
 "
 String primitiveDefinitionsString
 "
 !
 primitiveFunctions:aString
+"{ Pragma: +optSpace }"
 "set the primitiveFunction string"
 self setPrimitiveSpecsAt:3 to:aString.
 self addChangeRecordForPrimitiveFunctions:self.
 "Created: 29.10.1995 / 19:41:48 / cg"
 !
 primitiveFunctionsString
+"{ Pragma: +optSpace }"
 "return the primitiveFunctions string or nil"
 ^ self getPrimitiveSpecsAt:3
 !
 primitiveSpec
+"{ Pragma: +optSpace }"
 "return the primitiveSpec or nil"
 ^  primitiveSpec
 !
 primitiveSpec:anArrayOf3ElementsOrNil
+"{ Pragma: +optSpace }"
 "set the primitiveSpec or nil"
 primitiveSpec := anArrayOf3ElementsOrNil
 !
 primitiveVariables:aString
+"{ Pragma: +optSpace }"
 "set the primitiveVariable string"
 self setPrimitiveSpecsAt:2 to:aString.
 self addChangeRecordForPrimitiveVariables:self.
 "Created: 29.10.1995 / 19:41:58 / cg"
 !
 primitiveVariablesString
+"{ Pragma: +optSpace }"
 "return the primitiveVariables string or nil"
 ^ self getPrimitiveSpecsAt:2
 !
 privateClasses
+"{ Pragma: +optSpace }"
 "return a collection of my private classes (if any); nil otherwise"
 |classes myName|
 classes := IdentitySet new.
 "Modified: 15.10.1996 / 11:08:01 / cg"
 !
 privateClassesAt:aClassNameSymbol
+"{ Pragma: +optSpace }"
 "return a private class if present; nil otherwise"
 |class|
 class := self classVarAt:(':' , aClassNameSymbol) asSymbol.
 "Created: 11.10.1996 / 19:05:39 / cg"
 "Modified: 14.10.1996 / 17:23:30 / cg"
 !
 privateClassesAt:aClassNameSymbol put:aClass
+"{ Pragma: +optSpace }"
 "return a private class if present"
 self classVarAt:(':' , aClassNameSymbol) asSymbol put:aClass
 "Created: 11.10.1996 / 17:53:06 / cg"
 "Modified: 14.10.1996 / 17:23:36 / cg"
 !
 removeClassVarName:aString
+"{ Pragma: +optSpace }"
 "remove a class variable if not already there.
 Also writes a change record and notifies dependents.
 BUG: Currently, no recompilation is done - this will change."
 |names newNames|
 "Created: 29.10.1995 / 19:42:08 / cg"
 !
 renameCategory:oldCategory to:newCategory
+"{ Pragma: +optSpace }"
 "rename a category (changes category of those methods).
 Appends a change record and notifies dependents."
 |any|
 "Created: 29.10.1995 / 19:42:47 / cg"
 !
 unload
+"{ Pragma: +optSpace }"
 "if the receiver was autoloaded, unload and reinstall it as
 autoloaded. Can be used to get rid of no longer needed autoloaded
 classes.
 (maybe, autoloaded classes should unload themselfes when no
 longer needed - for example, after some delay when the last instance
 ! !
 !Class methodsFor:'changes management'!
 addChangeRecordForChangeCategory
+"{ Pragma: +optSpace }"
 "add a category change record to the changes file"
 self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
 !
 addChangeRecordForClass:aClass
+"{ Pragma: +optSpace }"
 "add a class-definition-record to the changes file"
 self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
 !
 addChangeRecordForClassCheckIn:aClass
+"{ Pragma: +optSpace }"
 "append a class-was-checkedIn-record to the changes file"
 self addInfoRecord:('checkin ' , aClass name , ' (' , aClass revision , ')')
 "Created: 18.11.1995 / 17:04:58 / cg"
 "Modified: 7.12.1995 / 23:45:01 / cg"
 !
 addChangeRecordForClassComment:aClass
+"{ Pragma: +optSpace }"
 "add a class-comment-record to the changes file"
 self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
 !
 addChangeRecordForClassContainerRemove:aClass
+"{ Pragma: +optSpace }"
 "append a container-was-removed-record to the changes file"
 self addInfoRecord:('removed source container of ' , aClass name)
 "Modified: 7.12.1995 / 23:45:01 / cg"
 "Created: 11.9.1996 / 15:37:19 / cg"
 !
 addChangeRecordForClassFileOut:aClass
+"{ Pragma: +optSpace }"
 "append a class-was-filedOut-record to the changes file"
 self addInfoRecord:('fileOut ' , aClass name)
 !
 addChangeRecordForClassInstvars:aClass
+"{ Pragma: +optSpace }"
 "add a class-instvars-record to the changes file"
 self writingChangePerform:#addChangeRecordForClassInstvars:to: with:aClass.
 !
 addChangeRecordForClassRemove:oldName
+"{ Pragma: +optSpace }"
 "add a class-remove-record to the changes file"
 self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName.
 !
 addChangeRecordForClassRename:oldName to:newName
+"{ Pragma: +optSpace }"
 "add a class-rename-record to the changes file"
 self writingChangeDo:[:aStream |
 	self addChangeRecordForClassRename:oldName to:newName to:aStream
 ]
 !
 addChangeRecordForMethod:aMethod
+"{ Pragma: +optSpace }"
 "add a method-change-record to the changes file"
 self askIfUpdatingChanges ifTrue:[
 	self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
 	"this test allows a smalltalk without Projects/ChangeSets"
 	]
 ]
 !
 addChangeRecordForMethodCategory:aMethod category:aString
+"{ Pragma: +optSpace }"
 "add a methodCategory-change-record to the changes file"
 self askIfUpdatingChanges ifTrue:[
 	self writingChangeDo:[:aStream |
 	    self addChangeRecordForMethodCategory:aMethod category:aString to:aStream.
 	]
 ]
 !
 addChangeRecordForMethodPrivacy:aMethod
+"{ Pragma: +optSpace }"
 "add a method-privacy-change-record to the changes file"
 self askIfUpdatingChanges ifTrue:[
 	self writingChangePerform:#addChangeRecordForMethodPrivacy:to: with:aMethod.
 	"this test allows a smalltalk without Projects/ChangeSets"
 "Modified: 27.8.1995 / 22:47:32 / claus"
 !
 addChangeRecordForPrimitiveDefinitions:aClass
+"{ Pragma: +optSpace }"
 "add a primitiveDefinitions-record to the changes file"
 self askIfUpdatingChanges ifTrue:[
 	self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass.
 	Project notNil ifTrue:[
 	]
 ]
 !
 addChangeRecordForPrimitiveFunctions:aClass
+"{ Pragma: +optSpace }"
 "add a primitiveFunctions-record to the changes file"
 self askIfUpdatingChanges ifTrue:[
 	self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass.
 	Project notNil ifTrue:[
 	]
 ]
 !
 addChangeRecordForPrimitiveVariables:aClass
+"{ Pragma: +optSpace }"
 "add a primitiveVariables-record to the changes file"
 self askIfUpdatingChanges ifTrue:[
 	self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
 	Project notNil ifTrue:[
 	]
 ]
 !
 addChangeRecordForRemoveSelector:aSelector
+"{ Pragma: +optSpace }"
 "add a method-remove-record to the changes file"
 self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector.
 !
 addChangeRecordForRenameCategory:oldCategory to:newCategory
+"{ Pragma: +optSpace }"
 "add a category-rename record to the changes file"
 self writingChangeDo:[:aStream |
 	self addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream.
 ]
 !
 addChangeRecordForSnapshot:aFileName
+"{ Pragma: +optSpace }"
 "add a snapshot-record to the changes file"
 self addInfoRecord:('snapshot ' , aFileName)
 !
 addChangeRecordForSnapshot:aFileName to:aStream
+"{ Pragma: +optSpace }"
 "add a snapshot-record to aStream"
 self addInfoRecord:('snapshot ' , aFileName) to:aStream
 !
 addChangeTimeStampTo:aStream
+"{ Pragma: +optSpace }"
 "a timestamp - prepended to any change, except infoRecords"
 |info|
 info := 'timestamp ' , OperatingSystem getLoginName , '@' , OperatingSystem getHostName.
 ! !
 !Class methodsFor:'private changes management'!
 addChangeRecordForChangeCategory:category to:aStream
+"{ Pragma: +optSpace }"
 "append a category change record to aStream"
 self printClassNameOn:aStream.
 aStream nextPutAll:(' category:' , category storeString).
 aStream nextPutChunkSeparator.
 "Created: 3.12.1995 / 13:43:33 / cg"
 "Modified: 3.12.1995 / 14:10:34 / cg"
 !
 addChangeRecordForClass:aClass to:aStream
+"{ Pragma: +optSpace }"
 "append a class-definition-record to aStream"
 aClass isLoaded ifTrue:[
 	aClass fileOutDefinitionOn:aStream.
 	aStream nextPutChunkSeparator.
 "Created: 3.12.1995 / 13:57:44 / cg"
 "Modified: 3.12.1995 / 14:11:26 / cg"
 !
 addChangeRecordForClassComment:aClass to:aStream
+"{ Pragma: +optSpace }"
 "append a class-comment-record to aStream"
 aClass fileOutCommentOn:aStream.
 "Modified: 4.3.1996 / 16:49:08 / cg"
 !
 addChangeRecordForClassInstvars:aClass to:aStream
+"{ Pragma: +optSpace }"
 "append a class-instvars-record to aStream"
 aClass fileOutClassInstVarDefinitionOn:aStream.
 aStream nextPutChunkSeparator.
 !
 addChangeRecordForClassRemove:oldName to:aStream
+"{ Pragma: +optSpace }"
 "append a class-remove-record to aStream"
 aStream nextPutAll:('Smalltalk removeClass:' , oldName).
 aStream nextPutChunkSeparator.
 !
 addChangeRecordForClassRename:oldName to:newName to:aStream
+"{ Pragma: +optSpace }"
 "append a class-rename-record to aStream"
 aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
 aStream nextPutChunkSeparator.
 !
 addChangeRecordForMethod:aMethod to:aStream
+"{ Pragma: +optSpace }"
 "append a method-change-record to aStream"
 self fileOutMethod:aMethod on:aStream.
 !
 addChangeRecordForMethodCategory:aMethod category:newCategory to:aStream
+"{ Pragma: +optSpace }"
 "append a methodCategory-change-record to aStream"
 |selector|
 selector := aMethod selector.
 	aStream nextPutChunkSeparator.
 ]
 !
 addChangeRecordForMethodPrivacy:aMethod to:aStream
+"{ Pragma: +optSpace }"
 "append a method-privacy-change-record to aStream"
 |selector|
 selector := aMethod selector.
 "Modified: 27.8.1995 / 22:59:56 / claus"
 !
 addChangeRecordForPrimitiveDefinitions:aClass to:aStream
+"{ Pragma: +optSpace }"
 "append a primitiveDefinitions-record to aStream"
 aStream nextPutAll:aClass name; nextPutAll:' primitiveDefinitions:'''; cr;
 	    nextPutAll:(aClass primitiveDefinitionsString storeString copyFrom:2).
 aStream nextPutChunkSeparator.
 !
 addChangeRecordForPrimitiveFunctions:aClass to:aStream
+"{ Pragma: +optSpace }"
 "append a primitiveFunctions-record to aStream"
 aStream nextPutAll:aClass name; nextPutAll:' primitiveFunctions:'''; cr;
 	    nextPutAll:(aClass primitiveFunctionsString storeString copyFrom:2).
 aStream nextPutChunkSeparator.
 !
 addChangeRecordForPrimitiveVariables:aClass to:aStream
+"{ Pragma: +optSpace }"
 "append a primitiveVariables-record to aStream"
 aStream nextPutAll:aClass name; nextPutAll:' primitiveVariables:'''; cr;
 	    nextPutAll:(aClass primitiveVariablesString storeString copyFrom:2).
 aStream nextPutChunkSeparator.
 !
 addChangeRecordForRemoveSelector:aSelector to:aStream
+"{ Pragma: +optSpace }"
 "append a method-remove-record to aStream"
 self printClassNameOn:aStream.
 aStream nextPutAll:(' removeSelector:' , aSelector asSymbol storeString).
 aStream nextPutChunkSeparator.
 "Modified: 1.7.1996 / 21:27:55 / cg"
 !
 addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream
+"{ Pragma: +optSpace }"
 "append a category-rename record to aStream"
 self printClassNameOn:aStream.
 aStream nextPutAll:(' renameCategory:' , oldCategory storeString).
 aStream nextPutAll:(' to:' , newCategory storeString).
 aStream nextPutChunkSeparator.
 !
 addInfoRecord:aMessage to:aStream
+"{ Pragma: +optSpace }"
 "append an info-record (snapshot, class fileOut etc.) to aStream"
 aStream nextPutAll:('''---- ' , aMessage , ' ',
 			Date today printString , ' ' ,
 			Time now printString ,
 			' ----''').
 aStream nextPutChunkSeparator.
 !
 writingChangeDo:aBlock
+"{ Pragma: +optSpace }"
 "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.
 The changefile is not kept open, to force the change to go to disk
 as soon as possible - thus, in case of a crash, no changes should
 "Modified: 18.11.1995 / 15:43:36 / cg"
 !
 writingChangePerform:aSelector with:anArgument
+"{ Pragma: +optSpace }"
 self writingChangeWithTimeStamp:true perform:aSelector with:anArgument
 "Created: 28.10.1995 / 16:50:48 / cg"
 "Modified: 18.11.1995 / 15:44:53 / cg"
 !
 writingChangeWithTimeStamp:doStampIt do:aBlock
+"{ Pragma: +optSpace }"
 "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.
 The changefile is not kept open, to force the change to go to disk
 as soon as possible - thus, in case of a crash, no changes should
 "Created: 18.11.1995 / 15:36:02 / cg"
 "Modified: 21.3.1996 / 16:32:30 / cg"
 !
 writingChangeWithTimeStamp:stampIt perform:aSelector with:anArgument
+"{ Pragma: +optSpace }"
 self writingChangeWithTimeStamp:stampIt do:[:stream |
 	self perform:aSelector with:anArgument with:stream.
 ]
 "Created: 18.11.1995 / 15:44:28 / cg"
 UpdateChangeFileQuerySignal isHandled ifFalse:[^ UpdatingChanges].
 ^ UpdateChangeFileQuerySignal raise
 !
 getPrimitiveSpecsAt:index
+"{ Pragma: +optSpace }"
 "return a primitiveSpecification component as string or nil"
 |pos stream string|
 primitiveSpec isNil ifTrue:[^ nil].
 ].
 ^ pos
 !
 setPrimitiveSpecsAt:index to:aString
+"{ Pragma: +optSpace }"
 "set a primitiveSpecification component to aString"
 primitiveSpec isNil ifTrue:[
 	primitiveSpec := Array new:3
 ].
 ! !
 !Class methodsFor:'protocol printOut'!
 printOutCategoryProtocol:aCategory on:aPrintStream
+"{ Pragma: +optSpace }"
 |dict any|
 dict := self methodDictionary.
 dict notNil ifTrue:[
 any := false.
 "Modified: 20.4.1996 / 18:20:26 / cg"
 "Modified: 12.6.1996 / 11:48:46 / stefan"
 !
 printOutMethodProtocol:aMethod on:aPrintStream
+"{ Pragma: +optSpace }"
 "given the source in aString, print the methods message specification
 and any method comments - without source; used to generate documentation
 pages"
 |text comment|
 "Modified: 20.4.1996 / 17:54:50 / cg"
 "Created: 20.4.1996 / 18:20:31 / cg"
 !
 printOutProtocolOn:aPrintStream
+"{ Pragma: +optSpace }"
 |collectionOfCategories|
 self printOutDefinitionOn:aPrintStream.
 aPrintStream cr.
 collectionOfCategories := self class categories.
 "Created: 7.12.1995 / 10:58:47 / cg"
 "Modified: 15.10.1996 / 18:55:28 / cg"
 !
 packageSourceCodeInfo
+"{ Pragma: +optSpace }"
 "return the sourceCodeInfo, which defines the module and the subdirectory
 in which the receiver class was built.
 This info is extracted from the package id (which is added to stc-compiled classes).
 This method is to be obsoleted soon, since the same info is now found
 in the versionString.
 "Created: 11.11.1995 / 14:27:20 / cg"
 "Modified: 15.10.1996 / 18:56:44 / cg"
 !
 revisionString
+"{ Pragma: +optSpace }"
 "return my revision string; that one is extracted from the
 classes #version method. Either this is a method returning that string,
 or its a comment-only method and the comment defines the version.
 If the source is not accessable or no such method exists,
 nil is returned."
 "Created: 9.12.1995 / 17:05:17 / cg"
 !
 setPackageFromRevision
+"{ Pragma: +optSpace }"
 "set my package from the info found in the revisionString if present.
 This is used to set some useful packageInfo after autoloading
 (otherwise, autoloaded classes/methods would go into your current
 package - which is probably not a good idea)"
 "Created: 10.11.1995 / 21:05:13 / cg"
 "Modified: 18.10.1996 / 13:28:29 / cg"
 !
 updateVersionMethodFor:newRevisionString
+"{ Pragma: +optSpace }"
 "helper for the checkin procedure.
 Update my #version method, to now return newRevisionString."
 |cls "vs m mgr"|
 ! !
 !Class class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.198 1996-10-27 11:37:00 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.199 1996-10-29 23:37:41 cg Exp $'
 ! !
 Class initialize!

changeset 1843	15df4adc5b70
parent 1824	71889773b28b
child 1846	b7042a82eee6