[Help-smalltalk] [PATCH] extract file-out code into a separate class

[Paolo Bonzini]

This is the first patch of Daniele's conversion tool.  By extracting 
file-out into its own class, we can add a subclass of the 
FileOutExporter that uses the RBFormatter to regenerate code, and use 
that in the converter.

File-out is currently half-broken, in that it will produce new-style 
files even if the code uses methods not surrounded by brackets.  The way 
we'll probably fix this, is by using the RBFormatter by default.

This is the first big body of code written using the new syntax, BTW.

Paolo

2007-05-25  Daniele Sciascia  <address@hidden>
            Paolo Bonzini  <address@hidden>
 
        * kernel/Class.st: Require Parser to file out.
        * kernel/ClassDesc.st: Require Parser to file out.

        * compiler/Exporter.st: New.
        * compiler/STLoaderObjs.st: Eliminate file-out code.


--- orig/compiler/STLoaderObjs.st
+++ mod/compiler/STLoaderObjs.st
@@ -445,105 +445,7 @@ nameIn: aNamespace
          self printString ]
 ! !
 
-!PseudoBehavior methodsFor: 'filing'!
-
-fileOutOn: aFileStream
-    "File out complete class description:  class definition, class and
-     instance methods"
-
-    self subclassResponsibility
-!
-
-fileOut: fileName
-    "Open the given file and to file out a complete class description to it"
-
-    | aFileStream  |
-    aFileStream := FileStream open: fileName mode: FileStream write.
-
-    Transcript nextPutAll: 'Filing out class to: '; nextPutAll: fileName.
-    
-    self fileOutOn: aFileStream. 
-    aFileStream close.
-!
-
-fileOutCategory: categoryName to: fileName
-    "File out all the methods belonging to the method category, categoryName,
-     to the fileName file"
-
-    | aFileStream |
-    aFileStream := FileStream open: fileName mode: FileStream write.
-
-    Transcript nextPutAll: 'Filing out a category to: '; nextPutAll: fileName.
-
-    self fileOutCategory: categoryName toStream: aFileStream.
-    aFileStream close
-!
-       
-fileOutCategory: category toStream: aFileStream
-    "File out all the methods belonging to the method category, categoryName,
-     to aFileStream"
-
-    | methods |
-    self selectors isNil ifTrue: [ ^self ].
-
-    aFileStream
-       nextPut: $!;
-       print: self;
-       nextPutAll: ' methodsFor: ';
-       store: category;
-       nextPut: $!.
-
-    methods := self selectors select: [ :selector |
-       (self compiledMethodAt: selector) methodCategory = category
-    ].
-
-    methods asSortedCollection do: [ :selector |
-       aFileStream
-           nextPutAll: '
-
-';         nextPutAll: (self sourceCodeAt: selector);
-           nextPut: $!
-    ].
-    aFileStream nextPutAll: ' !
-
-'
-!
-
-fileOutSelector: selector to: fileName
-    "File out the given selector to fileName"
-
-    | aFileStream |
-    aFileStream := FileStream open: fileName mode: FileStream write.
-
-    Transcript nextPutAll: 'Filing out a selector to: '; nextPutAll: fileName.
-    self fileOutHeaderOn: aFileStream.
-    aFileStream nextPutAll: '!';
-       print: self;
-       nextPutAll: ' methodsFor: ';
-       store: (self compiledMethodAt: selector) methodCategory;
-       nextPut: $!;
-       nl;
-       nextPutAll: (self sourceCodeAt: selector) ;
-       nextPutAll: '! !';
-       close
-! !
-
 
