--- a/Class.st Mon Oct 08 11:16:15 2001 +0200
+++ b/Class.st Mon Oct 08 11:17:34 2001 +0200
@@ -1177,7 +1177,7 @@
can it be done ?
(all of my methods must have a source)
"
- self allSelectorsAndMethodsDo:[:sel :aMethod |
+ self instAndClassSelectorsAndMethodsDo:[:sel :aMethod |
aMethod source isNil ifTrue:[^false].
aMethod hasPrimitiveCode ifTrue:[^ false].
].
@@ -1401,7 +1401,7 @@
] ifFalse:[
newClass setPackage:package.
].
- newClass allSelectorsAndMethodsDo:[:sel :mthd | mthd setPackage:package].
+ newClass instAndClassSelectorsAndMethodsDo:[:sel :mthd | mthd setPackage:package].
newClass methodDictionary:methods.
newClass class methodDictionary:cmethods.
@@ -1913,8 +1913,8 @@
basicFileOutDefinitionOn:aStream withNameSpace:forceNameSpace withPackage:showPackage
"append an expression on aStream, which defines myself."
- |s owner ns nsName fullName superName cls topOwner
- syntaxHilighting|
+ |s owner ns nsName fullName superNameWithoutNameSpacePrefix cls topOwner
+ syntaxHilighting superclassNamespace|
UserPreferences isNil ifTrue:[
syntaxHilighting := false
@@ -1922,14 +1922,14 @@
syntaxHilighting := UserPreferences current syntaxColoring.
].
+ fullName := FileOutNameSpaceQuerySignal query == true.
+
owner := self owningClass.
-
owner isNil ifTrue:[
ns := self nameSpace.
] ifFalse:[
- ns := self topOwningClass nameSpace
+ ns := self topOwningClass nameSpace.
].
- fullName := FileOutNameSpaceQuerySignal query == true.
(showPackage and:[owner isNil]) ifTrue:[
aStream nextPutAll:'"{ Package: '''.
@@ -1937,34 +1937,44 @@
aStream nextPutAll:''' }"'; cr; cr.
].
- ((owner isNil and:[fullName not])
- or:[owner notNil and:[forceNameSpace and:[fullName not]]]) ifTrue:[
- (ns notNil and:[ns ~~ Smalltalk]) ifTrue:[
- nsName := ns name.
- (nsName includes:$:) ifTrue:[
- nsName := '''' , nsName , ''''
- ].
-"/ aStream nextPutLine:'"{ NameSpace: ' , nsName , ' }"'; cr.
- aStream nextPutAll:'"{ NameSpace: '.
- syntaxHilighting ifTrue:[aStream bold].
- aStream nextPutAll:nsName.
- syntaxHilighting ifTrue:[aStream normal].
- 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:[
+ 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 isNil ifTrue:[
s := 'nil'
] ifFalse:[
+ superclassNamespace := superclass nameSpace.
+
fullName ifTrue:[
- superclass == owner ifTrue:[
- s := superclass nameWithoutNameSpacePrefix
- ] ifFalse:[
- s := superclass name
- ]
+ s := superclass name.
+"/ superclass == owner ifTrue:[
+"/ s := superclass nameWithoutNameSpacePrefix
+"/ ]
] ifFalse:[
- (ns == superclass nameSpace
+ (ns == superclassNamespace
and:[superclass owningClass isNil]) ifTrue:[
"/ superclass is in the same namespace;
"/ still prepend namespace prefix, to avoid
@@ -1976,37 +1986,37 @@
"/ but there is something else named like this
"/ to be found in my nameSpace (or a private class)
- superName := superclass nameWithoutNameSpacePrefix asSymbol.
- cls := self privateClassesAt:superName.
+ 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:superName
+ cls := ns privateClassesAt:superNameWithoutNameSpacePrefix
] ifFalse:[
"/ self error:'unexpected nil namespace'
]
] ifFalse:[
- cls := topOwner nameSpace at:superName.
+ cls := topOwner nameSpace at:superNameWithoutNameSpacePrefix.
]
].
(cls notNil and:[cls ~~ superclass]) ifTrue:[
- s := superclass nameSpace name , '::' , superName
+ 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.
- (superclass nameSpace notNil
- and:[superclass nameSpace ~~ Smalltalk]) ifTrue:[
+ (superclassNamespace notNil
+ and:[superclassNamespace ~~ Smalltalk]) ifTrue:[
(owner notNil
and:[owner nameSpace == superclass owningClass nameSpace])
ifTrue:[
- s := superclass nameWithoutNameSpacePrefix
+ s := superNameWithoutNameSpacePrefix
] ifFalse:[
s := superclass name
]
] ifFalse:[
- s := superName
+ s := superNameWithoutNameSpacePrefix
]
]
]
@@ -2068,7 +2078,6 @@
] ifFalse:[
s := owner nameWithoutNameSpacePrefix.
].
-"/ s := owner nameWithoutNameSpacePrefix.
aStream nextPutAll:s.
syntaxHilighting ifTrue:[aStream normal].
].
@@ -2230,12 +2239,7 @@
"/ file (i.e. all of my methods have their source as string)
anySourceRef := false.
- self methodDictionary do:[:m|
- m sourcePosition notNil ifTrue:[
- anySourceRef := true
- ]
- ].
- self class methodDictionary do:[:m|
+ self instAndClassMethodsDo:[:m |
m sourcePosition notNil ifTrue:[
anySourceRef := true
]
@@ -2284,16 +2288,7 @@
"/ first, to avoid accessing the newly written file.
anySourceRef := false.
- self methodDictionary do:[:m|
- |mSrc|
-
- (mSrc := m sourceFilename) notNil ifTrue:[
- mSrc asFilename baseName = fileName baseName ifTrue:[
- anySourceRef := true
- ]
- ]
- ].
- self class methodDictionary do:[:m|
+ self instAndClassMethodsDo:[:m |
|mSrc|
(mSrc := m sourceFilename) notNil ifTrue:[
@@ -3474,7 +3469,7 @@
|pkg|
pkg := self package.
- self allSelectorsAndMethodsDo:[:sel :mthd |
+ self instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd package ~= pkg ifTrue:[^ true].
].
^ false
@@ -3490,7 +3485,7 @@
Those are class extensions, which must be treated specially when checking classes
into the sourceCode repository. (extensions are stored separate)"
- self allSelectorsAndMethodsDo:[:sel :mthd |
+ self instAndClassSelectorsAndMethodsDo:[:sel :mthd |
mthd package = aPackageID ifTrue:[^ true].
].
^ false
@@ -4651,5 +4646,5 @@
!Class class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.399 2001-09-10 14:18:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.400 2001-10-08 09:17:34 cg Exp $'
! !