"

 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.

"

"{ Package: 'stx:libbasic' }"

ClassDescription subclass:#Class

	instanceVariableNames:'name category classvars comment subclasses classFilename package

		revision environment signature attributes'

	classVariableNames:'DefaultCategoryForSTV DefaultCategoryForVAGE

		DefaultCategoryForDolphin'

	poolDictionaries:''

	category:'Kernel-Classes'

!

Object subclass:#ClassAttributes

	instanceVariableNames:'primitiveDefinitions primitiveVariables primitiveFunctions

		sharedPools traitComposition localSelectors'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Class

!

Object subclass:#SimulatedClassPool

	instanceVariableNames:'class'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Class

!

Association subclass:#SimulatedVariableBinding

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:Class::SimulatedClassPool

!

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

"

!

documentation

"

    Class adds more functionality to classes; minimum stuff has already

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

    [Instance variables:]

        name            <Symbol>                    the classes name

        category        <Symbol>                    the classes category

        classvars       <String>                    the names of the class variables;

                        | <Collection of words>     initially, stc generates a string; this is converted on the fly

                                                    to an array of names. In the future, stc may be changed.

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

                                                    a number specifying the offset in classFilename, or nil

        subclasses      <Collection>                cached collection of subclasses

                                                    (not used for execution, but for the IDE to speed up certain operations)

        classFilename   <String>                    the file (or nil) where the classes' sources are found

        package         <Symbol>                    the package, in which the class was defined (inserted by compilers)

        revision        <String>                    revision string - inserted by stc

        environment     <Symbol | nil>              cached environment (i.e. Smalltalk or a namespace)

        signature       <SmallInteger>              the classes signature (used to detect obsolete or changed classes with binaryStorage)

                                                    This is filled in lazy - i.e. upon the first signature query.

        attributes   <Array | nil>                  describes primitiveIncludes, primitiveFunctions etc.

                                                    also a place to add additional attributes, without a need to recompile all classes.

    WARNING: layout known by compiler and runtime system

    [author:]

        Claus Gittinger

    [see also:]

        Behavior ClassDescription Metaclass

"

!

versionManagement

"

    old scheme (up to 5.4.x):

        the #version method is supposed to return a CVS (or RCS) version string.

        this string contains (among other info) the revision number of the CVS container

        from which the class was compiled. 

        To access the source code of a class, this file is reconstructed (either cached or

        checked out), and the source-chunk is fetched from that file at the position which

        is stored in the method object.

    new scheme (starting with 5.5.0):

        a classes sourcecode might be present in multiple source code management systems;

        for example, a site might decide to use CVS, where another might wonna use SVN

        (or other in the future).

        Therefore, a single version method is no longer sufficient; each sourceCodeManager

        will store its version info in its own format in a separate version method.

        The sourceCodeManager can be asked via #nameOfVersionMethodInClasses for the selector

        of this version.

        Currently these are #version_CVS and #version_SVN. More might be added in the future.

        Two additional identifiers are added to support a unique id, which can be used to

        compare classes and methods coming from different source containers:

            version_VID and version_FID

        Both are UUID's. The VID is updated with every change, whereas the FID is assigned only once.

        The FID can be interpreted as a functional-ID, and the VID as an identity id.

"

! !

!Class class methodsFor:'accessing-flags'!

tryLocalSourceFirst

    "if true, local source files are tried first, before a sourceCodemanager is

     consulted. This may speed up the source access, but adds some insecurity, because

     the sourceCodemanager is always getting the source for the classes correct version.

     In contrast, the local file might be different from (edited in an external tool) in

     the meantime. You have been warned - better leave it false (the sourceCodemanager will

     fill its cache and eventually be just as fast...)"

    ^ TryLocalSourceFirst

    "Created: 24.1.1996 / 19:55:35 / cg"

!

tryLocalSourceFirst:aBoolean

    "if true, local source files are tried first, before a sourceCodemanager is

     consulted. This may speed up the source access, but adds some insecurity, because

     the sourceCodemanager is always getting the source for the classes correct version.

     In contrast, the local file might be different from (edited in an external tool) in

     the meantime. You have been warned - better leave it false (the sourceCodemanager will

     fill its cache and eventually be just as fast...)"

    TryLocalSourceFirst := aBoolean

    "Created: 24.1.1996 / 19:55:35 / cg"