-!PseudoBehavior methodsFor: 'private'!
-
-collectCategories
-    "Answer all the method categories, sorted by name"
-
-    | categories |
-    self methodDictionary isNil ifTrue: [ ^#() ].
-
-    categories := Set new.
-    self methodDictionary do:
-       [ :method | categories add: (method methodCategory) ].
-
-    ^categories asSortedCollection
-! !
-
 !PseudoBehavior methodsFor: 'abstract'!
 
 asClass
@@ -794,15 +696,6 @@ sharedPools
 
 
 
-!LoadedMetaclass methodsFor: 'filing'!
-
-fileOutOn: aFileStream
-    "File out complete class description:  class definition, class and
-     instance methods"
-
-    instanceClass fileOutOn: aFileStream
-! !
-
 !LoadedMetaclass methodsFor: 'initializing'!
 
 for: aClass
@@ -907,93 +800,7 @@ import: aNamespace
     sharedPools := sharedPools copyWith: (aNamespace nameIn: self environment)
 ! !
 
-!LoadedClass methodsFor: 'filing'!
-
-fileOutHeaderOn: aFileStream
-    "Write date and time stamp to aFileStream"
-    | now |
-    aFileStream nextPutAll: '"Filed out from ';
-       nextPutAll: Smalltalk version;
-       nextPutAll: ' on '.
-    now := Date dateAndTimeNow.
-    aFileStream print: now asDate;
-       nextPutAll:  '  ';
-       print: now asTime;
-       nextPutAll: '"!
-
-'!
-
-fileOutDeclarationOn: aFileStream
-    "File out class definition to aFileStream"
-    | aSet printFormattedSet |
-    self isMetaclass ifTrue: [ ^self].
-
-    printFormattedSet := [ 
-       aFileStream nextPut: $'. 
-       (aSet isEmpty) not ifTrue: [
-           aSet do: [ :element |
-               aFileStream nextPutAll: element; space ]. 
-           aFileStream nextPut: $'.
-       ].
-    ].
-
-    aFileStream print: self superclass; space;
-       nextPutAll: self kindOfSubclass; space;
-       store: name asSymbol.
-
-    aFileStream nl; tab; nextPutAll: 'instanceVariableNames: '.
-       ((aSet := self instVarNames ) isEmpty)
-           ifTrue:[aFileStream nextPutAll: '''''']
-           ifFalse: printFormattedSet.
-
-    aFileStream nl; tab; nextPutAll: 'classVariableNames: '.
-       (aSet := self classVarNames) isEmpty
-           ifTrue:[aFileStream nextPutAll: '''''']
-           ifFalse: printFormattedSet.
-
-    aFileStream nl; tab; nextPutAll: 'poolDictionaries: '.
-       (aSet := self sharedPools) isEmpty
-           ifTrue:[aFileStream nextPutAll: '''''']
-           ifFalse: printFormattedSet.
-
-    aFileStream nl; tab; nextPutAll: 'category: ';
-       store: category;
-       nextPut: $!;
-       nl; nl;
-       print: self;
-       nextPutAll: ' comment: ';
-       nl;
-       store: self comment;
-       nextPut: $!;
-       nl; nl.
-
-    ((aSet := self asMetaclass instVarNames) isEmpty)
-       ifTrue:[ ^self ].
-
-    aFileStream print: self asMetaclass; nextPutAll: ' instanceVariableNames: 
'.
-    printFormattedSet value.
-    aFileStream nextPut: $!; nl; nl.
-!
-
-fileOutOn: aFileStream
-    "File out complete class description:  class definition, class and
-     instance methods"
-
-    self fileOutHeaderOn: aFileStream. 
-    self fileOutDeclarationOn: aFileStream.
-
-    self asMetaclass collectCategories do:
-       [ :category | self asMetaclass fileOutCategory: category toStream: 
aFileStream ].
-
-    self collectCategories do:
-       [ :category | self fileOutCategory: category toStream: aFileStream ].
-
-    (self asMetaclass includesSelector: #initialize) ifTrue: [
-       aFileStream nl; print: self; nextPutAll: ' initialize!'.
-    ].
-    aFileStream nl
-! !
-
+
 !LoadedClass methodsFor: 'initializing'!
 
 superclass: sup name: s instanceVariableNames: ivn classVariableNames: cvn


--- orig/kernel/Class.st
+++ mod/kernel/Class.st
@@ -578,87 +578,15 @@ isClass
 !Class methodsFor: 'filing'!
 
 fileOutDeclarationOn: aFileStream
-    "File out class definition to aFileStream"
-    | aSet printFormattedSet superclassName |
-    self isMetaclass ifTrue: [ ^self].
-
-    printFormattedSet := [ 
-       aFileStream nextPutAll: ''''. 
-       (aSet isEmpty) not ifTrue: [
-           aSet do: [ :element |
-               aFileStream nextPutAll: element; space ]. 
-           aFileStream nextPutAll: ''''.
-       ].
-    ].
-
-    superclassName := self superclass isNil
-       ifTrue: [ 'nil' ]
-       ifFalse: [ self superclass nameIn: self environment ].
-
-    aFileStream
-       nextPutAll: superclassName; space;
-       nextPutAll: self kindOfSubclass; space;
-       store: name asSymbol.
-
-    aFileStream nl; tab; nextPutAll: 'instanceVariableNames: '.
-       ((aSet := self instVarNames ) isEmpty)
-           ifTrue:[aFileStream nextPutAll: '''''']
-           ifFalse: printFormattedSet.
-
-    aFileStream nl; tab; nextPutAll: 'classVariableNames: '.
-       (aSet := self classVarNames) isEmpty
-           ifTrue:[aFileStream nextPutAll: '''''']
-           ifFalse: printFormattedSet.
-
-    aFileStream nl; tab; nextPutAll: 'poolDictionaries: '.
-       (aSet := self sharedPools) isEmpty
-           ifTrue:[aFileStream nextPutAll: '''''']
-           ifFalse: printFormattedSet.
-
-    aFileStream nl; tab; nextPutAll: 'category: ';
-       store: category;
-       nextPut: $!;
-       nl; nl;
-       print: self;
-       nextPutAll: ' comment: ';
-       nl;
-       store: self comment;
-       nextPut: $!;
-       nl; nl.
-
-    ((aSet := self class instVarNames) isEmpty)
-       ifTrue:[ ^self ].
-
-    aFileStream print: self class; nextPutAll: ' instanceVariableNames: '.
-    printFormattedSet value.
-    aFileStream nextPut: $!; nl; nl.
+    "File out class definition to aFileStream.  Requires package Parser."
+    self notYetImplemented
 !
 
 fileOutOn: aFileStream
     "File out complete class description:  class definition, class and
