"

 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.

"

!

version

!

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)

"

! !

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

     or updates are done and no changeList 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   

    "

!

instVarNames

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

    instvars isNil ifTrue:[

	^ OrderedCollection new

    ].

    ^ instvars asCollectionOfWords

    "

     Point instVarNames  

    "

!

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 

    "

!

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    

    "

!

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

!

instVarAtOffset:index

    "return the name of the instance variable at index"

    ^ self allInstanceVariableNames at:index

!

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"

    aStringOrSymbol isNil ifTrue:[

	category := aStringOrSymbol

    ] ifFalse:[

	category := aStringOrSymbol asSymbol

    ]

!

organization

    "for ST80 compatibility; 

     read the documentation in ClassOrganizer for more info."

    ^ ClassOrganizer for:self

! !

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

    |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:'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"

! !