!

updateChanges:aBoolean

    "turn on/off changes management. Return the prior value of the flag.

     This value is used as a default fallback - a querySignal handler may still

     decide to return something else."

    |prev|

    prev := UpdatingChanges.

    UpdatingChanges := aBoolean.

    ^ prev

!

updatingChanges

    "return true if changes are recorded.

     The value returned here is the default fallback - a querySignal handler may still

     decide to return something else."

    ^ UpdatingChanges

! !

!Class class methodsFor:'creating new classes'!

name:newName 

         subclassOf:aClass

         instanceVariableNames:stringOfInstVarNames

         category:categoryString

    "this new instance creation protocol will replace the traditional inst-creation messages"

    ^ self

        name:newName 

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        classVariableNames:nil

        poolDictionaries:nil

        category:categoryString

!

name:newName 

         subclassOf:aClass

         instanceVariableNames:stringOfInstVarNames

         classVariableNames:stringOfClassVarNames

         category:categoryString

    "this new instance creation protocol will replace the traditional inst-creation messages"

    ^ self

        name:newName 

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        classVariableNames:stringOfClassVarNames

        poolDictionaries:nil

        category:categoryString

!

name:newName 

         subclassOf:aClass

         instanceVariableNames:stringOfInstVarNames

         classVariableNames:stringOfClassVarNames

         classInstanceVariableNames:stringOfClassInstVarNames

         poolDictionaries:stringOfPoolNames

         category:categoryString

    "this new instance creation protocol will replace the traditional inst-creation messages"

    ^ self class

        name:newName 

        inEnvironment:Smalltalk

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        variable:false

        words:false

        pointers:false

        classVariableNames:stringOfClassVarNames

        poolDictionaries:stringOfPoolNames

        category:categoryString

        comment:nil

        changed:false

        classInstanceVariableNames:stringOfClassInstVarNames

    "Modified: 16.6.1997 / 11:53:58 / cg"

!

name:newName 

         subclassOf:aClass

         instanceVariableNames:stringOfInstVarNames

         classVariableNames:stringOfClassVarNames

         poolDictionaries:stringOfPoolNames

         category:categoryString

    "this new instance creation protocol will replace the traditional inst-creation messages"

    ^ self class

        name:newName 

        inEnvironment:Smalltalk

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        variable:false

        words:false

        pointers:false

        classVariableNames:stringOfClassVarNames

        poolDictionaries:stringOfPoolNames

        category:categoryString

        comment:nil

        changed:false

        classInstanceVariableNames:nil

    "Modified: 16.6.1997 / 11:53:58 / cg"

! !

!Class class methodsFor:'helpers'!

nameWithoutPrefix:name

    "helper for fileOut and others - return a name's printString,

     without any owningClass or nameSpace prefix"

    |idx|

    idx := name lastIndexOf:$:.

    [idx > 1 and:[ (name at:(idx-1)) ~~ $: ]] whileTrue:[

        idx := name lastIndexOf:$: startingAt:idx-2.

    ].

    idx == 0 ifTrue:[

        ^ name

    ].

    ^ name copyFrom:idx+1.

    "a public class:

     Class nameWithoutPrefix:'Array'

     Class nameWithoutPrefix:'Tools::Array'

    "

!

revisionInfoFromString:aString

    "{ Pragma: +optSpace }"

    "return a revision info, given a string.

     This extracts the relevant info from aString, asking

     the default sourceCode manager (if there is one).

     Notice, that this method is only invoked, if a class does not know

     its sourceCode manager."

    |mgr|

    "/

    "/ mhmh - ask the default manager.

    "/ if none has been defined, use the CVSSourceCodeManager

    "/

    mgr := SourceCodeManager ? CVSSourceCodeManager.

    "/

    "/ care for standAlone apps which have no CVS (libbasic3) included

    "/

    mgr isNil ifTrue:[

        AbstractSourceCodeManager notNil ifTrue:[

            ^ AbstractSourceCodeManager revisionInfoFromRCSString:aString

        ].

        ^ nil

    ].

    ^ mgr revisionInfoFromString:aString.

    "Modified: / 22-10-2008 / 20:27:21 / cg"

!