-     instance methods"
+     instance methods.  Requires package Parser."
 
-    self fileOutHeaderOn: aFileStream. 
-    self fileOutDeclarationOn: aFileStream.
-    self fileOutMethodsOn: aFileStream.
-    self fileOutInitializeOn: aFileStream!
-
-fileOutInitializeOn: aFileStream
-    (self class includesSelector: #initialize) ifTrue: [
-       aFileStream nl; print: self; nextPutAll: ' initialize!'.
-    ]!
-
-fileOutMethodsOn: aFileStream
-    "File out instance methods of the receiver."
-
-    self class collectCategories do:
-       [ :category | self class fileOutCategory: category toStream: 
aFileStream ].
-
-    self collectCategories do:
-       [ :category | self fileOutCategory: category toStream: aFileStream ].
-
-    aFileStream nl
-! !
+    self notYetImplemented! !
 
 
 !Class methodsFor: 'saving and loading'!


--- orig/kernel/ClassDesc.st
+++ mod/kernel/ClassDesc.st
@@ -271,13 +271,14 @@ sharedVariableString
 
 fileOutOn: aFileStream
     "File out complete class description:  class definition, class and
-     instance methods"
+     instance methods.  Requires package Parser."
 
     self subclassResponsibility
 !
 
 fileOut: fileName
-    "Open the given file and to file out a complete class description to it"
+    "Open the given file and to file out a complete class description to it.
+     Requires package Parser."
 
     | aFileStream  |
     aFileStream := FileStream open: fileName mode: FileStream write.
@@ -290,83 +291,33 @@ fileOut: fileName
 
 fileOutCategory: categoryName to: fileName
     "File out all the methods belonging to the method category, categoryName,
-     to the fileName file"
+     to the fileName file.  Requires package Parser."
 
     | aFileStream |
     aFileStream := FileStream open: fileName mode: FileStream write.
-
     Transcript nextPutAll: 'Filing out a category to: '; nextPutAll: fileName.
-
     self fileOutCategory: categoryName toStream: aFileStream.
     aFileStream close
 !
-       
-fileOutCategory: category toStream: aFileStream
-    "File out all the methods belonging to the method category, categoryName,
-     to aFileStream"
-
-    | methods |
-    self selectors isNil ifTrue: [ ^self ].
-
-    methods := self selectors select: [ :selector |
-       (self compiledMethodAt: selector) methodCategory = category
-    ].
-
-    methods isEmpty ifTrue: [ ^self ].
-
-    aFileStream
-       nextPut: $!;
-       print: self;
-       nextPutAll: ' methodsFor: ';
-       store: category;
-       nextPut: $!.
-
-    methods asSortedCollection do: [ :selector |
-       aFileStream
-           nextPutAll: '
-
-';
-           "nextPutAll: (STInST.RBFormatter new
-               format: (STInST.RBParser parseMethod: (self sourceCodeAt: 
selector)));"
-           nextPutAll: (self sourceCodeAt: selector);
-           nextPut: $!
-    ].
-    aFileStream nextPutAll: ' !
-
-'
-!
-
-fileOutHeaderOn: aFileStream
-    "Write date and time stamp to aFileStream"
-    | now |
-    aFileStream nextPutAll: '"Filed out from ';
-       nextPutAll: Smalltalk version;
-       nextPutAll: ' on '.
-    now := Date dateAndTimeNow.
-    aFileStream print: now asDate;
-       nextPutAll:  '  ';
-       print: now asTime;
-       nextPutAll: '"!
-
-'!
 
