- Support for better desktop integration - classes AbstractDesktop and friends.
- Introduced class Language (and SmalltalkLanguage as default)
"
COPYRIGHT (c) 2004 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:libbasic' }"
Object subclass:#SmalltalkChunkFileSourceWriter
instanceVariableNames:'classBeingSaved'
classVariableNames:''
poolDictionaries:''
category:'Kernel-Classes'
!
!SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2004 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.
"
! !
!SmalltalkChunkFileSourceWriter methodsFor:'source writing'!
fileOut:aClass on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
"file out my definition and all methods onto aStream.
If stampIt is true, a timeStamp comment is prepended.
If initIt is true, and the class implements a class-initialize method,
append a corresponding doIt expression for initialization.
The order by which the fileOut is done is used to put the version string at the end.
Thus, if the version string is expanded (by CVS), the characterPositions of methods should not move"
|collectionOfCategories copyrightMethod copyrightText comment versionMethod skippedMethods
nonMeta meta classesImplementingInitialize outStream|
nonMeta := aClass theNonMetaclass.
meta := nonMeta class.
nonMeta isLoaded ifFalse:[
^ ClassDescription fileOutErrorSignal
raiseRequestWith:nonMeta
errorString:' - will not fileOut unloaded class: ', nonMeta name
].
encoderOrNil isNil ifTrue:[
outStream := outStreamArg.
] ifFalse:[
outStream := EncodedStream stream:outStreamArg encoder:encoderOrNil.
outStream nextPutAll:'"{ Encoding: ' , encoderOrNil nameOfEncoding , ' }"'; cr; cr.
].
"
if there is a copyright method, add a copyright comment
at the beginning, taking the string from the copyright method.
We cannot do this unconditionally - that would lead to my copyrights
being put on your code ;-).
On the other hand: I want every file created by myself to have the
copyright string at the beginning be preserved .... even if the
code was edited in the browser and filedOut.
"
(copyrightMethod := meta compiledMethodAt:#copyright) notNil ifTrue:[
"
get the copyright method's comment-text, strip off empty and blank lines
and insert at beginning.
"
copyrightText := copyrightMethod comment.
copyrightText notEmptyOrNil ifTrue:[
copyrightText := copyrightText asCollectionOfLines asStringCollection.
copyrightText := copyrightText withoutLeadingBlankLines.
copyrightText := copyrightText withoutTrailingBlankLines.
copyrightText notEmpty ifTrue:[
copyrightText addFirst:'"'.
copyrightText addLast:'"'.
copyrightText := copyrightText asString.
outStream nextPutAllAsChunk:copyrightText.
].
].
].
stampIt ifTrue:[
"/
"/ first, a timestamp
"/
outStream nextPutAll:(Smalltalk timeStamp).
outStream nextPutChunkSeparator.
outStream cr; cr.
].
withDefinition ifTrue:[
"/
"/ then the definition(s)
"/
self fileOutAllDefinitionsOf:nonMeta on:outStream.
"/
"/ a comment - if any
"/
(comment := nonMeta comment) notNil ifTrue:[
nonMeta fileOutCommentOn:outStream.
outStream cr.
].
"/
"/ primitive definitions - if any
"/
nonMeta fileOutPrimitiveSpecsOn:outStream.
].
"/
"/ methods from all categories in metaclass (i.e. class methods)
"/ EXCEPT: the version method is placed at the very end, to
"/ avoid sourcePosition-shifts when checked out later.
"/ (RCS expands this string, so its size is not constant)
"/
collectionOfCategories := meta categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
"/
"/ documentation first (if any), but not the version method
"/
(collectionOfCategories includes:'documentation') ifTrue:[
versionMethod := meta compiledMethodAt:(nonMeta nameOfVersionMethod).
versionMethod notNil ifTrue:[
|source|
source := versionMethod source.
(source isEmptyOrNil or:[(source startsWith:nonMeta nameOfVersionMethod) not]) ifTrue:[
"something bad happend to the classes code"
Class fileOutErrorSignal
raiseRequestWith:aClass
errorString:' - bad source for version method (uncompiled class file?): ', (versionMethod displayString)
].
skippedMethods := Array with:versionMethod.
].
self fileOutCategory:'documentation' of:meta except:skippedMethods only:nil methodFilter:methodFilter on:outStream.
outStream cr.
].
"/
"/ initialization next (if any)
"/
(collectionOfCategories includes:'initialization') ifTrue:[
self fileOutCategory:'initialization' of:meta methodFilter:methodFilter on:outStream.
outStream cr.
].
"/
"/ instance creation next (if any)
"/
(collectionOfCategories includes:'instance creation') ifTrue:[
self fileOutCategory:'instance creation' of:meta methodFilter:methodFilter on:outStream.
outStream cr.
].
collectionOfCategories do:[:aCategory |
((aCategory ~= 'documentation')
and:[(aCategory ~= 'initialization')
and:[aCategory ~= 'instance creation']]) ifTrue:[
self fileOutCategory:aCategory of:meta methodFilter:methodFilter on:outStream.
outStream cr
]
]
].
"/
"/ methods from all categories
"/
collectionOfCategories := nonMeta categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory of:nonMeta methodFilter:methodFilter on:outStream.
outStream cr
]
].
"/
"/ any private classes' methods
"/
nonMeta privateClassesSorted do:[:aClass |
self fileOutAllMethodsOf:aClass on:outStream methodFilter:methodFilter
].
"/
"/ finally, the previously skipped version method
"/
versionMethod notNil ifTrue:[
self fileOutCategory:'documentation' of:meta except:nil only:skippedMethods methodFilter:methodFilter on:outStream.
].
initIt ifTrue:[
"/
"/ optionally an initialize message
"/
classesImplementingInitialize := OrderedCollection new.
(meta includesSelector:#initialize) ifTrue:[
classesImplementingInitialize add:nonMeta
].
nonMeta privateClassesSorted do:[:aPrivateClass |
(aPrivateClass theMetaclass includesSelector:#initialize) ifTrue:[
classesImplementingInitialize add:aPrivateClass
]
].
classesImplementingInitialize size ~~ 0 ifTrue:[
classesImplementingInitialize topologicalSort:[:a :b | b isSubclassOf:a].
outStream cr.
classesImplementingInitialize do:[:eachClass |
eachClass printClassNameOn:outStream. outStream nextPutAll:' initialize'.
outStream nextPutChunkSeparator.
outStream cr.
].
].
]
"Created: / 15-11-1995 / 12:53:06 / cg"
"Modified: / 01-04-1997 / 16:01:05 / stefan"
"Modified: / 04-10-2006 / 17:28:33 / cg"
!
fileOutAllDefinitionsOf:aNonMetaClass on:aStream
"append expressions on aStream, which defines myself and all of my private classes."
aNonMetaClass fileOutDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr.
"/
"/ optional classInstanceVariables
"/
aNonMetaClass class instanceVariableString isBlank ifFalse:[
aNonMetaClass fileOutClassInstVarDefinitionOn:aStream.
aStream nextPutChunkSeparator.
aStream cr; cr
].
"/ here, the full nameSpace prefixes are output,
"/ to avoid confusing stc
"/ (which otherwise could not find the correct superclass)
"/
Class fileOutNameSpaceQuerySignal answer:false do:[
Class forceNoNameSpaceQuerySignal answer:true do:[
aNonMetaClass privateClassesSorted do:[:aClass |
self fileOutAllDefinitionsOf:aClass on:aStream
]
]
].
"Created: 15.10.1996 / 11:15:19 / cg"
"Modified: 22.3.1997 / 16:11:56 / cg"
!
fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter
|collectionOfCategories|
collectionOfCategories := aClass class categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory of:aClass class methodFilter:methodFilter on:aStream.
aStream cr
]
].
collectionOfCategories := aClass categories asSortedCollection.
collectionOfCategories notNil ifTrue:[
collectionOfCategories do:[:aCategory |
self fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream.
aStream cr
]
].
aClass privateClassesSorted do:[:aClass |
self fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter
].
"Created: 15.10.1996 / 11:13:00 / cg"
"Modified: 22.3.1997 / 16:12:17 / cg"
!
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."
|source sortedSelectors first privacy interestingMethods cat|
interestingMethods := OrderedCollection new.
aClass methodsDo:[:aMethod |
| method found wanted |
"Support for method overrides"
method := aMethod.
found := false.
"/((aCategory = 'loading') and:[(aMethod selector == #loadAsAutoloaded:)]) ifTrue:[self halt].
[ method notNil and: [ found not ] ] whileTrue:
[(methodFilter isNil or:[methodFilter value:method])
ifTrue: [found := true]
ifFalse:[method := method overriddenMethod]].
method yourself.
method notNil ifTrue:[
(aCategory = method category) ifTrue:[
skippedMethods notNil ifTrue:[
wanted := (skippedMethods includesIdentical:method) not
] ifFalse:[
savedMethods notNil ifTrue:[
wanted := (savedMethods includesIdentical:method).
] ifFalse:[
wanted := true
]
].
wanted ifTrue:[
method selector isSymbol ifTrue:[
interestingMethods add:method
] ifFalse:[
Transcript showCR:'skipping non-symbol method ',method selector.
].
].
]
]
].
interestingMethods notEmpty ifTrue:[
first := true.
privacy := nil.
"/
"/ sort by selector
"/
sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
sortedSelectors sortWith:interestingMethods.
interestingMethods do:[:aMethod |
first ifFalse:[
privacy ~~ aMethod privacy ifTrue:[
first := true.
aStream space.
aStream nextPutChunkSeparator.
].
aStream cr; cr
].
privacy := aMethod privacy.
first ifTrue:[
aStream nextPutChunkSeparator.
aClass printClassNameOn:aStream.
privacy ~~ #public ifTrue:[
aStream space; nextPutAll:privacy; nextPutAll:'MethodsFor:'.
] ifFalse:[
aStream nextPutAll:' methodsFor:'.
].
cat := aCategory.
cat isNil ifTrue:[ cat := '' ].
aStream nextPutAll:aCategory asString storeString.
aStream nextPutChunkSeparator; cr; cr.
first := false.
].
source := aMethod source.
source isNil ifTrue:[
Class fileOutErrorSignal
raiseRequestWith:aClass
errorString:' - no source for method: ', (aMethod displayString)
] ifFalse:[
aStream nextChunkPut:source.
].
].
aStream space.
aStream nextPutChunkSeparator.
aStream cr
]
"Modified: / 28-08-1995 / 14:30:41 / claus"
"Modified: / 15-11-1996 / 11:32:21 / cg"
"Created: / 01-04-1997 / 16:04:33 / stefan"
"Modified: / 12-08-2009 / 12:30:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream
"file out all methods belonging to aCategory, aString onto aStream"
self fileOutCategory:aCategory of:aClass except:nil only:nil methodFilter:methodFilter on:aStream
"Created: 1.4.1997 / 16:04:44 / stefan"
! !
!SmalltalkChunkFileSourceWriter class methodsFor:'documentation'!
version
^ '$Id: SmalltalkChunkFileSourceWriter.st 10461 2009-08-12 13:49:00Z vranyj1 $'
! !