"
 COPYRIGHT (c) 1993 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.
"

Behavior subclass:#ClassDescription
       instanceVariableNames:'name category instvars signature'
       classVariableNames:''
       poolDictionaries:''
       category:'Kernel-Classes'
!

ClassDescription comment:'
COPYRIGHT (c) 1993 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.9 1994-10-10 00:22:34 claus Exp $
'!

!ClassDescription class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 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
"
$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.9 1994-10-10 00:22:34 claus Exp $
"
!

documentation
"
    this class has been added for ST-80 compatibility only.
    All class stuff used to be in Behavior and Class - but, to be
    able to file in some PD code, it became nescessary to add it.
    ClassDescription adds some descriptive information to the basic
    Behavior class.

    Instance variables:

    name            <String>        the classes name
    category        <String>        the classes category
    instvars        <String>        the names of the instance variables
"
! !

!ClassDescription methodsFor:'special accessing'!

setName:aString
    "set the classes name - be careful, it will be still
     in the Smalltalk dictionary - under another key.
     This is NOT for general use - see renameTo:"

    name := aString
!

setInstanceVariableString:aString
    "set the classes instvarnames string - no recompilation
     is done and no change records are written.
     This is NOT for general use."

    instvars := aString.
! !

!ClassDescription methodsFor:'accessing'!

instanceVariableString
    "return a string of the instance variable names"

    instvars isNil ifTrue:[^ ''].
    ^ instvars

    "
     Point instanceVariableString   
    "
!

instanceVariableString:aString
    "set the classes instvarnames string - notice, that this
     should be used only during class creation; the number of
     instance variables is determined by another instance 
     (see Behavior)."

    instvars := aString.
    self changed
!

instVarNames
    "return a collection of the instance variable name-strings"

    instvars isNil ifTrue:[
	^ OrderedCollection new
    ].
    ^ instvars asCollectionOfWords

    "
     Point instVarNames  
    "
!

allInstVarNames
    "return a collection of all the instance variable name-strings
     this includes all superclass-instance variables.
     Instvars of superclasses come first (i.e. the position matches
     the instVarAt:-index)."

    ^ self addAllInstVarNamesTo:(OrderedCollection new)

    "
     Dictionary instVarNames       
     Dictionary allInstVarNames    
    "
!

name
    "return the name of the class. In the current implementation,
     this returns a string, but will be changed to Symbol soon."

    ^ name
!

category
    "return the category of the class. 
     The returned value may be a string or symbol."

    ^ category

    "
     Point category                
     Dictionary category           
    "
!

category:aStringOrSymbol
    "set the category of the class to be the argument, aStringOrSymbol"

    category := aStringOrSymbol asSymbol
! !

!ClassDescription methodsFor:'signature checking'!

signature
    "return a signature number - this number is useful for a quick
     check for changed classes, and is done in the binary-object loader, 
     and the dynamic class loader.
     Do NOT change the algorithm here - others may depend on it.
     Also, the algorithm may change - so never interpret the returned value
     (if at all, use the access #XXXFromSignature: methods)"

    |value   "{ Class: SmallInteger }"
     nameKey "{ Class: SmallInteger }" |

    signature notNil ifTrue:[^ signature].

    value := self flags bitAnd:(Class maskIndexType).
    value := (value bitShift:3) + ((self class instSize - Class instSize) bitAnd:7).
    value := (value bitShift:7) + (self instSize bitAnd:16r7F).

    nameKey := 0.
    self allInstVarNames do:[:name |
	nameKey := nameKey bitShift:1.
	(nameKey bitAnd:16r10000) ~~ 0 ifTrue:[
	    nameKey := nameKey bitXor:1.
	    nameKey := nameKey bitAnd:16rFFFF.
	].
	nameKey := (nameKey + (name at:1) asciiValue) bitAnd:16rFFFF.
    ].
    value := value + (nameKey bitShift:14).
    signature := value.
    ^ value

    "
     Array signature
     ByteArray signature
     View signature
    "
!

instSizeFromSignature:aSignature
    "for checking class compatibility: return the some number based on
     the instSize from a signature key (not always the real instSize)."

    ^ aSignature bitAnd:16r7F

    "
     Class instSizeFromSignature:Point signature.     
     Class instSizeFromSignature:Association signature.   
     Class instSizeFromSignature:Dictionary signature.    
    "
!

classinstSizeFromSignature:aSignature
    "for checking class compatibility: return some number based on 
     the classinstSize from a signature key (not always the real classinstsize)."

    ^ (aSignature bitShift:-7) bitAnd:7
!

instTypeFromSignature:aSignature
    "for checking class compatibility: return some number based on
     the instType (i.e. variableBytes/Pointers etc.) from a signature key."

    ^ (aSignature bitShift:-10) bitAnd:(Class maskIndexType)

    "
     Class instTypeFromSignature:Object signature.               
     Class instTypeFromSignature:Array signature.                
     Class instTypeFromSignature:String signature.               
     Class instTypeFromSignature:OrderedCollection signature.    
    "
!

instNameKeyFromSignature:aSignature
    "for checking class compatibility: return a number based on the
     names and order of the instance variables from a signature key."

    ^ (aSignature bitShift:-14) bitAnd:16rFFFF

    "
     Point instNameKeyFromSignature:Point signature.             
     Association instNameKeyFromSignature:Association signature.  
    "
! !

!ClassDescription methodsFor:'renaming'!

renameTo:newName
    "change the name of the class - this writes a change record"

    |oldName oldSym|

    oldName := name.
    oldSym := name asSymbol.
    self setName:newName.

    Smalltalk at:oldSym put:nil.
    Smalltalk removeKey:oldSym.             "26.jun 93"
    Smalltalk at:(newName asSymbol) put:self.
! !

!ClassDescription methodsFor:'printing & storing'!

displayString
    "return a string for display in inspoectors"

    category == #obsolete ifTrue:[
	"add obsolete - to make life easier ..."
	^ self name "super displayString" , ' (obsolete)'
    ].
    category == #removed ifTrue:[
	"add removed - to make life easier ..."
	^ self name "super displayString" , ' (removed)'
    ].
    ^ self name "super displayString"
! !

!ClassDescription methodsFor:'private'!

addAllInstVarNamesTo:aCollection
    "helper - add the name-strings of the instance variables and of the inst-vars
     of all superclasses to the argument, aCollection. Return aCollection"

    (superclass notNil) ifTrue:[
	superclass addAllInstVarNamesTo:aCollection
    ].
    instvars notNil ifTrue:[
	aCollection addAll:(instvars asCollectionOfWords).
    ].
    ^ aCollection
! !