"
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:#VSEChunkFileSourceWriter
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Kernel-Classes-Support'
!
Object subclass:#VSESourceRewriter
instanceVariableNames:'source method methodClass'
classVariableNames:''
poolDictionaries:''
privateIn:VSEChunkFileSourceWriter
!
!VSEChunkFileSourceWriter 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]
"
! !
!VSEChunkFileSourceWriter class methodsFor:'class access'!
vseSourceRewriter
^ VSESourceRewriter
! !
!VSEChunkFileSourceWriter class methodsFor:'utilities'!
fileOutPackage:packageID on:aStream
|classesToFileout|
aStream lineEndCRLF.
classesToFileout := Smalltalk allClassesInPackage:packageID.
classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].
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
Smalltalk allClassesDo:[:eachClass |
(classesToFileout includes:eachClass) ifFalse:[
eachClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mPckg|
mPckg := mthd package.
(mPckg = packageID and:[mPckg ~= eachClass package]) ifTrue:[
eachClass
fileOutCategory:mthd category
methodFilter:[:m | m == mthd]
on:aStream.
aStream cr.
]
]
].
].
].
! !
!VSEChunkFileSourceWriter methodsFor:'source writing'!
fileOutCategory:aCategory of:aClass except:skippedMethods only:savedMethods methodFilter:methodFilter on:aStream
"file out all methods belonging to aCategory, aString onto aStream.
If skippedMethods is nonNil, those are not saved.
If savedMethods is nonNil, only those are saved.
If both are nil, all are saved. See version-method handling in
fileOut for what this is needed."
|sortedSelectors first prevPrivacy privacy interestingMethods|
interestingMethods := OrderedCollection new.
aClass methodsDo:[:aMethod |
|wanted|
(methodsAlreadySaved includes:aMethod) ifFalse:[
(aCategory = aMethod category) ifTrue:[
(methodFilter isNil or:[methodFilter value:aMethod]) ifTrue:[
skippedMethods notNil ifTrue:[
wanted := (skippedMethods includesIdentical:aMethod) not
] ifFalse:[
wanted := savedMethods isNil or:[ savedMethods includesIdentical:aMethod ].
].
wanted ifTrue:[
aMethod selector isSymbol ifTrue:[
interestingMethods add:aMethod
] ifFalse:[
Transcript showCR:'skipping non-symbol method ', aMethod selector printString.
].
].
]
]
]
].
interestingMethods notEmpty ifTrue:[
first := true.
prevPrivacy := nil.
"/
"/ sort by selector
"/
sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
sortedSelectors sortWith:interestingMethods.
interestingMethods do:[:eachMethod |
privacy := eachMethod privacy.
first ifFalse:[
privacy ~~ prevPrivacy ifTrue:[
first := true.
aStream space.
aStream nextPutChunkSeparator.
].
aStream cr; cr
].
first ifTrue:[
aStream nextPutChunkSeparator.
aClass printClassNameOn:aStream.
privacy ~~ #public ifTrue:[
aStream nextPutAll:' privateMethods'.
] ifFalse:[
aStream nextPutAll:' publicMethods'.
].
aStream nextPutChunkSeparator; cr; cr.
first := false.
].
self fileOutMethod:eachMethod on:aStream.
methodsAlreadySaved add:eachMethod.
prevPrivacy := privacy.
].
aStream space.
aStream nextPutChunkSeparator.
aStream cr
].
aStream cr
!
fileOutDefinitionOf:aClass on:aStream
"append an expression on aStream, which defines myself."
|s owner ns superclass nm|
owner := aClass owningClass.
ns := aClass topNameSpace.
"take care of nil-superclass"
superclass := aClass superclass.
superclass isNil ifTrue:[
s := 'nil'
] ifFalse:[
s := superclass nameWithNameSpacePrefix.
].
aStream nextPutAll:s. "/ superclass
aStream space.
aClass basicFileOutInstvarTypeKeywordOn:aStream.
nm := aClass nameWithoutPrefix.
aStream nextPut:$#.
aStream nextPutAll:nm.
aStream crtab.
aStream nextPutAll:'instanceVariableNames:'''.
aClass printInstVarNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream crtab.
aStream nextPutAll:'classVariableNames:'''.
aClass printClassVarNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream crtab.
aStream nextPutAll:'poolDictionaries:'''.
aClass printSharedPoolNamesOn:aStream indent:16.
aStream nextPutAll:''''.
aStream cr.
! !
!VSEChunkFileSourceWriter::VSESourceRewriter class methodsFor:'translation'!
rewriteMethod:method
^ self new rewriteMethod:method
! !
!VSEChunkFileSourceWriter::VSESourceRewriter methodsFor:'accessing'!
method
^ method
!
method:something
method := something.
!
methodClass
^ methodClass
!
methodClass:something
methodClass := something.
!
source
^ source
!
source:something
source := something.
! !
!VSEChunkFileSourceWriter::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 position < b position].
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.
! !
!VSEChunkFileSourceWriter class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic3/VSEChunkFileSourceWriter.st,v 1.3 2015-01-27 15:17:03 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libbasic3/VSEChunkFileSourceWriter.st,v 1.3 2015-01-27 15:17:03 cg Exp $'
! !