xml fileOut
authorClaus Gittinger <cg@exept.de>
Mon, 17 Jul 2000 19:01:35 +0200
changeset 5464 af5c4f052b20
parent 5463 18ec3ac68106
child 5465 330dde6e27e3
xml fileOut
Class.st
NameSpace.st
--- a/Class.st	Fri Jul 14 11:27:57 2000 +0200
+++ b/Class.st	Mon Jul 17 19:01:35 2000 +0200
@@ -2708,6 +2708,30 @@
 
 !
 
+fileOutXMLAllMethodsOn:aStream methodFilter:methodFilter
+    |collectionOfCategories|
+
+    collectionOfCategories := self class categories asSortedCollection.
+    collectionOfCategories notNil ifTrue:[
+        collectionOfCategories do:[:aCategory |
+            self class fileOutXMLCategory:aCategory methodFilter:methodFilter on:aStream.
+            aStream cr
+        ]
+    ].
+    collectionOfCategories := self categories asSortedCollection.
+    collectionOfCategories notNil ifTrue:[
+        collectionOfCategories do:[:aCategory |
+            self fileOutXMLCategory:aCategory methodFilter:methodFilter on:aStream.
+            aStream cr
+        ]
+    ].
+
+    self privateClassesSorted do:[:aClass |
+        aClass fileOutXMLAllMethodsOn:aStream methodFilter:methodFilter
+    ].
+
+!
+
 fileOutXMLAs:fileNameOrString
     "create a file consisting of all methods in myself in
      XML sourceForm.
@@ -2742,56 +2766,79 @@
 fileOutXMLDefinitionOn:aStream
     "append an xml expression on aStream, which defines myself."
 
-    |s owner ns nsName fullName superName cls topOwner|
+    |s owner ns nsName fullName superName cls topOwner varNames|
 
     aStream nextPutLine:'<class>'.
 
-    aStream nextPutAll:'<name>'.
+    aStream nextPutAll:'  <name>'.
     aStream nextPutAll:(self nameWithoutPrefix).
     aStream nextPutLine:'</name>'.
 
-    aStream nextPutAll:'<environment>'.
+    aStream nextPutAll:'  <environment>'.
     aStream nextPutAll:(self nameSpace name).
     aStream nextPutLine:'</environment>'.
 
-    aStream nextPutAll:'<super>'.
+    aStream nextPutAll:'  <super>'.
     aStream nextPutAll:(self theNonMetaclass superclass name).
     aStream nextPutLine:'</super>'.
 
-    aStream nextPutAll:'<private>'.
-    aStream nextPutAll:'false'.
+    aStream nextPutAll:'  <private>'.
+    aStream nextPutAll:(self isPrivate printString).
     aStream nextPutLine:'</private>'.
 
-    aStream nextPutAll:'<indexed-type>'.
+    aStream nextPutAll:'  <indexed-type>'.
     aStream nextPutAll:'none'.
     aStream nextPutLine:'</indexed-type>'.
 
-    aStream nextPutAll:'<inst-vars>'.
-    self instVarNames do:[:nm |
-        aStream nextPutAll:'<name>'.
-        aStream nextPutAll:nm.
-        aStream nextPutLine:'</name>'.
+    aStream nextPutAll:'  <inst-vars>'.
+    varNames := self instVarNames.
+    varNames size > 0 ifTrue:[
+        aStream cr.
+        varNames do:[:nm |
+            aStream nextPutAll:'    <name>'.
+            aStream nextPutAll:nm.
+            aStream nextPutLine:'</name>'.
+        ].
+        aStream nextPutAll:'  '.
     ].
     aStream nextPutLine:'</inst-vars>'.
 
-    aStream nextPutAll:'<class-inst-vars>'.
-    self class instVarNames do:[:nm |
-        aStream nextPutAll:'<name>'.
-        aStream nextPutAll:nm.
-        aStream nextPutLine:'</name>'.
+    aStream nextPutAll:'  <class-inst-vars>'.
+    varNames := self class instVarNames.
+    varNames size > 0 ifTrue:[
+        aStream cr.
+        varNames do:[:nm |
+            aStream nextPutAll:'    <name>'.
+            aStream nextPutAll:nm.
+            aStream nextPutLine:'</name>'.
+        ].
+        aStream nextPutAll:'  '.
     ].
     aStream nextPutLine:'</class-inst-vars>'.
 
-    aStream nextPutAll:'<imports>'.
+    aStream nextPutAll:'  <imports>'.
     aStream nextPutAll:''.
     aStream nextPutLine:'</imports>'.
 
-    aStream nextPutAll:'<category>'.
+    aStream nextPutAll:'  <category>'.
     aStream nextPutAll:self category.
     aStream nextPutLine:'</category>'.
 
     aStream nextPutLine:'</class>'.
 
+    varNames := self classVarNames.
+    varNames size > 0 ifTrue:[
+        varNames do:[:nm |
+            aStream nextPutLine:'<static>'.
+            aStream nextPutAll:' <name>'.
+            aStream nextPutAll:nm.
+            aStream nextPutLine:'</name>'.
+            aStream nextPutAll:' <environment>'.
+            aStream nextPutAll:self name.
+            aStream nextPutLine:'</environment>'.
+            aStream nextPutLine:'</static>'.
+        ].
+    ].
 
 !
 
@@ -4387,5 +4434,5 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.372 2000-04-14 16:43:33 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.373 2000-07-17 17:01:22 cg Exp $'
 ! !
--- a/NameSpace.st	Fri Jul 14 11:27:57 2000 +0200
+++ b/NameSpace.st	Mon Jul 17 19:01:35 2000 +0200
@@ -11,6 +11,8 @@
 "
 
 
+"{ Package: 'stx:libbasic' }"
+
 Object subclass:#NameSpace
 	instanceVariableNames:'category'
 	classVariableNames:''
@@ -378,6 +380,24 @@
     "Created: 4.1.1997 / 20:36:32 / cg"
 ! !
 
+!NameSpace class methodsFor:'fileOut-xml'!
+
+fileOutXMLDefinitionOn:aStream
+    "redefined to generate another definition message"
+
+    self == NameSpace ifTrue:[
+        super fileOutXMLDefinitionOn:aStream
+    ] ifFalse:[
+        aStream nextPutLine:'<name-space>'.
+        aStream nextPutLine:'  <name>' , self name , '</name>'.
+        aStream nextPutLine:'  <environment>Smalltalk</environment>'.
+        aStream nextPutLine:'  <private>false</private>'.
+        aStream nextPutLine:'  <imports>Smalltalk.*</imports>'.
+        aStream nextPutLine:'  <category>none</category>'.
+        aStream nextPutLine:'</name-space>'.
+    ]
+! !
+
 !NameSpace class methodsFor:'inspecting'!
 
 inspectorClass
@@ -434,18 +454,18 @@
 
 !
 
+isTopLevelNameSpace
+    ^ (self name includes:$:) not
+!
+
 isTopLevelNamespace
     "obsolete - use isTopLevelNameSpace"
 
     ^ (self name includes:$:) not
-!
-
-isTopLevelNameSpace
-    ^ (self name includes:$:) not
 ! !
 
 !NameSpace class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.38 2000-04-12 21:37:19 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/NameSpace.st,v 1.39 2000-07-17 17:01:35 cg Exp $'
 ! !