--- a/Behavior.st Sun Oct 29 19:08:45 1995 +0100
+++ b/Behavior.st Sun Oct 29 20:27:04 1995 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1988 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.49 1995-10-23 16:50:42 cg Exp $
+$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.50 1995-10-29 19:26:10 cg Exp $
'!
!Behavior class methodsFor:'documentation'!
@@ -43,7 +43,7 @@
version
"
-$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.49 1995-10-23 16:50:42 cg Exp $
+$Header: /cvs/stx/stx/libbasic/Behavior.st,v 1.50 1995-10-29 19:26:10 cg Exp $
"
!
@@ -415,14 +415,14 @@
uninitializedNew
"create an instance of myself with uninitialized contents.
- For all classes except ByteArray, this is the same as new."
+ For all classes except ByteArray, this is the same as #basicNew."
^ self basicNew
!
uninitializedNew:anInteger
"create an instance of myself with uninitialized contents.
- For all classes except ByteArray, this is the same as new."
+ For all classes except ByteArray, this is the same as #basicNew:."
^ self basicNew:anInteger
!
@@ -1442,8 +1442,8 @@
!
selectors
- "return the receivers selector array.
- Notice: this may not compatible with ST-80.
+ "return the receivers selector array as an orderedCollection.
+ Notice: this may not be compatible with ST-80.
(should we return a Set ?)"
^ selectorArray asOrderedCollection
--- a/Class.st Sun Oct 29 19:08:45 1995 +0100
+++ b/Class.st Sun Oct 29 20:27:04 1995 +0100
@@ -10,31 +10,23 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.7 on 28-oct-1995 at 17:08:56' !
+'From Smalltalk/X, Version:2.10.8 on 29-oct-1995 at 19:51:30' !
ClassDescription subclass:#Class
instanceVariableNames:'classvars comment subclasses classFilename package revision
- history'
+ history'
classVariableNames:'UpdatingChanges FileOutErrorSignal CatchMethodRedefinitions
- MethodRedefinitionSignal UpdateChangeFileQuerySignal'
+ MethodRedefinitionSignal UpdateChangeFileQuerySignal'
poolDictionaries:''
category:'Kernel-Classes'
!
-Class comment:'
-COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.63 1995-10-28 16:44:51 cg Exp $
-'!
-
!Class class methodsFor:'documentation'!
version
"
-$Header: /cvs/stx/stx/libbasic/Class.st,v 1.63 1995-10-28 16:44:51 cg Exp $
-"
-!
+$Header: /cvs/stx/stx/libbasic/Class.st,v 1.64 1995-10-29 19:26:30 cg Exp $
+"!
documentation
"
@@ -181,12 +173,6 @@
^ prev
!
-updatingChanges
- "return true if changes are recorded"
-
- ^ UpdatingChanges
-!
-
catchMethodRedefinitions:aBoolean
"turn on/off redefinition catching. Return the prior value of the flag."
@@ -197,6 +183,12 @@
^ prev
!
+updatingChanges
+ "return true if changes are recorded"
+
+ ^ UpdatingChanges
+!
+
catchMethodRedefinitions
"return the redefinition catching flag."
@@ -278,6 +270,17 @@
!Class methodsFor:'accessing'!
+allClassVarNames
+ "return a collection of all the class variable name-strings
+ this includes all superclass-class variables"
+
+ ^ self addAllClassVarNamesTo:(OrderedCollection new)
+
+ "
+ Float allClassVarNames
+ "
+!
+
classVarNames
"return a collection of the class variable name-strings.
Only names of class variables defined in this class are included
@@ -357,14 +360,17 @@
category := cat asSymbol
!
-allClassVarNames
- "return a collection of all the class variable name-strings
- this includes all superclass-class variables"
-
- ^ self addAllClassVarNamesTo:(OrderedCollection new)
+revision
+ "return the revision-ID of the class.
+ This is valid for stc-compiled classes only, and corresponds to the
+ rcs-id of the source from which this class was compiled.
+ To check if a source corresponds to a compiled binary, compare this
+ ID with the one found in the version-methods comment."
+
+ ^ revision
"
- Float allClassVarNames
+ Object revision
"
!
@@ -382,20 +388,6 @@
"
!
-classVarAt:aSymbol
- "return the value of a class variable.
- Currently, this returns nil if there is no such classvar -
- this may change."
-
- "
- this hides the (current) implementation of classVariables
- from the outside world. Currently, classvars are stored in
- the Smalltalk dictionary with a funny name, since there are
- no classPools yet.
- "
- ^ Smalltalk at:(self name , ':' , aSymbol) asSymbol
-!
-
comment
"return the comment (aString) of the class"
@@ -422,6 +414,20 @@
"
!
+classVarAt:aSymbol
+ "return the value of a class variable.
+ Currently, this returns nil if there is no such classvar -
+ this may change."
+
+ "
+ this hides the (current) implementation of classVariables
+ from the outside world. Currently, classvars are stored in
+ the Smalltalk dictionary with a funny name, since there are
+ no classPools yet.
+ "
+ ^ Smalltalk at:(self name , ':' , aSymbol) asSymbol
+!
+
classVarAt:aSymbol put:something
"store something in a classvariable.
Currently this creates a global with a funny name if no such
@@ -453,8 +459,11 @@
oldComment := self comment.
comment := aString.
self changed:#comment with:oldComment.
+ self updateVersionString.
self addChangeRecordForClassComment:self.
]
+
+ "Created: 29.10.1995 / 19:41:24 / cg"
!
package
@@ -473,20 +482,6 @@
package := aStringOrSymbol
!
-revision
- "return the revision-ID of the class.
- This is valid for stc-compiled classes only, and corresponds to the
- rcs-id of the source from which this class was compiled.
- To check if a source corresponds to a compiled binary, compare this
- ID with the one found in the version-methods comment."
-
- ^ revision
-
- "
- Object revision
- "
-!
-
revision:aString
"set the revision-ID.
This should normally not be done in the running system, as the source-manager
@@ -512,18 +507,6 @@
history := aString
!
-history:aString
- "set the history of the class."
-
- history := aString
-!
-
-primitiveSpec
- "return the primitiveSpec or nil"
-
- ^ primitiveSpec
-!
-
primitiveDefinitionsString
"return the primitiveDefinition string or nil"
@@ -547,6 +530,18 @@
^ self getPrimitiveSpecsAt:3
!
+history:aString
+ "set the history of the class."
+
+ history := aString
+!
+
+primitiveSpec
+ "return the primitiveSpec or nil"
+
+ ^ primitiveSpec
+!
+
primitiveSpec:anArrayOf3ElementsOrNil
"set the primitiveSpec or nil"
@@ -557,21 +552,30 @@
"set the primitiveDefinition string"
self setPrimitiveSpecsAt:1 to:aString.
- self addChangeRecordForPrimitiveDefinitions:self
+ self addChangeRecordForPrimitiveDefinitions:self.
+ self updateVersionString.
+
+ "Created: 29.10.1995 / 19:41:39 / cg"
!
primitiveVariables:aString
"set the primitiveVariable string"
self setPrimitiveSpecsAt:2 to:aString.
- self addChangeRecordForPrimitiveVariables:self
+ self addChangeRecordForPrimitiveVariables:self.
+ self updateVersionString.
+
+ "Created: 29.10.1995 / 19:41:58 / cg"
!
primitiveFunctions:aString
"set the primitiveFunction string"
self setPrimitiveSpecsAt:3 to:aString.
- self addChangeRecordForPrimitiveFunctions:self
+ self addChangeRecordForPrimitiveFunctions:self.
+ self updateVersionString.
+
+ "Created: 29.10.1995 / 19:41:48 / cg"
!
classFilename
@@ -639,12 +643,6 @@
^ code
!
-sharedPools
- "ST/X does not (currently) support pools"
-
- ^ #()
-!
-
addClassVarName:aString
"add a class variable if not already there and initialize it with nil.
Also writes a change record and notifies dependents.
@@ -653,8 +651,17 @@
(self classVarNames includes:aString) ifFalse:[
self classVariableString:(self classVariableString , ' ' , aString).
self addChangeRecordForClass:self.
+ self updateVersionString.
self changed:#definition.
]
+
+ "Created: 29.10.1995 / 19:40:51 / cg"
+!
+
+sharedPools
+ "ST/X does not (currently) support pools"
+
+ ^ #()
!
setClassVariableString:aString
@@ -679,8 +686,11 @@
names do:[:nm | nm ~= aString ifTrue:[newNames := newNames , nm , ' ']].
self classVariableString:newNames withoutSpaces.
self addChangeRecordForClass:self.
+ self updateVersionString.
self changed:#definition.
]
+
+ "Created: 29.10.1995 / 19:42:08 / cg"
!
renameCategory:oldCategory to:newCategory
@@ -698,8 +708,11 @@
].
any ifTrue:[
self addChangeRecordForRenameCategory:oldCategory to:newCategory.
+ self updateVersionString.
self changed:#methodCategory.
]
+
+ "Created: 29.10.1995 / 19:42:15 / cg"
! !
!Class methodsFor:'adding/removing'!
@@ -737,8 +750,11 @@
]
].
(super addSelector:newSelector withMethod:newMethod) ifTrue:[
- self addChangeRecordForMethod:newMethod
+ self updateVersionString.
+ self addChangeRecordForMethod:newMethod.
]
+
+ "Created: 29.10.1995 / 19:42:42 / cg"
!
removeSelector:aSelector
@@ -748,8 +764,11 @@
(super removeSelector:aSelector) ifTrue:[
self addChangeRecordForRemoveSelector:aSelector.
+ self updateVersionString.
self changed:#methodDictionary with:aSelector.
]
+
+ "Created: 29.10.1995 / 19:42:47 / cg"
!
unload
@@ -904,16 +923,10 @@
!Class methodsFor:'changes management'!
-withoutUpdatingChangesDo:aBlock
- "turn off change file update while evaluating aBlock.
- This method makes sure, that the update-flag is correctly restored
- in case of an abort or other error."
-
- UpdateChangeFileQuerySignal handle:[:ex |
- ex proceedWith:false
- ] do:[
- aBlock value
- ].
+addChangeRecordForMethod:aMethod to:aStream
+ "append a method-change-record to aStream"
+
+ self fileOutMethod:aMethod on:aStream.
!
changesStream
@@ -922,16 +935,16 @@
|aStream fileName|
(UpdateChangeFileQuerySignal raise) ifTrue:[
- fileName := ObjectMemory nameForChanges.
- aStream := FileStream oldFileNamed:fileName.
- aStream isNil ifTrue:[
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- self warn:'cannot create/update the changes file'.
- ^ nil
- ]
- ].
- aStream setToEnd
+ fileName := ObjectMemory nameForChanges.
+ aStream := FileStream oldFileNamed:fileName.
+ aStream isNil ifTrue:[
+ aStream := FileStream newFileNamed:fileName.
+ aStream isNil ifTrue:[
+ self warn:'cannot create/update the changes file'.
+ ^ nil
+ ]
+ ].
+ aStream setToEnd
].
^ aStream
@@ -939,22 +952,6 @@
"Modified: 28.10.1995 / 16:55:03 / cg"
!
-writingChangePerform:aSelector with:anArgument
- |aStream|
-
- self writingChangeDo:[:stream |
- self perform:aSelector with:anArgument with:stream.
- ]
-
- "Created: 28.10.1995 / 16:50:48 / cg"
-!
-
-addChangeRecordForMethod:aMethod to:aStream
- "append a method-change-record to aStream"
-
- self fileOutMethod:aMethod on:aStream.
-!
-
writingChangeDo:aBlock
"common helper to write a change record.
Opens the changefile and executes aBlock passing the stream
@@ -978,6 +975,40 @@
]
!
+writingChangePerform:aSelector with:anArgument
+ |aStream|
+
+ self writingChangeDo:[:stream |
+ self perform:aSelector with:anArgument with:stream.
+ ]
+
+ "Created: 28.10.1995 / 16:50:48 / cg"
+!
+
+withoutUpdatingChangesDo:aBlock
+ "turn off change file update while evaluating aBlock.
+ This method makes sure, that the update-flag is correctly restored
+ in case of an abort or other error."
+
+ UpdateChangeFileQuerySignal handle:[:ex |
+ ex proceedWith:false
+ ] do:[
+ aBlock value
+ ].
+!
+
+addChangeRecordForMethod:aMethod
+ "add a method-change-record to the changes file"
+
+ (UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
+ self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
+ "this test allows a smalltalk without Projects/ChangeSets"
+ Project notNil ifTrue:[
+ Project addMethodChange:aMethod in:self
+ ]
+ ]
+!
+
sourcesStream
"return a stream for writing the sources file.
Notice, in ST/X, it is noncommon to use a single
@@ -989,11 +1020,11 @@
fileName := ObjectMemory nameForSources.
aStream := FileStream oldFileNamed:fileName.
aStream isNil ifTrue:[
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- Transcript showCr:'cannot update sources file'.
- ^ nil
- ]
+ aStream := FileStream newFileNamed:fileName.
+ aStream isNil ifTrue:[
+ Transcript showCr:'cannot update sources file'.
+ ^ nil
+ ]
].
aStream setToEnd.
^ aStream
@@ -1114,16 +1145,14 @@
aStream nextPutChunkSeparator.
!
-addChangeRecordForMethod:aMethod
- "add a method-change-record to the changes file"
-
- (UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
- self writingChangePerform:#addChangeRecordForMethod:to: with:aMethod.
- "this test allows a smalltalk without Projects/ChangeSets"
- Project notNil ifTrue:[
- Project addMethodChange:aMethod in:self
- ]
- ]
+addInfoRecord:aMessage to:aStream
+ "append an info-record (snapshot, class fileOut etc.) to aStream"
+
+ aStream nextPutAll:('''---- ' , aMessage , ' ',
+ Date today printString , ' ' ,
+ Time now printString ,
+ ' ----''').
+ aStream nextPutChunkSeparator.
!
addChangeRecordForChangeCategory:category to:aStream
@@ -1134,14 +1163,10 @@
aStream nextPutChunkSeparator.
!
-addInfoRecord:aMessage to:aStream
- "append an info-record (snapshot, class fileOut etc.) to aStream"
-
- aStream nextPutAll:('''---- ' , aMessage , ' ',
- Date today printString , ' ' ,
- Time now printString ,
- ' ----''').
- aStream nextPutChunkSeparator.
+addChangeRecordForClass:aClass
+ "add a class-definition-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
!
addChangeRecordForSnapshot:aFileName to:aStream
@@ -1150,12 +1175,6 @@
self addInfoRecord:('snapshot ' , aFileName) to:aStream
!
-addChangeRecordForClass:aClass
- "add a class-definition-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
-!
-
addChangeRecordForRemoveSelector:aSelector
"add a method-remove-record to the changes file"
@@ -1235,6 +1254,12 @@
self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName.
!
+addInfoRecord:aMessage
+ "add an info-record (snapshot, class fileOut etc.) to the changes file"
+
+ self writingChangePerform:#addInfoRecord:to: with:aMessage.
+!
+
addChangeRecordForRenameCategory:oldCategory to:newCategory
"add a category-rename record to the changes file"
@@ -1243,28 +1268,22 @@
]
!
+addChangeRecordForClassFileOut:aClass
+ "append a class-was-filedOut-record to the changes file"
+
+ self addInfoRecord:('fileOut ' , aClass name)
+!
+
addChangeRecordForChangeCategory
"add a category change record to the changes file"
self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
!
-addInfoRecord:aMessage
- "add an info-record (snapshot, class fileOut etc.) to the changes file"
-
- self writingChangePerform:#addInfoRecord:to: with:aMessage.
-!
-
addChangeRecordForSnapshot:aFileName
"add a snapshot-record to the changes file"
self addInfoRecord:('snapshot ' , aFileName)
-!
-
-addChangeRecordForClassFileOut:aClass
- "append a class-was-filedOut-record to the changes file"
-
- self addInfoRecord:('fileOut ' , aClass name)
! !
!Class methodsFor:'compiling'!
@@ -1540,69 +1559,6 @@
aStream cr
!
-fileOutCommentOn:aStream
- "append an expression on aStream, which defines my comment"
-
- |comment s|
-
- aStream nextPutAll:name; nextPutAll:' comment:'.
- (comment := self comment) isNil ifTrue:[
- s := ''''''
- ] ifFalse:[
- s := comment storeString
- ].
- aStream nextPutAll:s.
- aStream cr
-!
-
-fileOutPrimitiveDefinitionsOn:aStream
- "append primitive defs (if any) to aStream."
-
- |s|
-
- "
- primitive definitions - if any
- "
- (s := self primitiveDefinitionsString) notNil ifTrue:[
- aStream nextPutChunkSeparator;
- nextPutAll:name; nextPutAll:' primitiveDefinitions';
- nextPutChunkSeparator;
- cr.
- aStream nextPutAll:s.
- aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
- ].
- (s := self primitiveVariablesString) notNil ifTrue:[
- aStream nextPutChunkSeparator;
- nextPutAll:name; nextPutAll:' primitiveVariables';
- nextPutChunkSeparator;
- cr.
- aStream nextPutAll:s.
- aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
- ].
-!
-
-fileOutPrimitiveSpecsOn:aStream
- "append primitive defs (if any) to aStream."
-
- |s|
-
- "
- primitive definitions - if any
- "
- self fileOutPrimitiveDefinitionsOn:aStream.
- "
- primitive functions - if any
- "
- (s := self primitiveFunctionsString) notNil ifTrue:[
- aStream nextPutChunkSeparator;
- nextPutAll:name; nextPutAll:' primitiveFunctions';
- nextPutChunkSeparator;
- cr.
- aStream nextPutAll:s.
- aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
- ].
-!
-
fileOutMethod:aMethod on:aStream
"file out the method, aMethod onto aStream"
@@ -1710,24 +1666,67 @@
"Modified: 28.8.1995 / 14:30:41 / claus"
!
-fileOutClassInstVarDefinitionOn:aStream
- "append an expression to define my classInstanceVariables on aStream"
-
- aStream nextPutAll:(name , ' class instanceVariableNames:''').
- self class printInstVarNamesOn:aStream indent:8.
- aStream nextPutAll:''''.
-
- "mhmh - good idea; saw this in SmallDraw sourcecode ..."
-
- aStream cr; cr; nextPut:(Character doubleQuote); cr.
- aStream space;
- nextPutAll:'The following class instance variables are inherited by this class:';
- cr; cr.
- self allSuperclassesDo:[:aSuperClass |
- aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
- aStream nextPutAll:(aSuperClass class instanceVariableString); cr.
+fileOutPrimitiveDefinitionsOn:aStream
+ "append primitive defs (if any) to aStream."
+
+ |s|
+
+ "
+ primitive definitions - if any
+ "
+ (s := self primitiveDefinitionsString) notNil ifTrue:[
+ aStream nextPutChunkSeparator;
+ nextPutAll:name; nextPutAll:' primitiveDefinitions';
+ nextPutChunkSeparator;
+ cr.
+ aStream nextPutAll:s.
+ aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
+ ].
+ (s := self primitiveVariablesString) notNil ifTrue:[
+ aStream nextPutChunkSeparator;
+ nextPutAll:name; nextPutAll:' primitiveVariables';
+ nextPutChunkSeparator;
+ cr.
+ aStream nextPutAll:s.
+ aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
].
- aStream nextPut:(Character doubleQuote); cr.
+!
+
+fileOutCommentOn:aStream
+ "append an expression on aStream, which defines my comment"
+
+ |comment s|
+
+ aStream nextPutAll:name; nextPutAll:' comment:'.
+ (comment := self comment) isNil ifTrue:[
+ s := ''''''
+ ] ifFalse:[
+ s := comment storeString
+ ].
+ aStream nextPutAll:s.
+ aStream cr
+!
+
+fileOutPrimitiveSpecsOn:aStream
+ "append primitive defs (if any) to aStream."
+
+ |s|
+
+ "
+ primitive definitions - if any
+ "
+ self fileOutPrimitiveDefinitionsOn:aStream.
+ "
+ primitive functions - if any
+ "
+ (s := self primitiveFunctionsString) notNil ifTrue:[
+ aStream nextPutChunkSeparator;
+ nextPutAll:name; nextPutAll:' primitiveFunctions';
+ nextPutChunkSeparator;
+ cr.
+ aStream nextPutAll:s.
+ aStream nextPutChunkSeparator; space; nextPutChunkSeparator; cr; cr
+ ].
!
fileOutOn:aStream
@@ -1861,39 +1860,6 @@
]
!
-fileOutCategory:aCategory
- "create a file 'class-category.st' consisting of all methods in aCategory.
- If the current project is not nil, create the file in the projects
- directory."
-
- |aStream fileName|
-
- fileName := name , '-' , aCategory , '.st'.
- fileName replaceAll:(Character space) by:$_.
-
- "
- this test allows a smalltalk to be built without Projects/ChangeSets
- "
- Project notNil ifTrue:[
- fileName := Project currentProjectDirectory , fileName.
- ].
-
- "
- if file exists, save original in a .sav file
- "
- fileName asFilename exists ifTrue:[
- fileName asFilename copyTo:(fileName , '.sav')
- ].
- aStream := FileStream newFileNamed:fileName.
- aStream isNil ifTrue:[
- ^ FileOutErrorSignal
- raiseRequestWith:fileName
- errorString:('cannot create file:', fileName)
- ].
- self fileOutCategory:aCategory on:aStream.
- aStream close
-!
-
fileOut
"create a file 'class.st' consisting of all methods in myself.
If the current project is not nil, create the file in the projects
@@ -1979,6 +1945,59 @@
self addChangeRecordForClassFileOut:self
!
+fileOutClassInstVarDefinitionOn:aStream
+ "append an expression to define my classInstanceVariables on aStream"
+
+ aStream nextPutAll:(name , ' class instanceVariableNames:''').
+ self class printInstVarNamesOn:aStream indent:8.
+ aStream nextPutAll:''''.
+
+ "mhmh - good idea; saw this in SmallDraw sourcecode ..."
+
+ aStream cr; cr; nextPut:(Character doubleQuote); cr.
+ aStream space;
+ nextPutAll:'The following class instance variables are inherited by this class:';
+ cr; cr.
+ self allSuperclassesDo:[:aSuperClass |
+ aStream tab; nextPutAll:aSuperClass name; nextPutAll:' - '.
+ aStream nextPutAll:(aSuperClass class instanceVariableString); cr.
+ ].
+ aStream nextPut:(Character doubleQuote); cr.
+!
+
+fileOutCategory:aCategory
+ "create a file 'class-category.st' consisting of all methods in aCategory.
+ If the current project is not nil, create the file in the projects
+ directory."
+
+ |aStream fileName|
+
+ fileName := name , '-' , aCategory , '.st'.
+ fileName replaceAll:(Character space) by:$_.
+
+ "
+ this test allows a smalltalk to be built without Projects/ChangeSets
+ "
+ Project notNil ifTrue:[
+ fileName := Project currentProjectDirectory , fileName.
+ ].
+
+ "
+ if file exists, save original in a .sav file
+ "
+ fileName asFilename exists ifTrue:[
+ fileName asFilename copyTo:(fileName , '.sav')
+ ].
+ aStream := FileStream newFileNamed:fileName.
+ aStream isNil ifTrue:[
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileName
+ errorString:('cannot create file:', fileName)
+ ].
+ self fileOutCategory:aCategory on:aStream.
+ aStream close
+!
+
fileOutMethod:aMethod
"create a file 'class-method.st' consisting of the method, aMethod.
If the current project is not nil, create the file in the projects
@@ -2350,6 +2369,91 @@
!Class methodsFor:'private'!
+updateVersionString
+ "update my version string, to reflect a change w.r.t.
+ the original source.
+ The original version string is kept as a reference i.e.
+ Header: /files/CVS/stx/libbasic/Class.st,v 1.63 1995/10/28 16:44:51 cg Exp $
+ is changed into:
+ Header: /files/CVS/stx/libbasic/Class.st,v 1.63mod 1995/10/28 16:44:51 cg Exp $
+ "
+
+ |cls vs m idx leftPart rightPart vsnString|
+
+ cls := self.
+ self isMeta ifFalse:[
+ cls := self class
+ ].
+ m := cls compiledMethodAt:#version.
+ m isNil ifTrue:[^ self].
+ vs := self versionString.
+ vs isNil ifTrue:[^ self].
+
+ "/ search for ,v
+ idx := vs indexOfSubCollection:'.st,v'.
+ idx == 0 ifTrue:[^ self].
+ leftPart := vs copyTo:(idx - 1 + 5).
+ rightPart := (vs copyFrom:(idx + 5)) withoutSpaces.
+ idx := rightPart indexOfSeparator.
+ idx == 0 ifTrue:[^ self].
+ vsnString := rightPart copyTo:idx - 1.
+ rightPart := rightPart copyFrom:idx + 1.
+ vsnString ~= self revision ifTrue:[
+ "/ alread a modified class
+"/ ('already modified: ' , vsnString) printNL.
+ ^ self
+ ].
+ m source:'version
+"
+' , leftPart , ' ' , vsnString , 'mod' , ' ' , rightPart , '
+"'.
+
+"/ ('updated to :' , vsnString , 'mod') printNL.
+
+ "
+ Class updateVersionString
+ Number updateVersionString
+ ProcessMonitor updateVersionString
+ "
+
+ "Created: 29.10.1995 / 19:25:15 / cg"
+ "Modified: 29.10.1995 / 19:39:38 / cg"
+!
+
+versionString
+ "return my version string; that one is extracted from the
+ classes #version methods source code.
+ If the source is not accessable or no such method exists,
+ nil is returned."
+
+ |cls m src lines idx|
+
+ cls := self.
+ self isMeta ifFalse:[
+ cls := self class
+ ].
+ m := cls compiledMethodAt:#version.
+ m isNil ifTrue:[^ nil].
+ src := m source.
+ src isNil ifTrue:[^ nil].
+ lines := src asCollectionOfLines.
+ idx := lines findFirst:[:l |
+ l withoutSpaces startsWith:'$Header'
+ ].
+ idx == 0 ifTrue:[^ nil].
+ ^ lines at:idx.
+
+ "
+ Smalltalk allClassesDo:[:cls |
+ Transcript showCr:cls versionString
+ ].
+
+ Number versionString
+ "
+
+ "Created: 29.10.1995 / 19:28:03 / cg"
+!
+
addAllClassVarNamesTo:aCollection
"helper - add the name-strings of the class variables and of the class-vars
of all superclasses to the argument, aCollection. Return aCollection"
@@ -2363,19 +2467,6 @@
^ aCollection
!
-addCategoriesTo:aCollection
- "helper - add categories to the argument, aCollection"
-
- methodArray do:[:aMethod |
- |cat|
-
- cat := aMethod category.
- (aCollection includes:cat) ifFalse:[
- aCollection add:cat
- ]
- ]
-!
-
getPrimitiveSpecsAt:index
"return a primitiveSpecification component as string or nil"
@@ -2403,6 +2494,19 @@
^ pos
!
+addCategoriesTo:aCollection
+ "helper - add categories to the argument, aCollection"
+
+ methodArray do:[:aMethod |
+ |cat|
+
+ cat := aMethod category.
+ (aCollection includes:cat) ifFalse:[
+ aCollection add:cat
+ ]
+ ]
+!
+
addAllCategoriesTo:aCollection
"helper - add categories and all superclasses categories
to the argument, aCollection"
@@ -2424,24 +2528,6 @@
!Class methodsFor:'queries'!
-categories
- "Return a Collection of all method-category strings known in class.
- The returned collection is not sorted by any order."
-
- |newList cat|
-
- newList := OrderedCollection new.
- methodArray do:[:aMethod |
- cat := aMethod category.
- newList indexOf:cat ifAbsent:[newList add:cat]
- ].
- ^ newList
-
- "
- Point categories
- "
-!
-
isClass
"return true, if the receiver is some kind of class
(a real class, not just behavior);
@@ -2460,19 +2546,21 @@
"
!
-allCategories
- "Return a Collection of all method-category strings known in class
- and all superclasses. The returned collection is not sorted by any order."
-
- |coll|
-
- coll := OrderedCollection new.
- self addAllCategoriesTo:coll.
- ^ coll
+categories
+ "Return a Collection of all method-category strings known in class.
+ The returned collection is not sorted by any order."
+
+ |newList cat|
+
+ newList := OrderedCollection new.
+ methodArray do:[:aMethod |
+ cat := aMethod category.
+ newList indexOf:cat ifAbsent:[newList add:cat]
+ ].
+ ^ newList
"
Point categories
- Point allCategories
"
!
@@ -2506,6 +2594,22 @@
^ Autoload wasAutoloaded:self
!
+allCategories
+ "Return a Collection of all method-category strings known in class
+ and all superclasses. The returned collection is not sorted by any order."
+
+ |coll|
+
+ coll := OrderedCollection new.
+ self addAllCategoriesTo:coll.
+ ^ coll
+
+ "
+ Point categories
+ Point allCategories
+ "
+!
+
whichClassDefinesInstVar:aVariableName
"return the class which defines the instance variable
named aVariableName. This method should not be used for
--- a/Metaclass.st Sun Oct 29 19:08:45 1995 +0100
+++ b/Metaclass.st Sun Oct 29 20:27:04 1995 +0100
@@ -10,21 +10,30 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.8 on 29-oct-1995 at 20:01:09' !
+
Class subclass:#Metaclass
- instanceVariableNames:'myClass'
- classVariableNames:''
- poolDictionaries:''
- category:'Kernel-Classes'
+ instanceVariableNames:'myClass'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes'
!
-Metaclass comment:'
-COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
+!Metaclass class methodsFor:'documentation'!
+
+version
+"
+$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.32 1995-10-29 19:26:47 cg Exp $
+"!
-$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.31 1995-09-08 16:46:05 claus Exp $
-'!
-
-!Metaclass class methodsFor:'documentation'!
+documentation
+"
+ every classes class is a subclass of Metaclass.
+ (i.e. every class is the sole instance of its Metaclass)
+ Metaclass provides support for creating new (sub)classes and/or
+ changing the definition of an already existing class.
+"
+!
copyright
"
@@ -38,21 +47,6 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-!
-
-version
-"
-$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.31 1995-09-08 16:46:05 claus Exp $
-"
-!
-
-documentation
-"
- every classes class is a subclass of Metaclass.
- (i.e. every class is the sole instance of its Metaclass)
- Metaclass provides support for creating new (sub)classes and/or
- changing the definition of an already existing class.
-"
! !
!Metaclass class methodsFor:'creating metaclasses'!
@@ -78,8 +72,375 @@
"
! !
+!Metaclass methodsFor:'accessing'!
+
+name
+ "return my name - that is the name of my sole class, with 'class'
+ appended. Currently, this is incompatible to ST-80 (which appends ' class')
+ and will be changed (have to check for side effects first ...)"
+
+ myClass isNil ifTrue:[
+ ^ 'someMetaclass'
+ ].
+"/ ^ myClass name , ' class'
+ ^ myClass name , 'class'
+! !
+
+!Metaclass methodsFor:'class instance variables'!
+
+instanceVariableNames:aString
+ "changing / adding class-inst vars -
+ this actually creates a new metaclass and class, leaving the original
+ classes around as obsolete classes. This may also be true for all subclasses,
+ if class instance variables are added/removed.
+ Existing instances continue to be defined by their original classes.
+
+ Time will show, if this is an acceptable behavior or if we should migrate
+ instances to become insts. of the new classes."
+
+ |newClass newMetaclass nClassInstVars oldClass
+ allSubclasses oldVars
+ oldNames newNames addedNames
+ oldOffsets newOffsets offset changeSet delta
+ oldToNew newSubMeta newSub oldSubMeta oldSuper
+ commonClassInstVars currentProject t|
+
+ "
+ cleanup needed here: extract common things with name:inEnvironment:...
+ and restructure things ... currently way too complex.
+ "
+
+ oldVars := self instanceVariableString.
+ aString = oldVars ifTrue:[
+"
+ Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
+"
+ ^ self
+ ].
+
+ oldNames := oldVars asCollectionOfWords.
+ newNames := aString asCollectionOfWords.
+
+ oldNames = newNames ifTrue:[
+"
+ Transcript showCr:'no real change'.
+"
+ "no real change (just formatting)"
+ self setInstanceVariableString:aString.
+ ^ self
+ ].
+
+"/ "
+"/ let user confirm, if any name is no good (and was good before)
+"/ "
+"/ (oldNames inject:true
+"/ into:[:okSoFar :word |
+"/ okSoFar and:[word first isUppercase]
+"/ ])
+"/ ifTrue:[
+"/ "was ok before"
+"/ (newNames inject:true
+"/ into:[:okSoFar :word |
+"/ okSoFar and:[word first isUppercase]
+"/ ])
+"/ ifFalse:[
+"/ (self confirm:'class instance variable names should start with an uppercase letter
+"/(by convention only)
+"/
+"/install anyway ?' withCRs)
+"/ ifFalse:[
+"/ ^ nil
+"/ ]
+"/ ]
+"/ ].
+
+ nClassInstVars := newNames size.
+
+"
+ Transcript showCr:'create new class/metaclass'.
+"
+
+ "
+ create the new metaclass
+ "
+ newMetaclass := Metaclass new.
+ newMetaclass setSuperclass:superclass.
+ newMetaclass instSize:(superclass instSize + nClassInstVars).
+ (nClassInstVars ~~ 0) ifTrue:[
+ newMetaclass setInstanceVariableString:aString
+ ].
+"/ newMetaclass flags:(Behavior flagBehavior "flagNotIndexed").
+ newMetaclass setName:name.
+ newMetaclass classVariableString:classvars.
+ newMetaclass category:category.
+ newMetaclass setComment:(self comment).
+
+ "find the class which is my sole instance"
+
+ t := Smalltalk allClasses select:[:element | element class == self].
+ (t size ~~ 1) ifTrue:[
+ self error:'oops - I should have exactly one instance'.
+ ^ nil
+ ].
+ oldClass := t anElement.
+
+ "
+ create the new class
+ "
+ newClass := newMetaclass new.
+ newClass setSuperclass:(oldClass superclass).
+ newClass instSize:(oldClass instSize).
+ newClass flags:(oldClass flags).
+ newClass setName:(oldClass name).
+ newClass setInstanceVariableString:(oldClass instanceVariableString).
+ newClass classVariableString:(oldClass classVariableString).
+ newClass setComment:(oldClass comment).
+ newClass category:(oldClass category).
+ (t := oldClass primitiveSpec) notNil ifTrue:[
+ newClass primitiveSpec:t.
+ newClass setClassFilename:(oldClass classFilename).
+ ].
+
+ "/ set the new classes package
+
+ Project notNil ifTrue:[
+ currentProject := Project current.
+ currentProject notNil ifTrue:[
+ t := currentProject packageName.
+ newMetaclass package:t.
+ newClass package:t.
+ ]
+ ].
+
+ changeSet := Set new.
+ ((oldNames size == 0)
+ or:[newNames startsWith:oldNames]) ifTrue:[
+ "new variable(s) has/have been added - old methods still work"
+
+" "
+ Transcript showCr:'copying methods ...'.
+ Transcript endEntry.
+" "
+ self copyMethodsFrom:self for:newMetaclass.
+ self copyMethodsFrom:oldClass for:newClass.
+
+ "
+ but have to recompile methods accessing stuff now defined
+ (it might have been a global before ...)
+ "
+
+ addedNames := newNames select:[:nm | (oldNames includes:nm) not].
+" "
+ Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
+ Transcript endEntry.
+" "
+ "recompile class-methods"
+ newMetaclass recompileMethodsAccessingAny:addedNames.
+ ] ifFalse:[
+ "
+ create the changeSet; thats the set of class instvar names
+ which have changed their position or are new
+ "
+ offset := 0. oldOffsets := Dictionary new.
+ oldNames do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
+ offset := 0. newOffsets := Dictionary new.
+ newNames do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
+
+ oldOffsets associationsDo:[:a |
+ |k|
+
+ k := a key.
+ (newOffsets includesKey:k) ifFalse:[
+ changeSet add:k
+ ] ifTrue:[
+ (a value ~~ (newOffsets at:k)) ifTrue:[
+ changeSet add:k
+ ]
+ ]
+ ].
+ newOffsets associationsDo:[:a |
+ |k|
+
+ k := a key.
+ (oldOffsets includesKey:k) ifFalse:[
+ changeSet add:k
+ ] ifTrue:[
+ (a value ~~ (oldOffsets at:k)) ifTrue:[
+ changeSet add:k
+ ]
+ ]
+ ].
+
+" "
+ Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
+ Transcript endEntry.
+" "
+ "
+ recompile class-methods
+ "
+ self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
+ newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
+
+ self copyMethodsFrom:oldClass for:newClass.
+ ].
+
+ delta := newNames size - oldNames size.
+
+ "
+ get list of all subclasses - do before superclass is changed
+ "
+ allSubclasses := oldClass allSubclasses.
+ allSubclasses := allSubclasses asSortedCollection:[:a :b |
+ b isSubclassOf:a
+ ].
+
+ oldToNew := IdentityDictionary new.
+
+ "
+ create a new class tree, based on new version
+ "
+ allSubclasses do:[:aSubclass |
+ oldSuper := aSubclass superclass.
+ oldSubMeta := aSubclass class.
+
+ newSubMeta := Metaclass new.
+ oldSuper == oldClass ifTrue:[
+ newSubMeta setSuperclass:newMetaclass.
+ ] ifFalse:[
+ newSubMeta setSuperclass:(oldToNew at:oldSuper) class.
+ ].
+ newSubMeta instSize:(oldSubMeta instSize + delta).
+ newSubMeta flags:(oldSubMeta flags).
+ newSubMeta setName:(oldSubMeta name).
+ newSubMeta setInstanceVariableString:(oldSubMeta instanceVariableString).
+ newSubMeta classVariableString:(oldSubMeta classVariableString).
+ newSubMeta setComment:(oldSubMeta comment).
+ newSubMeta category:(oldSubMeta category).
+
+ newSub := newSubMeta new.
+ oldSuper == oldClass ifTrue:[
+ newSub setSuperclass:newClass.
+ ] ifFalse:[
+ newSub setSuperclass:(oldToNew at:oldSuper).
+ ].
+ newSub setSelectorArray:(aSubclass selectorArray).
+ newSub setMethodArray:(aSubclass methodArray).
+ newSub setName:(aSubclass name).
+ newSub classVariableString:(aSubclass classVariableString).
+ newSub setComment:(aSubclass comment).
+ newSub category:(aSubclass category).
+
+ oldToNew at:aSubclass put:newSub.
+
+ aSubclass category:'obsolete'.
+ aSubclass class category:'obsolete'.
+ ].
+
+ "recompile what needs to be"
+
+ delta == 0 ifTrue:[
+ "only have to recompile class methods accessing
+ class instvars from changeset
+ "
+
+ allSubclasses do:[:oldSubclass |
+ |newSubclass|
+
+ newSubclass := oldToNew at:oldSubclass.
+
+Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
+ ' accessing any of ' , changeSet printString.
+
+ newSubclass class recompileMethodsAccessingAny:changeSet.
+ ]
+ ] ifFalse:[
+ "
+ have to recompile all class methods accessing class instvars
+ "
+ commonClassInstVars := oldClass class allInstVarNames.
+ changeSet do:[:v |
+ commonClassInstVars remove:v ifAbsent:[]
+ ].
+
+ allSubclasses do:[:oldSubclass |
+ |newSubclass classInstVars|
+
+ newSubclass := oldToNew at:oldSubclass.
+
+ classInstVars := newSubclass class allInstVarNames asSet.
+ classInstVars removeAll:commonClassInstVars.
+ classInstVars addAll:changeSet.
+
+Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
+ ' accessing any of ' , classInstVars printString.
+
+ newSubclass class recompileMethodsAccessingAny:classInstVars.
+ ]
+ ].
+
+ self updateVersionString.
+ self addChangeRecordForClassInstvars:newClass.
+
+ "install all new classes"
+
+ Smalltalk at:(oldClass name asSymbol) put:newClass.
+ ObjectMemory flushCachesFor:oldClass.
+
+ allSubclasses do:[:oldClass |
+ |newClass|
+
+ newClass := oldToNew at:oldClass.
+"
+Transcript showCr:'install ' , newClass name , '(' , newClass category , ')' ,
+ ' as ' , newClass name.
+"
+ Smalltalk at:newClass name asSymbol put:newClass.
+ ObjectMemory flushCachesFor:oldClass.
+ ].
+
+ "tell dependents ..."
+
+ oldClass changed:#definition.
+ self changed:#definition.
+
+ ^ newMetaclass
+
+ "Created: 29.10.1995 / 19:57:08 / cg"
+! !
+
+!Metaclass methodsFor:'copying'!
+
+postCopy
+ "redefined - a copy may have a new instance"
+
+ myClass := nil
+! !
+
!Metaclass methodsFor:'creating classes'!
+new
+ "create & return a new metaclass (a classes class).
+ Since metaclasses only have one instance (the class),
+ complain if there is already one.
+ You get a new class by sending #new to the returned metaclass
+ (confusing - isn't it ?)"
+
+ |newClass|
+
+ myClass notNil ifTrue:[
+ ^ self error:'Each metaclass may only have one instance'.
+ ].
+ newClass := self basicNew.
+ newClass setSuperclass:Object
+ selectors:(Array new:0)
+ methods:(Array new:0)
+ instSize:0
+ flags:(Behavior flagBehavior).
+ newClass setName:'someClass'.
+ myClass := newClass.
+ ^ newClass
+!
+
name:newName inEnvironment:aSystemDictionary
subclassOf:aClass
instanceVariableNames:stringOfInstVarNames
@@ -713,385 +1074,6 @@
ObjectMemory flushCaches.
^ newClass
-!
-
-new
- "create & return a new metaclass (a classes class).
- Since metaclasses only have one instance (the class),
- complain if there is already one.
- You get a new class by sending #new to the returned metaclass
- (confusing - isn't it ?)"
-
- |newClass|
-
- myClass notNil ifTrue:[
- ^ self error:'Each metaclass may only have one instance'.
- ].
- newClass := self basicNew.
- newClass setSuperclass:Object
- selectors:(Array new:0)
- methods:(Array new:0)
- instSize:0
- flags:(Behavior flagBehavior).
- newClass setName:'someClass'.
- myClass := newClass.
- ^ newClass
-! !
-
-!Metaclass methodsFor:'class instance variables'!
-
-instanceVariableNames:aString
- "changing / adding class-inst vars -
- this actually creates a new metaclass and class, leaving the original
- classes around as obsolete classes. This may also be true for all subclasses,
- if class instance variables are added/removed.
- Existing instances continue to be defined by their original classes.
-
- Time will show, if this is an acceptable behavior or if we should migrate
- instances to become insts. of the new classes."
-
- |newClass newMetaclass nClassInstVars oldClass
- allSubclasses oldVars
- oldNames newNames addedNames
- oldOffsets newOffsets offset changeSet delta
- oldToNew newSubMeta newSub oldSubMeta oldSuper
- commonClassInstVars currentProject t|
-
- "
- cleanup needed here: extract common things with name:inEnvironment:...
- and restructure things ... currently way too complex.
- "
-
- oldVars := self instanceVariableString.
- aString = oldVars ifTrue:[
-"
- Transcript showCr:'no change (', oldVars , ') -> (', aString , ')'.
-"
- ^ self
- ].
-
- oldNames := oldVars asCollectionOfWords.
- newNames := aString asCollectionOfWords.
-
- oldNames = newNames ifTrue:[
-"
- Transcript showCr:'no real change'.
-"
- "no real change (just formatting)"
- self setInstanceVariableString:aString.
- ^ self
- ].
-
-"/ "
-"/ let user confirm, if any name is no good (and was good before)
-"/ "
-"/ (oldNames inject:true
-"/ into:[:okSoFar :word |
-"/ okSoFar and:[word first isUppercase]
-"/ ])
-"/ ifTrue:[
-"/ "was ok before"
-"/ (newNames inject:true
-"/ into:[:okSoFar :word |
-"/ okSoFar and:[word first isUppercase]
-"/ ])
-"/ ifFalse:[
-"/ (self confirm:'class instance variable names should start with an uppercase letter
-"/(by convention only)
-"/
-"/install anyway ?' withCRs)
-"/ ifFalse:[
-"/ ^ nil
-"/ ]
-"/ ]
-"/ ].
-
- nClassInstVars := newNames size.
-
-"
- Transcript showCr:'create new class/metaclass'.
-"
-
- "
- create the new metaclass
- "
- newMetaclass := Metaclass new.
- newMetaclass setSuperclass:superclass.
- newMetaclass instSize:(superclass instSize + nClassInstVars).
- (nClassInstVars ~~ 0) ifTrue:[
- newMetaclass setInstanceVariableString:aString
- ].
-"/ newMetaclass flags:(Behavior flagBehavior "flagNotIndexed").
- newMetaclass setName:name.
- newMetaclass classVariableString:classvars.
- newMetaclass category:category.
- newMetaclass setComment:(self comment).
-
- "find the class which is my sole instance"
-
- t := Smalltalk allClasses select:[:element | element class == self].
- (t size ~~ 1) ifTrue:[
- self error:'oops - I should have exactly one instance'.
- ^ nil
- ].
- oldClass := t anElement.
-
- "
- create the new class
- "
- newClass := newMetaclass new.
- newClass setSuperclass:(oldClass superclass).
- newClass instSize:(oldClass instSize).
- newClass flags:(oldClass flags).
- newClass setName:(oldClass name).
- newClass setInstanceVariableString:(oldClass instanceVariableString).
- newClass classVariableString:(oldClass classVariableString).
- newClass setComment:(oldClass comment).
- newClass category:(oldClass category).
- (t := oldClass primitiveSpec) notNil ifTrue:[
- newClass primitiveSpec:t.
- newClass setClassFilename:(oldClass classFilename).
- ].
-
- "/ set the new classes package
-
- Project notNil ifTrue:[
- currentProject := Project current.
- currentProject notNil ifTrue:[
- t := currentProject packageName.
- newMetaclass package:t.
- newClass package:t.
- ]
- ].
-
- changeSet := Set new.
- ((oldNames size == 0)
- or:[newNames startsWith:oldNames]) ifTrue:[
- "new variable(s) has/have been added - old methods still work"
-
-" "
- Transcript showCr:'copying methods ...'.
- Transcript endEntry.
-" "
- self copyMethodsFrom:self for:newMetaclass.
- self copyMethodsFrom:oldClass for:newClass.
-
- "
- but have to recompile methods accessing stuff now defined
- (it might have been a global before ...)
- "
-
- addedNames := newNames select:[:nm | (oldNames includes:nm) not].
-" "
- Transcript showCr:'recompiling methods accessing ' , addedNames printString , '...'.
- Transcript endEntry.
-" "
- "recompile class-methods"
- newMetaclass recompileMethodsAccessingAny:addedNames.
- ] ifFalse:[
- "
- create the changeSet; thats the set of class instvar names
- which have changed their position or are new
- "
- offset := 0. oldOffsets := Dictionary new.
- oldNames do:[:nm | offset := offset + 1. oldOffsets at:nm put:offset].
- offset := 0. newOffsets := Dictionary new.
- newNames do:[:nm | offset := offset + 1. newOffsets at:nm put:offset].
-
- oldOffsets associationsDo:[:a |
- |k|
-
- k := a key.
- (newOffsets includesKey:k) ifFalse:[
- changeSet add:k
- ] ifTrue:[
- (a value ~~ (newOffsets at:k)) ifTrue:[
- changeSet add:k
- ]
- ]
- ].
- newOffsets associationsDo:[:a |
- |k|
-
- k := a key.
- (oldOffsets includesKey:k) ifFalse:[
- changeSet add:k
- ] ifTrue:[
- (a value ~~ (oldOffsets at:k)) ifTrue:[
- changeSet add:k
- ]
- ]
- ].
-
-" "
- Transcript showCr:'recompiling methods accessing ' , changeSet printString , ' ...'.
- Transcript endEntry.
-" "
- "
- recompile class-methods
- "
- self copyInvalidatedMethodsFrom:self for:newMetaclass accessingAny:changeSet.
- newMetaclass recompileInvalidatedMethods:(Metaclass compiledMethodAt:#invalidCodeObject).
-
- self copyMethodsFrom:oldClass for:newClass.
- ].
-
- delta := newNames size - oldNames size.
-
- "
- get list of all subclasses - do before superclass is changed
- "
- allSubclasses := oldClass allSubclasses.
- allSubclasses := allSubclasses asSortedCollection:[:a :b |
- b isSubclassOf:a
- ].
-
- oldToNew := IdentityDictionary new.
-
- "
- create a new class tree, based on new version
- "
- allSubclasses do:[:aSubclass |
- oldSuper := aSubclass superclass.
- oldSubMeta := aSubclass class.
-
- newSubMeta := Metaclass new.
- oldSuper == oldClass ifTrue:[
- newSubMeta setSuperclass:newMetaclass.
- ] ifFalse:[
- newSubMeta setSuperclass:(oldToNew at:oldSuper) class.
- ].
- newSubMeta instSize:(oldSubMeta instSize + delta).
- newSubMeta flags:(oldSubMeta flags).
- newSubMeta setName:(oldSubMeta name).
- newSubMeta setInstanceVariableString:(oldSubMeta instanceVariableString).
- newSubMeta classVariableString:(oldSubMeta classVariableString).
- newSubMeta setComment:(oldSubMeta comment).
- newSubMeta category:(oldSubMeta category).
-
- newSub := newSubMeta new.
- oldSuper == oldClass ifTrue:[
- newSub setSuperclass:newClass.
- ] ifFalse:[
- newSub setSuperclass:(oldToNew at:oldSuper).
- ].
- newSub setSelectorArray:(aSubclass selectorArray).
- newSub setMethodArray:(aSubclass methodArray).
- newSub setName:(aSubclass name).
- newSub classVariableString:(aSubclass classVariableString).
- newSub setComment:(aSubclass comment).
- newSub category:(aSubclass category).
-
- oldToNew at:aSubclass put:newSub.
-
- aSubclass category:'obsolete'.
- aSubclass class category:'obsolete'.
- ].
-
- "recompile what needs to be"
-
- delta == 0 ifTrue:[
- "only have to recompile class methods accessing
- class instvars from changeset
- "
-
- allSubclasses do:[:oldSubclass |
- |newSubclass|
-
- newSubclass := oldToNew at:oldSubclass.
-
-Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , changeSet printString.
-
- newSubclass class recompileMethodsAccessingAny:changeSet.
- ]
- ] ifFalse:[
- "
- have to recompile all class methods accessing class instvars
- "
- commonClassInstVars := oldClass class allInstVarNames.
- changeSet do:[:v |
- commonClassInstVars remove:v ifAbsent:[]
- ].
-
- allSubclasses do:[:oldSubclass |
- |newSubclass classInstVars|
-
- newSubclass := oldToNew at:oldSubclass.
-
- classInstVars := newSubclass class allInstVarNames asSet.
- classInstVars removeAll:commonClassInstVars.
- classInstVars addAll:changeSet.
-
-Transcript showCr:'recompiling class methods of ' , newSubclass class name ,
- ' accessing any of ' , classInstVars printString.
-
- newSubclass class recompileMethodsAccessingAny:classInstVars.
- ]
- ].
-
- self addChangeRecordForClassInstvars:newClass.
-
- "install all new classes"
-
- Smalltalk at:(oldClass name asSymbol) put:newClass.
- ObjectMemory flushCachesFor:oldClass.
-
- allSubclasses do:[:oldClass |
- |newClass|
-
- newClass := oldToNew at:oldClass.
-"
-Transcript showCr:'install ' , newClass name , '(' , newClass category , ')' ,
- ' as ' , newClass name.
-"
- Smalltalk at:newClass name asSymbol put:newClass.
- ObjectMemory flushCachesFor:oldClass.
- ].
-
- "tell dependents ..."
-
- oldClass changed:#definition.
- self changed:#definition.
-
- ^ newMetaclass
-! !
-
-!Metaclass methodsFor:'copying'!
-
-postCopy
- "redefined - a copy may have a new instance"
-
- myClass := nil
-! !
-
-!Metaclass methodsFor:'accessing'!
-
-name
- "return my name - that is the name of my sole class, with 'class'
- appended. Currently, this is incompatible to ST-80 (which appends ' class')
- and will be changed (have to check for side effects first ...)"
-
- myClass isNil ifTrue:[
- ^ 'someMetaclass'
- ].
-"/ ^ myClass name , ' class'
- ^ myClass name , 'class'
-! !
-
-!Metaclass methodsFor:'queries'!
-
-isMeta
- "return true, if the receiver is some kind of metaclass;
- true is returned here. Redefines isMeta in Object"
-
- ^ true
-!
-
-soleInstance
- "return my sole class."
-
- ^ myClass
! !
!Metaclass methodsFor:'private'!
@@ -1271,26 +1253,6 @@
]
!
-anyInvalidatedMethodsIn:aClass
- "return true, if aClass has any invalidated methods in it"
-
- |trap trapCode trapByteCode|
-
- trap := Metaclass compiledMethodAt:#invalidCodeObject.
- trapCode := trap code.
- trapByteCode := trap byteCode.
-
- aClass methodArray do:[:aMethod |
- trapCode notNil ifTrue:[
- (aMethod code = trapCode) ifTrue:[^ true]
- ].
- trapByteCode notNil ifTrue:[
- (aMethod byteCode == trapByteCode) ifTrue:[^ true]
- ]
- ].
- ^ false
-!
-
checkConventionsFor:className instVarNames:instVarNameString classVarNames:classVarNameString
"Check for some 'considered bad-style' things, like lower case names.
NOTICE:
@@ -1335,4 +1297,40 @@
].
^ true
+!
+
+anyInvalidatedMethodsIn:aClass
+ "return true, if aClass has any invalidated methods in it"
+
+ |trap trapCode trapByteCode|
+
+ trap := Metaclass compiledMethodAt:#invalidCodeObject.
+ trapCode := trap code.
+ trapByteCode := trap byteCode.
+
+ aClass methodArray do:[:aMethod |
+ trapCode notNil ifTrue:[
+ (aMethod code = trapCode) ifTrue:[^ true]
+ ].
+ trapByteCode notNil ifTrue:[
+ (aMethod byteCode == trapByteCode) ifTrue:[^ true]
+ ]
+ ].
+ ^ false
! !
+
+!Metaclass methodsFor:'queries'!
+
+isMeta
+ "return true, if the receiver is some kind of metaclass;
+ true is returned here. Redefines isMeta in Object"
+
+ ^ true
+!
+
+soleInstance
+ "return my sole class."
+
+ ^ myClass
+! !
+
--- a/Smalltalk.st Sun Oct 29 19:08:45 1995 +0100
+++ b/Smalltalk.st Sun Oct 29 20:27:04 1995 +0100
@@ -10,30 +10,23 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.7 on 28-oct-1995 at 17:10:25' !
+'From Smalltalk/X, Version:2.10.8 on 29-oct-1995 at 20:01:13' !
Object subclass:#Smalltalk
instanceVariableNames:''
classVariableNames:'ExitBlocks CachedClasses SystemPath StartupClass StartupSelector
- StartupArguments CachedAbbreviations SilentLoading Initializing
- StandAlone LogDoits LoadBinaries RealSystemPath ResourcePath
- SourcePath BitmapPath BinaryPath FileInPath'
+ StartupArguments CachedAbbreviations SilentLoading Initializing
+ StandAlone LogDoits LoadBinaries RealSystemPath ResourcePath
+ SourcePath BitmapPath BinaryPath FileInPath'
poolDictionaries:''
category:'System-Support'
!
-Smalltalk comment:'
-COPYRIGHT (c) 1988 by Claus Gittinger
- All Rights Reserved
-
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.70 1995-10-29 18:08:45 cg Exp $
-'!
-
!Smalltalk class methodsFor:'documentation'!
version
"
-$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.70 1995-10-29 18:08:45 cg Exp $
+$Header: /cvs/stx/stx/libbasic/Smalltalk.st,v 1.71 1995-10-29 19:27:04 cg Exp $
"
!
@@ -347,6 +340,16 @@
%}
!
+includesKey:aKey
+ "return true, if the key is known"
+
+%{ /* NOCONTEXT */
+ extern OBJ __GLOBAL_KEYKNOWN();
+
+ RETURN ( __GLOBAL_KEYKNOWN(aKey) );
+%}
+!
+
at:aKey ifAbsent:aBlock
"retrieve the value stored at aKey.
If there is nothing stored under this key, return the value of
@@ -393,16 +396,6 @@
^ aValue
!
-includesKey:aKey
- "return true, if the key is known"
-
-%{ /* NOCONTEXT */
- extern OBJ __GLOBAL_KEYKNOWN();
-
- RETURN ( __GLOBAL_KEYKNOWN(aKey) );
-%}
-!
-
removeKey:aKey
"remove the argument from the globals dictionary"
@@ -562,7 +555,10 @@
self at:cSym put:value.
].
+ aClass updateVersionString.
aClass addChangeRecordForClassRename:oldName to:newName
+
+ "Created: 29.10.1995 / 19:58:32 / cg"
!
removeClass:aClass
@@ -1425,6 +1421,20 @@
!Smalltalk class methodsFor:'system management'!
+searchPath:aPath for:aFileName in:aDirName
+ "search aPath for a subdirectory named aDirectory with a file
+ named aFileName"
+
+ aPath do:[:dirName |
+ |realName|
+
+ (OperatingSystem isReadable:(realName := dirName , '/' , aDirName , '/' , aFileName)) ifTrue: [
+ ^ realName
+ ]
+ ].
+ ^ nil
+!
+
language
"return the language setting"
@@ -1451,18 +1461,10 @@
"
!
-searchPath:aPath for:aFileName in:aDirName
- "search aPath for a subdirectory named aDirectory with a file
- named aFileName"
-
- aPath do:[:dirName |
- |realName|
-
- (OperatingSystem isReadable:(realName := dirName , '/' , aDirName , '/' , aFileName)) ifTrue: [
- ^ realName
- ]
- ].
- ^ nil
+loadBinaries:aBoolean
+ "turn on/off loading of binary objects"
+
+ LoadBinaries := aBoolean
!
logDoits:aBoolean
@@ -1475,54 +1477,6 @@
!
-loadBinaries:aBoolean
- "turn on/off loading of binary objects"
-
- LoadBinaries := aBoolean
-!
-
-systemPath
- "return a collection of directorynames, where smalltalk
- looks for system files
- (usually in subdirs such as resources, bitmaps, source etc.)
- see comment in Smalltalk>>initSystemPath."
-
- ^ SystemPath
-
- "
- Smalltalk systemPath
- Smalltalk systemPath addLast:'someOtherDirectoryPath'
- "
-!
-
-loadBinaries
- "return true, if binaries should be loaded into the system,
- false if this should be suppressed. The default is false (for now)."
-
- ^ LoadBinaries
-!
-
-realSystemPath
- "return the realSystemPath - thats the directorynames from
- SystemPath which exist and are readable"
-
- RealSystemPath isNil ifTrue:[
- RealSystemPath := SystemPath select:[:dirName |
- (OperatingSystem isDirectory:dirName)
- and:[OperatingSystem isReadable:dirName]
- ].
- ].
- ^ RealSystemPath
-!
-
-constructPathFor:aDirectoryName
- "search for aDirectory in SystemPath"
-
- ^ self realSystemPath select:[:dirName |
- OperatingSystem isDirectory:(dirName , '/' , aDirectoryName)
- ].
-!
-
getSourceFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'source' in SystemPath);
@@ -1545,6 +1499,48 @@
"
!
+systemPath
+ "return a collection of directorynames, where smalltalk
+ looks for system files
+ (usually in subdirs such as resources, bitmaps, source etc.)
+ see comment in Smalltalk>>initSystemPath."
+
+ ^ SystemPath
+
+ "
+ Smalltalk systemPath
+ Smalltalk systemPath addLast:'someOtherDirectoryPath'
+ "
+!
+
+realSystemPath
+ "return the realSystemPath - thats the directorynames from
+ SystemPath which exist and are readable"
+
+ RealSystemPath isNil ifTrue:[
+ RealSystemPath := SystemPath select:[:dirName |
+ (OperatingSystem isDirectory:dirName)
+ and:[OperatingSystem isReadable:dirName]
+ ].
+ ].
+ ^ RealSystemPath
+!
+
+constructPathFor:aDirectoryName
+ "search for aDirectory in SystemPath"
+
+ ^ self realSystemPath select:[:dirName |
+ OperatingSystem isDirectory:(dirName , '/' , aDirectoryName)
+ ].
+!
+
+loadBinaries
+ "return true, if binaries should be loaded into the system,
+ false if this should be suppressed. The default is false (for now)."
+
+ ^ LoadBinaries
+!
+
getResourceFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'resource' in SystemPath);
@@ -1567,10 +1563,6 @@
"
!
-flushPathCaches
- RealSystemPath := ResourcePath := SourcePath := BitmapPath := BinaryPath := FileInPath := nil
-!
-
getBitmapFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'bitmaps' in SystemPath);
@@ -1593,6 +1585,24 @@
"
!
+flushPathCaches
+ RealSystemPath := ResourcePath := SourcePath := BitmapPath := BinaryPath := FileInPath := nil
+!
+
+bitmapFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'bitmaps' in SystemPath"
+
+ |aString|
+
+ aString := self getBitmapFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ FileStream readonlyFileNamed:aString
+ ].
+ ^ nil
+!
+
getSystemFileName:aFileName
"search aFileName in some standard places;
return the absolute filename or nil if none is found.
@@ -1617,6 +1627,20 @@
^ nil
!
+systemFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ see comment in Smalltalk>>initSystemPath"
+
+ |aString|
+
+ aString := self getSystemFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ FileStream readonlyFileNamed:aString
+ ].
+ ^ nil
+!
+
systemPath:aPath
"set the collection of directorynames, where smalltalk
looks for system files
@@ -1632,28 +1656,28 @@
"
!
-systemFileStreamFor:aFileName
+resourceFileStreamFor:aFileName
"search aFileName in some standard places;
return a readonly fileStream or nil if not found.
- see comment in Smalltalk>>initSystemPath"
+ Searches in subdirectories named 'resource' in SystemPath"
|aString|
- aString := self getSystemFileName:aFileName.
+ aString := self getResourceFileName:aFileName.
aString notNil ifTrue:[
^ FileStream readonlyFileNamed:aString
].
^ nil
!
-bitmapFileStreamFor:aFileName
+sourceFileStreamFor:aFileName
"search aFileName in some standard places;
return a readonly fileStream or nil if not found.
- Searches in subdirectories named 'bitmaps' in SystemPath"
+ Searches in subdirectories named 'source' in SystemPath"
|aString|
- aString := self getBitmapFileName:aFileName.
+ aString := self getSourceFileName:aFileName.
aString notNil ifTrue:[
^ FileStream readonlyFileNamed:aString
].
@@ -1679,20 +1703,6 @@
!
-sourceFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
- Searches in subdirectories named 'source' in SystemPath"
-
- |aString|
-
- aString := self getSourceFileName:aFileName.
- aString notNil ifTrue:[
- ^ FileStream readonlyFileNamed:aString
- ].
- ^ nil
-!
-
getBinaryFileName:aFileName
"search aFileName in some standard places
(subdirectories named 'binary' in SystemPath);
@@ -1711,34 +1721,6 @@
^ self searchPath:BinaryPath for:aFileName in:'binary'
!
-resourceFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
- Searches in subdirectories named 'resource' in SystemPath"
-
- |aString|
-
- aString := self getResourceFileName:aFileName.
- aString notNil ifTrue:[
- ^ FileStream readonlyFileNamed:aString
- ].
- ^ nil
-!
-
-fileInFileStreamFor:aFileName
- "search aFileName in some standard places;
- return a readonly fileStream or nil if not found.
- Searches in subdirectories named 'fileIn' in SystemPath"
-
- |aString|
-
- aString := self getFileInFileName:aFileName.
- aString notNil ifTrue:[
- ^ FileStream readonlyFileNamed:aString
- ].
- ^ nil
-!
-
readAbbreviations
"read classname to filename mappings from include/abbrev.stc.
sigh - all for those poor sys5.3 or MSDOS people with short filenames ..."
@@ -1769,6 +1751,20 @@
"
!
+fileInFileStreamFor:aFileName
+ "search aFileName in some standard places;
+ return a readonly fileStream or nil if not found.
+ Searches in subdirectories named 'fileIn' in SystemPath"
+
+ |aString|
+
+ aString := self getFileInFileName:aFileName.
+ aString notNil ifTrue:[
+ ^ FileStream readonlyFileNamed:aString
+ ].
+ ^ nil
+!
+
libraryFileNameOfClass:aClassName
"read the libinfo file 'liblist.stc' and the abbreviation file
'abbrev.stc' for an entry for aClassName.
@@ -1882,6 +1878,48 @@
"
!
+secureFileIn:aFileName
+ "read in the named file, looking for it at standard places.
+ Catch any error during fileIn. Return true if ok, false if failed"
+
+ (SignalSet
+ with:AbortSignal
+ with:Process terminateSignal)
+ handle:[:ex |
+ ex return
+ ] do:[
+ ^ self fileIn:aFileName
+ ].
+ ^ false
+!
+
+fileIn:aFileName
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed"
+
+ ^ self fileIn:aFileName lazy:nil silent:nil logged:false
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st'
+ "
+
+ "Created: 28.10.1995 / 17:06:28 / cg"
+!
+
+silentFileIn:aFilename
+ "same as fileIn:, but do not output 'compiled...'-messages on Transcript.
+ Main use is during startup."
+
+ |wasSilent|
+
+ wasSilent := self silentLoading:true.
+ [
+ self fileIn:aFilename
+ ] valueNowOrOnUnwindDo:[
+ self silentLoading:wasSilent
+ ]
+!
+
fileInClass:aClassName fromObject:aFileName
"read in the named object file and dynamic-link it into the system
- look for it in some standard places;
@@ -1907,48 +1945,6 @@
"
!
-secureFileIn:aFileName
- "read in the named file, looking for it at standard places.
- Catch any error during fileIn. Return true if ok, false if failed"
-
- (SignalSet
- with:AbortSignal
- with:Process terminateSignal)
- handle:[:ex |
- ex return
- ] do:[
- ^ self fileIn:aFileName
- ].
- ^ false
-!
-
-silentFileIn:aFilename
- "same as fileIn:, but do not output 'compiled...'-messages on Transcript.
- Main use is during startup."
-
- |wasSilent|
-
- wasSilent := self silentLoading:true.
- [
- self fileIn:aFilename
- ] valueNowOrOnUnwindDo:[
- self silentLoading:wasSilent
- ]
-!
-
-fileIn:aFileName
- "read in the named file - look for it in some standard places;
- return true if ok, false if failed"
-
- ^ self fileIn:aFileName lazy:nil silent:nil logged:false
-
- "
- Smalltalk fileIn:'source/TicTacToe.st'
- "
-
- "Created: 28.10.1995 / 17:06:28 / cg"
-!
-
fileIn:aFileName logged:logged
"read in the named file - look for it in some standard places;
return true if ok, false if failed.
@@ -1961,24 +1957,6 @@
"
!
-fileIn:aFileName lazy:lazy
- "read in the named file - look for it in some standard places;
- return true if ok, false if failed.
- If lazy is true, no code is generated for methods, instead stups
- are created which compile themself when first executed. This allows
- for much faster fileIn (but slows down the first execution later).
- Since no syntax checks are done when doing lazy fileIn, use this only for
- code which is known to be syntactically correct."
-
- ^ self fileIn:aFileName lazy:lazy silent:nil logged:false
-
- "
- Smalltalk fileIn:'source/TicTacToe.st' lazy:true
- "
-
- "Created: 28.10.1995 / 17:06:36 / cg"
-!
-
fileIn:aFileName lazy:lazy silent:silent logged:logged
"read in the named file - look for it in some standard places;
return true if ok, false if failed.
@@ -2053,6 +2031,24 @@
"
!
+fileIn:aFileName lazy:lazy
+ "read in the named file - look for it in some standard places;
+ return true if ok, false if failed.
+ If lazy is true, no code is generated for methods, instead stups
+ are created which compile themself when first executed. This allows
+ for much faster fileIn (but slows down the first execution later).
+ Since no syntax checks are done when doing lazy fileIn, use this only for
+ code which is known to be syntactically correct."
+
+ ^ self fileIn:aFileName lazy:lazy silent:nil logged:false
+
+ "
+ Smalltalk fileIn:'source/TicTacToe.st' lazy:true
+ "
+
+ "Created: 28.10.1995 / 17:06:36 / cg"
+!
+
fileIn:aFileName lazy:lazy silent:silent
"read in the named file - look for it in some standard places;
return true if ok, false if failed.
@@ -2095,15 +2091,6 @@
^ self fileInClass:aClassName initialize:true lazy:false silent:false
!
-fileInClass:aClassName initialize:doInit
- "find a source/object file for aClassName and -if found - load it.
- search is in some standard places trying driver-file (.ld), object-file (.o) and
- finally source file (.st) in that order.
- The file is first searched for using the class name, then the abbreviated name."
-
- ^ self fileInClass:aClassName initialize:doInit lazy:false silent:false
-!
-
fileInClass:aClassName initialize:doInit lazy:loadLazy silent:beSilent
"find a source/object file for aClassName and -if found - load it.
search is in some standard places, trying driver-file (.ld), object-file (.o) and
@@ -2211,6 +2198,15 @@
^ newClass
!
+fileInClass:aClassName initialize:doInit
+ "find a source/object file for aClassName and -if found - load it.
+ search is in some standard places trying driver-file (.ld), object-file (.o) and
+ finally source file (.st) in that order.
+ The file is first searched for using the class name, then the abbreviated name."
+
+ ^ self fileInClass:aClassName initialize:doInit lazy:false silent:false
+!
+
fileInClass:aClassName initialize:doInit lazy:loadLazy
"find a source/object file for aClassName and -if found - load it.
search is in some standard places trying driver-file (.ld), object-file (.o) and
@@ -2397,6 +2393,17 @@
"
!
+timeStamp
+ "return a string useful for timestamping a file.
+ The returned string is padded with spaces for a constant
+ length (to avoid changing a files size in fileOut with unchanged
+ class)."
+
+ ^ ('''From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
+ , Date today printString , ' at ' , Time now printString
+ , '''') paddedTo:80 with:(Character space)
+!
+
hello
"return a greeting string"
@@ -2418,16 +2425,5 @@
"
Smalltalk hello
"
-!
-
-timeStamp
- "return a string useful for timestamping a file.
- The returned string is padded with spaces for a constant
- length (to avoid changing a files size in fileOut with unchanged
- class)."
-
- ^ ('''From Smalltalk/X, Version:' , (Smalltalk versionString) , ' on '
- , Date today printString , ' at ' , Time now printString
- , '''') paddedTo:80 with:(Character space)
! !