"

 COPYRIGHT (c) 1988 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:#Metaclass

	instanceVariableNames:'myClass'

	classVariableNames:'ConfirmationQuerySignal'

	poolDictionaries:''

	category:'Kernel-Classes'

!

!Metaclass class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1988 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

"

    every classes class is a subclass of Metaclass.

    (i.e. every class is the sole instance of its Metaclass)

    Metaclass provides support for creating new (sub)classes and/or 

    changing the definition of an already existing class.

    [author:]

	Claus Gittinger

    [see also:]

	Behavior ClassDescription Class

"

! !

!Metaclass class methodsFor:'Signal constants'!

confirmationQuerySignal

    "return the query signal which is raised to ask if user

     confirmation dialogs should be opened.

     If unhandled, they are."

    ^ ConfirmationQuerySignal

    "Created: 31.7.1997 / 21:55:39 / cg"

! !

!Metaclass class methodsFor:'class initialization'!

initialize

    ConfirmationQuerySignal := QuerySignal new defaultAnswer:true

    "Modified: 31.7.1997 / 21:54:44 / cg"

! !

!Metaclass class methodsFor:'creating metaclasses'!

new

    "creating a new metaclass - have to set the new classes

     flags correctly to have it behave like a metaclass ...

     Not for normal applications - creating new metaclasses is a very

     tricky thing; should be left to the gurus ;-)"

    |newMetaclass|

    newMetaclass := super new.

    newMetaclass instSize:(Class instSize).

    newMetaclass setSuperclass:Class.

    ^ newMetaclass

    "

     Metaclass new           <- new metaclass

     Metaclass new new       <- new class

     Metaclass new new new   <- new instance

    "

! !

!Metaclass 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 == Metaclass class or:[self == Metaclass]

    "Modified: 23.4.1996 / 15:59:44 / cg"

! !

!Metaclass methodsFor:'Compatibility-ST80'!

comment:aString

    "ignored - sometimes found in ST-80 fileOut files.

     Comments are supposed to be defined via class messages."

    "Created: 9.10.1997 / 18:14:34 / cg"

!

sourceCodeTemplate

    "ST80 compatibility - return a definition message for myself.

     Same as #definition"

    ^ self soleInstance definition

    "Created: / 1.11.1997 / 13:16:45 / cg"

! !

!Metaclass methodsFor:'autoload check'!

isLoaded

    "return true, if the class has been loaded; 

     redefined in Autoload; see comment there"

    ^ myClass isLoaded

! !

!Metaclass methodsFor:'class instance variables'!

instanceVariableNames:aString

    "changing / adding class-inst vars -

     this actually creates a new metaclass and class, leaving the original

     classes around as obsolete classes. This may also be true for all subclasses,

     if class instance variables are added/removed.

     Existing instances continue to be defined by their original classes.

     Time will show, if this is an acceptable behavior or if we should migrate

     instances to become insts. of the new classes."

    |builder|

    builder := ClassBuilder new.

    builder oldMetaclass:self instanceVariableNames:aString.

    builder rebuildForChangedInstanceVariables.

! !

!Metaclass methodsFor:'compiler interface'!

browserClass

    "return the browser to use for this class - 

     this can be redefined in special classes, to get different browsers"

    ^ UserPreferences systemBrowserClass.

    "Created: 3.5.1996 / 12:36:40 / cg"

!

compilerClass

    "return the compiler to use for this class - 

     this can be redefined in special classes, to compile classes with

     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ Compiler

!

evaluatorClass

    "return the compiler to use for expression evaluation for this class - 

     this can be redefined in special classes, to evaluate expressions with

     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ Compiler

!

formatterClass

    "return the parser to use for formatting (prettyPrinting) this class - 

     this can be redefined in special classes, to format classes with

     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ Parser

    "Created: / 27.4.1998 / 15:33:34 / cg"

!

parserClass

    "return the parser to use for parsing this class - 

     this can be redefined in special classes, to parse classes with

     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ Parser

    "Created: 18.4.1997 / 21:02:41 / cg"

!

subclassDefinerClass

    "Answer an evaluator class appropriate for evaluating definitions of new 

     subclasses of this class."

    ^ self evaluatorClass

!

syntaxHighlighterClass

    "return the class to use for syntaxHighlighting (prettyPrinting) this class - 

     this can be redefined in special classes, to highlight classes with

     Lisp, Prolog, ASN1, Basic :-) or whatever syntax."

    ^ SyntaxHighlighter

    "Created: / 27.4.1998 / 15:34:08 / cg"

! !

!Metaclass methodsFor:'copying'!

postCopy

    "redefined - a copy may have a new instance"

    myClass := nil

! !

!Metaclass methodsFor:'creating classes'!

name:newName inEnvironment:aSystemDictionary

             subclassOf:aClass

             instanceVariableNames:stringOfInstVarNames

             variable:variableBoolean

             words:wordsBoolean

             pointers:pointersBoolean

             classVariableNames:stringOfClassVarNames

             poolDictionaries:stringOfPoolNames

             category:categoryString

             comment:commentString

             changed:changed

    ^ self

        name:newName 

        inEnvironment:aSystemDictionary

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        variable:variableBoolean

        words:wordsBoolean

        pointers:pointersBoolean

        classVariableNames:stringOfClassVarNames

        poolDictionaries:stringOfPoolNames

        category:categoryString

        comment:commentString

        changed:changed

        classInstanceVariableNames:nil

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

!

