Metaclass.st
changeset 17277 41175deb61ee
parent 16769 3ef6b678e97d
child 17592 469b9ab4d3de
equal deleted inserted replaced
17276:6642666dd477 17277:41175deb61ee
     9  other person.  No title to or ownership of the software is
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    10  hereby transferred.
    11 "
    11 "
    12 "{ Package: 'stx:libbasic' }"
    12 "{ Package: 'stx:libbasic' }"
    13 
    13 
       
    14 "{ NameSpace: Smalltalk }"
       
    15 
    14 ClassDescription subclass:#Metaclass
    16 ClassDescription subclass:#Metaclass
    15 	instanceVariableNames:'myClass'
    17 	instanceVariableNames:'myClass'
    16 	classVariableNames:'ConfirmationQuerySignal'
    18 	classVariableNames:'ConfirmationQuerySignal'
    17 	poolDictionaries:''
    19 	poolDictionaries:''
    18 	category:'Kernel-Classes'
    20 	category:'Kernel-Classes'
   107     ^ self == Metaclass class or:[self == Metaclass]
   109     ^ self == Metaclass class or:[self == Metaclass]
   108 
   110 
   109     "Modified: 23.4.1996 / 15:59:44 / cg"
   111     "Modified: 23.4.1996 / 15:59:44 / cg"
   110 ! !
   112 ! !
   111 
   113 
       
   114 
   112 !Metaclass methodsFor:'Compatibility-ST80'!
   115 !Metaclass methodsFor:'Compatibility-ST80'!
   113 
   116 
   114 comment:aString
   117 comment:aString
   115     "ignored - sometimes found in ST-80 fileOut files.
   118     "ignored - sometimes found in ST-80 fileOut files.
   116      Comments are supposed to be defined via class messages."
   119      Comments are supposed to be defined via class messages."
   124 
   127 
   125     ^ self soleInstance definition
   128     ^ self soleInstance definition
   126 
   129 
   127     "Created: / 1.11.1997 / 13:16:45 / cg"
   130     "Created: / 1.11.1997 / 13:16:45 / cg"
   128 ! !
   131 ! !
       
   132 
   129 
   133 
   130 !Metaclass methodsFor:'autoload check'!
   134 !Metaclass methodsFor:'autoload check'!
   131 
   135 
   132 isLoaded
   136 isLoaded
   133     "return true, if the class has been loaded;
   137     "return true, if the class has been loaded;
   401 !
   405 !
   402 
   406 
   403 basicFileOutDefinitionOf:aClass on:aStream withNameSpace:forceNameSpace withPackage:showPackage syntaxHilighting:syntaxHilighting
   407 basicFileOutDefinitionOf:aClass on:aStream withNameSpace:forceNameSpace withPackage:showPackage syntaxHilighting:syntaxHilighting
   404     "append an expression on aStream, which defines myself."
   408     "append an expression on aStream, which defines myself."
   405 
   409 
   406     |s owner ns nsName fullName forceNoNameSpace superNameWithoutNameSpacePrefix cls topOwner
   410     |s owner namespace nsName fullName forceNoNameSpace superNameWithoutNameSpacePrefix cls topOwner
   407      superclass superclassNamespace nm useStoreString boldOn boldOff pkg|
   411      superclass superclassNamespace nm useStoreString boldOn boldOff pkg|
   408 
   412 
   409     syntaxHilighting ifTrue:[
   413     syntaxHilighting ifTrue:[
   410         boldOn := [aStream bold].
   414         boldOn := [aStream bold].
   411         boldOff := [aStream normal].
   415         boldOff := [aStream normal].
   412     ].
   416     ].
   413 
   417 
   414     fullName := FileOutNameSpaceQuerySignal query == true.
   418     fullName := FileOutNameSpaceQuerySignal query == true.
   415     owner := aClass owningClass.
   419     owner := aClass owningClass.
   416     ns := aClass topNameSpace.
   420     namespace := aClass topNameSpace.
   417 
   421 
   418     (showPackage and:[owner isNil]) ifTrue:[
   422     (showPackage and:[owner isNil]) ifTrue:[
   419         pkg := aClass getPackage.
   423         pkg := aClass getPackage.
   420         (pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
   424         (pkg notNil and:[pkg ~= PackageId noProjectID]) ifTrue:[
   421             aStream nextPutAll:'"{ Package: '''.
   425             aStream nextPutAll:'"{ Package: '''.
   442 "/        ]
   446 "/        ]
   443 "/    ].
   447 "/    ].
   444 
   448 
   445     fullName ifFalse:[
   449     fullName ifFalse:[
   446         (owner isNil or:[forceNameSpace]) ifTrue:[
   450         (owner isNil or:[forceNameSpace]) ifTrue:[
   447             (ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
   451             (namespace notNil and:[namespace ~~ Smalltalk]) ifTrue:[
   448                 nsName := ns name.
   452                 nsName := namespace name.
   449                 (nsName includes:$:) ifTrue:[
   453                 (nsName includes:$:) ifTrue:[
   450                     nsName := '''' , nsName , ''''
   454                     nsName := '''' , nsName , ''''
   451                 ].
   455                 ].
   452                 aStream nextPutAll:'"{ NameSpace: '.
   456                 aStream nextPutAll:'"{ NameSpace: '.
   453                 boldOn value.
   457                 boldOn value.
   454                 aStream nextPutAll:nsName.
   458                 aStream nextPutAll:nsName.
   455                 boldOff value.
   459                 boldOff value.
   456                 aStream nextPutAll:' }"'; cr; cr.
   460                 aStream nextPutAll:' }"'; cr; cr.
   457             ]
   461             ] ifFalse:[
       
   462                 "/ always write a namespace directive - even for smalltalk classes.
       
   463                 "/ reason: the fileout might go into a big file containing multiple classes
       
   464                 "/ in different namespaces (otherwise, the smalltalk class would later be filed into
       
   465                 "/ the previous class's namespace)
       
   466                 aStream nextPutAll:'"{ NameSpace: Smalltalk }"'; cr; cr.
       
   467             ].
   458         ].
   468         ].
   459     ].
   469     ].
   460 
   470 
   461     "take care of nil-superclass"
   471     "take care of nil-superclass"
   462     superclass := aClass superclass.
   472     superclass := aClass superclass.
   478             s := superclass nameWithNameSpacePrefix.
   488             s := superclass nameWithNameSpacePrefix.
   479         ] ifFalse:[
   489         ] ifFalse:[
   480             fullName ifTrue:[
   490             fullName ifTrue:[
   481                 s := superclass name.
   491                 s := superclass name.
   482             ] ifFalse:[
   492             ] ifFalse:[
   483                 (ns == superclassNamespace
   493                 (namespace == superclassNamespace
   484                 and:[superclass owningClass isNil]) ifTrue:[
   494                 and:[superclass owningClass isNil]) ifTrue:[
   485                     "/ superclass is in the same namespace and not private;
   495                     "/ superclass is in the same namespace and not private;
   486                     "/ still prepend namespace prefix for private classes,
   496                     "/ still prepend namespace prefix for private classes,
   487                     "/  to avoid confusing stc, which needs that information.
   497                     "/  to avoid confusing stc, which needs that information.
   488                     "/ LATE note (AUG2002) - no longer; stc was fixed.
   498                     "/ LATE note (AUG2002) - no longer; stc was fixed.
   499 
   509 
   500                     superNameWithoutNameSpacePrefix := superclass nameWithoutNameSpacePrefix asSymbol.
   510                     superNameWithoutNameSpacePrefix := superclass nameWithoutNameSpacePrefix asSymbol.
   501                     cls := aClass privateClassesAt:superNameWithoutNameSpacePrefix.
   511                     cls := aClass privateClassesAt:superNameWithoutNameSpacePrefix.
   502                     cls isNil ifTrue:[
   512                     cls isNil ifTrue:[
   503                         (topOwner := aClass topOwningClass) isNil ifTrue:[
   513                         (topOwner := aClass topOwningClass) isNil ifTrue:[
   504                             ns := aClass nameSpace.
   514                             namespace := aClass nameSpace.
   505                             ns notNil ifTrue:[
   515                             namespace notNil ifTrue:[
   506                                 cls := ns privateClassesAt:superNameWithoutNameSpacePrefix
   516                                 cls := namespace privateClassesAt:superNameWithoutNameSpacePrefix
   507                             ] ifFalse:[
   517                             ] ifFalse:[
   508                                 "/ aClass error:'unexpected nil namespace'
   518                                 "/ aClass error:'unexpected nil namespace'
   509                             ]
   519                             ]
   510                         ] ifFalse:[
   520                         ] ifFalse:[
   511                             cls := topOwner nameSpace at:superNameWithoutNameSpacePrefix.
   521                             cls := topOwner nameSpace at:superNameWithoutNameSpacePrefix.
   524                              and:[superclass topOwningClass notNil
   534                              and:[superclass topOwningClass notNil
   525                              and:[topOwner nameSpace == superclass topOwningClass "owningClass" nameSpace]
   535                              and:[topOwner nameSpace == superclass topOwningClass "owningClass" nameSpace]
   526                             ]]) ifTrue:[
   536                             ]]) ifTrue:[
   527                                 s := superNameWithoutNameSpacePrefix
   537                                 s := superNameWithoutNameSpacePrefix
   528                             ] ifFalse:[
   538                             ] ifFalse:[
   529                                 ns == superclass topNameSpace ifTrue:[
   539                                 namespace == superclass topNameSpace ifTrue:[
   530                                     s := superNameWithoutNameSpacePrefix
   540                                     s := superNameWithoutNameSpacePrefix
   531                                 ] ifFalse:[
   541                                 ] ifFalse:[
   532                                     s := superclass name
   542                                     s := superclass name
   533                                 ]
   543                                 ]
   534                             ]
   544                             ]
   916 ! !
   926 ! !
   917 
   927 
   918 !Metaclass class methodsFor:'documentation'!
   928 !Metaclass class methodsFor:'documentation'!
   919 
   929 
   920 version_CVS
   930 version_CVS
   921     ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.214 2014-07-11 12:22:12 cg Exp $'
   931     ^ '$Header: /cvs/stx/stx/libbasic/Metaclass.st,v 1.215 2014-12-31 09:15:58 cg Exp $'
   922 ! !
   932 ! !
   923 
   933 
   924 
   934 
   925 Metaclass initialize!
   935 Metaclass initialize!