--- a/Class.st Fri Sep 19 10:44:02 2003 +0200
+++ b/Class.st Mon Sep 22 11:11:53 2003 +0200
@@ -2136,185 +2136,10 @@
basicFileOutDefinitionOn:aStream withNameSpace:forceNameSpace withPackage:showPackage
"append an expression on aStream, which defines myself."
- |s owner ns nsName fullName forceNoNameSpace superNameWithoutNameSpacePrefix cls topOwner
- syntaxHilighting superclass superclassNamespace|
-
- UserPreferences isNil ifTrue:[
- syntaxHilighting := false
- ] ifFalse:[
- syntaxHilighting := UserPreferences current syntaxColoring.
- ].
-
- fullName := FileOutNameSpaceQuerySignal query == true.
- owner := self owningClass.
- ns := self topNameSpace.
-
- (showPackage and:[owner isNil]) ifTrue:[
- aStream nextPutAll:'"{ Package: '''.
- aStream nextPutAll:self package asString.
- aStream nextPutAll:''' }"'; cr; cr.
- ].
-
- "/ the backward compatible namespace directive is only used
- "/ for non-private classes.
- "/ Private classes cannot be filed into another smalltalk anyway,
- "/ and there is no need to complicate global lookup in stc...
-
- owner notNil ifTrue:[
- forceNoNameSpace := ForceNoNameSpaceQuerySignal query == true.
- forceNoNameSpace ifFalse:[
- fullName := true.
- ]
- ].
-
- fullName ifFalse:[
- (owner isNil or:[forceNameSpace]) ifTrue:[
- (ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
- nsName := ns name.
- (nsName includes:$:) ifTrue:[
- nsName := '''' , nsName , ''''
- ].
- aStream nextPutAll:'"{ NameSpace: '.
- syntaxHilighting ifTrue:[aStream bold].
- aStream nextPutAll:nsName.
- syntaxHilighting ifTrue:[aStream normal].
- aStream nextPutAll:' }"'; cr; cr.
- ]
- ].
- ].
-
- "take care of nil-superclass"
- superclass := self superclass.
- superclass isNil ifTrue:[
- s := 'nil'
- ] ifFalse:[
- superclassNamespace := superclass nameSpace.
-
- fullName ifTrue:[
- s := superclass name.
- ] ifFalse:[
- (ns == superclassNamespace
- and:[superclass owningClass isNil]) ifTrue:[
- "/ superclass is in the same namespace and not private;
- "/ still prepend namespace prefix for private classes,
- "/ to avoid confusing stc, which needs that information.
- "/ LATE note (AUG2002) - no longer; stc was fixed.
-"/ owner notNil ifTrue:[
-"/ s := superclass name
-"/ ] ifFalse:[
- s := superclass nameWithoutPrefix
-"/ ]
- ] ifFalse:[
- "/ a very special (rare) situation:
- "/ my superclass resides in another nameSpace,
- "/ but there is something else named like this
- "/ to be found in my nameSpace (or a private class)
-
- superNameWithoutNameSpacePrefix := superclass nameWithoutNameSpacePrefix asSymbol.
- cls := self privateClassesAt:superNameWithoutNameSpacePrefix.
- cls isNil ifTrue:[
- (topOwner := self topOwningClass) isNil ifTrue:[
- ns := self nameSpace.
- ns notNil ifTrue:[
- cls := ns privateClassesAt:superNameWithoutNameSpacePrefix
- ] ifFalse:[
- "/ self error:'unexpected nil namespace'
- ]
- ] ifFalse:[
- cls := topOwner nameSpace at:superNameWithoutNameSpacePrefix.
- ]
- ].
- (cls notNil and:[cls ~~ superclass]) ifTrue:[
- s := superclassNamespace name , '::' , superNameWithoutNameSpacePrefix
- ] ifFalse:[
- "/ no class with that name found in my namespace ...
- "/ if the superclass resides in Smalltalk,
- "/ suppress prefix; otherwise, use full prefix.
- (superclassNamespace notNil
- and:[superclassNamespace ~~ Smalltalk]) ifTrue:[
- (owner notNil
- and:[(topOwner := owner topOwningClass) notNil
- and:[topOwner nameSpace == superclass topOwningClass "owningClass" nameSpace
- ]]) ifTrue:[
- s := superNameWithoutNameSpacePrefix
- ] ifFalse:[
- ns == superclass topNameSpace ifTrue:[
- s := superNameWithoutNameSpacePrefix
- ] ifFalse:[
- s := superclass name
- ]
- ]
- ] ifFalse:[
- s := superNameWithoutNameSpacePrefix
- ]
- ]
- ]
- ]
- ].
-
- syntaxHilighting ifTrue:[aStream bold].
- aStream nextPutAll:s. "/ superclass
- syntaxHilighting ifTrue:[aStream normal].
- aStream space.
- self basicFileOutInstvarTypeKeywordOn:aStream.
-
- (fullName and:[owner isNil]) ifTrue:[
- aStream nextPutAll:'#'''.
- syntaxHilighting ifTrue:[aStream bold].
- aStream nextPutAll:(self name).
- syntaxHilighting ifTrue:[aStream normal].
- aStream nextPutAll:''''.
- ] ifFalse:[
- aStream nextPut:$#.
- syntaxHilighting ifTrue:[aStream bold].
- aStream nextPutAll:(self nameWithoutPrefix).
- syntaxHilighting ifTrue:[aStream normal].
- ].
-
- aStream crtab.
- aStream nextPutAll:'instanceVariableNames:'''.
- syntaxHilighting ifTrue:[aStream bold].
- self printInstVarNamesOn:aStream indent:16.
- syntaxHilighting ifTrue:[aStream normal].
- aStream nextPutAll:''''.
-
- aStream crtab.
- aStream nextPutAll:'classVariableNames:'''.
- syntaxHilighting ifTrue:[aStream bold].
- self printClassVarNamesOn:aStream indent:16.
- syntaxHilighting ifTrue:[aStream normal].
- aStream nextPutAll:''''.
-
- aStream crtab.
- aStream nextPutAll:'poolDictionaries:'''''.
-
- aStream crtab.
- owner isNil ifTrue:[
- "/ a public class
- aStream nextPutAll:'category:'.
- category isNil ifTrue:[
- s := ''''''
- ] ifFalse:[
- s := category asString storeString
- ].
- aStream nextPutAll:s.
- ] ifFalse:[
- "/ a private class
- aStream nextPutAll:'privateIn:'.
- syntaxHilighting ifTrue:[aStream bold].
- fullName ifTrue:[
- s := owner name.
- ] ifFalse:[
- s := owner nameWithoutNameSpacePrefix.
- ].
- aStream nextPutAll:s.
- syntaxHilighting ifTrue:[aStream normal].
- ].
- aStream cr
-
- "Created: / 4.1.1997 / 20:38:16 / cg"
- "Modified: / 8.8.1997 / 10:59:50 / cg"
- "Modified: / 18.3.1999 / 18:15:46 / stefan"
+ self class
+ basicFileOutDefinitionOf:self
+ on:aStream
+ withNameSpace:forceNameSpace withPackage:showPackage
!
basicFileOutInstvarTypeKeywordOn:aStream
@@ -5043,5 +4868,5 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.444 2003-09-17 12:00:36 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.445 2003-09-22 09:11:35 cg Exp $'
! !