"
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 in: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 := ClassBuilder new.
builder name:newName
in: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.
!
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
in: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"
!
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"
! !
!Metaclass methodsFor:'enumerating'!
instAndClassSelectorsAndMethodsDo:aTwoArgBlock
myClass instAndClassSelectorsAndMethodsDo:aTwoArgBlock
! !
!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
!
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"
"Modified: / 31.1.2000 / 16:17:02 / cg"
!
topOwningClass
"return nil here - regular metaclasses are never private"
^ nil
"Created: 3.1.1997 / 19:18:06 / cg"
! !
!Metaclass methodsFor:'source management'!
binaryRevision
^ myClass binaryRevision
"
Object binaryRevision
Object class binaryRevision
"
"Modified: 2.4.1997 / 01:17:04 / stefan"
!
sourceStream
"return the classes source stream"
^ myClass sourceStream
"Modified: 1.4.1997 / 14:36:31 / stefan"
!
sourceStreamFor:sourceFileName
"return the sourceStream for a sourceFileName"
^ myClass sourceStreamFor:sourceFileName
"Modified: 1.4.1997 / 14:36:38 / stefan"
! !
!Metaclass class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.181 2001-10-08 09:46:53 cg Exp $'
! !
Metaclass initialize!