"
 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 primitiveSpec signature'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Kernel-Classes'
!

!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.
"
!

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 C'Description
    in between 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
	primitiveSpec   <Array|nil>     describes primitiveIncludes, primitiveFunctions etc.
	signature       <SmallInteger>  the classes signature (used to detect obsolete
					or changed classes with binaryStorage)
"
!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ClassDescription.st,v 1.21 1995-11-23 10:46:35 cg Exp $'
! !

!ClassDescription class methodsFor:'instance creation'!

new
    "creates and returns a new class.
     Redefined to give the new class at least some name info"

    |newClass|

    newClass := super new.
    newClass setName:('some' , self name).
    ^ newClass
! !

!ClassDescription methodsFor:'accessing'!

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    
    "
!

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"

    aStringOrSymbol isNil ifTrue:[
	category := aStringOrSymbol
    ] ifFalse:[
	category := aStringOrSymbol asSymbol
    ]
!

instVarAtOffset:index
    "return the name of the instance variable at index"

    ^ self allInstanceVariableNames at:index
!

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

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

    "
     Point instVarNames  
    "
!

instVarOffsetOf:aVariableName
    "return the index (as used in instVarAt:/instVarAt:put:) of a named instance
     variable. The returned number is 1..instSize for valid variable names, nil for
     illegal names."

    ^ self allInstVarNames indexOf:aVariableName ifAbsent:nil
!

instanceVariableOffsets
    "returns a dictionary containing the instance variable index
     for each instVar name"

    |dict index|

    index := 0. dict := Dictionary new.
    self allInstVarNames do:[:nm | index := index + 1. dict at:nm put:index].
    ^ dict

    "
     Point instanceVariableOffsets 
     GraphicsContext instanceVariableOffsets 
    "
!

instanceVariableString
    "return a string of the instance variable names"

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

    "
     Point instanceVariableString   
    "
!

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

    ^ name
!

organization
    "for ST80 compatibility; 
     read the documentation in ClassOrganizer for more info."

    ^ ClassOrganizer for:self
! !

!ClassDescription methodsFor:'printing & storing'!

displayString
    "return a string for display in inspectors"

    |nm more|

    category == #obsolete ifTrue:[
	"add obsolete - to make life easier ..."
	more := ' (obsolete)'
    ].
    category == #removed ifTrue:[
	"add removed - to make life easier ..."
	more := ' (removed)'
    ].

    nm := self name.
    more isNil ifTrue:[^ nm].
    ^ nm , more    
! !

!ClassDescription methodsFor:'private'!

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

    |superInsts|

    (superclass notNil) ifTrue:[
	superclass addAllInstVarNamesTo:aCollection
    ].
    instvars notNil ifTrue:[
	aCollection addAll:(instvars asCollectionOfWords).
    ] ifFalse:[
	"/ mhmh - either someone klduged around, or this is
	"/ a system running without sourceInfo. Generate
	"/ synthetic names.

	superclass isNil ifTrue:[
	    superInsts := 0
	] ifFalse:[
	    superInsts := superclass instSize
	].
	aCollection addAll:((superInsts+1 to:self instSize) 
				collect:[:index | '* instVar' , index printString , ' *'])
    ].
    ^ aCollection

    "Modified: 30.10.1995 / 19:46:21 / cg"
! !

!ClassDescription methodsFor:'renaming'!

renameTo:newName
    "change the name of the class"

    |oldSym|

    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:'signature checking'!

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
!

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.  
    "
!

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.    
    "
!

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.    
    "
!

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
    "
! !

!ClassDescription methodsFor:'special accessing'!

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

    instvars := aString.
!

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
! !