--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/VSEFileSourceWriter.st Tue Jan 27 21:28:12 2015 +0100
@@ -0,0 +1,282 @@
+"
+ COPYRIGHT (c) 2015 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic3' }"
+
+"{ NameSpace: Smalltalk }"
+
+SmalltalkChunkFileSourceWriter subclass:#VSEFileSourceWriter
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes-Support'
+!
+
+Object subclass:#VSESourceRewriter
+ instanceVariableNames:'source method methodClass'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:VSEFileSourceWriter
+!
+
+!VSEFileSourceWriter class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2015 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ fileout in a format which can be read by visualAge.
+ For transporting software.
+"
+!
+
+examples
+"
+ [exBegin]
+ |s|
+
+ s := 'test.st' asFilename writeStream.
+ [
+ VSEChunkFileSourceWriter new
+ fileOut:OrderedCollection on:s
+ ] ensure:[
+ s close
+ ]
+ [exEnd]
+
+ [exBegin]
+ |s|
+
+ s := '' writeStream.
+ [
+ VSEChunkFileSourceWriter new
+ fileOut:OrderedCollection on:s
+ ] ensure:[
+ s close
+ ].
+ s contents
+ [exEnd]
+"
+! !
+
+!VSEFileSourceWriter class methodsFor:'class access'!
+
+vseSourceRewriter
+ ^ VSESourceRewriter
+! !
+
+!VSEFileSourceWriter class methodsFor:'utilities'!
+
+ensureNoUnicodeInClass:aClass
+ "/ check if we need UTF8 encoding
+ aClass withAllPrivateClasses do:[:cls |
+ cls instAndClassMethods contains:[:m |
+ self ensureNoUnicodeInMethod:m
+ ]
+ ].
+!
+
+ensureNoUnicodeInMethod:aMethod
+ |src|
+
+ src := aMethod source.
+ src isNil ifTrue:[
+ self error:'missing source in ',aMethod whoString
+ ].
+ src isWideString ifTrue:[
+ self error:(aMethod whoString , ' contains unicode strings or character contants. Cannot be exported to VSE')
+ ].
+!
+
+extensionMethodsFor:packageID
+ |methodsToFileOut|
+
+ methodsToFileOut := OrderedCollection new.
+ Smalltalk allClassesDo:[:eachClass |
+ eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ |mPckg|
+
+ mPckg := mthd package.
+ (mPckg = packageID and:[mPckg ~= eachClass package]) ifTrue:[
+ methodsToFileOut add:mthd.
+ ]
+ ]
+ ].
+ ^ methodsToFileOut
+!
+
+fileOutPackage:packageID on:aStream
+ |classesToFileout methodsToFileOut|
+
+ aStream lineEndCRLF.
+
+ classesToFileout := Smalltalk allClassesInPackage:packageID.
+ classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
+
+ methodsToFileOut := self extensionMethodsFor:packageID.
+
+ classesToFileout do:[:eachClass |
+ self ensureNoUnicodeInClass:eachClass
+ ].
+ methodsToFileOut do:[:eachClass |
+ self ensureNoUnicodeInMethod:eachClass
+ ].
+
+ AbstractSourceFileWriter methodSourceRewriteQuery handle:[:rewriteQuery |
+ |method source|
+
+ method := rewriteQuery method.
+ source := rewriteQuery source.
+ source := VSEChunkFileSourceWriter vseSourceRewriter rewriteMethod:method.
+ rewriteQuery proceedWith:source.
+ ] do:[
+ classesToFileout do:[:eachClass |
+ eachClass fileOutOn:aStream.
+ ].
+
+ "/ fileout extensions
+ methodsToFileOut do:[:eachExtension |
+ eachExtension mclass
+ fileOutCategory:eachExtension category
+ methodFilter:[:m | m == eachExtension]
+ on:aStream.
+ aStream cr.
+ ].
+ ].
+! !
+
+!VSEFileSourceWriter::VSESourceRewriter class methodsFor:'translation'!
+
+rewriteMethod:method
+ ^ self new rewriteMethod:method
+! !
+
+!VSEFileSourceWriter::VSESourceRewriter methodsFor:'accessing'!
+
+method
+ ^ method
+!
+
+method:something
+ method := something.
+!
+
+methodClass
+ ^ methodClass
+!
+
+methodClass:something
+ methodClass := something.
+!
+
+source
+ ^ source
+!
+
+source:something
+ source := something.
+! !
+
+!VSEFileSourceWriter::VSESourceRewriter methodsFor:'translation'!
+
+doRewrite
+ self rewriteEOLComments.
+ self rewriteGlobalsWithNamespace.
+ ^ source.
+!
+
+rewriteEOLComments
+ |tree parser eolComments|
+
+ parser := Parser new.
+ parser saveComments:true.
+ parser parseMethod:source in:methodClass ignoreErrors:true ignoreWarnings:true.
+
+ tree := parser tree.
+ eolComments := parser comments select:[:each | each isEndOfLineComment].
+ "/ start with the last (so I don't have to update the positions)
+ eolComments sort:[:a :b | a startPosition < b startPosition].
+ eolComments reverseDo:[:each |
+ source := (source copyTo:(each endPosition)),'"',(source copyFrom:(each endPosition + 1))
+ ].
+!
+
+rewriteGlobalsWithNamespace
+ |tree parser namesToRewrite|
+
+ namesToRewrite := OrderedCollection new.
+
+ parser := Parser new.
+ parser saveComments:true.
+ parser parseMethod:source in:methodClass ignoreErrors:true ignoreWarnings:true.
+ parser tree isNil ifTrue:[ ^ self ].
+
+ parser tree variableNodesDo:[:each |
+ |nameInSource|
+
+ each isGlobalVariable ifTrue:[
+ (each name includes:$:) ifTrue:[
+ nameInSource := source copyFrom:each startPosition to:each endPosition.
+ (nameInSource includes:$:) ifTrue:[
+ namesToRewrite add:each.
+ ].
+ ].
+ ].
+ ].
+
+ "/ start with the last (so I don't have to update the positions)
+ namesToRewrite sort:[:a :b | a position < b position].
+ namesToRewrite reverseDo:[:each |
+ |idx nameInSource ns nm|
+
+ nameInSource := source copyFrom:each startPosition to:each endPosition.
+ idx := nameInSource indexOf:$:.
+ ns := nameInSource copyTo:idx-1.
+ idx := nameInSource indexOf:$: startingAt:idx+1.
+ nm := nameInSource copyFrom:idx+1.
+ (ns = methodClass nameSpace name) ifFalse:[
+ Transcript show:'reference to other namespace'.
+ ] ifTrue:[
+ source := (source copyTo:(each startPosition-1)),nm,(source copyFrom:(each endPosition + 1))
+ ].
+ ].
+!
+
+rewriteMethod:methodArg
+ method := methodArg.
+ source := method source.
+ methodClass := method mclass.
+
+ ^ self doRewrite.
+! !
+
+!VSEFileSourceWriter class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/VSEFileSourceWriter.st,v 1.1 2015-01-27 20:28:12 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libbasic3/VSEFileSourceWriter.st,v 1.1 2015-01-27 20:28:12 cg Exp $'
+! !
+