+fileOutCategory: categoryName toStream: aFileStream
+    "File out the given selector to a FileStream.  Requires package Parser."
+    self notYetImplemented
+!
+       
 fileOutSelector: selector to: fileName
-    "File out the given selector to fileName"
+    "File out the given selector to fileName.  Requires package Parser."
 
     | aFileStream |
     aFileStream := FileStream open: fileName mode: FileStream write.
-
     Transcript nextPutAll: 'Filing out a selector to: '; nextPutAll: fileName.
-    self fileOutHeaderOn: aFileStream.
-    aFileStream nextPutAll: '!';
-       print: self;
-       nextPutAll: ' methodsFor: ';
-       store: (self compiledMethodAt: selector) methodCategory;
-       nextPut: $!;
-       nl;
-       nextPutAll: (self sourceCodeAt: selector) ;
-       nextPutAll: '! !';
-       close
+    self fileOutSelector: selector toStream: aFileStream.
+    aFileStream close
+!
+
+fileOutSelector: selector toStream: aFileStream
+    "File out the given selector to a FileStream.  Requires package Parser."
+    self notYetImplemented
 ! !
 
 


--- orig/packages.xml.in
+++ mod/packages.xml.in
@@ -395,6 +395,7 @@
   <filein>STDecompiler.st</filein>
   <filein>STLoaderObjs.st</filein>
   <filein>STLoader.st</filein>
+  <filein>Exporter.st</filein>
 
   <filein>RewriteTests.st</filein>
 
@@ -413,6 +414,7 @@
   <file>STLoaderObjs.st</file>
   <file>STSymTable.st</file>
   <file>RewriteTests.st</file>
+  <file>Exporter.st</file>
 </package>
 
 <package>



* added files

--- /dev/null
+++ 
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./compiler/.arch-ids/Exporter.st.id
@@ -0,0 +1 @@
+Paolo Bonzini <address@hidden> Fri May 25 15:06:54 2007 25196.0