name:newName inEnvironment:aSystemDictionaryOrClass

             subclassOf:aClass

             instanceVariableNames:stringOfInstVarNames

             variable:variableBoolean

             words:wordsBoolean

             pointers:pointersBoolean

             classVariableNames:stringOfClassVarNames

             poolDictionaries:stringOfPoolNames

             category:categoryString

             comment:commentString

             changed:changed

             classInstanceVariableNames:stringOfClassInstVarNamesOrNil

    "this is the main workhorse for installing new classes - special care

     has to be taken, when changing an existing classes definition. In this

     case, some or all of the methods and subclasses methods have to be

     recompiled.

     Also, the old class(es) are still kept (but not accessable as a global),

     to allow existing instances some life. 

     This might change in the future.

    "

    |builder|

    builder := self newClassBuilder.

    builder name:newName 

        inEnvironment:aSystemDictionaryOrClass

        subclassOf:aClass

        instanceVariableNames:stringOfInstVarNames

        variable:variableBoolean

        words:wordsBoolean

        pointers:pointersBoolean

        classVariableNames:stringOfClassVarNames

        poolDictionaries:stringOfPoolNames

        category:categoryString

        comment:commentString

        changed:changed

        classInstanceVariableNames:stringOfClassInstVarNamesOrNil.

    ^ builder buildClass.

!

new

    "create & return a new metaclass (a classes class).

     Since metaclasses only have one instance (the class),

     complain if there is already one.

     You get a new class by sending #new to the returned metaclass

     (confusing - isn't it ?)"

    |newClass|

    myClass notNil ifTrue:[

        self error:'Each metaclass may only have one instance'.

    ].

    newClass := self basicNew.

    newClass 

        setSuperclass:Object

        methodDictionary:(MethodDictionary new)

        instSize:0 

        flags:(Behavior flagBehavior).

    myClass := newClass.

    ^ newClass

    "Modified: 1.4.1997 / 15:44:50 / stefan"

!

newClassBuilder

    ^ ClassBuilder new.

! !

!Metaclass methodsFor:'enumerating'!

instAndClassSelectorsAndMethodsDo:aTwoArgBlock

    myClass instAndClassSelectorsAndMethodsDo:aTwoArgBlock

!

subclassesDo:aBlock

    "evaluate the argument, aBlock for all immediate subclasses.

     This will only enumerate globally known classes - for anonymous

     behaviors, you have to walk over all instances of Behavior."

    "metaclasses are not found via Smalltalk allClassesDo:

     here, walk over classes and enumerate corresponding metas"

    self soleInstance subclassesDo:[:aSubClass |

        aBlock value:aSubClass class

    ].

! !

!Metaclass methodsFor:'fileOut'!

fileOutDefinitionOn:aStream

    myClass fileOutClassInstVarDefinitionOn:aStream

    "Modified: / 21.6.1998 / 04:10:02 / cg"

! !

!Metaclass methodsFor:'private'!

setSoleInstance:aClass 

    myClass := aClass

    "Created: 12.12.1995 / 13:46:22 / cg"

! !

!Metaclass methodsFor:'queries'!

category

    "return my category"

    ^ myClass category

    "Created: 2.4.1997 / 00:46:11 / stefan"

!

comment

    "return my comment"

    ^ myClass comment

    "Created: 2.4.1997 / 00:51:35 / stefan"

!

hasExtensions

    "return true if I have extensions"

    ^ myClass hasExtensions

!

hasExtensionsFrom:aPackageID

    "return true if I have extensions from a package"

    ^ myClass hasExtensionsFrom:aPackageID

!

isBuiltInClass

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

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

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

    "Created: 15.4.1996 / 17:17:34 / cg"

    "Modified: 23.4.1996 / 15:59:37 / cg"

!

isMeta

    "return true, if the receiver is some kind of metaclass;

     true is returned here. Redefines isMeta in Object"

    ^ true

!

name

    "return my name - that is the name of my sole class, with ' class'

     appended."

    |nm|

    myClass isNil ifTrue:[

        ^ #someMetaclass

    ].

    (nm := myClass name) isNil ifTrue:[

        'Metaclass [warning]: no name in my class' errorPrintCR.

        ^ #'unnamed class'

    ].

    ^ nm , ' class'

    "Modified: 10.1.1997 / 17:55:08 / cg"

    "Modified: 1.4.1997 / 15:53:11 / stefan"

!

nameSpace

    "return the nameSpace I am contained in.

     Due to the implementation of nameSpaces (as classVariables),

     a class can only be contained in one nameSpace (which is the desired)"

    "/ this information is in the class

    ^ myClass nameSpace

    "Created: 7.11.1996 / 13:18:52 / cg"

!

owningClass

    "return nil here - regular metaclasses are never private"

    ^ nil

    "Created: 12.10.1996 / 20:12:16 / cg"

!

package

    "return my package-id"

    ^ myClass package

    "Created: 15.10.1996 / 19:44:51 / cg"

!

soleInstance 

    "return my sole class."

    ^ myClass

!

subclasses

    ^ myClass subclasses collect:[:theNonMetaClass| theNonMetaClass class].

    "

       Integer class subclasses

    "

!

theMetaclass

    "return myself; also implemented in my class object, which also returns me."

    ^ self

    "Created: / 30.1.2000 / 23:08:15 / cg"

    "Modified: / 31.1.2000 / 16:15:00 / cg"

!

theNonMetaclass

    "return my class object, also implemented in my class object, which also returns iteself."

    ^ self soleInstance

    "Created: / 30.1.2000 / 23:08:11 / cg"