"

 COPYRIGHT (c) 1989 by Claus Gittinger

	       All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

ClassDescription subclass:#Class

       instanceVariableNames:'classvars comment subclasses classFilename package history'

       classVariableNames:'UpdatingChanges FileOutErrorSignal'

       poolDictionaries:''

       category:'Kernel-Classes'

!

Class comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

'!

!Class class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	       All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

version

"

"

!

documentation

"

    Class adds more functionality to classes; minimum stuff has already

    been defined in Behavior and ClassDescription; this adds naming, categories etc.

    Also change management and recompilation is defined here (since the superclasses

    do not have enough symbolic information to support compilation).

    For production code, the stc compiler is planned to (optionally) generate classes 

    as subclasses of Behavior - to excludes all name, source info etc., 

    however, normally all classes are subclasses of Class.

    Instance variables:

	classvars       <String>        the names of the class variables

	comment         <String>        the classes comment; either a string,

					a number specifying the offset in classFilename, or nil

	subclasses      <Collection>    cached collection of subclasses

					(currently unused - but will be soon)

	classFilename   <String>        the file (or nil) where the classes

					sources are found 

	package         <Symbol>        the package, in which the class was defined

					(not currently used)

	history         <any>           a place for a history string (not currently used)

    Class variables:

	UpdatingChanges <Boolean>       true if the changes-file shall be updated

					(except during startup and when filing in, this flag

					 is usually true)

	FileOutErrorSignal              raised when an error occurs during fileOut

    WARNING: layout known by compiler and runtime system

"

! !

!Class class methodsFor:'initialization'!

initialize

    "the classvariable 'UpdatingChanges' controls if changes are put

     into the changes-file; normally this variable is set to true, but

     (for example) during fileIn or when changes are applied, it is set to false

     to avoid putting too much junk into the changes-file."

    UpdatingChanges := true.

    FileOutErrorSignal isNil ifTrue:[

	Object initialize.

	FileOutErrorSignal := Object errorSignal newSignalMayProceed:false.

	FileOutErrorSignal nameClass:self message:#fileOutErrorSignal.

	FileOutErrorSignal notifierString:'error during fileOut'.

    ]

! !

!Class class methodsFor:'signal access'!

fileOutErrorSignal

    "return the signal raised when an error occurs while fileing out.

     This is signalled to allow browsers some user feed back in case

     a fileout fails (for example due to disk-full errors)"

    ^ FileOutErrorSignal

! !

!Class class methodsFor:'creating new classes'!

new

    "creates and returs a new class"

    |newClass|

    newClass := super new.

"/    newClass setComment:(self comment) category:(self category).

    ^ newClass

! !

!Class class methodsFor:'enumeration '!

allClassesInCategory:aCategory do:aBlock

    "evaluate aBlock for all classes in aCategory;

     no specific order is defined."

    Smalltalk allBehaviorsDo:[:aClass |

	aClass isMeta ifFalse:[

	    (aClass category = aCategory) ifTrue:[

		aBlock value:aClass

	    ]

	].

    ]

    "

     Class allClassesInCategory:'Kernel-Classes' 

			     do:[:class |Transcript showCr:class name]

    "

!

allClassesInCategory:aCategory inOrderDo:aBlock

    "evaluate aBlock for all classes in aCategory;

     superclasses come first - then subclasses."

    |classes|

    classes := OrderedCollection new.

    Smalltalk allBehaviorsDo:[:aClass |

	aClass isMeta ifFalse:[

	    (aClass category = aCategory) ifTrue:[

		classes add:aClass

	    ]

	]

    ].

    classes topologicalSort:[:a :b | b isSubclassOf:a].

    classes do:aBlock

! !

!Class methodsFor:'subclass creation'!

subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s category:cat

    "create a new class as a subclass of an existing class (the receiver).

     The subclass will have indexed variables if the receiving-class has."

    self isVariable ifFalse:[

	^ self class

	    name:t

	    inEnvironment:Smalltalk

	    subclassOf:self

	    instanceVariableNames:f

	    variable:false

	    words:true

	    pointers:true

	    classVariableNames:d

	    poolDictionaries:s

	    category:cat

	    comment:nil

	    changed:false

    ].

    self isBytes ifTrue:[

	^ self

	    variableByteSubclass:t

	    instanceVariableNames:f

	    classVariableNames:d

	    poolDictionaries:s

	    category:cat

    ].

    self isLongs ifTrue:[

	^ self

	    variableLongSubclass:t

	    instanceVariableNames:f

	    classVariableNames:d

	    poolDictionaries:s

	    category:cat

    ].

    self isFloats ifTrue:[

	^ self

	    variableFloatSubclass:t

	    instanceVariableNames:f

	    classVariableNames:d

	    poolDictionaries:s

	    category:cat

    ].

    self isDoubles ifTrue:[

	^ self

	    variableDoubleSubclass:t

	    instanceVariableNames:f

	    classVariableNames:d

	    poolDictionaries:s

	    category:cat

    ].

    self isWords ifTrue:[

	^ self

	    variableWordSubclass:t

	    instanceVariableNames:f

	    classVariableNames:d

	    poolDictionaries:s

	    category:cat

    ].

    ^ self

	variableSubclass:t

	instanceVariableNames:f

	classVariableNames:d

	poolDictionaries:s

	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"

    self isVariable ifTrue:[

	self isBytes ifFalse:[

	    ^ self error:

		'cannot make a variable byte subclass of a variable non-byte class'

	].

    ].

    ^ self class

	name:t

	inEnvironment:Smalltalk

	subclassOf:self

	instanceVariableNames:f

	variable:true

	words:false

	pointers:false

	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

!

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 

	words:false

	pointers:false

	classVariableNames:d

	poolDictionaries:s

	category:cat

	comment:nil

	changed:false

!

variableFloatSubclass: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 float-sized nonpointer variables"

    self isVariable ifTrue:[

	self isFloats ifFalse:[

	    ^ self error:

		'cannot make a variable float subclass of a variable non-float class'

	].

    ].

    ^ self class

	name:t

	inEnvironment:Smalltalk

	subclassOf:self

	instanceVariableNames:f

	variable:#float 

	words:false

	pointers:false

	classVariableNames:d

	poolDictionaries:s

	category:cat

	comment:nil

	changed:false

!

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 double-sized nonpointer variables"

    self isVariable ifTrue:[

	self isDoubles ifFalse:[

	    ^ self error:

		'cannot make a variable double subclass of a variable non-double class'

	].

    ].

    ^ self class

	name:t

	inEnvironment:Smalltalk

	subclassOf:self

	instanceVariableNames:f

	variable:#double 

	words:false

	pointers:false

	classVariableNames:d

	poolDictionaries:s

	category:cat

	comment:nil

	changed:false

! !

!Class methodsFor:'ST/V subclass creation'!

subclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s

    "this method allows fileIn of ST/V classes 

     (which seem to have no category)"

    ^ self subclass:t 

	   instanceVariableNames:f

	   classVariableNames:d

	   poolDictionaries:s

	   category:'ST/V classes'

!

variableByteSubclass:t classVariableNames:d poolDictionaries:s

    "this method allows fileIn of ST/V variable byte classes 

     (which seem to have no category and no instvars)"

    ^ self variableByteSubclass:t 

	   instanceVariableNames:''

	   classVariableNames:d

	   poolDictionaries:s

	   category:'ST/V classes'

!

variableSubclass:t instanceVariableNames:f classVariableNames:d poolDictionaries:s

    "this method allows fileIn of ST/V variable pointer classes 

     (which seem to have no category)"

    ^ self variableSubclass:t 

	   instanceVariableNames:f

	   classVariableNames:d

	   poolDictionaries:s

	   category:'ST/V classes'

! !

!Class methodsFor:'accessing'!

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  

    "

!

classVarNames

    "return a collection of the class variable name-strings.

     Only names of class variables defined in this class are included

     in the returned collection - use allClassVarNames, to get all known names."

    classvars isNil ifTrue:[

	^ OrderedCollection new

    ].

    ^ classvars asCollectionOfWords

    "

     Object classVarNames 

     Float classVarNames

    "

!

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.

!

allClassVarNames

    "return a collection of all the class variable name-strings

     this includes all superclass-class variables"

    ^ self addAllClassVarNamesTo:(OrderedCollection new)