"{ Encoding: utf8 }"

"

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

"{ NameSpace: Smalltalk }"

ClassDescription subclass:#Class

	instanceVariableNames:'name category classvars comment subclasses classFilename package

		revision environment signature attributes'

	classVariableNames:'DefaultCategoryForDolphin DefaultCategoryForSTV

		DefaultCategoryForUncategorizedClasses

		DefaultCategoryForUndeclaredClasses DefaultCategoryForVAGE

		SubclassCacheSequenceNumber ValidateSourceOnlyOnce

		ValidatedClasses'

	poolDictionaries:''

	category:'Kernel-Classes'

!

Array variableSubclass:#ArrayWithSequenceNumberValidation

	instanceVariableNames:'sequenceNumber'

	classVariableNames:''

	poolDictionaries:''

	privateIn:Class

!

Object subclass:#ClassAttributes

	instanceVariableNames:'primitiveDefinitions primitiveVariables primitiveFunctions

		sharedPools traitComposition localSelectors vGuid fGuid

		projectDirectory'

	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

    [note:]

        the subclasses instvar keeps a cached collection of the known subclasses in the system.

        this cache is lazyly flushed when a SubclassCacheSequenceNumber comparison detects a mismatch.

        (this seqNr is incremented, whenever something in any class hierarchy changes).

        This is a q&d mechanism to allow for no-overhead fileIn and package loading,

        and reasonable speedup in the hierarchy walkers (i.e. the browsers).

        (flushing all is obviously too much flushing, and we could do better in many situations)

    [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...)"

    "JV: When smalltalk is not yet initialized, do use local sources

         because before that, SCM support may not be loaded and configured

         properly, leading to funny errors."

    ^ Smalltalk isInitialized not or:[TryLocalSourceFirst == true].

    "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

    "this new instance creation protocol may be used in scripts to replace the traditional inst-creation messages"

    ^ self

        name:newName

        subclassOf:Object

        instanceVariableNames:''

        category:(self defaultCategoryForUncategorizedClasses)

!

name:newName instanceVariableNames:stringOfInstVarNames

    "this new instance creation protocol may be used in scripts to replace the traditional inst-creation messages"

    ^ self

        name:newName

        subclassOf:Object

        instanceVariableNames:stringOfInstVarNames

        category:(self defaultCategoryForUncategorizedClasses)

!

name:newName subclassOf:aClass

    "this new instance creation protocol may be used in scripts to replace the traditional inst-creation messages"

    ^ self

        name:newName

        subclassOf:aClass

        instanceVariableNames:''

        category:(self defaultCategoryForUncategorizedClasses)

!

name:newName subclassOf:aClass instanceVariableNames:stringOfInstVarNames

    "this new instance creation protocol may be used in scripts to replace the traditional inst-creation messages"

    ^ self

        name:newName

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        category:(self defaultCategoryForUncategorizedClasses)

!

name:newName subclassOf:aClass instanceVariableNames:stringOfInstVarNames category:categoryString

    "this new instance creation protocol may be used in scripts to 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 may be used in scripts to 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 may be used in scripts to 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 may be used in scripts to 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"

!

undeclared: name

    "Creates an 'undeclared' class, a placeholder for

     superclass when loading/filing-in a class whose

     superclass does not exist yet."

    Transcript showCR:'Smalltalk [info]: Declaring undeclared class: ', name.

    ^ Object 

        subclass: name asSymbol

        instanceVariableNames:''

        classVariableNames:''

        poolDictionaries:''

        category:(self defaultCategoryForUndeclaredClasses)

    "Created: / 08-11-2010 / 16:08:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Class class methodsFor:'helpers'!

nameWithoutPrefix:name

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

     without any owningClass or nameSpace prefix"

    |idx|

    name isNil ifTrue:[^ nil].

    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'

    "

    "Modified: / 13-06-2012 / 14:41:21 / cg"

!

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: / 29-09-2011 / 21:53:29 / cg"

!

revisionStringFromSource:aMethodSourceString

    "{ Pragma: +optSpace }"

    "extract a revision string from a method's source string.

     Caveat: Assumes CVS."

    |lines line|

    lines := aMethodSourceString asCollectionOfLines.

    lines do:[:l |

        |i|

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

        "JV @ 2009-12-13: Also search for '$Id: ' (because of SVN-only classes)"

        i == 0 ifTrue:[

        i := l indexOfSubCollection:'$Id: '].

        "JV @ 2013-07-18: Also search for '$Changeset: ' (because of Mercurial-only classes)"

        i == 0 ifTrue:[

        i := l indexOfSubCollection:'$Changeset: '].

        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"

    "Modified: / 19-07-2013 / 23:32:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

    SubclassCacheSequenceNumber := (SubclassCacheSequenceNumber ? 0) + 1.

"/    self allSubInstancesDo:[:cls |

"/        cls flushSubclasses

"/    ].

    "

     Class flushSubclassInfo

    "

    "Modified: / 06-12-2011 / 16:20:13 / cg"

!

flushSubclassInfoFor:aClass

    "throw away (forget) the cached subclass information for aClass, 

     as created by #subclassInfo.

     This is private protocol"

    aClass notNil ifTrue:[

        aClass flushSubclasses

    ].