--- a/Class.st Wed Nov 15 12:59:48 1995 +0100
+++ b/Class.st Wed Nov 15 13:03:26 1995 +0100
@@ -10,13 +10,12 @@
hereby transferred.
"
-'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'
- classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal CatchMethodRedefinitions
- MethodRedefinitionSignal UpdateChangeFileQuerySignal'
+ history'
+ classVariableNames:'UpdatingChanges LockChangesFile FileOutErrorSignal
+ CatchMethodRedefinitions MethodRedefinitionSignal
+ UpdateChangeFileQuerySignal'
poolDictionaries:''
category:'Kernel-Classes'
!
@@ -37,10 +36,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.70 1995-11-14 19:01:36 cg Exp $'
-!
-
documentation
"
Class adds more functionality to classes; minimum stuff has already
@@ -108,7 +103,10 @@
WARNING: layout known by compiler and runtime system
"
-! !
+!
+
+version
+^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.71 1995-11-15 12:03:26 cg Exp $'! !
!Class class methodsFor:'initialization'!
@@ -140,15 +138,6 @@
!Class class methodsFor:'Signal constants'!
-updateChangeFileQuerySignal
- "return the signal used as an upQuery if the changeFile should be updated.
- If unhandled, the value of UpdatingChanges is returned by the signals
- static handler."
-
- ^ UpdateChangeFileQuerySignal
-
-!
-
fileOutErrorSignal
"return the signal raised when an error occurs while fileing out.
This is signalled to allow browsers some user feed back in case
@@ -164,20 +153,41 @@
methods to be overwritten or redefined by incompatible methods"
^ MethodRedefinitionSignal
+!
+
+updateChangeFileQuerySignal
+ "return the signal used as an upQuery if the changeFile should be updated.
+ If unhandled, the value of UpdatingChanges is returned by the signals
+ static handler."
+
+ ^ UpdateChangeFileQuerySignal
+
! !
!Class class methodsFor:'accessing - flags'!
-updateChanges:aBoolean
- "turn on/off changes management. Return the prior value of the flag."
+catchMethodRedefinitions
+ "return the redefinition catching flag."
+
+ ^ CatchMethodRedefinitions
+!
+
+catchMethodRedefinitions:aBoolean
+ "turn on/off redefinition catching. Return the prior value of the flag."
|prev|
- prev := UpdatingChanges.
- UpdatingChanges := aBoolean.
+ prev := CatchMethodRedefinitions.
+ CatchMethodRedefinitions := aBoolean.
^ prev
!
+lockChangesFile
+ "return true, if the change file is locked during update"
+
+ ^ LockChangesFile
+!
+
lockChangesFile:aBoolean
"turn on/off change-file-locking. Return the previous value of the flag."
@@ -188,13 +198,13 @@
^ prev
!
-catchMethodRedefinitions:aBoolean
- "turn on/off redefinition catching. Return the prior value of the flag."
+updateChanges:aBoolean
+ "turn on/off changes management. Return the prior value of the flag."
|prev|
- prev := CatchMethodRedefinitions.
- CatchMethodRedefinitions := aBoolean.
+ prev := UpdatingChanges.
+ UpdatingChanges := aBoolean.
^ prev
!
@@ -202,18 +212,6 @@
"return true if changes are recorded"
^ UpdatingChanges
-!
-
-lockChangesFile
- "return true, if the change file is locked during update"
-
- ^ LockChangesFile
-!
-
-catchMethodRedefinitions
- "return the redefinition catching flag."
-
- ^ CatchMethodRedefinitions
! !
!Class class methodsFor:'enumeration '!
@@ -291,6 +289,21 @@
!Class methodsFor:'accessing'!
+addClassVarName:aString
+ "add a class variable if not already there and initialize it with nil.
+ Also writes a change record and notifies dependents.
+ BUG: Currently, no recompilation is done - this will change."
+
+ (self classVarNames includes:aString) ifFalse:[
+ self classVariableString:(self classVariableString , ' ' , aString).
+ self addChangeRecordForClass:self.
+ self updateRevisionString.
+ self changed:#definition.
+ ]
+
+ "Created: 29.10.1995 / 19:40:51 / cg"
+!
+
allClassVarNames
"return a collection of all the class variable name-strings
this includes all superclass-class variables"
@@ -302,6 +315,41 @@
"
!
+classFilename
+ "return the name of the file from which the class was compiled.
+ This is currently NOT used."
+
+ ^ classFilename
+!
+
+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
+ classVar exists - 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 put:something.
+!
+
classVarNames
"return a collection of the class variable name-strings.
Only names of class variables defined in this class are included
@@ -318,6 +366,20 @@
"
!
+classVariableString
+ "return a string of the class variables names.
+ Only names of class variables defined in this class are in the
+ returned string."
+
+ classvars isNil ifTrue:[^ ''].
+ ^ classvars
+
+ "
+ Object classVariableString
+ Float classVariableString
+ "
+!
+
classVariableString:aString
"set the classes classvarnames string;
Initialize new class variables with nil, clear and remove old ones.
@@ -360,19 +422,201 @@
]
!
-setComment:com category:categoryStringOrSymbol
- "set the comment and category of the class;
- do NOT create a change record"
-
- |cat|
-
- comment := com.
- categoryStringOrSymbol isNil ifTrue:[
- cat := ''
- ] ifFalse:[
- cat := categoryStringOrSymbol
+comment
+ "return the comment (aString) of the class"
+
+ |stream string|
+
+ "the comment is either a string, or an integer specifying the
+ position within the classes sourcefile ...
+ "
+ comment isNumber ifTrue:[
+ classFilename notNil ifTrue:[
+ stream := self sourceStream. "/ Smalltalk sourceFileStreamFor:classFilename.
+ stream notNil ifTrue:[
+ stream position:comment.
+ string := String readFrom:stream onError:''.
+ stream close.
+ ^ string
+ ]
+ ]
].
- category := cat asSymbol
+ ^ comment
+
+ "
+ Object comment
+ "
+!
+
+comment:aString
+ "set the comment of the class to be the argument, aString;
+ create a change record and notify dependents."
+
+ |oldComment|
+
+ comment ~= aString ifTrue:[
+ oldComment := self comment.
+ comment := aString.
+ self changed:#comment with:oldComment.
+ self updateRevisionString.
+ self addChangeRecordForClassComment:self.
+ ]
+
+ "Created: 29.10.1995 / 19:41:24 / cg"
+!
+
+definition
+ "return an expression-string to define myself"
+
+ |s|
+
+ s := WriteStream on:(String new).
+ self fileOutDefinitionOn:s.
+ ^ s contents
+
+ "
+ Object definition
+ Point definition
+ "
+!
+
+history
+ "return the history of the class"
+
+ ^ history
+
+ "
+ Object history
+ "
+!
+
+history:aString
+ "set the history of the class."
+
+ history := aString
+!
+
+package
+ "return the package of the class"
+
+ ^ package
+
+ "
+ Object package
+ "
+!
+
+package:aStringOrSymbol
+ "set the package of the class."
+
+ package := aStringOrSymbol
+!
+
+primitiveDefinitions:aString
+ "set the primitiveDefinition string"
+
+ self setPrimitiveSpecsAt:1 to:aString.
+ self addChangeRecordForPrimitiveDefinitions:self.
+ self updateRevisionString.
+
+ "Created: 29.10.1995 / 19:41:39 / cg"
+!
+
+primitiveDefinitionsString
+ "return the primitiveDefinition string or nil"
+
+ ^ self getPrimitiveSpecsAt:1
+
+ "
+ Object primitiveDefinitionsString
+ String primitiveDefinitionsString
+ "
+!
+
+primitiveFunctions:aString
+ "set the primitiveFunction string"
+
+ self setPrimitiveSpecsAt:3 to:aString.
+ self addChangeRecordForPrimitiveFunctions:self.
+ self updateRevisionString.
+
+ "Created: 29.10.1995 / 19:41:48 / cg"
+!
+
+primitiveFunctionsString
+ "return the primitiveFunctions string or nil"
+
+ ^ self getPrimitiveSpecsAt:3
+!
+
+primitiveSpec
+ "return the primitiveSpec or nil"
+
+ ^ primitiveSpec
+!
+
+primitiveSpec:anArrayOf3ElementsOrNil
+ "set the primitiveSpec or nil"
+
+ primitiveSpec := anArrayOf3ElementsOrNil
+!
+
+primitiveVariables:aString
+ "set the primitiveVariable string"
+
+ self setPrimitiveSpecsAt:2 to:aString.
+ self addChangeRecordForPrimitiveVariables:self.
+ self updateRevisionString.
+
+ "Created: 29.10.1995 / 19:41:58 / cg"
+!
+
+primitiveVariablesString
+ "return the primitiveVariables string or nil"
+
+ ^ self getPrimitiveSpecsAt:2
+!
+
+removeClassVarName:aString
+ "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|
+
+ names := self classVarNames.
+ (names includes:aString) ifTrue:[
+ newNames := ''.
+ names do:[:nm | nm ~= aString ifTrue:[newNames := newNames , nm , ' ']].
+ self classVariableString:newNames withoutSpaces.
+ self addChangeRecordForClass:self.
+ self updateRevisionString.
+ self changed:#definition.
+ ]
+
+ "Created: 29.10.1995 / 19:42:08 / cg"
+!
+
+renameCategory:oldCategory to:newCategory
+ "rename a category (changes category of those methods).
+ Appends a change record and notifies dependents."
+
+ |any|
+
+ any := false.
+ methodArray do:[:aMethod |
+ aMethod category = oldCategory ifTrue:[
+ aMethod category:newCategory.
+ any := true.
+ ]
+ ].
+ any ifTrue:[
+ self addChangeRecordForRenameCategory:oldCategory to:newCategory.
+ self updateRevisionString.
+ self changed:#methodCategory.
+ ]
+
+ "Created: 29.10.1995 / 19:42:15 / cg"
!
revision
@@ -417,72 +661,33 @@
"Created: 11.11.1995 / 14:27:20 / cg"
!
-classVariableString
- "return a string of the class variables names.
- Only names of class variables defined in this class are in the
- returned string."
-
- classvars isNil ifTrue:[^ ''].
- ^ classvars
-
- "
- Object classVariableString
- Float classVariableString
- "
+revision:aString
+ "set the revision-ID.
+ This should normally not be done in the running system, as the source-manager
+ will need this to validate sourcefiles being correct for a given binary
+ (and optionally: extracting the required sourcefile from the rcs source)"
+
+ revision := aString
!
-comment
- "return the comment (aString) of the class"
-
- |stream string|
-
- "the comment is either a string, or an integer specifying the
- position within the classes sourcefile ...
- "
- comment isNumber ifTrue:[
- classFilename notNil ifTrue:[
- stream := self sourceStream. "/ Smalltalk sourceFileStreamFor:classFilename.
- stream notNil ifTrue:[
- stream position:comment.
- string := String readFrom:stream onError:''.
- stream close.
- ^ string
- ]
- ]
- ].
- ^ comment
-
- "
- Object comment
- "
+setClassFilename:aFilename
+ "set the classes filename.
+ This is a dangerous (low level) operation, since the
+ comment and primitiveSpecs may no longer be accessable, if a wrong filename
+ is set here."
+
+ classFilename := aFilename
+
+ "Modified: 8.9.1995 / 14:16:48 / claus"
!
-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
- classVar exists - 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 put:something.
+setClassVariableString:aString
+ "set the classes classvarnames string.
+ This is a dangerous (low level) operation, since the
+ classvariables are not really created or updated. Also,
+ NO change record is written."
+
+ classvars := aString
!
setComment:aString
@@ -492,37 +697,25 @@
comment := aString
!
-comment:aString
- "set the comment of the class to be the argument, aString;
- create a change record and notify dependents."
-
- |oldComment|
-
- comment ~= aString ifTrue:[
- oldComment := self comment.
- comment := aString.
- self changed:#comment with:oldComment.
- self updateRevisionString.
- self addChangeRecordForClassComment:self.
- ]
-
- "Created: 29.10.1995 / 19:41:24 / cg"
+setComment:com category:categoryStringOrSymbol
+ "set the comment and category of the class;
+ do NOT create a change record"
+
+ |cat|
+
+ comment := com.
+ categoryStringOrSymbol isNil ifTrue:[
+ cat := ''
+ ] ifFalse:[
+ cat := categoryStringOrSymbol
+ ].
+ category := cat asSymbol
!
-package
- "return the package of the class"
-
- ^ package
-
- "
- Object package
- "
-!
-
-package:aStringOrSymbol
- "set the package of the class."
-
- package := aStringOrSymbol
+setHistory:aString
+ "set the history of the class."
+
+ history := aString
!
setPackage:aStringOrSymbol
@@ -531,13 +724,42 @@
package := aStringOrSymbol
!
-revision:aString
- "set the revision-ID.
- This should normally not be done in the running system, as the source-manager
- will need this to validate sourcefiles being correct for a given binary
- (and optionally: extracting the required sourcefile from the rcs source)"
-
- revision := aString
+sharedPools
+ "ST/X does not (currently) support pools"
+
+ ^ #()
+!
+
+source
+ "return the classes full source code"
+
+ |code aStream|
+
+" this is too slow for big classes ...
+ code := String new:1000.
+ aStream := WriteStream on:code.
+ self fileOutOn:aStream
+"
+ aStream := FileStream newFileNamed:'__temp'.
+ aStream isNil ifTrue:[
+ self notify:'cannot create temporary file.'.
+ ^ nil
+ ].
+ FileOutErrorSignal handle:[:ex |
+ aStream nextPutAll:'"no source available"'.
+ ] do:[
+ self fileOutOn:aStream.
+ ].
+ aStream close.
+ aStream := FileStream oldFileNamed:'__temp'.
+ aStream isNil ifTrue:[
+ self notify:'oops - cannot reopen temp file'.
+ ^ nil
+ ].
+ code := aStream contents.
+ aStream close.
+ OperatingSystem removeFile:'__temp'.
+ ^ code
!
sourceCodeInfo
@@ -652,158 +874,6 @@
"Created: 4.11.1995 / 20:36:53 / cg"
!
-history
- "return the history of the class"
-
- ^ history
-
- "
- Object history
- "
-!
-
-setHistory:aString
- "set the history of the class."
-
- history := aString
-!
-
-primitiveDefinitionsString
- "return the primitiveDefinition string or nil"
-
- ^ self getPrimitiveSpecsAt:1
-
- "
- Object primitiveDefinitionsString
- String primitiveDefinitionsString
- "
-!
-
-primitiveVariablesString
- "return the primitiveVariables string or nil"
-
- ^ self getPrimitiveSpecsAt:2
-!
-
-primitiveFunctionsString
- "return the primitiveFunctions string or nil"
-
- ^ 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"
-
- primitiveSpec := anArrayOf3ElementsOrNil
-!
-
-primitiveDefinitions:aString
- "set the primitiveDefinition string"
-
- self setPrimitiveSpecsAt:1 to:aString.
- self addChangeRecordForPrimitiveDefinitions:self.
- self updateRevisionString.
-
- "Created: 29.10.1995 / 19:41:39 / cg"
-!
-
-primitiveVariables:aString
- "set the primitiveVariable string"
-
- self setPrimitiveSpecsAt:2 to:aString.
- self addChangeRecordForPrimitiveVariables:self.
- self updateRevisionString.
-
- "Created: 29.10.1995 / 19:41:58 / cg"
-!
-
-primitiveFunctions:aString
- "set the primitiveFunction string"
-
- self setPrimitiveSpecsAt:3 to:aString.
- self addChangeRecordForPrimitiveFunctions:self.
- self updateRevisionString.
-
- "Created: 29.10.1995 / 19:41:48 / cg"
-!
-
-classFilename
- "return the name of the file from which the class was compiled.
- This is currently NOT used."
-
- ^ classFilename
-!
-
-setClassFilename:aFilename
- "set the classes filename.
- This is a dangerous (low level) operation, since the
- comment and primitiveSpecs may no longer be accessable, if a wrong filename
- is set here."
-
- classFilename := aFilename
-
- "Modified: 8.9.1995 / 14:16:48 / claus"
-!
-
-definition
- "return an expression-string to define myself"
-
- |s|
-
- s := WriteStream on:(String new).
- self fileOutDefinitionOn:s.
- ^ s contents
-
- "
- Object definition
- Point definition
- "
-!
-
-source
- "return the classes full source code"
-
- |code aStream|
-
-" this is too slow for big classes ...
- code := String new:1000.
- aStream := WriteStream on:code.
- self fileOutOn:aStream
-"
- aStream := FileStream newFileNamed:'__temp'.
- aStream isNil ifTrue:[
- self notify:'cannot create temporary file.'.
- ^ nil
- ].
- FileOutErrorSignal handle:[:ex |
- aStream nextPutAll:'"no source available"'.
- ] do:[
- self fileOutOn:aStream.
- ].
- aStream close.
- aStream := FileStream oldFileNamed:'__temp'.
- aStream isNil ifTrue:[
- self notify:'oops - cannot reopen temp file'.
- ^ nil
- ].
- code := aStream contents.
- aStream close.
- OperatingSystem removeFile:'__temp'.
- ^ code
-!
-
sourceStream
"return an open stream on my sourcefile, nil if that is not available"
@@ -873,78 +943,6 @@
"
"Created: 10.11.1995 / 21:05:13 / cg"
-!
-
-addClassVarName:aString
- "add a class variable if not already there and initialize it with nil.
- Also writes a change record and notifies dependents.
- BUG: Currently, no recompilation is done - this will change."
-
- (self classVarNames includes:aString) ifFalse:[
- self classVariableString:(self classVariableString , ' ' , aString).
- self addChangeRecordForClass:self.
- self updateRevisionString.
- self changed:#definition.
- ]
-
- "Created: 29.10.1995 / 19:40:51 / cg"
-!
-
-sharedPools
- "ST/X does not (currently) support pools"
-
- ^ #()
-!
-
-setClassVariableString:aString
- "set the classes classvarnames string.
- This is a dangerous (low level) operation, since the
- classvariables are not really created or updated. Also,
- NO change record is written."
-
- classvars := aString
-!
-
-removeClassVarName:aString
- "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|
-
- names := self classVarNames.
- (names includes:aString) ifTrue:[
- newNames := ''.
- names do:[:nm | nm ~= aString ifTrue:[newNames := newNames , nm , ' ']].
- self classVariableString:newNames withoutSpaces.
- self addChangeRecordForClass:self.
- self updateRevisionString.
- self changed:#definition.
- ]
-
- "Created: 29.10.1995 / 19:42:08 / cg"
-!
-
-renameCategory:oldCategory to:newCategory
- "rename a category (changes category of those methods).
- Appends a change record and notifies dependents."
-
- |any|
-
- any := false.
- methodArray do:[:aMethod |
- aMethod category = oldCategory ifTrue:[
- aMethod category:newCategory.
- any := true.
- ]
- ].
- any ifTrue:[
- self addChangeRecordForRenameCategory:oldCategory to:newCategory.
- self updateRevisionString.
- self changed:#methodCategory.
- ]
-
- "Created: 29.10.1995 / 19:42:15 / cg"
! !
!Class methodsFor:'adding/removing'!
@@ -1058,6 +1056,16 @@
"
!
+storeBinaryDefinitionOf: anAssociation on: stream manager: manager
+ "not usable at the moment - there are no classpools currently"
+
+ | string |
+
+ string := self name, ' classPool at: ', anAssociation key storeString.
+ stream nextNumber: 2 put: string size.
+ string do: [:char| stream nextPut: char asciiValue]
+!
+
storeBinaryDefinitionOn: stream manager: manager
"classes will store the name, signature and instvar names.
They restore by looking for that name in the Smalltalk dictionary.
@@ -1104,16 +1112,6 @@
Rectangle storeBinaryOn:s.
Object readBinaryFrom:(ReadStream on:s contents)
"
-!
-
-storeBinaryDefinitionOf: anAssociation on: stream manager: manager
- "not usable at the moment - there are no classpools currently"
-
- | string |
-
- string := self name, ' classPool at: ', anAssociation key storeString.
- stream nextNumber: 2 put: string size.
- string do: [:char| stream nextPut: char asciiValue]
! !
!Class methodsFor:'c function interfacing'!
@@ -1155,12 +1153,278 @@
!Class methodsFor:'changes management'!
+addChangeRecordForChangeCategory
+ "add a category change record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForChangeCategory:to: with:category.
+!
+
+addChangeRecordForChangeCategory:category to:aStream
+ "append a category change record to aStream"
+
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' category:' , category storeString).
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForClass:aClass
+ "add a class-definition-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
+!
+
+addChangeRecordForClass:aClass to:aStream
+ "append a class-definition-record to aStream"
+
+ aClass isLoaded ifTrue:[
+ aClass fileOutDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+ ]
+!
+
+addChangeRecordForClassComment:aClass
+ "add a class-comment-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
+!
+
+addChangeRecordForClassComment:aClass to:aStream
+ "append a class-comment-record to aStream"
+
+ aClass fileOutCommentOn:aStream.
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForClassFileOut:aClass
+ "append a class-was-filedOut-record to the changes file"
+
+ self addInfoRecord:('fileOut ' , aClass name)
+!
+
+addChangeRecordForClassInstvars:aClass
+ "add a class-instvars-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForClassInstvars:to: with:aClass.
+!
+
+addChangeRecordForClassInstvars:aClass to:aStream
+ "append a class-instvars-record to aStream"
+
+ aClass fileOutClassInstVarDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForClassRemove:oldName
+ "add a class-remove-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForClassRemove:to: with:oldName.
+!
+
+addChangeRecordForClassRemove:oldName to:aStream
+ "append a class-remove-record to aStream"
+
+ aStream nextPutAll:('Smalltalk removeClass:' , oldName).
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForClassRename:oldName to:newName
+ "add a class-rename-record to the changes file"
+
+ self writingChangeDo:[:aStream |
+ self addChangeRecordForClassRename:oldName to:newName to:aStream
+ ]
+!
+
+addChangeRecordForClassRename:oldName to:newName to:aStream
+ "append a class-rename-record to aStream"
+
+ aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
+ 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
+ ]
+ ]
+!
+
addChangeRecordForMethod:aMethod to:aStream
"append a method-change-record to aStream"
self fileOutMethod:aMethod on:aStream.
!
+addChangeRecordForMethodCategory:aMethod category:aString
+ "add a methodCategory-change-record to the changes file"
+
+ (UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
+ self writingChangeDo:[:aStream |
+ self addChangeRecordForMethodCategory:aMethod category:aString to:aStream.
+ ].
+
+ "this test allows a smalltalk without Projects/ChangeSets"
+ Project notNil ifTrue:[
+ Project addMethodCategoryChange:aMethod category:aString in:self
+ ]
+ ]
+!
+
+addChangeRecordForMethodCategory:aMethod category:newCategory to:aStream
+ "append a methodCategory-change-record to aStream"
+
+ |selector|
+
+ selector := aMethod selector.
+ selector notNil ifTrue:[
+ aStream nextPutAll:'('.
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
+ aStream nextPutAll:(') category:' , newCategory storeString).
+ aStream nextPutChunkSeparator.
+ ]
+!
+
+addChangeRecordForMethodPrivacy:aMethod
+ "add a method-privacy-change-record to the changes file"
+
+ (UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
+ self writingChangePerform:#addChangeRecordForMethodPrivacy:to: with:aMethod.
+ "this test allows a smalltalk without Projects/ChangeSets"
+ Project notNil ifTrue:[
+ Project addMethodPrivacyChange:aMethod in:self
+ ]
+ ]
+
+ "Modified: 27.8.1995 / 22:47:32 / claus"
+!
+
+addChangeRecordForMethodPrivacy:aMethod to:aStream
+ "append a method-privacy-change-record to aStream"
+
+ |selector|
+
+ selector := aMethod selector.
+ selector notNil ifTrue:[
+ aStream nextPutAll:'('.
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
+ aStream nextPutAll:(') privacy:' , aMethod privacy storeString).
+ aStream nextPutChunkSeparator.
+ ]
+
+ "Modified: 27.8.1995 / 22:59:56 / claus"
+!
+
+addChangeRecordForPrimitiveDefinitions:aClass
+ "add a primitiveDefinitions-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass.
+!
+
+addChangeRecordForPrimitiveDefinitions:aClass to:aStream
+ "append a primitiveDefinitions-record to aStream"
+
+ aStream nextPutAll:aClass name
+ , ' primitiveDefinitions:'
+ , aClass primitiveDefinitionsString storeString.
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForPrimitiveFunctions:aClass
+ "add a primitiveFunctions-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass.
+!
+
+addChangeRecordForPrimitiveFunctions:aClass to:aStream
+ "append a primitiveFunctions-record to aStream"
+
+ aStream nextPutAll:aClass name
+ , ' primitiveFunctions:'
+ , aClass primitiveFunctionsString storeString.
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForPrimitiveVariables:aClass
+ "add a primitiveVariables-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
+!
+
+addChangeRecordForPrimitiveVariables:aClass to:aStream
+ "append a primitiveVariables-record to aStream"
+
+ aStream nextPutAll:aClass name
+ , ' primitiveVariables:'
+ , aClass primitiveVariablesString storeString.
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForRemoveSelector:aSelector
+ "add a method-remove-record to the changes file"
+
+ self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector.
+!
+
+addChangeRecordForRemoveSelector:aSelector to:aStream
+ "append a method-remove-record to aStream"
+
+ self printClassNameOn:aStream.
+ aStream nextPutAll:(' removeSelector:#' , aSelector).
+ aStream nextPutChunkSeparator.
+!
+
+addChangeRecordForRenameCategory:oldCategory to:newCategory
+ "add a category-rename record to the changes file"
+
+ self writingChangeDo:[:aStream |
+ self addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream.
+ ]
+!
+
+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 nextPutChunkSeparator.
+!
+
+addChangeRecordForSnapshot:aFileName
+ "add a snapshot-record to the changes file"
+
+ self addInfoRecord:('snapshot ' , aFileName)
+!
+
+addChangeRecordForSnapshot:aFileName to:aStream
+ "add a snapshot-record to aStream"
+
+ self addInfoRecord:('snapshot ' , aFileName) to:aStream
+!
+
+addInfoRecord:aMessage
+ "add an info-record (snapshot, class fileOut etc.) to the changes file"
+
+ self writingChangePerform:#addInfoRecord:to: with:aMessage.
+!
+
+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.
+!
+
changesStream
"return a Stream for the writing changes file - or nil if no update is wanted"
@@ -1190,6 +1454,41 @@
"Modified: 28.10.1995 / 16:55:03 / cg"
!
+sourcesStream
+ "return a stream for writing the sources file.
+ Notice, in ST/X, it is noncommon to use a single
+ source file; typically each classes source is kept
+ in a separate file."
+
+ |aStream fileName|
+
+ 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 setToEnd.
+ ^ aStream
+
+ "Created: 28.10.1995 / 16:53:17 / 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
+ ].
+!
+
writingChangeDo:aBlock
"common helper to write a change record.
Opens the changefile and executes aBlock passing the stream
@@ -1219,307 +1518,6 @@
]
"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
- source file; typically each classes source is kept
- in a separate file."
-
- |aStream fileName|
-
- 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 setToEnd.
- ^ aStream
-
- "Created: 28.10.1995 / 16:53:17 / cg"
-!
-
-addChangeRecordForRemoveSelector:aSelector to:aStream
- "append a method-remove-record to aStream"
-
- self printClassNameOn:aStream.
- aStream nextPutAll:(' removeSelector:#' , aSelector).
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForMethodCategory:aMethod category:newCategory to:aStream
- "append a methodCategory-change-record to aStream"
-
- |selector|
-
- selector := aMethod selector.
- selector notNil ifTrue:[
- aStream nextPutAll:'('.
- self printClassNameOn:aStream.
- aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
- aStream nextPutAll:(') category:' , newCategory storeString).
- aStream nextPutChunkSeparator.
- ]
-!
-
-addChangeRecordForMethodPrivacy:aMethod to:aStream
- "append a method-privacy-change-record to aStream"
-
- |selector|
-
- selector := aMethod selector.
- selector notNil ifTrue:[
- aStream nextPutAll:'('.
- self printClassNameOn:aStream.
- aStream nextPutAll:(' compiledMethodAt:' , selector storeString).
- aStream nextPutAll:(') privacy:' , aMethod privacy storeString).
- aStream nextPutChunkSeparator.
- ]
-
- "Modified: 27.8.1995 / 22:59:56 / claus"
-!
-
-addChangeRecordForClass:aClass to:aStream
- "append a class-definition-record to aStream"
-
- aClass isLoaded ifTrue:[
- aClass fileOutDefinitionOn:aStream.
- aStream nextPutChunkSeparator.
- ]
-!
-
-addChangeRecordForClassInstvars:aClass to:aStream
- "append a class-instvars-record to aStream"
-
- aClass fileOutClassInstVarDefinitionOn:aStream.
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForClassComment:aClass to:aStream
- "append a class-comment-record to aStream"
-
- aClass fileOutCommentOn:aStream.
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForPrimitiveVariables:aClass to:aStream
- "append a primitiveVariables-record to aStream"
-
- aStream nextPutAll:aClass name
- , ' primitiveVariables:'
- , aClass primitiveVariablesString storeString.
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForPrimitiveDefinitions:aClass to:aStream
- "append a primitiveDefinitions-record to aStream"
-
- aStream nextPutAll:aClass name
- , ' primitiveDefinitions:'
- , aClass primitiveDefinitionsString storeString.
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForPrimitiveFunctions:aClass to:aStream
- "append a primitiveFunctions-record to aStream"
-
- aStream nextPutAll:aClass name
- , ' primitiveFunctions:'
- , aClass primitiveFunctionsString storeString.
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForClassRename:oldName to:newName to:aStream
- "append a class-rename-record to aStream"
-
- aStream nextPutAll:('Smalltalk renameClass:' , oldName , ' to:''' , newName , '''').
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForClassRemove:oldName to:aStream
- "append a class-remove-record to aStream"
-
- aStream nextPutAll:('Smalltalk removeClass:' , oldName).
- aStream nextPutChunkSeparator.
-!
-
-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 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.
-!
-
-addChangeRecordForChangeCategory:category to:aStream
- "append a category change record to aStream"
-
- self printClassNameOn:aStream.
- aStream nextPutAll:(' category:' , category storeString).
- aStream nextPutChunkSeparator.
-!
-
-addChangeRecordForClass:aClass
- "add a class-definition-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForClass:to: with:aClass.
-!
-
-addChangeRecordForSnapshot:aFileName to:aStream
- "add a snapshot-record to aStream"
-
- self addInfoRecord:('snapshot ' , aFileName) to:aStream
-!
-
-addChangeRecordForRemoveSelector:aSelector
- "add a method-remove-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForRemoveSelector:to: with:aSelector.
-!
-
-addChangeRecordForMethodCategory:aMethod category:aString
- "add a methodCategory-change-record to the changes file"
-
- (UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
- self writingChangeDo:[:aStream |
- self addChangeRecordForMethodCategory:aMethod category:aString to:aStream.
- ].
-
- "this test allows a smalltalk without Projects/ChangeSets"
- Project notNil ifTrue:[
- Project addMethodCategoryChange:aMethod category:aString in:self
- ]
- ]
-!
-
-addChangeRecordForMethodPrivacy:aMethod
- "add a method-privacy-change-record to the changes file"
-
- (UpdateChangeFileQuerySignal raise) "UpdatingChanges" ifTrue:[
- self writingChangePerform:#addChangeRecordForMethodPrivacy:to: with:aMethod.
- "this test allows a smalltalk without Projects/ChangeSets"
- Project notNil ifTrue:[
- Project addMethodPrivacyChange:aMethod in:self
- ]
- ]
-
- "Modified: 27.8.1995 / 22:47:32 / claus"
-!
-
-addChangeRecordForClassInstvars:aClass
- "add a class-instvars-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForClassInstvars:to: with:aClass.
-!
-
-addChangeRecordForClassComment:aClass
- "add a class-comment-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForClassComment:to: with:aClass.
-!
-
-addChangeRecordForPrimitiveVariables:aClass
- "add a primitiveVariables-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForPrimitiveVariables:to: with:aClass.
-!
-
-addChangeRecordForPrimitiveDefinitions:aClass
- "add a primitiveDefinitions-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForPrimitiveDefinitions:to: with:aClass.
-!
-
-addChangeRecordForPrimitiveFunctions:aClass
- "add a primitiveFunctions-record to the changes file"
-
- self writingChangePerform:#addChangeRecordForPrimitiveFunctions:to: with:aClass.
-!
-
-addChangeRecordForClassRename:oldName to:newName
- "add a class-rename-record to the changes file"
-
- self writingChangeDo:[:aStream |
- self addChangeRecordForClassRename:oldName to:newName to:aStream
- ]
-!
-
-addChangeRecordForClassRemove:oldName
- "add a class-remove-record to the changes file"
-
- 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"
-
- self writingChangeDo:[:aStream |
- self addChangeRecordForRenameCategory:oldCategory to:newCategory to:aStream.
- ]
-!
-
-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.
-!
-
-addChangeRecordForSnapshot:aFileName
- "add a snapshot-record to the changes file"
-
- self addInfoRecord:('snapshot ' , aFileName)
! !
!Class methodsFor:'compiling'!
@@ -1554,28 +1552,13 @@
notifying:requestor
!
-recompileMethodsAccessingAny:setOfNames
- "recompile all methods accessing a variable from setOfNames"
-
- self recompileMethodsAccessingAny:setOfNames orSuper:false
-!
-
-recompileMethodsAccessingAny:setOfNames orSuper:superBoolean
- "recompile all methods accessing a variable from setOfNames,
- or super (if superBoolean is true)"
-
- |p|
+recompile
+ "recompile all methods
+ used when a class changes instances and therefore all methods
+ have to be recompiled"
selectorArray do:[:aSelector |
- |m|
-
- m := self compiledMethodAt:aSelector.
- p := Parser parseMethod:(m source) in:self.
- (p isNil
- or:[(p usedVars notNil and:[p usedVars includesAny:setOfNames])
- or:[superBoolean and:[p usesSuper]]]) ifTrue:[
- self recompile:aSelector
- ]
+ self recompile:aSelector
]
!
@@ -1597,16 +1580,6 @@
]
!
-recompile
- "recompile all methods
- used when a class changes instances and therefore all methods
- have to be recompiled"
-
- selectorArray do:[:aSelector |
- self recompile:aSelector
- ]
-!
-
recompileAll
"recompile this class and all subclasses"
@@ -1635,10 +1608,50 @@
self recompile:aSelector
]
]
+!
+
+recompileMethodsAccessingAny:setOfNames
+ "recompile all methods accessing a variable from setOfNames"
+
+ self recompileMethodsAccessingAny:setOfNames orSuper:false
+!
+
+recompileMethodsAccessingAny:setOfNames orSuper:superBoolean
+ "recompile all methods accessing a variable from setOfNames,
+ or super (if superBoolean is true)"
+
+ |p|
+
+ selectorArray do:[:aSelector |
+ |m|
+
+ m := self compiledMethodAt:aSelector.
+ p := Parser parseMethod:(m source) in:self.
+ (p isNil
+ or:[(p usedVars notNil and:[p usedVars includesAny:setOfNames])
+ or:[superBoolean and:[p usesSuper]]]) ifTrue:[
+ self recompile:aSelector
+ ]
+ ]
! !
!Class methodsFor:'fileIn interface'!
+ignoredMethodsFor:aCategory
+ "this is a speciality of ST/X - it allows quick commenting of methods
+ from a source-file by replacing the 'methodsFor:' by 'ignoredMethodsFor'.
+ Returns a ClassCategoryReader to read in and skip methods."
+
+ ^ ClassCategoryReader skippingChunks
+!
+
+methods
+ "this method allows fileIn of ST/V methods -
+ return a ClassCategoryReader to read in and compile methods for me."
+
+ ^ ClassCategoryReader class:self category:'ST/V methods'
+!
+
methodsFor:aCategory
"return a ClassCategoryReader to read in and compile methods for me.
This one actually creates the ClassReader when code is filed-in."
@@ -1646,12 +1659,33 @@
^ ClassCategoryReader class:self category:aCategory
!
-publicMethodsFor:aCategory
- "this method allows fileIn of ENVY methods
- (although ST/X currently does NOT support method visibility).
- Returns a ClassCategoryReader to read in and compile methods for me."
-
- ^ self methodsFor:aCategory
+methodsForUndefined:categoryString
+ "ST-80 compatibility.
+ I dont yet know what this does - it was encountered by some tester.
+ For now, simply forward it."
+
+ ^ self methodsFor:categoryString
+!
+
+primitiveDefinitions
+ "this method allows fileIn of classes with primitive code
+ outside of methods - it returns a CCReader which skips the next chunks"
+
+ ^ ClassCategoryReader class:self primitiveSpec:#primitiveDefinitions:
+!
+
+primitiveFunctions
+ "this method allows fileIn of classes with primitive code
+ outside of methods - it returns a CCReader which skips the next chunks"
+
+ ^ ClassCategoryReader class:self primitiveSpec:#primitiveFunctions:
+!
+
+primitiveVariables
+ "this method allows fileIn of classes with primitive code
+ outside of methods - it returns a CCReader which skips the next chunks"
+
+ ^ ClassCategoryReader class:self primitiveSpec:#primitiveVariables:
!
privateMethodsFor:aCategory
@@ -1670,58 +1704,16 @@
^ (self methodsFor:aCategory) protectedProtocol
!
-methodsForUndefined:categoryString
- "ST-80 compatibility.
- I dont yet know what this does - it was encountered by some tester.
- For now, simply forward it."
-
- ^ self methodsFor:categoryString
-!
-
-ignoredMethodsFor:aCategory
- "this is a speciality of ST/X - it allows quick commenting of methods
- from a source-file by replacing the 'methodsFor:' by 'ignoredMethodsFor'.
- Returns a ClassCategoryReader to read in and skip methods."
-
- ^ ClassCategoryReader skippingChunks
-!
-
-methods
- "this method allows fileIn of ST/V methods -
- return a ClassCategoryReader to read in and compile methods for me."
-
- ^ ClassCategoryReader class:self category:'ST/V methods'
-!
-
-primitiveDefinitions
- "this method allows fileIn of classes with primitive code
- outside of methods - it returns a CCReader which skips the next chunks"
-
- ^ ClassCategoryReader class:self primitiveSpec:#primitiveDefinitions:
-!
-
-primitiveVariables
- "this method allows fileIn of classes with primitive code
- outside of methods - it returns a CCReader which skips the next chunks"
-
- ^ ClassCategoryReader class:self primitiveSpec:#primitiveVariables:
-!
-
-primitiveFunctions
- "this method allows fileIn of classes with primitive code
- outside of methods - it returns a CCReader which skips the next chunks"
-
- ^ ClassCategoryReader class:self primitiveSpec:#primitiveFunctions:
+publicMethodsFor:aCategory
+ "this method allows fileIn of ENVY methods
+ (although ST/X currently does NOT support method visibility).
+ Returns a ClassCategoryReader to read in and compile methods for me."
+
+ ^ self methodsFor:aCategory
! !
!Class methodsFor:'fileOut'!
-fileOutDefinitionOn:aStream
- "append an expression on aStream, which defines myself."
-
- ^ self basicFileOutDefinitionOn:aStream
-!
-
basicFileOutDefinitionOn:aStream
"append an expression on aStream, which defines myself."
@@ -1795,306 +1787,14 @@
aStream cr
!
-fileOutMethod:aMethod on:aStream
- "file out the method, aMethod onto aStream"
-
- |cat source privacy|
-
- methodArray notNil ifTrue:[
- aStream nextPutChunkSeparator.
- self printClassNameOn:aStream.
-
- (privacy := aMethod privacy) ~~ #public ifTrue:[
- aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'''.
- ] ifFalse:[
- aStream nextPutAll:' methodsFor:'''.
- ].
- cat := aMethod category.
- cat notNil ifTrue:[
- aStream nextPutAll:cat
- ].
- aStream nextPut:$'; nextPutChunkSeparator; cr; cr.
- source := aMethod source.
- source isNil ifTrue:[
- FileOutErrorSignal
- raiseRequestWith:self
- errorString:('no source for method: ' ,
- self name , '>>' ,
- (self selectorAtMethod:aMethod))
- ] ifFalse:[
- aStream nextChunkPut:source.
- ].
- aStream space.
- aStream nextPutChunkSeparator.
- aStream cr
- ]
-
- "Modified: 27.8.1995 / 01:23:19 / claus"
-!
-
-fileOutCategory:aCategory on:aStream
- "file out all methods belonging to aCategory, aString onto aStream"
-
- |nMethods count source sortedSelectors sortedMethods first
- privacy|
-
- methodArray notNil ifTrue:[
- nMethods := 0.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- nMethods := nMethods + 1
- ]
- ].
- (nMethods ~~ 0) ifTrue:[
- count := 1.
- first := true.
- privacy := nil.
-
- "/
- "/ sort by selector
- "/
- sortedSelectors := selectorArray copy.
- sortedMethods := methodArray copy.
- sortedSelectors sortWith:sortedMethods.
-
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
-
- first ifFalse:[
- privacy ~~ aMethod privacy ifTrue:[
- first := true.
- aStream space.
- aStream nextPutChunkSeparator.
- ].
- aStream cr; cr
- ].
-
- privacy := aMethod privacy.
-
- first ifTrue:[
- aStream nextPutChunkSeparator.
- self printClassNameOn:aStream.
- privacy ~~ #public ifTrue:[
- aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'''.
- ] ifFalse:[
- aStream nextPutAll:' methodsFor:'''.
- ].
- aCategory notNil ifTrue:[
- aStream nextPutAll:aCategory
- ].
- aStream nextPut:$'; nextPutChunkSeparator; cr; cr.
- first := false.
- ].
- source := aMethod source.
- source isNil ifTrue:[
- FileOutErrorSignal raiseRequestWith:'no source for method'
- ] ifFalse:[
- aStream nextChunkPut:source.
- ].
- count := count + 1
- ]
- ].
- aStream space.
- aStream nextPutChunkSeparator.
- aStream cr
- ]
- ]
-
- "Modified: 28.8.1995 / 14:30:41 / claus"
-!
-
-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
- ].
-!
-
-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
+checkIn
+ "check my source into the source repository"
+
+ SourceCodeManager notNil ifTrue:[
+ SourceCodeManager checkinClass:self
].
- 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
- "file out my definition and all methods onto aStream"
-
- |collectionOfCategories copyrightText comment cls|
-
- self isLoaded ifFalse:[
- ^ FileOutErrorSignal
- raiseRequestWith:self
- errorString:'will not fileOut unloaded classes'
- ].
-
- "
- if there is a copyright method, add a copyright comment
- at the beginning, taking the string from the copyright method.
- We cannot do this unconditionally - that would lead to my copyrights
- being put on your code ;-).
- On the other hand: I want every file created by myself to have the
- copyright string at the beginning be preserved .... even if the
- code was edited in the browser and filedOut.
- "
- ((cls := self class) selectorArray includes:#copyright) ifTrue:[
- "
- get the copyright methods source,
- and insert at beginning.
- "
- copyrightText := (cls compiledMethodAt:#copyright) source.
- copyrightText isNil ifTrue:[
- "
- no source available - trigger an error
- "
- FileOutErrorSignal
- raiseRequestWith:'no source for class ' , name , ' available. Cannot fileOut'.
- ^ self
- ].
- copyrightText := copyrightText asCollectionOfLines.
- copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
- copyrightText do:[:line | aStream nextPutAll:line. aStream cr.].
- ].
-
- "
- first, a timestamp
- "
- aStream nextPutAll:(Smalltalk timeStamp).
- aStream nextPutChunkSeparator.
- aStream cr; cr.
-
- "
- then the definition
- "
- self fileOutDefinitionOn:aStream.
- aStream nextPutChunkSeparator.
- aStream cr; cr.
- "
- optional classInstanceVariables
- "
- self class instanceVariableString isBlank ifFalse:[
- self fileOutClassInstVarDefinitionOn:aStream.
- aStream nextPutChunkSeparator.
- aStream cr; cr
- ].
-
- "
- a comment - if any
- "
- (comment := self comment) notNil ifTrue:[
- aStream nextPutAll:name; nextPutAll:' comment:'.
- aStream nextPutAll:(comment storeString).
- aStream nextPutChunkSeparator.
- aStream cr; cr
- ].
-
- "
- primitive definitions - if any
- "
- self fileOutPrimitiveSpecsOn:aStream.
-
- "
- methods from all categories in metaclass
- "
- collectionOfCategories := self class categories asSortedCollection.
- collectionOfCategories notNil ifTrue:[
- "
- documentation first (if any)
- "
- (collectionOfCategories includes:'documentation') ifTrue:[
- self class fileOutCategory:'documentation' on:aStream.
- aStream cr.
- ].
- "
- initialization next (if any)
- "
- (collectionOfCategories includes:'initialization') ifTrue:[
- self class fileOutCategory:'initialization' on:aStream.
- aStream cr.
- ].
- "
- instance creation next (if any)
- "
- (collectionOfCategories includes:'instance creation') ifTrue:[
- self class fileOutCategory:'instance creation' on:aStream.
- aStream cr.
- ].
- collectionOfCategories do:[:aCategory |
- ((aCategory ~= 'documentation')
- and:[(aCategory ~= 'initialization')
- and:[aCategory ~= 'instance creation']]) ifTrue:[
- self class fileOutCategory:aCategory on:aStream.
- aStream cr
- ]
- ]
- ].
- "
- methods from all categories in myself
- "
- collectionOfCategories := self categories asSortedCollection.
- collectionOfCategories notNil ifTrue:[
- collectionOfCategories do:[:aCategory |
- self fileOutCategory:aCategory on:aStream.
- aStream cr
- ]
- ].
- "
- optionally an initialize message
- "
- (self class implements:#initialize) ifTrue:[
- aStream nextPutAll:(name , ' initialize').
- aStream nextPutChunkSeparator.
- aStream cr
- ]
+
+ "Created: 15.11.1995 / 12:54:59 / cg"
!
fileOut
@@ -2182,26 +1882,6 @@
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
@@ -2235,6 +1915,131 @@
aStream close
!
+fileOutCategory:aCategory on:aStream
+ "file out all methods belonging to aCategory, aString onto aStream"
+
+ |source sortedSelectors first privacy interrestingMethods|
+
+ methodArray notNil ifTrue:[
+ interrestingMethods := OrderedCollection new.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ interrestingMethods add:aMethod.
+ ]
+ ].
+ interrestingMethods notEmpty ifTrue:[
+ first := true.
+ privacy := nil.
+
+ "/
+ "/ sort by selector
+ "/
+ sortedSelectors := interrestingMethods collect:[:m | self selectorAtMethod:m].
+ sortedSelectors sortWith:interrestingMethods.
+
+ interrestingMethods do:[:aMethod |
+ first ifFalse:[
+ privacy ~~ aMethod privacy ifTrue:[
+ first := true.
+ aStream space.
+ aStream nextPutChunkSeparator.
+ ].
+ aStream cr; cr
+ ].
+
+ privacy := aMethod privacy.
+
+ first ifTrue:[
+ aStream nextPutChunkSeparator.
+ self printClassNameOn:aStream.
+ privacy ~~ #public ifTrue:[
+ aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'''.
+ ] ifFalse:[
+ aStream nextPutAll:' methodsFor:'''.
+ ].
+ aCategory notNil ifTrue:[
+ aStream nextPutAll:aCategory
+ ].
+ aStream nextPut:$'; nextPutChunkSeparator; cr; cr.
+ first := false.
+ ].
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal raiseRequestWith:'no source for method'
+ ] ifFalse:[
+ aStream nextChunkPut:source.
+ ].
+ ].
+ aStream space.
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ]
+ ]
+
+ "Modified: 28.8.1995 / 14:30:41 / claus"
+ "Modified: 15.11.1995 / 12:45:54 / cg"
+!
+
+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.
+!
+
+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
+!
+
+fileOutDefinitionOn:aStream
+ "append an expression on aStream, which defines myself."
+
+ ^ self basicFileOutDefinitionOn:aStream
+!
+
+fileOutIn:aFileDirectory
+ "create a file 'class.st' consisting of all methods in self in
+ directory aFileDirectory (ignoring any directory setting in
+ the current porject).
+ This is not logged in that change file (should it be ?)."
+
+ |aStream fileName|
+
+ fileName := (Smalltalk fileNameForClass:self name) , '.st'.
+ aStream := FileStream newFileNamed:fileName in:aFileDirectory.
+ aStream isNil ifTrue:[
+ ^ FileOutErrorSignal
+ raiseRequestWith:fileName
+ errorString:('cannot create file:', fileName)
+ ].
+ self fileOutOn: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
@@ -2270,23 +2075,232 @@
]
!
-fileOutIn:aFileDirectory
- "create a file 'class.st' consisting of all methods in self in
- directory aFileDirectory (ignoring any directory setting in
- the current porject).
- This is not logged in that change file (should it be ?)."
-
- |aStream fileName|
-
- fileName := (Smalltalk fileNameForClass:self name) , '.st'.
- aStream := FileStream newFileNamed:fileName in:aFileDirectory.
- aStream isNil ifTrue:[
- ^ FileOutErrorSignal
- raiseRequestWith:fileName
- errorString:('cannot create file:', fileName)
+fileOutMethod:aMethod on:aStream
+ "file out the method, aMethod onto aStream"
+
+ |cat source privacy|
+
+ methodArray notNil ifTrue:[
+ aStream nextPutChunkSeparator.
+ self printClassNameOn:aStream.
+
+ (privacy := aMethod privacy) ~~ #public ifTrue:[
+ aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'''.
+ ] ifFalse:[
+ aStream nextPutAll:' methodsFor:'''.
+ ].
+ cat := aMethod category.
+ cat notNil ifTrue:[
+ aStream nextPutAll:cat
+ ].
+ aStream nextPut:$'; nextPutChunkSeparator; cr; cr.
+ source := aMethod source.
+ source isNil ifTrue:[
+ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:('no source for method: ' ,
+ self name , '>>' ,
+ (self selectorAtMethod:aMethod))
+ ] ifFalse:[
+ aStream nextChunkPut:source.
+ ].
+ aStream space.
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ]
+
+ "Modified: 27.8.1995 / 01:23:19 / claus"
+!
+
+fileOutOn:aStream
+ "file out my definition and all methods onto aStream"
+
+ ^ self fileOutOn:aStream withTimeStamp:true
+
+ "Created: 15.11.1995 / 12:53:32 / cg"
+!
+
+fileOutOn:aStream withTimeStamp:stampIt
+ "file out my definition and all methods onto aStream"
+
+ |collectionOfCategories copyrightText comment cls|
+
+ self isLoaded ifFalse:[
+ ^ FileOutErrorSignal
+ raiseRequestWith:self
+ errorString:'will not fileOut unloaded classes'
+ ].
+
+ "
+ if there is a copyright method, add a copyright comment
+ at the beginning, taking the string from the copyright method.
+ We cannot do this unconditionally - that would lead to my copyrights
+ being put on your code ;-).
+ On the other hand: I want every file created by myself to have the
+ copyright string at the beginning be preserved .... even if the
+ code was edited in the browser and filedOut.
+ "
+ ((cls := self class) selectorArray includes:#copyright) ifTrue:[
+ "
+ get the copyright methods source,
+ and insert at beginning.
+ "
+ copyrightText := (cls compiledMethodAt:#copyright) source.
+ copyrightText isNil ifTrue:[
+ "
+ no source available - trigger an error
+ "
+ FileOutErrorSignal
+ raiseRequestWith:'no source for class ' , name , ' available. Cannot fileOut'.
+ ^ self
+ ].
+ copyrightText := copyrightText asCollectionOfLines.
+ copyrightText := copyrightText copyFrom:2 to:(copyrightText size).
+ copyrightText do:[:line | aStream nextPutAll:line. aStream cr.].
+ ].
+
+ stampIt ifTrue:[
+ "
+ first, a timestamp
+ "
+ aStream nextPutAll:(Smalltalk timeStamp).
+ aStream nextPutChunkSeparator.
+ aStream cr; cr.
+ ].
+
+ "
+ then the definition
+ "
+ self fileOutDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+ aStream cr; cr.
+ "
+ optional classInstanceVariables
+ "
+ self class instanceVariableString isBlank ifFalse:[
+ self fileOutClassInstVarDefinitionOn:aStream.
+ aStream nextPutChunkSeparator.
+ aStream cr; cr
].
- self fileOutOn:aStream.
- aStream close
+
+ "
+ a comment - if any
+ "
+ (comment := self comment) notNil ifTrue:[
+ aStream nextPutAll:name; nextPutAll:' comment:'.
+ aStream nextPutAll:(comment storeString).
+ aStream nextPutChunkSeparator.
+ aStream cr; cr
+ ].
+
+ "
+ primitive definitions - if any
+ "
+ self fileOutPrimitiveSpecsOn:aStream.
+
+ "
+ methods from all categories in metaclass
+ "
+ collectionOfCategories := self class categories asSortedCollection.
+ collectionOfCategories notNil ifTrue:[
+ "
+ documentation first (if any)
+ "
+ (collectionOfCategories includes:'documentation') ifTrue:[
+ self class fileOutCategory:'documentation' on:aStream.
+ aStream cr.
+ ].
+ "
+ initialization next (if any)
+ "
+ (collectionOfCategories includes:'initialization') ifTrue:[
+ self class fileOutCategory:'initialization' on:aStream.
+ aStream cr.
+ ].
+ "
+ instance creation next (if any)
+ "
+ (collectionOfCategories includes:'instance creation') ifTrue:[
+ self class fileOutCategory:'instance creation' on:aStream.
+ aStream cr.
+ ].
+ collectionOfCategories do:[:aCategory |
+ ((aCategory ~= 'documentation')
+ and:[(aCategory ~= 'initialization')
+ and:[aCategory ~= 'instance creation']]) ifTrue:[
+ self class fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
+ ]
+ ].
+ "
+ methods from all categories in myself
+ "
+ collectionOfCategories := self categories asSortedCollection.
+ collectionOfCategories notNil ifTrue:[
+ collectionOfCategories do:[:aCategory |
+ self fileOutCategory:aCategory on:aStream.
+ aStream cr
+ ]
+ ].
+ "
+ optionally an initialize message
+ "
+ (self class implements:#initialize) ifTrue:[
+ aStream nextPutAll:(name , ' initialize').
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ]
+
+ "Created: 15.11.1995 / 12:53:06 / cg"
+!
+
+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
+ ].
! !
!Class methodsFor:'printOut'!
@@ -2302,6 +2316,63 @@
]
!
+printClassVarNamesOn:aStream indent:indent
+ "print the class variable names indented and breaking at line end"
+
+ self printNameArray:(self classVarNames) on:aStream indent:indent
+!
+
+printFullHierarchyOn:aStream indent:indent
+ "print myself and all subclasses on aStream.
+ recursively calls itself to print subclasses.
+ Can be used to print hierarchy on the printer."
+
+ aStream spaces:indent; bold; nextPutAll:name; normal; nextPutAll:' ('.
+ self printInstVarNamesOn:aStream indent:(indent + name size + 2).
+ aStream nextPutAll:')'.
+ aStream cr.
+
+ (self subclasses sort:[:a :b | a name < b name]) do:[:aSubclass |
+ aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
+ ]
+
+ "|printStream|
+ printStream := Printer new.
+ Object printFullHierarchyOn:printStream indent:0.
+ printStream close"
+!
+
+printHierarchyAnswerIndentOn:aStream
+ "print my class hierarchy on aStream - return indent
+ recursively calls itself to print superclass and use returned indent
+ for my description - used in the browser"
+
+ |indent|
+
+ indent := 0.
+ (superclass notNil) ifTrue:[
+ indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
+ ].
+ aStream spaces:indent.
+ aStream nextPutAll:name; nextPutAll:' ('.
+ self printInstVarNamesOn:aStream indent:(indent + name size + 2).
+ aStream nextPutAll:')'.
+ aStream cr.
+ ^ indent
+!
+
+printHierarchyOn:aStream
+ "print my class hierarchy on aStream"
+
+ self printHierarchyAnswerIndentOn:aStream
+!
+
+printInstVarNamesOn:aStream indent:indent
+ "print the instance variable names indented and breaking at line end"
+
+ self printNameArray:(self instVarNames) on:aStream indent:indent
+!
+
printNameArray:anArray on:aStream indent:indent
"print an array of strings separated by spaces; when the stream
defines a lineLength, break when this limit is reached; indent
@@ -2345,61 +2416,58 @@
]
!
-printClassVarNamesOn:aStream indent:indent
- "print the class variable names indented and breaking at line end"
-
- self printNameArray:(self classVarNames) on:aStream indent:indent
-!
-
-printInstVarNamesOn:aStream indent:indent
- "print the instance variable names indented and breaking at line end"
-
- self printNameArray:(self instVarNames) on:aStream indent:indent
-!
-
-printHierarchyOn:aStream
- "print my class hierarchy on aStream"
-
- self printHierarchyAnswerIndentOn:aStream
+printOutCategory:aCategory on:aPrintStream
+ "print out all methods in aCategory on aPrintStream should be a PrintStream"
+
+ |any|
+ methodArray notNil ifTrue:[
+ any := false.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ any := true
+ ]
+ ].
+ any ifTrue:[
+ aPrintStream italic.
+ aPrintStream nextPutAll:aCategory.
+ aPrintStream normal.
+ aPrintStream cr; cr.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ self printOutSource:(aMethod source) on:aPrintStream.
+ aPrintStream cr; cr
+ ]
+ ].
+ aPrintStream cr
+ ]
+ ]
!
-printHierarchyAnswerIndentOn:aStream
- "print my class hierarchy on aStream - return indent
- recursively calls itself to print superclass and use returned indent
- for my description - used in the browser"
-
- |indent|
-
- indent := 0.
- (superclass notNil) ifTrue:[
- indent := (superclass printHierarchyAnswerIndentOn:aStream) + 2
- ].
- aStream spaces:indent.
- aStream nextPutAll:name; nextPutAll:' ('.
- self printInstVarNamesOn:aStream indent:(indent + name size + 2).
- aStream nextPutAll:')'.
- aStream cr.
- ^ indent
-!
-
-printFullHierarchyOn:aStream indent:indent
- "print myself and all subclasses on aStream.
- recursively calls itself to print subclasses.
- Can be used to print hierarchy on the printer."
-
- aStream spaces:indent; bold; nextPutAll:name; normal; nextPutAll:' ('.
- self printInstVarNamesOn:aStream indent:(indent + name size + 2).
- aStream nextPutAll:')'.
- aStream cr.
-
- (self subclasses sort:[:a :b | a name < b name]) do:[:aSubclass |
- aSubclass printFullHierarchyOn:aStream indent:(indent + 2)
+printOutCategoryProtocol:aCategory on:aPrintStream
+ |any|
+
+ methodArray notNil ifTrue:[
+ any := false.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ any := true
+ ]
+ ].
+ any ifTrue:[
+ aPrintStream italic.
+ aPrintStream nextPutAll:aCategory.
+ aPrintStream normal.
+ aPrintStream cr; cr.
+ methodArray do:[:aMethod |
+ (aCategory = aMethod category) ifTrue:[
+ self printOutSourceProtocol:aMethod
+ on:aPrintStream.
+ aPrintStream cr; cr
+ ]
+ ].
+ aPrintStream cr
+ ]
]
-
- "|printStream|
- printStream := Printer new.
- Object printFullHierarchyOn:printStream indent:0.
- printStream close"
!
printOutDefinitionOn:aPrintStream
@@ -2435,29 +2503,51 @@
]
!
-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|
-
- text := aMethod source asStringCollection.
- (text size < 1) ifTrue:[^self].
- aPrintStream bold.
- aPrintStream nextPutAll:(text at:1).
+printOutOn:aPrintStream
+ "print out all methods on aPrintStream which should be a printStream"
+
+ |collectionOfCategories|
+
+ self printOutDefinitionOn:aPrintStream.
aPrintStream cr.
- (text size >= 2) ifTrue:[
- aPrintStream italic.
- aPrintStream spaces:((text at:2) indexOfNonSeparatorStartingAt:1).
- aPrintStream nextPutAll:aMethod comment.
- aPrintStream cr.
+ collectionOfCategories := self class categories.
+ collectionOfCategories notNil ifTrue:[
+ aPrintStream nextPutAll:'class protocol'.
+ aPrintStream cr; cr.
+ collectionOfCategories do:[:aCategory |
+ self class printOutCategory:aCategory on:aPrintStream
+ ]
].
- aPrintStream normal
-
- "
- Float printOutProtocolOn:Stdout
- "
+ collectionOfCategories := self categories.
+ collectionOfCategories notNil ifTrue:[
+ aPrintStream nextPutAll:'instance protocol'.
+ aPrintStream cr; cr.
+ collectionOfCategories do:[:aCategory |
+ self printOutCategory:aCategory on:aPrintStream
+ ]
+ ]
+!
+
+printOutProtocolOn:aPrintStream
+ |collectionOfCategories|
+ self printOutDefinitionOn:aPrintStream.
+ aPrintStream cr.
+ collectionOfCategories := self class categories.
+ collectionOfCategories notNil ifTrue:[
+ aPrintStream nextPutAll:'class protocol'.
+ aPrintStream cr; cr.
+ collectionOfCategories do:[:aCategory |
+ self class printOutCategoryProtocol:aCategory on:aPrintStream
+ ]
+ ].
+ collectionOfCategories := self categories.
+ collectionOfCategories notNil ifTrue:[
+ aPrintStream nextPutAll:'instance protocol'.
+ aPrintStream cr; cr.
+ collectionOfCategories do:[:aCategory |
+ self printOutCategoryProtocol:aCategory on:aPrintStream
+ ]
+ ]
!
printOutSource:aString on:aPrintStream
@@ -2503,200 +2593,94 @@
]
!
-printOutCategory:aCategory on:aPrintStream
- "print out all methods in aCategory on aPrintStream should be a PrintStream"
-
- |any|
- methodArray notNil ifTrue:[
- any := false.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- any := true
- ]
- ].
- any ifTrue:[
- aPrintStream italic.
- aPrintStream nextPutAll:aCategory.
- aPrintStream normal.
- aPrintStream cr; cr.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- self printOutSource:(aMethod source) on:aPrintStream.
- aPrintStream cr; cr
- ]
- ].
- aPrintStream cr
- ]
- ]
-!
-
-printOutOn:aPrintStream
- "print out all methods on aPrintStream which should be a printStream"
-
- |collectionOfCategories|
-
- self printOutDefinitionOn: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|
+
+ text := aMethod source asStringCollection.
+ (text size < 1) ifTrue:[^self].
+ aPrintStream bold.
+ aPrintStream nextPutAll:(text at:1).
aPrintStream cr.
- collectionOfCategories := self class categories.
- collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'class protocol'.
- aPrintStream cr; cr.
- collectionOfCategories do:[:aCategory |
- self class printOutCategory:aCategory on:aPrintStream
- ]
+ (text size >= 2) ifTrue:[
+ aPrintStream italic.
+ aPrintStream spaces:((text at:2) indexOfNonSeparatorStartingAt:1).
+ aPrintStream nextPutAll:aMethod comment.
+ aPrintStream cr.
].
- collectionOfCategories := self categories.
- collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'instance protocol'.
- aPrintStream cr; cr.
- collectionOfCategories do:[:aCategory |
- self printOutCategory:aCategory on:aPrintStream
- ]
- ]
+ aPrintStream normal
+
+ "
+ Float printOutProtocolOn:Stdout
+ "
+! !
+
+!Class methodsFor:'private'!
+
+addAllCategoriesTo:aCollection
+ "helper - add categories and all superclasses categories
+ to the argument, aCollection"
+
+ (superclass notNil) ifTrue:[
+ superclass addAllCategoriesTo:aCollection
+ ].
+ self addCategoriesTo:aCollection
!
-printOutCategoryProtocol:aCategory on:aPrintStream
- |any|
-
- methodArray notNil ifTrue:[
- any := false.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- any := true
- ]
- ].
- any ifTrue:[
- aPrintStream italic.
- aPrintStream nextPutAll:aCategory.
- aPrintStream normal.
- aPrintStream cr; cr.
- methodArray do:[:aMethod |
- (aCategory = aMethod category) ifTrue:[
- self printOutSourceProtocol:aMethod
- on:aPrintStream.
- aPrintStream cr; cr
- ]
- ].
- aPrintStream cr
+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"
+
+ (superclass notNil) ifTrue:[
+ superclass addAllClassVarNamesTo:aCollection
+ ].
+ classvars notNil ifTrue:[
+ aCollection addAll:(classvars asCollectionOfWords).
+ ].
+ ^ aCollection
+!
+
+addCategoriesTo:aCollection
+ "helper - add categories to the argument, aCollection"
+
+ methodArray do:[:aMethod |
+ |cat|
+
+ cat := aMethod category.
+ (aCollection includes:cat) ifFalse:[
+ aCollection add:cat
]
]
!
-printOutProtocolOn:aPrintStream
- |collectionOfCategories|
- self printOutDefinitionOn:aPrintStream.
- aPrintStream cr.
- collectionOfCategories := self class categories.
- collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'class protocol'.
- aPrintStream cr; cr.
- collectionOfCategories do:[:aCategory |
- self class printOutCategoryProtocol:aCategory on:aPrintStream
- ]
- ].
- collectionOfCategories := self categories.
- collectionOfCategories notNil ifTrue:[
- aPrintStream nextPutAll:'instance protocol'.
- aPrintStream cr; cr.
- collectionOfCategories do:[:aCategory |
- self printOutCategoryProtocol:aCategory on:aPrintStream
- ]
- ]
-! !
-
-!Class methodsFor:'private'!
-
-updateRevisionString
- "update my revision string, to reflect a change w.r.t.
- the original source.
- The original revision 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 $
+getPrimitiveSpecsAt:index
+ "return a primitiveSpecification component as string or nil"
+
+ |pos stream string|
+
+ primitiveSpec isNil ifTrue:[^ nil].
+ pos := primitiveSpec at:index.
+ pos isNil ifTrue:[^ nil].
+
+ "the primitiveSpec is either a string, or an integer specifying the
+ position within the classes sourcefile ...
"
-
- |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 revisionString.
- 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
+ pos isNumber ifTrue:[
+ classFilename notNil ifTrue:[
+ stream := self sourceStream. "/ Smalltalk sourceFileStreamFor:classFilename.
+ stream notNil ifTrue:[
+ stream position:pos+1.
+ string := stream nextChunk.
+ stream close.
+ ^ string
+ ]
+ ].
+ ^ nil
].
- m source:'version
-^ ''' , leftPart , ' ' , vsnString , 'mod' , ' ' , rightPart , ''''.
-
-"/ ('updated to :' , vsnString , 'mod') printNL.
-
- "
- Class updateRevisionString
- Number updateRevisionString
- ProcessMonitor updateRevisionString
- "
-
- "Created: 29.10.1995 / 19:25:15 / cg"
- "Modified: 29.10.1995 / 19:39:38 / cg"
-!
-
-revisionString
- "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."
-
- |cls meta m src lines idx val|
-
- self isMeta ifTrue:[
- meta := self. cls := meta soleInstance
- ] ifFalse:[
- cls := self. meta := self class
- ].
-
- m := meta compiledMethodAt:#version.
- m isNil ifTrue:[^ nil].
-
- "/ if its a method returning the string,
- val := cls version.
- val isString ifTrue:[^ val].
-
- 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 revisionString
- ].
-
- Number revisionString
- FileDirectory revisionString
- "
-
- "Created: 29.10.1995 / 19:28:03 / cg"
- "Modified: 11.11.1995 / 14:11:41 / cg"
+ ^ pos
!
revisionInfo
@@ -2756,67 +2740,48 @@
"Modified: 14.11.1995 / 16:00:51 / 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"
-
- (superclass notNil) ifTrue:[
- superclass addAllClassVarNamesTo:aCollection
- ].
- classvars notNil ifTrue:[
- aCollection addAll:(classvars asCollectionOfWords).
+revisionString
+ "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."
+
+ |cls meta m src lines idx val|
+
+ self isMeta ifTrue:[
+ meta := self. cls := meta soleInstance
+ ] ifFalse:[
+ cls := self. meta := self class
].
- ^ aCollection
-!
-
-getPrimitiveSpecsAt:index
- "return a primitiveSpecification component as string or nil"
-
- |pos stream string|
-
- primitiveSpec isNil ifTrue:[^ nil].
- pos := primitiveSpec at:index.
- pos isNil ifTrue:[^ nil].
-
- "the primitiveSpec is either a string, or an integer specifying the
- position within the classes sourcefile ...
+
+ m := meta compiledMethodAt:#version.
+ m isNil ifTrue:[^ nil].
+
+ "/ if its a method returning the string,
+ val := cls version.
+ val isString ifTrue:[^ val].
+
+ 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.
+
"
- pos isNumber ifTrue:[
- classFilename notNil ifTrue:[
- stream := self sourceStream. "/ Smalltalk sourceFileStreamFor:classFilename.
- stream notNil ifTrue:[
- stream position:pos+1.
- string := stream nextChunk.
- stream close.
- ^ string
- ]
- ].
- ^ nil
- ].
- ^ 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"
-
- (superclass notNil) ifTrue:[
- superclass addAllCategoriesTo:aCollection
- ].
- self addCategoriesTo:aCollection
+ Smalltalk allClassesDo:[:cls |
+ Transcript showCr:cls revisionString
+ ].
+
+ Number revisionString
+ FileDirectory revisionString
+ "
+
+ "Created: 29.10.1995 / 19:28:03 / cg"
+ "Modified: 11.11.1995 / 14:11:41 / cg"
!
setPrimitiveSpecsAt:index to:aString
@@ -2826,25 +2791,72 @@
primitiveSpec := Array new:3
].
primitiveSpec at:index put:aString
+!
+
+updateRevisionString
+ "update my revision string, to reflect a change w.r.t.
+ the original source.
+ The original revision 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 revisionString.
+ 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 updateRevisionString
+ Number updateRevisionString
+ ProcessMonitor updateRevisionString
+ "
+
+ "Created: 29.10.1995 / 19:25:15 / cg"
+ "Modified: 29.10.1995 / 19:39:38 / cg"
! !
!Class methodsFor:'queries'!
-isClass
- "return true, if the receiver is some kind of class
- (a real class, not just behavior);
- true is returned here - the method is redefined from Object.
- See also Behavior>>isBehavior."
-
- ^ true
+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 isClass
- 1 isClass
- Behavior new isBehavior
- Behavior new isClass
- Class new isBehavior
- Class new isClass
+ Point categories
+ Point allCategories
"
!
@@ -2866,6 +2878,33 @@
"
!
+isClass
+ "return true, if the receiver is some kind of class
+ (a real class, not just behavior);
+ true is returned here - the method is redefined from Object.
+ See also Behavior>>isBehavior."
+
+ ^ true
+
+ "
+ Point isClass
+ 1 isClass
+ Behavior new isBehavior
+ Behavior new isClass
+ Class new isBehavior
+ Class new isClass
+ "
+!
+
+wasAutoloaded
+ "return true, if this class came into the system via an
+ autoload; false otherwise.
+ This is not an attribute of the class, but instead remembered in
+ Autoload. The interface here is for covenience."
+
+ ^ Autoload wasAutoloaded:self
+!
+
whichClassDefinesClassVar:aVariableName
"return the class which defines the class variable
named aVariableName. This method should not be used for
@@ -2887,31 +2926,6 @@
"
!
-wasAutoloaded
- "return true, if this class came into the system via an
- autoload; false otherwise.
- This is not an attribute of the class, but instead remembered in
- Autoload. The interface here is for covenience."
-
- ^ 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
@@ -3003,32 +3017,6 @@
category:cat
!
-variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
- "create a new class as a subclass of an existing class (the receiver)
- in which the subclass has indexable pointer variables"
-
- self isVariable ifTrue:[
- self isPointers ifFalse:[
- ^ self error:
- 'cannot make a variable pointer subclass of a variable non-pointer class'
- ]
- ].
-
- ^ self class
- name:t
- inEnvironment:Smalltalk
- subclassOf:self
- instanceVariableNames:f
- variable:true
- words:false
- pointers:true
- classVariableNames:d
- poolDictionaries:s
- category:cat
- comment:nil
- changed:false
-!
-
variableByteSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
"create a new class as a subclass of an existing class (the receiver)
in which the subclass has indexable byte-sized nonpointer variables"
@@ -3055,14 +3043,15 @@
changed:false
!
-variableWordSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+variableDoubleSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+
"create a new class as a subclass of an existing class (the receiver)
- in which the subclass has indexable word-sized nonpointer variables"
+ in which the subclass has indexable double-sized nonpointer variables"
self isVariable ifTrue:[
- self isWords ifFalse:[
+ self isDoubles ifFalse:[
^ self error:
- 'cannot make a variable word subclass of a variable non-word class'
+ 'cannot make a variable double subclass of a variable non-double class'
].
].
@@ -3071,33 +3060,7 @@
inEnvironment:Smalltalk
subclassOf:self
instanceVariableNames:f
- variable:true
- words:true
- pointers:false
- classVariableNames:d
- poolDictionaries:s
- category:cat
- comment:nil
- changed:false
-!
-
-variableLongSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
- "create a new class as a subclass of an existing class (the receiver)
- in which the subclass has indexable long-sized nonpointer variables"
-
- self isVariable ifTrue:[
- self isLongs ifFalse:[
- ^ self error:
- 'cannot make a variable long subclass of a variable non-long class'
- ].
- ].
-
- ^ self class
- name:t
- inEnvironment:Smalltalk
- subclassOf:self
- instanceVariableNames:f
- variable:#long
+ variable:#double
words:false
pointers:false
classVariableNames:d
@@ -3134,15 +3097,14 @@
changed:false
!
-variableDoubleSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
-
+variableLongSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
"create a new class as a subclass of an existing class (the receiver)
- in which the subclass has indexable double-sized nonpointer variables"
+ in which the subclass has indexable long-sized nonpointer variables"
self isVariable ifTrue:[
- self isDoubles ifFalse:[
+ self isLongs ifFalse:[
^ self error:
- 'cannot make a variable double subclass of a variable non-double class'
+ 'cannot make a variable long subclass of a variable non-long class'
].
].
@@ -3151,7 +3113,7 @@
inEnvironment:Smalltalk
subclassOf:self
instanceVariableNames:f
- variable:#double
+ variable:#long
words:false
pointers:false
classVariableNames:d
@@ -3159,6 +3121,58 @@
category:cat
comment:nil
changed:false
+!
+
+variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+ "create a new class as a subclass of an existing class (the receiver)
+ in which the subclass has indexable pointer variables"
+
+ self isVariable ifTrue:[
+ self isPointers ifFalse:[
+ ^ self error:
+ 'cannot make a variable pointer subclass of a variable non-pointer class'
+ ]
+ ].
+
+ ^ self class
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:true
+ words:false
+ pointers:true
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
+!
+
+variableWordSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat
+ "create a new class as a subclass of an existing class (the receiver)
+ in which the subclass has indexable word-sized nonpointer variables"
+
+ self isVariable ifTrue:[
+ self isWords ifFalse:[
+ ^ self error:
+ 'cannot make a variable word subclass of a variable non-word class'
+ ].
+ ].
+
+ ^ self class
+ name:t
+ inEnvironment:Smalltalk
+ subclassOf:self
+ instanceVariableNames:f
+ variable:true
+ words:true
+ pointers:false
+ classVariableNames:d
+ poolDictionaries:s
+ category:cat
+ comment:nil
+ changed:false
! !
Class initialize!