revisionStringFromSource:aMethodSourceString

    "{ Pragma: +optSpace }"

    "extract a revision string from a methods source string.

     Caveat: Assumes CVS."

    |lines line|

    lines := aMethodSourceString asCollectionOfLines.

    lines do:[:l |

        |i|

        i := l indexOfSubCollection:'$Header: '.

        i ~~ 0 ifTrue:[

            line := l copyFrom:i.

            i := line lastIndexOf:$$.

            i > 1 ifTrue:[

                line := line copyTo:i.

            ].

            ^ line

        ]

    ].

    ^ nil

    "Created: / 15-10-1996 / 18:57:57 / cg"

    "Modified: / 22-10-2008 / 20:29:50 / cg"

! !

!Class class methodsFor:'misc'!

template:aCategoryString

    "return a class-definition template"

    ^ 'NameOfSuperclass subclass:#NameOfClass

    instanceVariableNames:''instVarName1 instVarName2''

    classVariableNames:''classVarName1 classVarName2''

    poolDictionaries:''''

    category:''' , aCategoryString , ''''

    "Created: / 19.6.1998 / 02:09:06 / cg"

! !

!Class class methodsFor:'private'!

flushSubclassInfo

    "throw away (forget) the cached subclass information, as created

     by #subclassInfo.

     This is private protocol"

    SubclassInfo := nil.

    "

     Class flushSubclassInfo

    "

    "Modified: 22.1.1997 / 18:39:36 / cg"

!

subclassInfo

    "build & return a dictionary, containing the set of subclass

     for each class. This information is kept until explicitely flushed

     by #flushSubclassInfo.

     This cache is used internally, for enumerators like #allSubclasses

     or #allSubclassesDo:, to avoid repeated recursive walks over the class

     hierarchy.

     This is private protocol."

    |d|

    SubclassInfo notNil ifTrue:[^ SubclassInfo].

    d := IdentityDictionary new.

    Smalltalk allClassesDo:[:aClass |

        |superCls setToAddSubclass|

        superCls := aClass superclass.

        superCls notNil ifTrue:[

            setToAddSubclass := d at:superCls ifAbsent:nil.

            setToAddSubclass isNil ifTrue:[

                d at:superCls put:(Set with:aClass).

            ] ifFalse:[

                setToAddSubclass add:aClass

            ]

        ]

    ].

    SubclassInfo := d.

    ^ d

    "

     Class subclassInfo

    "

    "Modified: 22.1.1997 / 18:44:59 / cg"

! !

!Class class methodsFor:'queries'!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == Class class or:[self == Class]

    "Created: 15.4.1996 / 17:17:13 / cg"

    "Modified: 23.4.1996 / 15:56:58 / cg"

! !

!Class methodsFor:'Compatibility-Dolphin'!

defaultCategoryForDolphinClasses

    ^ DefaultCategoryForDolphin ? 'Dolphin classes'.

!

stb_version

    ^ 0

!

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

    "{ Pragma: +optSpace }"

    "this method allows fileIn of Dolphin classes "

    ^ self subclass:t

           instanceVariableNames:f

           classVariableNames:d

           poolDictionaries:s

           category:(self defaultCategoryForDolphinClasses)

           classInstanceVariableNames:classInstanceVariableNames

    "Modified: / 15.6.1998 / 21:31:34 / cg"

    "Modified: / 18.3.1999 / 18:16:11 / stefan"

!

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

    "{ Pragma: +optSpace }"

    "this method allows fileIn of Dolphin classes "

    ^ self variableSubclass:t

           instanceVariableNames:f

           classVariableNames:d

           poolDictionaries:s

           category:(self defaultCategoryForDolphinClasses)

           classInstanceVariableNames:classInstanceVariableNames

    "Modified: / 15.6.1998 / 21:31:34 / cg"

    "Modified: / 18.3.1999 / 18:16:11 / stefan"

! !

!Class methodsFor:'Compatibility-ST/V and V''Age'!

defaultCategoryForSTVorVAGEClasses

    |cat app|

    DefaultApplicationQuerySignal isHandled ifTrue:[

        app := DefaultApplicationQuerySignal query.

        app notNil ifTrue:[

            cat := 'Applications-' , app name.

        ] ifFalse:[

            cat := DefaultCategoryForVAGE ? 'V''Age classes'.

        ].

    ] ifFalse:[