--- /dev/null
+++ 
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./compiler/Exporter.st
@@ -0,0 +1,344 @@
+"======================================================================
+|
+|   Class fileout support
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Daniele Sciascia.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+| 
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+| 
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+Object subclass: FileOutExporter [
+    | outClass outStream completeFileOut defaultNamespace |
+    
+    <comment: 'This class is responsible for filing out 
+               a given class on a given stream'>
+    
+    FileOutExporter class >> on: aClass to: aStream [    
+        ^super new initializeWith: aClass and: aStream.
+    ]
+
+    FileOutExporter class >> fileOut: aClass to: aStream [    
+        (self on: aClass to: aStream) fileOut
+    ]
+
+    FileOutExporter class >> fileOut: aClass toFile: aString [    
+        | aStream |
+        aStream := FileStream open: aString mode: FileStream write.
+        [ (self on: aClass to: aStream) fileOut ]
+            ensure: [ aStream close ]
+    ]
+    
+    FileOutExporter class >> fileOutCategory: aString of: aClass to: aStream [
+       | methods exporter |
+        methods := aClass selectors select: [ :selector |
+            (aClass compiledMethodAt: selector) methodCategory = aString ].
+        exporter := self on: aClass asClass to: aStream.
+        exporter completeFileOut: false.
+       aClass isClass
+           ifTrue: [ exporter fileOutSelectors: methods classSelectors: #() ]
+           ifFalse: [ exporter fileOutSelectors: #() classSelectors: methods ]
+    ]
+    
+    FileOutExporter class >> fileOutSelector: aSymbol of: aClass to: aStream [
+       | exporter |
+        exporter := self on: aClass asClass to: aStream.
+        exporter completeFileOut: false.
+       aClass isClass
+           ifTrue: [ exporter fileOutSelectors: {aSymbol} classSelectors: #() ]
+           ifFalse: [ exporter fileOutSelectors: #() classSelectors: {aSymbol} 
]
+    ]
+    
+    initializeWith: aClass and: aStream [
+        outClass := aClass.
+        outStream := aStream.
+           completeFileOut := true.
+    ]
+
+    completeFileOut [
+        ^completeFileOut
+    ]
+
+    completeFileOut: aBoolean [
+        completeFileOut := aBoolean.
+    ]
+
+    defaultNamespace [
+           defaultNamespace isNil 
+               ifTrue: [ defaultNamespace := Namespace current ].
+        ^defaultNamespace
+    ]
+
+    defaultNamespace: aNamespace [
+        defaultNamespace := aNamespace.
+    ]
+
+    fileOut [                   
+        self fileOutHeader.
+        self fileOutDeclaration: [ self fileOutMethods ].
+        completeFileOut
+               ifFalse: [ self fileOutInitialize ]
+    ]
+      
+    fileOutSelectors: selectors classSelectors: classSelectors [
+        self fileOutHeader.
+        self fileOutDeclaration: [
+            
+            outStream space: 4.
+            
+            classSelectors do: [ :each | self fileOutSource: each class: true ]
+                           separatedBy: [ outStream nl; nl; space: 4 ].
+             
+            (classSelectors isEmpty)
+                ifFalse: [ outStream nl; nl; space: 4 ].
+            
+            selectors do: [ :each | self fileOutSource: each class: false ]
+                      separatedBy: [ outStream nl; nl; space: 4 ]
+        ]
+    ]
+
+    fileOutHeader [
+        | now |
+        outStream 
+            nextPutAll: '"Filed out from ';
+            nextPutAll: Smalltalk version;
+            nextPutAll: ' on '.
+            
+        now := Date dateAndTimeNow.
+        
+        outStream
+            print: now asDate;
+            space;
+            print: now asTime;
+            nextPutAll: '"';
+            nl; nl
+    ]
+    
+    printFormattedSet: aSet [
+        aSet isNil ifTrue: [ ^self ].
+        aSet do: [ :element | outStream nextPutAll: element ]
+            separatedBy: [ outStream space ]
+    ]
+    
+    fileOutDeclaration: aBlock [
+        outClass environment = self defaultNamespace
+               ifTrue: [ ^self fileOutClassBody: aBlock ].
+        
+        outStream nextPut: 12 asCharacter; nl;
+                  nextPutAll: 'Namespace current: ';
+                  store: outClass environment;
+                  nextPutAll: ' ['; nl; nl.
+                  
+           self fileOutClassBody: aBlock.
+
+        outStream nextPut: $]; nl.
+    ]
+    
+    fileOutClassBody: aBlock [
+           completeFileOut
+               ifTrue: [ self fileOutClassDeclaration: aBlock ]
+               ifFalse: [ self fileOutClassExtension: aBlock ].
+    ]
+    
+    fileOutClassExtension: aBlock [
+        outStream nextPutAll: (outClass asClass name).
+        
+        (outClass isMetaclass)
+            ifTrue:  [ outStream nextPutAll: ' class extend ['; nl ]
+            ifFalse: [ outStream nextPutAll: ' extend ['; nl ].
+            
+        aBlock value.
+        
+        outStream nl; nextPut: $]; nl; nl.
+    ]
+
+    fileOutClassDeclaration: aBlock [
+        | aSet superclassName |
+        
+        outClass isMetaclass ifTrue: [ ^outClass ].
+        
+        superclassName := outClass superclass isNil
+            ifTrue: [ 'nil' ]
+            ifFalse: [ outClass superclass nameIn: self defaultNamespace ].
+        
+        outStream
+            nextPutAll: superclassName; space;
+               nextPutAll: 'subclass: ';
+            nextPutAll: outClass name; space;
+            nextPut: $[; nl; space: 4. 
+        
+        "instance variables"
+        (outClass instVarNames isEmpty) ifFalse: [
+            outStream nextPut: $|; space.
+            self printFormattedSet: outClass instVarNames.
+            outStream space; nextPut: $|; nl; space: 4
+        ].
+            
+           "shape"
+           (outClass shape notNil)
+               ifTrue: [ (outClass superclass isNil not)
+                   ifTrue: [ outStream nl; space: 4;
+                                 nextPutAll: '<shape: ';
+                                         store: outClass shape;
+                                         nextPut: $> ] ].
+                                         
+               "sharedPools"
+        (aSet := outClass sharedPools) do: [ :element | 
+            outStream nl; space: 4; nextPutAll: '<import: '.
+            outStream nextPutAll: element.
+            outStream nextPutAll: '>' ].
+
+           "category and comment"      
+        outStream nl; space: 4;
+                 nextPutAll: '<category: ';
+                 print: outClass category;
+                 nextPut: $>;
+                 nl; space: 4;
+                 nextPutAll: '<comment: ';
+                 print: outClass comment;
+                 nextPut: $>;
+                  nl.
+           
+        "class instance varriables"            
+        outClass asMetaclass instVarNames isEmpty
+            ifFalse: [ outStream nl; space: 4; nextPutAll: outClass name;
+                       nextPutAll: ' class ['; nl; space: 4.
+                       outStream nextPut: $|; space.
+                       self printFormattedSet: outClass asMetaclass 
instVarNames.
+                       outStream space; nextPut: $|; nl; space: 4.
+                       outStream nl; space: 4; nextPut: $]; nl ].
+         
+        "class variables"
+        ((aSet := outClass classVarNames) isEmpty)
+            ifFalse: [
+                outStream nl.
+                aSet do: [ :var | outStream space: 4; nextPutAll: var; 
nextPutAll: ' := nil.'; nl ] ].
+
+        aBlock value.
+                       
+        outStream nextPut: $]; nl; nl.
+    ]
+
+    fileOutMethods [            
+        outClass asMetaclass collectCategories do:
+            [ :category | self fileOutCategory: category class: true ].
+                
+        outClass asMetaclass selectors isEmpty ifFalse: [ outStream nl ].
+        
+        outClass collectCategories do: 
+            [ :category | self fileOutCategory: category class: false ]
+    ]
+    
+    fileOutCategory: category class: isClass [
+        | methods theClass |
+
+       theClass := isClass
+           ifTrue: [ outClass asMetaclass ]
+           ifFalse: [ outClass ].
+        
+        methods := theClass selectors select: 
+                    [ :selector | (theClass compiledMethodAt: selector) 
+                                    methodCategory = category ].
+        
+        methods asSortedCollection
+           do: [ :selector | self fileOutSource: selector class: isClass ]
+    ]
+    
+    fileOutSource: selector class: isClass [
+        | class |
+        
+        outStream nl; nextPutAll: '    '.
+        class := isClass 
+                    ifTrue: [ outStream nextPutAll: outClass name; nextPutAll: 
' class >> '.
+                              outClass asMetaclass ]
+                    ifFalse: [ outClass ].
+        outStream nextPutAll: (class sourceCodeAt: selector) trimSeparators; 
nl.
+    ]
+
+    fileOutInitialize [
+        (outClass includesSelector: #initialize)
+            ifTrue: [ outStream nl; 
+                        nextPutAll: 'Eval [ ';
+                        print: outClass; 
+                        nextPutAll: ' initialize ]'; nl. ]
+    ]
+]
+
+FileOutExporter subclass: FormattingExporter [
+    
+    <comment: 'This class in addition to FileOutExporter, uses an RBFormatter
+               to pretty print the body of every method.'>
+               
+    fileOutHeader [ ]
+    fileOutInitialize [ ]
+
+    fileOutSource: selector class: isClass [
+        | class source |
+        outStream nl; nextPutAll: '    '.
+        class := isClass 
+                    ifTrue: [
+                       outStream
+                           nextPutAll: outClass name;
+                           nextPutAll: ' class >> '.
+                        outClass asMetaclass ]
+                    ifFalse: [ outClass ].
+                    
+       source := STInST.RBFormatter new
+                     initialIndent: 1;
+                      format: (STInST.RBParser 
+                                  parseMethod: (class sourceCodeAt: selector)
+                                  category: (class compiledMethodAt: selector)
+                                               methodCategory).
+        outStream nextPutAll: source; nl.
+    ]
+]
+
+Class extend [
+    fileOutDeclarationOn: aFileStream [
+        (STInST.FileOutExporter on: self to: aFileStream)
+            fileOutDeclaration: [ ]
+    ]
+
+    fileOutOn: aFileStream [
+        STInST.FileOutExporter fileOut: self to: aFileStream
+    ]
+]
+
+ClassDescription extend [
+    fileOutSelector: aSymbol toStream: aFileStream [
+        "File out all the methods belonging to the method category,
+        category, to aFileStream.  Requires package Parser."
+       
+        STInST.FileOutExporter fileOutSelector: aSymbol of: self to: 
aFileStream
+    ]
+
+    fileOutCategory: category toStream: aFileStream [
+        "File out all the methods belonging to the method category,
+        category, to aFileStream.  Requires package Parser."
+       
+        STInST.FileOutExporter fileOutCategory: category of: self to: 
aFileStream
+    ]
+]