class: VSEFileSourceWriter
added:
#fileOutPackage:on:
#rewrittenClassNameOf:
"
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:'api'!
fileOutPackage:currentProject on:aStream
self new fileOutPackage:currentProject on:aStream
! !
!VSEFileSourceWriter class methodsFor:'class access'!
vseSourceRewriter
^ VSESourceRewriter
! !
!VSEFileSourceWriter methodsFor:'source writing'!
rewrittenClassNameOf:aClass
|nm idx|
nm := aClass name.
((nm includesString:'::') or:[aClass nameSpace notNil]) ifTrue:[
idx := nm indexOfSubCollection:'::'.
^ (nm copyTo:idx-1) , VSESourceRewriter nameSpaceSeparatorReplacement , (nm copyFrom:idx+2)
].
^ nm
! !
!VSEFileSourceWriter 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
! !
!VSEFileSourceWriter::VSESourceRewriter class methodsFor:'defaults'!
nameSpaceSeparatorReplacement
^ '__'
! !
!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.
self rewriteClassReferences.
self rewriteExceptionHandlers.
^ source.
!
rewriteClassReferences
|parser globalsToRename symbolsToRename replacer newSource tree|
"/ all references to namespace variables
parser := Parser
parseMethod:source
in:methodClass
ignoreErrors:false
ignoreWarnings:false.
globalsToRename := Dictionary new.
symbolsToRename := Dictionary new.
parser usedGlobals do:[:eachGlobal |
|idx nsName clsName|
(eachGlobal includes:$:) ifTrue:[
idx := eachGlobal indexOfSubCollection:'::'.
nsName := eachGlobal copyTo:idx-1.
clsName := eachGlobal copyFrom:idx+2.
globalsToRename at:eachGlobal put:(nsName,(self class nameSpaceSeparatorReplacement),clsName).
nsName = methodClass nameSpace name ifTrue:[
globalsToRename at:clsName put:(nsName,(self class nameSpaceSeparatorReplacement),clsName).
]
].
].
parser usedSymbols do:[:eachSymbol |
|idx nsName clsName|
(eachSymbol includesString:'::') ifTrue:[
idx := eachSymbol indexOfSubCollection:'::'.
nsName := eachSymbol copyTo:idx-1.
clsName := eachSymbol copyFrom:idx+2.
(nsName notEmpty
and:[ clsName notEmpty
and:[ nsName knownAsSymbol
and:[ (Smalltalk classNamed:nsName) isNameSpace ]]])
ifTrue:[
symbolsToRename at:eachSymbol put:(nsName,(self class nameSpaceSeparatorReplacement),clsName) asSymbol.
].
] ifFalse:[
(methodClass nameSpace includesKey:eachSymbol asSymbol) ifTrue:[
symbolsToRename at:eachSymbol put:(methodClass nameSpace name,(self class nameSpaceSeparatorReplacement),eachSymbol) asSymbol.
]
]
].
(globalsToRename isEmpty and:[symbolsToRename isEmpty]) ifTrue:[^ self ].
replacer := ParseTreeSourceRewriter new.
replacer alwaysPerformAllSearches:true.
globalsToRename keysAndValuesDo:[:oldName :newName |
replacer replaceVariable: oldName with: newName.
].
symbolsToRename keysAndValuesDo:[:oldName :newName |
replacer replaceLiteral: oldName with: newName.
].
tree := RBParser
parseMethod:source
onError:[:aString :pos | self halt. ^self].
replacer executeTree: tree.
newSource := replacer executeReplacementsInSource:source.
"/ self halt.
"/ to verify, check parsability
RBParser
parseMethod:newSource
onError:[:aString :pos | self halt.].
source := newSource.
!
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))
].
"/ to verify, check parsability
RBParser
parseMethod:source
onError:[:aString :pos | self halt.].
!
rewriteExceptionHandlers
|parser replacer newSource tree|
"/ all references to namespace variables
parser := Parser
parseMethod:source
in:methodClass
ignoreErrors:false
ignoreWarnings:false.
(parser messagesSent includesAny: #( 'answer:do:' 'ignoreIn:' )) ifTrue:[
self halt
].
replacer := ParseTreeSourceRewriter new.
replacer alwaysPerformAllSearches:true.
replacer
replace: '[| `@temps | ``@.Statements. ] valueNowOrOnUnwindDo: ``@block'
"->"
with: '[| `@temps | ``@.Statements. ] ensure: ``@block';
replace: '[| `@temps | ``@.Statements. ] valueOnUnwindDo: ``@block'
"->"
with: '[| `@temps | ``@.Statements. ] ifCurtailed: ``@block';
replace:'``@err handle:``@handler do: ``@expr'
"->"
with: '``@expr on: ``@err do: ``@handler'.
tree := RBParser
parseMethod:source
onError:[:aString :pos | self halt. ^ self].
(replacer executeTree: tree) ifTrue:[
newSource := replacer executeReplacementsInSource:source.
"/ self halt.
source := newSource.
].
"/ to verify, check parsability
RBParser
parseMethod:source
onError:[:aString :pos | self halt.].
!
rewriteGlobalsWithNamespace
"obsolete old version - now done in rewriteClassReferences"
|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))
].
].
"/ to verify, check parsability
RBParser
parseMethod:source
onError:[:aString :pos | self halt.].
!
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.4 2015-01-28 17:01:15 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libbasic3/VSEFileSourceWriter.st,v 1.4 2015-01-28 17:01:15 cg Exp $'
! !