- ChangeSet>>#fromFile: sets the name of the CS to tje filename.
- ChangeSetDiffEntry: added #versionBaseText
"
COPYRIGHT (c) 1993 by Claus Gittinger
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' }"
OrderedCollection subclass:#ChangeSet
instanceVariableNames:'changedClasses changeSelectors name'
classVariableNames:''
poolDictionaries:''
category:'System-Changes'
!
Object subclass:#ChangeFileReader
instanceVariableNames:'inputStream parseTree changeAction changeSet selector receiver
arguments receiverSelector receiverReceiver lineNumber position
className methodSelector chunk'
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
Error subclass:#ChangeProcessingError
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
SmalltalkChunkFileSourceWriter subclass:#ClassSourceWriter
instanceVariableNames:'changeSetBeingSaved infos topClassName classInfos metaInfos'
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
Object subclass:#ClassInfo
instanceVariableNames:'name superclass definition methods'
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet::ClassSourceWriter
!
Object subclass:#DiffSet
instanceVariableNames:'changed onlyInReceiver onlyInArg'
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
ChangeSet::ChangeFileReader subclass:#DolphinPACFileReader
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
ChangeSet::ChangeProcessingError subclass:#InvalidChangeChunkError
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
ChangeSet::ChangeFileReader subclass:#SIFChangeFileReader
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
!
!ChangeSet class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1993 by Claus Gittinger
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
"
used in the changes management to keep track of changes
[author:]
Claus Gittinger
"
! !
!ChangeSet class methodsFor:'instance creation'!
forExistingClass:aClass
"build a changeSet for some given class, all of its private classes
and all extensions if any.
I.e. a changeSet which represents the existing class in the image.
That does of course not give deltas, but instead reflects the current
state of the given class.
It is useful in conjunction with the other utility methods,
for example, when building patchLists, diffSets, comparing etc."
|changeSet s changeObject|
"/ kludge: could do this much faster...
s := ReadWriteStream on:''.
aClass fileOutOn:s.
s reset.
changeSet := self fromStream:s.
"/ fetch the real package info...
changeSet do:[:eachChange |
eachChange isMethodChange ifTrue:[
changeObject := eachChange changeMethod.
changeObject notNil ifTrue:[
eachChange package:changeObject package
].
] ifFalse:[
eachChange isClassChange ifTrue:[
changeObject := eachChange changeClass.
changeObject notNil ifTrue:[
eachChange package:changeObject package
].
].
].
].
^ changeSet
"/ |source changeSet chunk sawExcla lastTimeStamp s change nameSpace|
"/ changeSet := self new.
"/
"/ "/ first, a classDefinition change ...
"/ changeSet addClassDefinitionChangeFor:aClass.
"/ "/ are there any class-instVars ?
"/ aClass class instVarNames size > 0 ifTrue:[
"/ changeSet addInstVarDefinitionChangeFor:aClass class.
"/ ].
"/ "/ a comment ?
"/ aClass comment size > 0 ifTrue:[
"/ changeSet addClassCommentChangeFor:aClass.
"/ ].
"/
"/ "/ class methods first ...
"/ aClass class methodDictionary keysAndValuesDo:[:sel :mthd |
"/ changeSet addMethodChange:mthd in:aClass class.
"/ ].
"/
"/ "/ instance methods ...
"/ aClass methodDictionary keysAndValuesDo:[:sel :mthd |
"/ changeSet addMethodChange:mthd in:aClass.
"/ ].
"/
"/ ^ changeSet
"
ChangeSet forExistingClass:ChangeSet
ChangeSet forExistingClass:A
Rectangle hasExtensions
ChangeSet forExistingClass:Rectangle
"
"Created: / 16-02-1998 / 12:19:34 / cg"
"Modified: / 12-10-2006 / 23:45:14 / cg"
"Modified (format): / 01-12-2011 / 19:10:22 / cg"
!
forExistingClass:aClass withExtensions:withExtensions extensionsOnly:extensionsOnly
"build a changeSet for some given full class, the base-class or the extensions only,
as specified by the with-arguments.
That does of course not give deltas, but instead reflects the current
state of the given class.
It is useful in conjunction with the other utility methods,
for example, when building patchLists, diffSets etc."
|changeSet classPackage|
changeSet := self forExistingClass:aClass.
classPackage := aClass package.
extensionsOnly ifTrue:[
^ changeSet
select:[:change |
change isMethodChange and:[ change package ~= classPackage ]
].
].
withExtensions ifFalse:[
^ changeSet
reject:[:change |
change isMethodChange and:[ change package ~= classPackage ]
].
].
^ changeSet
"
ChangeSet forExistingClass:ChangeSet
Rectangle hasExtensions
Rectangle extensions
ChangeSet forExistingClass:Rectangle withExtensions:true extensionsOnly:false
ChangeSet forExistingClass:Rectangle withExtensions:false extensionsOnly:false
ChangeSet forExistingClass:Rectangle withExtensions:false extensionsOnly:true
"
"Created: / 12-10-2006 / 18:13:02 / cg"
"Modified: / 12-10-2006 / 23:46:05 / cg"
!
forExistingMethods:aCollectionOfMethods
"build a changeSet for a collection of methods.
That does of course not give deltas, but instead reflects the current
state of the given set of methods.
It is useful in conjunction with the other utility methods,
for example, when building patchLists, diffSets etc."
|changeSet stream previousPackage|
changeSet := self new.
aCollectionOfMethods do:[:eachMethod |
|change source|
source := eachMethod source.
source isNil ifTrue:[
Transcript showCR:'oops - no source for ',eachMethod whoString.
].
change := MethodDefinitionChange new.
eachMethod mclass notNil ifTrue:[ change className:eachMethod mclass name ].
source notNil ifTrue:[ change source:source ].
change selector:eachMethod selector.
change package:(eachMethod package).
change category:(eachMethod category).
changeSet add:change.
].
"/ stream := ReadWriteStream on:''.
"/ aCollectionOfMethods do:[:eachMethod |
"/ previousPackage ~= eachMethod package ifTrue:[
"/ stream nextPutAll:'"{ Package: '''.
"/ stream nextPutAll:eachMethod package asString.
"/ stream nextPutAll:''' }"'; cr; cr.
"/ ].
"/ eachMethod mclass fileOutMethod:eachMethod on:stream
"/ ].
"/ stream reset.
"/ changeSet := self fromStream:stream.
"/ changeSet do:[:eachChange |
"/ eachChange package:(eachChange changeMethod package).
"/ ].
^ changeSet
"
ChangeSet forExistingMethods:(Array with:(Array compiledMethodAt:#at:)
with:(Object compiledMethodAt:#at:)
with:(Behavior compiledMethodAt:#compiledMethodAt:) )
"
"Modified: / 17-09-2011 / 10:26:03 / cg"
!
forPackage: package
^self forPackage: package ignoreAutoloaded: false.
"Created: / 20-05-2008 / 17:56:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 12-08-2009 / 14:23:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
forPackage: package ignoreAutoloaded: ignoreAutoloaded
"build a changeSet for a given package"
|changeSet packageClasses packageExtensions|
packageClasses := ProjectDefinition searchForClassesWithProject: package.
packageExtensions := ProjectDefinition searchForExtensionsWithProject: package.
changeSet := self forExistingMethods: packageExtensions.
packageClasses do:
[:cls|
(ignoreAutoloaded not and:[cls isLoaded not])
ifTrue:[cls autoload].
cls isLoaded
ifTrue:
[changeSet addAll:
(self
forExistingClass:cls
withExtensions:false
extensionsOnly:false)]].
changeSet name: 'Package ' , package.
^changeSet
"Created: / 12-08-2009 / 14:22:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 16-03-2012 / 15:37:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fromDiffSet:aDiffSet
"build a changeSet from a given diffSet. This can be used as a patchSet,
to update the first-version in the diffSet to the second-version"
|changeSet|
changeSet := self new.
"/ class definitions first...
changeSet addAll:((aDiffSet changed collect:[:eachPair | eachPair second]) select:[:ch | ch isClassDefinitionChange]).
changeSet addAll:((aDiffSet onlyInArg) select:[:ch | ch isClassDefinitionChange]).
"/ first add new methods...
changeSet addAll:((aDiffSet onlyInArg) reject:[:ch | ch isClassDefinitionChange]).
"/ then, changed methods...
changeSet addAll:((aDiffSet changed collect:[:eachPair | eachPair second]) reject:[:ch | ch isClassDefinitionChange]).
"/ then, removed methods...
aDiffSet onlyInReceiver do:[:each |
|ch|
ch := MethodRemoveChange className:(each className) selector:(each selector).
changeSet add:ch.
].
^ changeSet
"Created: / 08-02-2011 / 10:48:36 / cg"
!
fromDirectory: aStringOfFilename
| d cs |
d := aStringOfFilename asFilename.
cs := self new.
d directoryContentsAsFilenames do:
[:each|
each suffix = 'st' ifTrue:
[cs addAll: (self fromFileOrDirectory: each)]].
cs name: aStringOfFilename asFilename asAbsoluteFilename pathName.
^cs
"
ChangeSet fromDirectory: (Smalltalk getPackageDirectoryForPackage:'stx:libbasic')
"
"Created: / 02-04-2011 / 00:54:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fromDolphinPACStream:aStream
"build a changeSet from a stream, containing dolphin pac file chunks."
^ self fromDolphinPACStream:aStream while:[:thisChange | true]
!
fromDolphinPACStream:aStream while:aConditionBlock
"build a changeSet from a stream, containing dolphin pac file chunks."
|changeSet|
changeSet := self new.
self
changesFromStream:aStream
for:changeSet
reader:(DolphinPACFileReader new)
do:[:aChange :lineNumberOrNil :posOrNil |
changeSet add:aChange.
(aConditionBlock value:aChange) ifFalse:[^ changeSet].
].
^ changeSet
!
fromFile:aFilename
|mime stream nm|
nm := aFilename asFilename asAbsoluteFilename pathName.
mime := MIMETypes mimeTypeForFilename:aFilename.
mime isNil ifTrue:[
mime := aFilename asFilename mimeTypeOfContents.
mime isNil ifTrue:[
self error:'unknown MIME type for file'.
].
].
[
stream := aFilename asFilename readStream.
mime = 'text/xml' ifTrue:[
^ (self fromXMLStream:stream) name: nm; yourself.
].
mime = 'application/x-smalltalk-source-sif' ifTrue:[
^ (self fromSIFStream:stream) name: nm; yourself
].
mime = 'application/x-smalltalk-dolphin-package' ifTrue:[
^ (self fromDolphinPACStream:stream) name: nm; yourself
].
stream := EncodedStream decodedStreamFor:stream.
^ (self fromStream:stream) name: nm; yourself
] ensure:[
stream notNil ifTrue:[stream close].
].
"
ChangeSet fromFile:('changes')
ChangeSet fromFile:('patches')
"
"Created: / 16-02-1998 / 12:19:34 / cg"
"Modified: / 14-12-1999 / 15:23:16 / cg"
"Modified: / 16-03-2012 / 15:46:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fromFileOrDirectory: fileOrDirectory
| f |
f := fileOrDirectory asFilename.
^(f isDirectory
ifTrue:[self fromDirectory: f]
ifFalse:[self fromFile: f])
name: f pathName;
yourself.
"
ChangeSet fromFileOrDirectory: (Smalltalk getPackageDirectoryForPackage:'stx:libbasic')
"
"Created: / 02-04-2011 / 00:50:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fromSIFStream:aStream
"build a changeSet from a SIF stream, containing chunks
in smalltalk interchange format.
Return the changeSet."
^ self fromSIFStream:aStream while:[:thisChange | true]
!
fromSIFStream:aStream while:aConditionBlock
"build a changeSet from a SIF stream, containing chunks
in smalltalk interchange format.
Return the changeSet."
|changeSet|
changeSet := self new.
self
changesFromStream:aStream
for:changeSet
reader:(SIFChangeFileReader new)
do:[:aChange :lineNumberOrNil :posOrNil |
changeSet add:aChange.
(aConditionBlock value:aChange) ifFalse:[^ changeSet].
].
^ changeSet
!
fromStream:aStream
"build a changeSet from a stream, containing chunks.
(i.e. either a classes sourceFile or a change-file).
Return the changeSet."
^ self fromStream:aStream while:[:thisChange | true]
"
ChangeSet fromStream:('changes' asFilename readStream)
ChangeSet fromStream:('patches' asFilename readStream)
ChangeSet fromStream:(Object source asString readStream)
"
"Created: / 16.2.1998 / 12:19:34 / cg"
"Modified: / 14.12.1999 / 15:23:16 / cg"
!
fromStream:aStream while:aConditionBlock
"build a changeSet from a stream, containing chunks.
(i.e. either a classes sourceFile or a change-file).
Return the changeSet."
|changeSet|
changeSet := self new.
self
changesFromStream:aStream
for:changeSet
reader:(ChangeFileReader new)
do:[:aChange :lineNumberOrNil :posOrNil |
changeSet add:aChange.
(aConditionBlock value:aChange) ifFalse:[^ changeSet].
].
^ changeSet
"
ChangeSet fromStream:('changes' asFilename readStream)
ChangeSet fromStream:('patches' asFilename readStream)
ChangeSet fromStream:(Object source asString readStream)
"
"Created: / 16.2.1998 / 12:19:34 / cg"
"Modified: / 14.12.1999 / 15:23:16 / cg"
!
fromXMLStream:aStream
"build a changeSet from an XML stream, containing XML definitions.
Return the changeSet."
|changeSet builder nameSpace|
aStream isNil ifTrue:[^ nil].
changeSet := self new.
nameSpace := Smalltalk.
builder := XML::SourceScannerNodeBuilder new.
builder scanFile:aStream do:[:change | changeSet add: change. ].
^ changeSet
"
ChangeSet fromXMLStream:('../../goodies/xml/vw/xmlFileInTests/XMLParser.xml' asFilename readStream)
ChangeSetBrowser
openOn:(ChangeSet fromXMLStream:('../../goodies/xml/vw/xmlFileInTests/XMLParser.xml' asFilename readStream))
"
! !
!ChangeSet class methodsFor:'Compatibility-ST80'!
patches
^ #()
"Created: / 27.10.1997 / 13:52:54 / cg"
! !
!ChangeSet class methodsFor:'Compatibility-VW'!
component: component definition: anObject change: changeSymbol
"Include indication that a class/namespace was added or removed
from a CodeComponent."
self
changed:#'component:definition:change:'
with:
( Array
with: component
with: anObject
with: changeSymbol
)
! !
!ChangeSet class methodsFor:'instance creation-private'!
changesFromStream:aStream do:aBlock
"enumerate changes from a stream and invoke aBlock on each.
The block is invoked with the change, a lineNumberOrNil and streamPosition arguments.
The lineNumber is only valid, if the underlying stream
provides line-numbers; otherwise, nil is passed."
^ self
changesFromStream:aStream
for:(self new)
reader:nil
do:aBlock
"
ChangeSet
changesFromStream:('changes' asFilename readStream)
do:[:chg | Transcript showCR:chg]
"
"Created: / 16.2.1998 / 12:19:34 / cg"
"Modified: / 14.12.1999 / 15:23:16 / cg"
!
changesFromStream:aStream for:aChangeSet reader:aReader do:aBlock
"enumerate changes from a stream and invoke aBlock on each.
The block is invoked with the change, a lineNumberOrNil and streamPosition arguments.
The lineNumber is only valid, if the underlying stream
provides line-numbers; otherwise, nil is passed."
|chunk lastTimeStamp s change nameSpace package
lineNumber pos reader size |
nameSpace := Smalltalk.
package := Class packageQuerySignal query.
(reader := aReader) isNil ifTrue:[
reader := ChangeFileReader new.
].
size := aStream size.
reader changeSet:aChangeSet.
reader changeAction:aBlock.
reader inputStream:aStream.
[aStream atEnd] whileFalse:[
aStream skipSeparators.
lineNumber := aStream lineNumber.
pos := aStream position1Based.
ProgressNotification notify: nil progress:(100 / size) * pos.
chunk := aStream nextChunk.
(chunk notEmptyOrNil) ifTrue:[
Class nameSpaceQuerySignal handle:[:ex| ex proceedWith:nameSpace] do:[
Class packageQuerySignal handle:[:ex| ex proceedWith:package] do:[
|parser tree ns pkg|
parser := Parser for:chunk.
tree := parser
parseExpressionWithSelf:nil
notifying:nil
ignoreErrors:true
ignoreWarnings:true
inNameSpace:nameSpace.
tree notNil ifTrue:[
tree == #Error ifTrue:[
change := DoItChange new.
change source:chunk.
aBlock valueWithOptionalArgument:change and:lineNumber and:pos.
] ifFalse:[
"/ if there is any nameSpace directive in there, extract it.
((ns := parser currentNameSpace) notNil
and:[ns ~~ nameSpace]) ifTrue:[
nameSpace := ns
].
"/ if there is any package directive in there, extract it.
((pkg := parser currentPackage) notNil
and:[pkg ~~ package]) ifTrue:[
package := pkg
].
"/
"/ what type of chunk is this ...
"/
tree isConstant ifTrue:[
(s := tree evaluate) isString ifTrue:[
(s startsWith:'---- timestamp ') ifTrue:[
lastTimeStamp := s.
]
] ifFalse:[
self error:'unexpected change-chunk' mayProceed:true
]
] ifFalse:[
tree isMessage ifTrue:[
(reader
changesFromParseTree:tree
lineNumber:lineNumber
position:pos
chunk: chunk
) ifFalse:[
change := DoItChange new.
change source:chunk.
aBlock valueWithOptionalArgument:change and:lineNumber and:pos.
]
] ifFalse:[
InvalidChangeChunkError
raiseRequestErrorString:'unexpected change-chunk'
"/ mayProceed:true.
]
]
]
]
]
]
]
].
"
ChangeSet fromStream:('changes' asFilename readStream)
ChangeSet fromStream:('patches' asFilename readStream)
ChangeSet fromStream:(Object source asString readStream)
"
"Created: / 16-02-1998 / 12:19:34 / cg"
"Modified: / 14-12-1999 / 15:23:16 / cg"
"Modified: / 11-02-2012 / 20:09:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
skipEncodingChunkOn:stream
<resource: #obsolete>
self obsoleteMethodWarning:'use stream>>skipENcodingChunk'.
stream skipEncodingChunk
! !
!ChangeSet class methodsFor:'queries'!
current
"ST-80 compatibility: return the current changeSet"
|p|
(Project notNil and:[(p := Project current) notNil]) ifTrue:[
^ p changeSet
].
^ #()
"
ChangeSet current
"
! !
!ChangeSet class methodsFor:'utilities'!
decodedStreamFor:aStream
<resource: #obsolete>
^ EncodedStream decodedStreamFor:aStream
! !
!ChangeSet methodsFor:'Compatibility-ST80'!
changeClass:aClass
"dummy here"
"Created: / 4.2.2000 / 18:30:59 / cg"
!
changeSelectors
"return a collection of all selectors for which changes are in this changeSet"
|selectors|
changeSelectors isNil ifTrue:[
selectors := IdentitySet new.
self do:[:chg |
|sel|
chg notNil ifTrue:[
chg isMethodChange ifTrue:[
sel := chg selector.
sel notNil ifTrue:[
selectors add:sel
]
]
]
].
changeSelectors := selectors.
].
^ changeSelectors.
"
ChangeSet current changeSelectors
"
"Modified: / 30-05-2007 / 12:12:32 / cg"
!
changedClasses
"return a collection of all classes for which changes are in this changeSet"
|classes|
changedClasses isNil ifTrue:[
classes := IdentitySet new.
self do:[:chg |
|cls|
chg notNil ifTrue:[
cls := chg changeClass.
cls notNil ifTrue:[
cls isRealNameSpace ifFalse:[
classes add:cls
]
]
]
].
changedClasses := classes.
].
^ changedClasses.
"
ChangeSet current changedClasses
ChangeSet current flushChangedClassesCache
"
"Modified: / 10-11-2006 / 17:17:26 / cg"
!
component:component definition:anObject change:changeSymbol
"Include indication that a class/namespace was added or removed
from a CodeComponent."
self
changed:#'component:definition:change:'
with:
( Array
with: component
with: anObject
with: changeSymbol
)
!
reorganizeSystem
"dummy here"
"Created: / 6.2.2000 / 20:45:10 / cg"
! !
!ChangeSet methodsFor:'accessing'!
name
^ name
!
name:something
name := something.
! !
!ChangeSet methodsFor:'change & update'!
changed:anAspectSymbol with:aParameter
"Allow objects to depend on the ChangeSet class instead of a particular instance
of ChangeSet (which may be switched using projects)."
self == ChangeSet current ifTrue:[
ChangeSet changed:anAspectSymbol with:aParameter.
].
super changed:anAspectSymbol with:aParameter
! !
!ChangeSet methodsFor:'changes management'!
addClassCommentChangeFor:aClass
"add a classComment change to the receiver"
|newChange|
newChange := ClassCommentChange class:aClass.
newChange comment:aClass comment.
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 14.11.2001 / 13:35:34 / cg"
!
addClassDefinitionChangeFor:aClass
"add a classDefinition change to the receiver"
|newChange|
newChange := ClassDefinitionChange class:aClass source:(aClass definition).
newChange package:aClass package.
self rememberChangedClass:aClass.
self addChange:newChange
"
(ChangeSet new addClassDefinitionChangeFor:ChangeSet) inspect
"
"Modified: / 12-10-2006 / 18:17:02 / cg"
!
addClassRemoveChange:oldClass
"add a classRemove change to the receiver"
|newChange|
newChange := ClassRemoveChange new className:oldClass name.
self rememberChangedClass:oldClass.
oldClass isPrivate ifTrue:[
self rememberChangedClass:oldClass topOwningClass.
].
ClassRemoveChange::ClassBeingRemovedQuery
answer:oldClass
do:[
self addChange:newChange
]
"Modified: / 14.11.2001 / 13:35:39 / cg"
!
addClassRenameChangeFrom:oldName to:newName
"add a classRename change to the receiver"
|newChange|
newChange := ClassRenameChange new oldName:oldName newName:newName.
self rememberChangedClass:(Smalltalk at:newName).
self addChange:newChange
"Modified: / 14.11.2001 / 13:35:41 / cg"
!
addDoIt:aString
"add a doIt to the receiver"
|newChange|
newChange := DoItChange new source:aString.
self addChange:newChange.
"Modified: / 14.11.2001 / 13:35:44 / cg"
!
addInstVarDefinitionChangeFor:aClass
"add an instVarDefinition change to the receiver"
|newChange|
newChange := ClassInstVarDefinitionChange
class:aClass
source:(aClass name , ' instanceVariableNames:' , aClass instanceVariableString storeString).
newChange classInstVarNames:aClass instanceVariableString asCollectionOfWords.
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 25-11-2011 / 17:38:42 / cg"
!
addMethodCategoryChange:aMethod category:newCategory in:aClass
"add a methodCategory change to the receiver"
|newChange|
newChange := MethodCategoryChange
class:aClass
selector:(aClass selectorAtMethod:aMethod)
category:newCategory.
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 14.11.2001 / 13:35:48 / cg"
!
addMethodChange:aMethod fromOld:oldMethod in:aClass
"add a method change to the receiver"
|newChange|
newChange := MethodChange
class:aClass
selector:aMethod selector
source:aMethod source
category:aMethod category.
oldMethod notNil ifTrue:[
newChange previousVersion:oldMethod.
].
self rememberChangedClass:aClass.
self addChange:newChange.
"Modified: / 14.11.2001 / 13:35:50 / cg"
!
addMethodChange:aMethod in:aClass
"add a method change to the receiver"
|newChange|
newChange := MethodChange
class:aClass
selector:aMethod selector
source:aMethod source
category:aMethod category.
newChange package:(aMethod package).
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 12-10-2006 / 18:15:28 / cg"
!
addMethodPackageChange:aMethod package:newPackage in:aClass
"add a methodPackage change to the receiver"
|newChange|
newChange := MethodPackageChange
class:aClass
selector:(aClass selectorAtMethod:aMethod)
package:newPackage.
self rememberChangedClass:aClass.
self addChange:newChange
"Created: / 09-10-2006 / 14:02:33 / cg"
!
addMethodPrivacyChange:aMethod in:aClass
"add a methodPrivacy change to the receiver"
|newChange|
newChange := MethodPrivacyChange
class:aClass
selector:(aClass selectorAtMethod:aMethod)
privacy:aMethod privacy.
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 27.8.1995 / 22:55:22 / claus"
"Modified: / 14.11.2001 / 13:35:55 / cg"
!
addPrimitiveDefinitionsChangeFor:aClass
"add a primitiveDefinitions change to the receiver"
|newChange|
newChange := ClassPrimitiveDefinitionsChange new
class:aClass source:(aClass primitiveDefinitionsString).
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 14.11.2001 / 13:35:57 / cg"
!
addPrimitiveFunctionsChangeFor:aClass
"add a primitiveFunctions change to the receiver"
|newChange|
newChange := ClassPrimitiveFunctionsChange new
class:aClass source:(aClass primitiveFunctionsString).
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 14.11.2001 / 13:35:59 / cg"
!
addPrimitiveVariablesChangeFor:aClass
"add a primitiveVariables change to the receiver"
|newChange|
newChange := ClassPrimitiveVariablesChange new
class:aClass source:(aClass primitiveVariablesString).
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 14.11.2001 / 13:36:01 / cg"
!
addRemoveSelectorChange:aSelector fromOld:oldMethod in:aClass
"add a method-remove change to the receiver"
|newChange|
newChange := MethodRemoveChange class:aClass selector:aSelector.
oldMethod notNil ifTrue:[
newChange previousVersion:oldMethod.
].
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 27.8.1995 / 22:55:22 / claus"
"Created: / 16.2.1998 / 12:47:07 / cg"
"Modified: / 14.11.2001 / 13:36:04 / cg"
!
addRenameCategoryChangeIn:aClass from:oldCategory to:newCategory
"add a category rename change to the receiver"
|newChange|
newChange := MethodCategoryRenameChange class:aClass.
newChange oldCategoryName:oldCategory newCategoryName:newCategory.
self rememberChangedClass:aClass.
self addChange:newChange
"Modified: / 14.11.2001 / 13:36:06 / cg"
! !
!ChangeSet methodsFor:'fileOut'!
fileOutAs: aStringOrFilename
| stream |
stream := aStringOrFilename asFilename writeStream.
[ self fileOutOn: stream ]
ensure: [stream close]
"Created: / 05-12-2009 / 12:33:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutOn: stream
self do:[:chg|chg fileOutOn: stream]
"Created: / 05-12-2009 / 12:32:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet methodsFor:'misc'!
addPatch:nameOfPatch
"ignored for now - allows fileIn of ST-80 patch stuff .."
^ self
! !
!ChangeSet methodsFor:'private-accessing'!
addChange:aChange
|changeClass|
aChange timeOfChangeIfKnown isNil ifTrue:[
aChange timeStamp:(Timestamp now).
].
self add:aChange.
changedClasses notNil ifTrue:[
(changeClass := aChange changeClass) notNil ifTrue:[
changedClasses add:changeClass.
].
].
changeSelectors notNil ifTrue:[
aChange isMethodChange ifTrue:[
changeSelectors add:aChange selector.
].
].
"/ aChange sendChangeNotificationThroughSmalltalk.
self changed:#addChange: with:aChange.
"Created: / 14-11-2001 / 13:35:11 / cg"
"Modified: / 10-11-2006 / 16:47:13 / cg"
!
flushChangedClassesCache
changedClasses := changeSelectors := nil
"
ChangeSet current flushChangedClassesCache
"
!
rememberChangedClass:aClass
changedClasses notNil ifTrue:[
changedClasses add:aClass
].
!
removeAll:aCollection
aCollection notEmpty ifTrue:[
super removeAll:aCollection.
changedClasses := changeSelectors := nil.
self changed:#removeAll: with:aCollection.
]
!
unrememberChangedClasses
changedClasses := nil
! !
!ChangeSet methodsFor:'queries'!
changedPackages
"return a collection of all packages for which changes are in this changeSet"
|classes changedPackages|
changedPackages := Set new.
self do:[:chg |
|p mthd cls|
p := chg package.
p isNil ifTrue:[
chg isMethodChange ifTrue:[
mthd := chg changeMethod.
mthd notNil ifTrue:[
p := mthd package.
] ifFalse:[
cls := chg changeClass.
cls notNil ifTrue:[
p := cls package.
]
]
] ifFalse:[
chg isClassChange ifTrue:[
cls := chg changeClass.
cls notNil ifTrue:[
p := cls package.
]
]
].
].
p notNil ifTrue:[
changedPackages add:p.
]
].
"/ self changedClasses do:[:cls |
"/ |p|
"/
"/ (p := cls package) notNil ifTrue:[
"/ changedPackages add:p.
"/ ]
"/ ].
^ changedPackages.
"
ChangeSet current changedPackages
"
"Created: / 22-09-2006 / 16:37:40 / cg"
"Modified: / 13-10-2006 / 01:20:48 / cg"
!
changesForPackage:aPackageSymbol
"
ChangeSet current changesForPackage:#'stx:goodies/libsvn'.
"
^(self select:[:aChange |
|removeThis mClass mthd|
removeThis := false.
(aChange isMethodChange or:[aChange isMethodRemoveChange]) ifTrue:[
mClass := aChange changeClass.
mClass notNil ifTrue:[
mthd := mClass compiledMethodAt:(aChange selector).
mthd isNil ifTrue:[
aChange isMethodRemoveChange ifTrue:[
removeThis := (mClass package = aPackageSymbol)
].
] ifFalse:[
removeThis := (mthd package = aPackageSymbol)
]
].
] ifFalse:[
(aChange isClassChange) ifTrue:[
(aChange changeClass notNil) ifTrue:[
removeThis := (aChange changeClass package = aPackageSymbol)
].
].
].
removeThis
])
"Created: / 05-11-2001 / 14:21:17 / cg"
"Modified: / 12-10-2006 / 16:51:27 / cg"
"Modified: / 22-10-2008 / 13:25:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
includesChangeForClass:aClass
|nameOfClass|
nameOfClass := aClass theNonMetaclass name.
(self changedClasses contains:[:aClass | aClass theNonMetaclass name = nameOfClass]) ifFalse:[^ false].
^ self contains:[:aChange | aChange className = nameOfClass]
"
ChangeSet current includesChangeForClass:ChangeSet
ChangeSet current includesChangeForClass:ChangeSet class
ChangeSet current includesChangeForClass:SourceCodeManagerUtilities
ChangeSet current includesChangeForClass:(Expecco::ExpeccoXMLDecoder::ObjectCreator)
"
"Modified: / 09-10-2006 / 13:39:22 / cg"
!
includesChangeForClass:aClass selector:selector
|nameOfNonMetaClass nameOfClass|
(self changeSelectors includes:selector) ifFalse:[^ false].
nameOfNonMetaClass := aClass theNonMetaclass name.
(self changedClasses contains:[:aClass | aClass theNonMetaclass name = nameOfNonMetaClass]) ifFalse:[^ false].
nameOfClass := aClass name.
^ self contains:[:aChange |
selector = aChange selector
ifFalse:[
false
] ifTrue:[
nameOfClass = aChange className
]
]
"
ChangeSet current includesChangeForClass:ChangeSet selector:#includesChangeForClass:
"
"Created: / 31.10.2001 / 10:26:31 / cg"
"Modified: / 31.10.2001 / 10:59:49 / cg"
!
includesChangeForClassOrMetaclass:aClass
|nameOfClass nameOfMetaclass|
nameOfClass := aClass theNonMetaclass name.
nameOfMetaclass := aClass theMetaclass name.
(self changedClasses contains:[:eachClass | eachClass theNonMetaclass name = nameOfClass]) ifFalse:[
^ false.
].
^ self contains:[:eachChange |
|changeClassName|
changeClassName := eachChange className.
changeClassName = nameOfClass or:[changeClassName = nameOfMetaclass]
]
"Modified: / 09-10-2006 / 13:40:29 / cg"
!
includesChangeForClassOrMetaclassOrPrivateClassOf:aClass
|nameOfClass nameOfMetaclass|
nameOfClass := aClass theNonMetaclass name.
nameOfMetaclass := aClass theMetaclass name.
self do:[:aChange |
|changeClassName changeClass|
changeClassName := aChange className.
(changeClassName = nameOfClass) ifTrue:[^ true].
(changeClassName = nameOfMetaclass) ifTrue:[^ true].
changeClass := aChange changeClass.
(changeClass notNil
and:[changeClass isPrivate
and:[changeClass owningClass == aClass]]) ifTrue:[
^ true
]
].
^ false
!
includesChangeForClassOrMetaclassOrPrivateClassOfAny:aCollectionOfClasses
|namesOfClasses namesOfMetaclasses|
namesOfClasses := aCollectionOfClasses collect:[:eachClass | eachClass theNonMetaclass name] as:Array.
namesOfMetaclasses := aCollectionOfClasses collect:[:eachClass | eachClass theMetaclass name] as:Array.
self do:[:aChange |
|changeClassName changeClass|
changeClassName := aChange className.
(namesOfClasses includes:changeClassName) ifTrue:[^ true].
(namesOfMetaclasses includes:changeClassName) ifTrue:[^ true].
changeClass := aChange changeClass.
(changeClass notNil and:[changeClass isPrivate]) ifTrue:[
(aCollectionOfClasses includes:changeClass owningClass) ifTrue:[
^ true
].
]
].
^ false
"Created: / 08-09-2011 / 04:24:26 / cg"
!
includesChangeForPackage:aPackageID
^ self changedPackages includes:aPackageID
"/ ^ self contains:[:aChange | aChange package = aPackageID]
"
ChangeSet current includesChangeForPackage:'stx:libbasic'
"
"Created: / 25-10-2006 / 18:06:55 / cg"
!
selectForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:aCollectionOfClasses
|namesOfClasses namesOfMetaclasses|
namesOfClasses := aCollectionOfClasses collect:[:eachClass | eachClass theNonMetaclass name] as:Array.
namesOfMetaclasses := aCollectionOfClasses collect:[:eachClass | eachClass theMetaclass name] as:Array.
^ aCollectionOfClasses
select:[:aChange |
|changeClassName changeClass|
changeClassName := aChange className.
(namesOfClasses includes:changeClassName)
or:[ (namesOfMetaclasses includes:changeClassName)
or:[
changeClass := aChange changeClass.
(changeClass notNil
and:[ changeClass isPrivate
and:[ (aCollectionOfClasses includes:changeClass owningClass) ]])
]]
].
"Created: / 08-09-2011 / 04:38:32 / cg"
! !
!ChangeSet methodsFor:'utilities'!
apply
"apply all changes in the receivers changeSet"
self do:[:aChange |
aChange apply
]
!
condenseChanges
| changesToRemove changesToKeep |
changesToKeep := self class new.
changesToRemove := self class new.
self reverseDo:
[:change|
(changesToKeep anySatisfy:[:each|each isForSameAs: change])
ifTrue:[changesToRemove add: change]
ifFalse:[changesToKeep add: change]
].
self condenseChanges: changesToRemove.
"Created: / 22-10-2008 / 13:05:13 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
condenseChanges:changesToRemove
"remove the given changes - a helper for the rest of the condense protocol"
changesToRemove notEmpty ifTrue:[
changedClasses := changeSelectors := nil.
self removeAll:changesToRemove.
self changed.
Smalltalk changed:#currentChangeSet with:self.
].
"Created: / 12-10-2006 / 16:51:11 / cg"
!
condenseChangesForClass:aClass
"remove all changes for aClass
(i.e. leave changes for other classes)."
self condenseChangesForClass:aClass package:nil
!
condenseChangesForClass:aClass package:aPackageSymbol
"remove all changes for aClass and aPackageSymbol
(i.e. leave methodChanges for other packages).
This is invoked when a class is checked into the repository."
self condenseChangesForClass:aClass selector:nil package:aPackageSymbol
"Modified: / 5.11.2001 / 14:29:22 / cg"
!
condenseChangesForClass:aClass selector:aSelector
"remove all changes for aClass >> selector."
self condenseChangesForClass:aClass selector:aSelector package:nil
"Created: / 26-09-2006 / 17:22:59 / cg"
!
condenseChangesForClass:aClass selector:selectorOrNil package:aPackageSymbol
"remove all changes for aClass/selector and aPackageSymbol
(i.e. leave methodChanges for other packages).
If selectorOrNil is nil, all changes for that class are removed;
otherwise, only changes for the given selector.
This is invoked when a class is checked into the repository."
|changesToRemove className metaClassName chgCls|
className := aClass theNonMetaclass name.
metaClassName := aClass theMetaclass name.
changesToRemove := self select:[:aChange |
|chgClassName chgClass removeThis mClass mthd|
removeThis := false.
chgClassName := aChange className.
(chgClassName = className or:[chgClassName = metaClassName]) ifTrue:[
removeThis := true
] ifFalse:[
chgCls := aChange changeClass.
chgCls isNil ifTrue:[
(chgClassName startsWith:(aClass name,':')) ifTrue:[
"a change for a private class of a no-longer present one..."
removeThis := true
].
].
(chgCls notNil
and:[chgCls isPrivate
and:[chgCls topOwningClass == aClass]]) ifTrue:[
removeThis := true
]
].
selectorOrNil notNil ifTrue:[
(aChange isMethodChange or:[aChange isMethodRemoveChange]) ifFalse:[
removeThis := false.
] ifTrue:[
aChange selector = selectorOrNil ifFalse:[
removeThis := false.
].
]
].
removeThis ifTrue:[
aChange isMethodChange ifTrue:[
mClass := aChange changeClass.
mClass notNil ifTrue:[
mthd := mClass compiledMethodAt:(aChange selector).
mthd isNil ifTrue:[
"/ mthd does no longer exist
"/ I no longer understand what this was meant for .. (sigh)
"/ aPackageSymbol notNil ifTrue:[
"/ removeThis := false
"/ ]
] ifFalse:[
(aPackageSymbol notNil and:[mthd package ~= aPackageSymbol]) ifTrue:[
removeThis := false
]
]
]
].
].
removeThis
].
self condenseChanges:changesToRemove
"Modified: / 12-10-2006 / 16:51:38 / cg"
!
condenseChangesForExtensionsInPackage:aPackageSymbol
"remove all changes for aClass and aPackageSymbol
(i.e. leave methodChanges for other packages).
This is invoked when a class is checked into the repository."
|changesToRemove|
changesToRemove := OrderedCollection new.
changesToRemove := self select:[:aChange |
|removeThis mClass mthd|
(aChange isMethodChange or:[aChange isMethodRemoveChange]) ifTrue:[
removeThis := false.
mClass := aChange changeClass.
mClass notNil ifTrue:[
mthd := mClass compiledMethodAt:(aChange selector).
mthd isNil ifTrue:[
aChange isMethodRemoveChange ifTrue:[
removeThis := true
].
] ifFalse:[
mthd package = aPackageSymbol ifTrue:[
removeThis := true
]
]
].
].
removeThis
].
self condenseChanges:changesToRemove
"Created: / 05-11-2001 / 14:21:17 / cg"
"Modified: / 12-10-2006 / 16:51:32 / cg"
!
condenseChangesForPackage:aPackageSymbol
"remove all changes for aPackageSymbol
This is invoked when a project is checked into the repository."
|changesToRemove|
changesToRemove := self select:[:aChange |
|removeThis mClass mthd|
removeThis := false.
(aChange isMethodChange or:[aChange isMethodRemoveChange]) ifTrue:[
mClass := aChange changeClass.
mClass notNil ifTrue:[
mthd := mClass compiledMethodAt:(aChange selector).
mthd isNil ifTrue:[
aChange isMethodRemoveChange ifTrue:[
removeThis := (mClass package = aPackageSymbol)
].
] ifFalse:[
removeThis := (mthd package = aPackageSymbol)
]
].
] ifFalse:[
(aChange isClassChange) ifTrue:[
(aChange changeClass notNil) ifTrue:[
removeThis := (aChange changeClass package = aPackageSymbol)
].
].
].
removeThis
].
self condenseChanges:changesToRemove
"Created: / 05-11-2001 / 14:21:17 / cg"
"Modified: / 12-10-2006 / 16:51:27 / cg"
!
diffSetsAgainst:anotherChangeSet
"walk over the receiver and anotherChangeSet,
add all changes to one of the tree lists:
onlyInReceiver, onlyInArg or changed,
each being a changeSet containing corresponding changes.
WARNING:
destructive; could modify both the receiver and the argument by possibly
changing methodChanges into categoryChanges"
|otherChangeIndicesBySelector otherNonMethodChangeIndices changeIndicesBySelector nonMethodChangeIndices
onlyInReceiver onlyInArg changedMethods
indexFromChangedMethodsToA indexFromChangedMethodsToB
"info" ret|
onlyInReceiver := ChangeSet new.
onlyInArg := ChangeSet new.
changedMethods := ChangeSet new.
indexFromChangedMethodsToA := OrderedCollection new.
indexFromChangedMethodsToB := OrderedCollection new.
otherChangeIndicesBySelector := Dictionary new.
otherNonMethodChangeIndices := OrderedCollection new.
"/ these caches reduces square runtime to almost linear...
anotherChangeSet keysAndValuesDo:[:idxB :aChangeInB |
|setOfOtherChangeIndicesForThisSelector|
aChangeInB isMethodChange ifTrue:[
setOfOtherChangeIndicesForThisSelector := otherChangeIndicesBySelector at:(aChangeInB selector) ifAbsentPut:[OrderedCollection new].
setOfOtherChangeIndicesForThisSelector add:idxB.
] ifFalse:[
otherNonMethodChangeIndices add:idxB
].
].
self keysAndValuesDo:[:idxA :aChangeInA |
|indicesOfChangesToExplore anyFound ch|
anyFound := false.
aChangeInA isMethodChange ifTrue:[
indicesOfChangesToExplore := otherChangeIndicesBySelector at:(aChangeInA selector) ifAbsent:#()
] ifFalse:[
indicesOfChangesToExplore := otherNonMethodChangeIndices.
].
indicesOfChangesToExplore do:[:idxB |
|aChangeInB|
aChangeInB := anotherChangeSet at:idxB.
(aChangeInA isForSameAs:aChangeInB) ifTrue:[
anyFound := true.
"/ also in B - is it different ?
(aChangeInA sameAs:aChangeInB) ifFalse:[
changedMethods add:aChangeInA.
indexFromChangedMethodsToA add:idxA.
indexFromChangedMethodsToB add:idxB.
] ifTrue:[
aChangeInA isMethodChange ifTrue:[
aChangeInA methodCategory ~= aChangeInB methodCategory ifTrue:[
"/ only the category is different;
"/ make it a MethodCategory changes.
ch := MethodCategoryChange new
className:aChangeInA className
selector:aChangeInA selector
category:aChangeInA methodCategory.
self at:idxA put:ch.
ch := MethodCategoryChange new
className:aChangeInB className
selector:aChangeInB selector
category:aChangeInB methodCategory.
anotherChangeSet at:idxB put:ch.
changedMethods add:aChangeInA.
indexFromChangedMethodsToA add:idxA.
indexFromChangedMethodsToB add:idxB.
]
].
]
] ifFalse:[
(aChangeInA sameAs:aChangeInB) ifTrue:[
anyFound := true.
] ifFalse:[
]
]
].
anyFound ifFalse:[
onlyInReceiver add:aChangeInA.
]
].
"/ these caches reduces square runtime to almost linear...
changeIndicesBySelector := Dictionary new.
nonMethodChangeIndices := OrderedCollection new.
self keysAndValuesDo:[:idxA :aChangeInA |
|setOfChangeIndicesForThisSelector|
aChangeInA isMethodChange ifTrue:[
setOfChangeIndicesForThisSelector := changeIndicesBySelector at:(aChangeInA selector) ifAbsentPut:[OrderedCollection new].
setOfChangeIndicesForThisSelector add:idxA.
] ifFalse:[
nonMethodChangeIndices add:idxA
].
].
anotherChangeSet keysAndValuesDo:[:idxB :aChangeInB |
|anyFound indicesOfChangesToExplore|
anyFound := false.
aChangeInB isMethodChange ifTrue:[
indicesOfChangesToExplore := changeIndicesBySelector at:(aChangeInB selector) ifAbsent:#()
] ifFalse:[
indicesOfChangesToExplore := nonMethodChangeIndices.
].
indicesOfChangesToExplore do:[:idxA |
|aChangeInA idxM|
aChangeInA := self at:idxA.
(aChangeInA isForSameAs:aChangeInB) ifTrue:[
anyFound := true.
"/ also in B - is it different ?
(aChangeInA sameAs:aChangeInB) ifFalse:[
"/ already there ?
idxM := changedMethods findFirst:[:c | c isForSameAs:aChangeInB].
idxM == 0 ifTrue:[
changedMethods add:aChangeInB.
indexFromChangedMethodsToB add:idxB.
] ifFalse:[
indexFromChangedMethodsToB at:idxM put:idxB
]
]
] ifFalse:[
(aChangeInA sameAs:aChangeInB) ifTrue:[
anyFound := true.
] ifFalse:[
]
]
].
anyFound ifFalse:[
onlyInArg add:aChangeInB.
]
].
"/ info := OrderedCollection new:(changedMethods size).
"/ changedMethods keysAndValuesDo:[:idx :changedMethod |
"/ info add:(Array
"/ with:(indexFromChangedMethodsToA at:idx)
"/ with:(indexFromChangedMethodsToB at:idx)
"/ )
"/ ].
changedMethods := (1 to:changedMethods size) asOrderedCollection collect:[:idx |
|cA cB|
cA := self at:(indexFromChangedMethodsToA at:idx).
cB := anotherChangeSet at:(indexFromChangedMethodsToB at:idx).
Array with:cA with:cB
].
ret := DiffSet new
changed:changedMethods
onlyInReceiver:onlyInReceiver
onlyInArg:onlyInArg.
"/ ret info:info.
^ret
"Modified: / 12-10-2006 / 22:22:39 / cg"
"Modified (comment): / 01-12-2011 / 19:12:55 / cg"
!
diffSetsAgainstImage
|imageChangeSet|
imageChangeSet := self class new.
self changedClasses do:
[:class|
(class isMetaclass or:[class isPrivate]) ifFalse:
[imageChangeSet addAll:
(self class fromStream: class source asString readStream)]].
^self diffSetsAgainst: imageChangeSet
"Created: / 04-12-2007 / 16:03:28 / janfrog"
!
flatten
| flatten |
flatten := self class new: self size.
self do:[:ea|ea do:[:ea2|flatten add: ea2]].
^flatten
"Created: / 29-10-2010 / 14:40:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
groupBy: groupBlock labelAs: labelBlock
"
returns a new changeset consisting of CompositeChanges.
Changes are grouped together by value (tag) of groupBlock.
Each composite change is then labeled using label
returned by labelBlock (called with the tag returned
by groupBlock as arg)
"
^ self groupBy: groupBlock labelAs: labelBlock sort: false
"Created: / 24-07-2009 / 23:17:38 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 25-07-2009 / 19:40:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 29-10-2010 / 12:45:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-08-2011 / 16:07:30 / cg"
!
groupBy: groupBlock labelAs: labelBlock sort: doSort
"returns a new changeset consisting of CompositeChanges.
Changes are grouped together by value (tag) of groupBlock.
Each composite change is then labeled using label
returned by labelBlock (called with the tag returned
by groupBlock as arg)"
| buckets newChangeset keys |
buckets := OrderedDictionary new.
self do:
[:change| | tag |
tag := groupBlock value: change.
(buckets at: tag ifAbsentPut: [ChangeSet new:4])
add: change].
newChangeset := ChangeSet new: buckets size.
keys := buckets keys select:[:k | k notNil].
doSort ifTrue:[
keys sort.
].
keys do:[:tag |
|changes classDefs|
changes := buckets at:tag.
"/ buckets keysAndValuesDo:
"/ [:tag :changes| | classDefs |
"Move class definition to the front"
classDefs := changes select:[:chg|chg isClassDefinitionChange].
changes removeAll: classDefs.
changes addAllFirst: classDefs.
tag notNil ifTrue:[
newChangeset add:
(CompositeChange
name: (labelBlock value: tag)
changes: changes)]
].
(buckets includesKey: nil) ifTrue:[
newChangeset addAll: (buckets at: nil)
].
^newChangeset
"Created: / 24-07-2009 / 23:17:38 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 25-07-2009 / 19:40:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 29-10-2010 / 12:45:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 30-08-2011 / 16:07:01 / cg"
!
groupByClass
|nm|
^self
groupBy: [:change|
change isClassChange ifTrue: [
nm := change className.
(nm endsWith:' class') ifTrue:[nm := nm copyTo: nm size - 6].
nm
] ifFalse: [
nil
]
]
labelAs: [:className|
className
]
sort: true
"Created: / 25-07-2009 / 19:43:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 24-10-2009 / 18:49:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-08-2011 / 16:08:38 / cg"
!
saveSignedToFile:aFilename
"write the changeSet to a signed file in chunk format"
self saveSignedToFile:aFilename format:nil
"Created: / 08-02-2011 / 11:18:54 / cg"
!
saveSignedToFile:aFilename format:formatSymbolOrNil
"write the changeSet to a signed file in some format.
Sign with the exept key (which you do not have outside of exept!!).
Nil fomat is chunk"
|s pkcs7SignedData|
s := WriteStream on:(String new:2000).
self saveToStream:s format:formatSymbolOrNil.
pkcs7SignedData := Expecco::KeyFileGenerator new signExpeccoCode:s contents.
aFilename asFilename contents:pkcs7SignedData.
"Modified: / 08-02-2011 / 11:48:01 / cg"
!
saveToFile:aFilename
"write the changeSet to a regular file in chunk format"
self saveToFile:aFilename format:nil
"Created: / 08-02-2011 / 11:18:46 / cg"
!
saveToFile:aFilename format:formatSymbolOrNil
"write the changeSet to a regular file in some format.
Nil fomat is chunk"
|s|
s := aFilename asFilename writeStream.
self saveToStream:s format:formatSymbolOrNil.
s close.
"Created: / 08-02-2011 / 11:20:06 / cg"
!
saveToStream:aStream format:formatSymbolOrNil
"write the changeSet to a stream in some format.
Nil fomat is chunk"
formatSymbolOrNil isNil ifTrue:[
self do:[:eachChange |
eachChange isMethodCodeChange ifTrue:[
aStream nextPutAll:'!!',(eachChange className),' methodsFor: '.
aStream nextPutAll:(eachChange methodCategory storeString).
aStream nextPutLine:'!!'.
aStream cr.
aStream nextPutAll:(eachChange source).
aStream nextPutLine:'!! !!'.
] ifFalse:[
aStream nextPutAll:(eachChange source).
aStream nextPutLine:'!!'.
].
aStream cr.
].
].
self halt
"Created: / 08-02-2011 / 11:25:16 / cg"
! !
!ChangeSet::ChangeFileReader methodsFor:'accessing'!
changeAction:aBlock
changeAction := aBlock.
!
changeSet:something
"set the value of the instance variable 'changeSet' (automatically generated)"
changeSet := something.
!
inputStream:aStream
inputStream := aStream.
! !
!ChangeSet::ChangeFileReader methodsFor:'helpers'!
addChange:change
changeAction
valueWithOptionalArgument:change
and:lineNumber
and:position.
!
checkReceiverIsGlobalNamed:expectedName
^ self variableNameOfReceiver = expectedName
!
classNameOf:aReceiver
| nameSpace clsName |
nameSpace := Class nameSpaceQuerySignal query.
(aReceiver isUnaryMessage and:[aReceiver selector == #class])
ifTrue:[clsName := (aReceiver receiver name) , ' class']
ifFalse:[clsName := aReceiver name].
^(nameSpace ~~ Smalltalk and:[(clsName startsWith: nameSpace name) not])
ifTrue:[nameSpace name , '::' , clsName]
ifFalse:[clsName].
"Modified: / 24-01-2012 / 17:07:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
receiversClassName
^ self classNameOf:receiver
!
variableNameOfReceiver
receiver isVariable ifFalse:[ ^ nil ].
^ receiver name
! !
!ChangeSet::ChangeFileReader methodsFor:'reading'!
changesFromParseTree:aTree lineNumber:initialLineNumberOrNil position:initialPositionOrNil
"given a parse-tree (from parsing some changes source/chunk),
create changes and evaluate changeAction on each.
The chnageAction-block is invoked with the change and a lineNumberOrNil as
arg; the lineNumber is only valid, if the underlying inputStream
provides line-numbers; otherwise, nil is passed."
^self changesFromParseTree:aTree lineNumber:initialLineNumberOrNil position:initialPositionOrNil chunk: nil
"Modified: / 24-01-2012 / 17:29:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changesFromParseTree:aTree lineNumber:initialLineNumberOrNil position:initialPositionOrNil chunk: initialChunkOrNil
"given a parse-tree (from parsing some changes source/chunk),
create changes and evaluate changeAction on each.
The chnageAction-block is invoked with the change and a lineNumberOrNil as
arg; the lineNumber is only valid, if the underlying inputStream
provides line-numbers; otherwise, nil is passed."
lineNumber := initialLineNumberOrNil.
position := initialPositionOrNil.
chunk := initialChunkOrNil.
parseTree := aTree.
selector := aTree selector.
receiver := aTree receiver.
arguments := aTree arguments.
receiver isMessage ifTrue:[
receiverSelector := receiver selector.
receiverReceiver := receiver receiver.
].
^ self processChange
"Created: / 24-01-2012 / 17:28:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::ChangeFileReader methodsFor:'reading-private'!
handleCategoriesForChange
|selector category categories attributes change|
selector := arguments first value.
className := self receiversClassName.
categories := OrderedCollection new.
attributes := OrderedCollection new.
[
inputStream skipSeparators.
category := inputStream nextChunk.
category notEmptyOrNil
] whileTrue:[
( #( 'public' 'private' ) includes: category) ifTrue:[
attributes add:category
] ifFalse:[
categories add:category
].
].
categories size == 1 ifTrue:[
"/ easy
change := MethodCategoryChange
className:className
selector:selector
source:(parseTree printString)
category:(categories first).
self addChange:change.
] ifFalse:[
self halt:'multiple/missing categories not supported'.
].
attributes size == 1 ifTrue:[
"/ easy
(attributes first = 'public') ifTrue:[
"/ default anyway - ignore
] ifFalse:[
change := MethodPrivacyChange
className:className
selector:selector
privacy:(attributes first asSymbol).
change source:(parseTree printString).
self addChange:change.
].
] ifFalse:[
self halt:'multiple/missing attributes not supported'.
].
^ true
!
handleClassCommentChange
|change|
className := self receiversClassName.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
change := ClassCommentChange new.
change className:className comment:(arguments at:1) evaluate.
change source:(parseTree printString).
self addChange:change.
^ true
!
handleClassDefinitionChange
|nameSpace change|
className := (arguments at:1) evaluate.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
nameSpace := Class nameSpaceQuerySignal query.
nameSpace ~~ Smalltalk ifTrue:[
className := nameSpace name , '::' , className
].
change := ClassDefinitionChange new.
change className:className; source:(parseTree printString).
receiver isVariable ifTrue:[
change superClassName:receiver name.
].
selector keywords with:arguments do:[:kw :arg |
kw = #'instanceVariableNames:' ifTrue:[
change instanceVariableNames:arg evaluate.
].
kw = #'classVariableNames:' ifTrue:[
change classVariableNames:arg evaluate.
].
kw = #'poolDictionaries:' ifTrue:[
change poolDictionaries:arg evaluate.
].
kw = #'category:' ifTrue:[
change category:arg evaluate.
].
kw = #'privateIn:' ifTrue:[
change className:(arg name ,'::',change classNameWithoutNamespace).
change owningClassName:(arg name).
change private:true.
].
].
change package:(Class packageQuerySignal query).
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ change nameSpaceName:(nameSpace name).
"/ ].
"/
self addChange:change.
^ true
"Modified: / 30-08-2010 / 13:56:32 / cg"
!
handleClassInstanceVariableDefinitionChange
|change|
className := self receiversClassName.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
change := ClassInstVarDefinitionChange new.
change className:className.
change source:(parseTree printString).
change classInstVarNames:(parseTree arguments first value asCollectionOfWords asArray).
self addChange:change.
^ true
"Modified: / 25-11-2011 / 17:40:49 / cg"
!
handleMethodCategoryChange
|change|
(receiver isMessage
and:[receiverSelector == #'compiledMethodAt:']) ifFalse:[
self error:'unexpected change' mayProceed:true.
^ false.
].
className := self classNameOf:receiverReceiver.
self assert:className notNil.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
methodSelector := (receiver arguments at:1) evaluate.
self assert:methodSelector notNil.
change := MethodCategoryChange new.
change
className:className
selector:methodSelector
category:(arguments at:1) evaluate.
self addChange:change.
^ true
!
handleMethodCategoryRenameChange
|change|
className := self receiversClassName.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
change := MethodCategoryRenameChange new.
change
className:className;
oldCategoryName:(arguments at:1) evaluate
newCategoryName:(arguments at:2) evaluate.
self addChange:change.
^ true
!
handleMethodChange
[
^ self handleMethodChangeUnsafe
] on: Error do:[:ex|
| change |
change := InvalidChange new source: chunk.
self addChange: change.
"Read methods that may follow"
[ (chunk := inputStream nextChunk) notEmptyOrNil ] whileTrue:[
change := InvalidChange new source: chunk.
self addChange: change.
]
].
^ true
"Modified (comment): / 24-01-2012 / 17:32:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
handleMethodChangeUnsafe
|priv categoryName methodSource changes change parser |
(selector == #'ignoredMethodsFor:') ifTrue:[
priv := #ignored.
] ifFalse:[
priv := nil
].
className := self receiversClassName.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
((selector == #'methods')
or:[(selector == #'publicMethods')
or:[(selector == #'methodsFor')]]) ifTrue:[
categoryName := 'uncategorized public'
] ifFalse:[
(selector == #'privateMethods') ifTrue:[
categoryName := 'uncategorized private'
] ifFalse:[
categoryName := (arguments at:1) evaluate.
]
].
inputStream skipSeparators.
lineNumber := inputStream lineNumber.
position := inputStream position1Based.
methodSource := chunk := inputStream nextChunk.
changes := OrderedCollection new.
[methodSource notEmptyOrNil] whileTrue:[
parser := Parser
parseMethodArgAndVarSpecification:methodSource
in:nil
ignoreErrors:true
ignoreWarnings:true
parseBody:false.
parser isNil ifTrue:[
"/ something wierd ...
methodSelector := '????'.
] ifFalse:[
methodSelector := parser selector.
].
change := MethodChange new.
change
className:className
selector:methodSelector
source:methodSource
category:categoryName
privacy:priv.
self addChange:change.
inputStream skipSeparators.
lineNumber := inputStream lineNumber.
position := inputStream position1Based.
methodSource := chunk := inputStream nextChunk.
].
^ true
"Created: / 24-01-2012 / 16:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
handleMethodPrivacyChange
|change|
(receiver isMessage
and:[receiverSelector == #'compiledMethodAt:']) ifFalse:[
self error:'unexpected change' mayProceed:true.
^ false.
].
className := self classNameOf:receiverReceiver.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
methodSelector := (receiver arguments at:1) evaluate.
change := MethodPrivacyChange new.
change
className:className
selector:methodSelector
privacy:(arguments at:1) evaluate.
self addChange:change.
^ true
!
handleNameSpaceCreationChange
|change|
(self checkReceiverIsGlobalNamed:#Namespace) ifFalse:[
(self checkReceiverIsGlobalNamed:#NameSpace) ifFalse:[
self error:'unexpected receiver in nameSpace message' mayProceed:true.
^ false
].
].
className := (arguments at:1) evaluate.
change := NameSpaceCreationChange new.
change name:className.
self addChange:change.
^ true
!
handlePrimitiveChange
|change primSource|
className := self receiversClassName.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
inputStream skipSeparators.
primSource := inputStream nextChunk.
selector == #'primitiveDefinitions' ifTrue:[
change := ClassPrimitiveDefinitionsChange new
] ifFalse:[
selector == #'primitiveFunctions' ifTrue:[
change := ClassPrimitiveFunctionsChange new
] ifFalse:[
change := ClassPrimitiveVariablesChange new
]
].
change className:className source:primSource.
self addChange:change.
^ true
!
handleRemoveClassChange
|change|
(self checkReceiverIsGlobalNamed:#Smalltalk) ifFalse:[
self error:'unexpected receiver in remove-class message' mayProceed:true.
^ false
].
className := (arguments at:1) name.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
change := ClassRemoveChange new.
change className:className.
self addChange:change.
^ true
!
handleRemoveMethodChange
|change|
className := self receiversClassName.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
methodSelector := (arguments at:1) evaluate.
change := MethodRemoveChange new.
change className:className selector:methodSelector.
self addChange:change.
^ true
!
handleRenameClassChange
|oldName newName change|
(self checkReceiverIsGlobalNamed:#Smalltalk) ifFalse:[
self error:'unexpected receiver in rename-class message' mayProceed:true.
^ false.
].
oldName := (arguments at:1) name.
newName := (arguments at:2) evaluate.
change := ClassRenameChange new oldName:oldName newName:newName.
self addChange:change.
^ true
!
handleSqueakCommentStamp
|comment change|
inputStream skipSeparators.
comment := inputStream nextChunk.
className := self receiversClassName.
change := ClassCommentChange new.
change className:className comment:comment.
change source:(parseTree printString).
self addChange:change.
^ true
!
handleVW7ClassDefinitionChange
|nameSpace change|
nameSpace := receiver.
className := (arguments at:1) evaluate.
"/ nameSpace := Class nameSpaceQuerySignal query.
"/ nameSpace ~~ Smalltalk ifTrue:[
"/ className := nameSpace name , '::' , className
"/ ].
change := ClassDefinitionChange new.
change className:className; source:(parseTree printString).
change package:(Class packageQuerySignal query).
self addChange:change.
^ true
!
processChange
"given a parse-tree (from parsing some changes source/chunk),
create changes and evaluate changeAction on each.
The block is invoked with the change and a lineNumberOrNil as
arg; the lineNumber is only valid, if the underlying stream
provides line-numbers; otherwise, nil is passed."
[
^ self processChangeUnsafe
] on: Error do:[:ex|
| change |
change := InvalidChange new source: chunk.
self addChange: change.
].
^true
"Modified: / 24-01-2012 / 17:34:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
processChangeUnsafe
"given a parse-tree (from parsing some changes source/chunk),
create changes and evaluate changeAction on each.
The block is invoked with the change and a lineNumberOrNil as
arg; the lineNumber is only valid, if the underlying stream
provides line-numbers; otherwise, nil is passed."
|dispatchSelector|
dispatchSelector := ('process_',(selector copyReplaceAll:$: with:$_)) asSymbol.
"/ Transcript showCR:dispatchSelector.
(self respondsTo:dispatchSelector) ifTrue:[
^ self perform:dispatchSelector.
].
"/ any subclass definiton selector ?
(Behavior definitionSelectors includes:selector)
ifTrue:[
^ self handleClassDefinitionChange.
].
^ false
"Created: / 24-01-2012 / 17:33:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
process_categoriesFor_
"'categoriesFor:' chunk (Dolphin)"
^ self handleCategoriesForChange.
!
process_category_
"'category:' chunk (ST/X)"
^ self handleMethodCategoryChange.
!
process_commentStamp_prior_
"'commentStamp:prior::' chunk (Squeak)"
^ self handleSqueakCommentStamp.
!
process_comment_
"'comment:' chunk (ST/X)"
^ self handleClassCommentChange.
!
process_ignoredMethodsFor_
"'ignoredMethodsFor:' chunk (ST/X)"
^ self handleMethodChange.
!
process_instanceVariableNames_
"'instanceVariableNames:' chunk (ST/X)"
^ self handleClassInstanceVariableDefinitionChange.
!
process_methods
"'methods' chunk (ST/V and dolphin)"
^ self handleMethodChange.
!
process_methodsFor
"'methodsFor' chunk (ST/V and dolphin)"
^ self handleMethodChange.
!
process_methodsForUndefined_
"'methodsForUndefined:' chunk (?)"
^ self handleMethodChange.
!
process_methodsFor_
"'methodsFor:' chunk (ST/80, Squeak, ST/X, VW, ...)"
^ self handleMethodChange.
!
process_methodsFor_stamp_
"'methodsFor:stamp:' chunk (Squeak)"
^ self handleMethodChange.
!
process_name_
"'name:' chunk (ST/X)"
^ self handleNameSpaceCreationChange.
!
process_primitiveDefinitions
"'primitiveDefinitions' chunk (ST/X)"
^ self handlePrimitiveChange.
!
process_primitiveFunctions
"'primitiveFunctions' chunk (ST/X)"
^ self handlePrimitiveChange.
!
process_primitiveVariables
"'primitiveVariables' chunk (ST/X)"
^ self handlePrimitiveChange.
!
process_privacy_
"'privacy:' chunk (ST/X)"
^ self handleMethodPrivacyChange.
!
process_privateMethods
"'privateMethods' chunk (ST/V and dolphin)"
^ self handleMethodChange.
!
process_privateMethodsFor_
"'privateMethodsFor:' chunk (ST/X)"
^ self handleMethodChange.
!
process_protectedMethodsFor_
"'protectedMethodsFor:' chunk (ST/X)"
^ self handleMethodChange.
!
process_publicMethods
"'publicMethods' chunk (ST/V and dolphin)"
^ self handleMethodChange.
!
process_publicMethodsFor_
"'publicMethodsFor:' chunk (ST/X)"
^ self handleMethodChange.
!
process_removeClass_
"'removeClass:' chunk (ST/X)"
^ self handleRemoveClassChange.
!
process_removeSelector_
"'removeSelector:' chunk (ST/X)"
^ self handleRemoveMethodChange.
!
process_renameCategory_to_
"'renameCategory:to:' chunk (ST/X)"
^ self handleMethodCategoryRenameChange.
!
process_renameClass_to_
"'renameClass:to:' chunk (ST/X)"
^ self handleRenameClassChange.
! !
!ChangeSet::ClassSourceWriter methodsFor:'private'!
analyze
"Analyzes changeset an build some index"
classInfos := Dictionary new.
metaInfos := Dictionary new.
topClassName := nil.
"Pass 1 - collect classes"
changeSetBeingSaved do:[:change|
change isClassDefinitionChange ifTrue:[
| nm |
nm := change className.
(nm endsWith:' class') ifFalse:[
(classInfos includesKey: nm) ifTrue:[
self error:'Multiple definitions of class ', nm.
^self.
].
classInfos at: nm put: (ClassInfo new name: nm).
metaInfos at: nm put: (ClassInfo new name: nm , ' class').
change isPrivateClassDefinitionChange ifFalse:[
topClassName notNil ifTrue:[
self error: ('Multiple top class definitions (%1 vs %2)' bindWith: topClassName with: nm).
].
topClassName := nm.
]
].
]
].
"Pass 2: fill in infos"
changeSetBeingSaved do:[:change|
| nm info |
nm := change className.
(nm endsWith: ' class') ifTrue:[
info := metaInfos at: (nm copyTo:(nm size - 6)).
] ifFalse:[
info := classInfos at: nm.
"Fill superclass info..."
change isClassDefinitionChange ifTrue:[
| superNm |
superNm := change superClassName.
(classInfos includesKey: superNm) ifTrue:[
info superclass: (classInfos at: superNm).
(metaInfos at: nm) superclass: (classInfos at: superNm).
].
].
].
info addChange: change.
].
"
ChangeSet::ClassSourceWriter new
changeSetBeingSaved: (ChangeSet forExistingClass: ChangeSet);
analyze;
yourself
"
"Created: / 15-03-2012 / 17:51:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changeSetBeingSaved:something
changeSetBeingSaved := something.
!
privateClassesOf: classInfo
^classInfos values select:[:info|
info name size > classInfo name size and:[
(info name indexOf: $: startingAt: classInfo name size + 3) == 0.
]
]
"Created: / 15-03-2012 / 19:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
privateClassesSortedOf: classInfo
|classes|
classes := self privateClassesOf: classInfo.
(classes size > 0) ifTrue:[
classes := classes asOrderedCollection.
classes sort:[:a :b | a name < b name].
classes topologicalSort:[:a :b |
"/ a must come before b iff:
"/ b is a subclass of a
"/ b has a private class which is a subclass of a
|mustComeBefore pivateClassesOfB|
mustComeBefore := (b isSubclassOf:a) or:[b isPrivateClassOf: a].
mustComeBefore
].
].
^ classes.
"
Object privateClassesSorted
NewSystemBrowser privateClassesSorted
NewSystemBrowser privateClasses
"
"Created: / 15-03-2012 / 19:45:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::ClassSourceWriter methodsFor:'source writing'!
fileOut:aChangeSet on:outStreamArg withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
|collectionOfCategories versionMethods
nonMeta meta classesImplementingInitialize outStream|
changeSetBeingSaved := aChangeSet.
self analyze.
nonMeta := classInfos at: topClassName.
meta := metaInfos at: topClassName.
methodsAlreadySaved := Set new.
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.
"
self generateHeaderWithCopyrightOn:outStream.
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.
"/ ].
"/
"/ ST/X primitive definitions - if any
"/
self fileOutPrimitiveSpecsOf: nonMeta on:outStream.
].
^self.
"/
"/ 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.
versionMethods := meta methodDictionary values select:[:mthd | mthd isVersionMethod].
collectionOfCategories notNil ifTrue:[
"/
"/ documentation first (if any), but not the version method
"/
(collectionOfCategories includes:'documentation') ifTrue:[
"/ versionMethods do:[:versionMethod |
"/ |source|
"/
"/ source := versionMethod source.
"/ (source isEmptyOrNil or:[(source startsWith:nonMeta nameOfOldVersionMethod) not]) ifTrue:[
"/ "something bad happend to the classes code"
"/
"/ Class fileOutErrorSignal
"/ raiseRequestWith:aClass
"/ errorString:' - bad source for version method (uncompiled class file?): ', (versionMethod displayString)
"/ ].
"/ ].
self fileOutCategory:'documentation' of:meta except:versionMethods 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
]
]
].
"/ if there are any primitive definitions (vw-like ffi-primitives),
"/ file them out first in the order: defines, types.
"/ Otherwise, we might have trouble when filing in later, because the types are needed
"/ for the primitive calls.
nonMeta methodDictionary keysAndValuesDo:[:sel :m |
m isVisualWorksTypedef ifTrue:[
self fileOutCategory:m category of:nonMeta except:nil only:(Array with:m) methodFilter:methodFilter on:outStream.
].
].
"/
"/ 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
"/
versionMethods notEmpty ifTrue: [
self fileOutCategory:'documentation' of:meta except:nil only:versionMethods 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: / 29-09-2011 / 14:53:49 / cg"
"Created: / 15-03-2012 / 17:39:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutAllDefinitionsOf:nonMetaInfo on:aStream
"append expressions on aStream, which defines myself and all of my private classes."
| metaInfo |
aStream nextPutAll: nonMetaInfo definition source.
aStream nextPutChunkSeparator.
aStream cr; cr.
"/
"/ optional classInstanceVariables
"/
metaInfo := metaInfos at: nonMetaInfo name.
metaInfo definition notNil ifTrue:[
aStream nextPutAll: metaInfo definition source.
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:[
(self privateClassesSortedOf: nonMetaInfo) do:[:i |
self fileOutAllDefinitionsOf:i on:aStream
]
]
].
"Created: / 15-10-1996 / 11:15:19 / cg"
"Modified: / 22-03-1997 / 16:11:56 / cg"
"Created: / 15-03-2012 / 19:18:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
fileOutPrimitiveSpecsOf: nonMeta on:outStream
"Nothing now..."
"Created: / 15-03-2012 / 19:48:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateHeaderWithCopyrightOn:outStream
|copyrightChange copyrightText|
copyrightChange :=
(metaInfos at: topClassName) methodAt: #copyright.
copyrightChange notNil ifTrue:[
"
get the copyright method's comment-text, strip off empty and blank lines
and insert at beginning.
"
copyrightText := Parser methodCommentFromSource: copyrightChange source.
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.
].
].
].
"Created: / 15-03-2012 / 19:01:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::ClassSourceWriter::ClassInfo class methodsFor:'instance creation'!
new
"return an initialized instance"
^ self basicNew initialize.
! !
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'accessing'!
definition
^ definition
!
definition:something
definition := something.
!
methodAt: selector
^methods detect:[:each|each selector == selector] ifNone:[nil].
"Created: / 15-03-2012 / 19:11:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
methods
^ methods
!
methods:something
methods := something.
!
name
^ name
!
name:something
name := something.
!
superclass
^ superclass
!
superclass:something
superclass := something.
! !
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'adding'!
addChange: change
change isClassDefinitionChange ifTrue:[
definition := change.
^self.
].
change isMethodCodeChange ifTrue:[
methods add: change.
^self.
].
self error: 'Unknown change'
"Created: / 15-03-2012 / 19:12:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
"/ please change as required (and remove this comment)
"/ name := nil.
"/ instDefinition := nil.
"/ classDefinition := nil.
methods := OrderedCollection new.
"/ super initialize. -- commented since inherited method does nothing
"Modified: / 15-03-2012 / 19:12:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'printing & storing'!
printOn:aStream
"append a printed representation if the receiver to the argument, aStream"
super printOn:aStream.
aStream nextPutAll:'('.
name printOn:aStream.
aStream nextPutAll:')'.
"Modified: / 15-03-2012 / 19:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'queries'!
isPrivateClassOf: classInfo
^name startsWith: classInfo name
"Created: / 15-03-2012 / 19:42:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isSubclassOf: classInfo
^superclass notNil and:
[superclass == classInfo or:[superclass isSubclassOf: classInfo]]
"Created: / 15-03-2012 / 19:41:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ChangeSet::DiffSet class methodsFor:'documentation'!
documentation
"
I represent the differences between two change sets.
As such, I can be used by a VersionDiffBrowser and to generate patchSets.
"
! !
!ChangeSet::DiffSet methodsFor:'accessing'!
changed
"return the set of methods which were different"
^ changed
"Modified: / 12-10-2006 / 22:06:55 / cg"
!
changed:something
"set the set of changed methods"
changed := something.
"Modified: / 12-10-2006 / 22:06:03 / cg"
!
changed:changedArg onlyInReceiver:onlyInReceiverArg onlyInArg:onlyInArgArg
"set instance variables (automatically generated)"
changed := changedArg.
changed isNil ifTrue:[changed := OrderedCollection new].
onlyInReceiver := onlyInReceiverArg.
onlyInReceiver isNil ifTrue:[onlyInReceiver := ChangeSet new].
onlyInArg := onlyInArgArg.
onlyInArg isNil ifTrue:[onlyInArg := ChangeSet new].
!
onlyInArg
"return the set of methods which were only present in the argument of the diffset"
^ onlyInArg
"Modified: / 12-10-2006 / 22:07:02 / cg"
!
onlyInArg:something
onlyInArg := something.
!
onlyInReceiver
"return the set of methods which were only present in the receiver of the diffset"
^ onlyInReceiver
"Modified: / 12-10-2006 / 22:07:12 / cg"
!
onlyInReceiver:something
onlyInReceiver := something.
! !
!ChangeSet::DiffSet methodsFor:'merging'!
addDiffSet:anotherDiffset
changed addAll:(anotherDiffset changed).
onlyInReceiver addAll:(anotherDiffset onlyInReceiver).
onlyInArg addAll:(anotherDiffset onlyInArg).
"Created: / 12-10-2006 / 22:49:30 / cg"
!
copy
^ self class new
changed:changed copy
onlyInReceiver:onlyInReceiver copy
onlyInArg:onlyInArg copy
"Created: / 12-10-2006 / 22:50:56 / cg"
! !
!ChangeSet::DiffSet methodsFor:'misc'!
removeAllVersionMethods
changed := changed
reject:[:pair |
pair first isMethodChangeForVersionMethod
].
onlyInReceiver := onlyInReceiver
reject:[:chg |
chg isMethodChangeForVersionMethod
].
onlyInArg := onlyInArg
reject:[:chg |
chg isMethodChangeForVersionMethod
].
! !
!ChangeSet::DiffSet methodsFor:'queries'!
isEmpty
^ changed isEmpty
and:[ onlyInReceiver isEmpty
and:[ onlyInArg isEmpty ] ]
!
notEmpty
^ self isEmpty not
"Created: / 12-10-2006 / 23:12:27 / cg"
! !
!ChangeSet::DolphinPACFileReader methodsFor:'reading-private'!
handleCategoriesForClass
|category change|
[
inputStream skipSeparators.
category := inputStream nextChunk.
category notEmpty
] whileTrue:[
change := ClassCategoryChange new.
change
className:className
category:category.
self addChange:change.
].
^ true
!
handleCategoriesForMethod
|methodSelector categories change isPrivate isPublic category|
methodSelector := (arguments at:1) evaluate.
inputStream skipSeparators.
isPrivate := false.
categories := OrderedCollection new.
[
|done category |
category := inputStream nextChunk withoutSeparators.
done := category isEmpty.
done ifFalse:[
categories add:category
].
done
] whileFalse.
categories size > 1 ifTrue:[
isPrivate := categories includes:'private'.
categories remove:'private' ifAbsent:nil.
].
categories size > 1 ifTrue:[
isPublic := categories includes:'public'.
categories remove:'public' ifAbsent:nil.
].
"/ categories size > 1 ifTrue:[
"/ self halt.
"/ ].
category := categories first.
isPrivate ifTrue:[
category := category , '-private'.
].
change := MethodCategoryChange new.
change
className:className
selector:methodSelector
category:category.
self addChange:change.
^ true
!
processChange
"given a parse-tree (from parsing some changes source/chunk),
create changes and evaluate changeAction on each.
The block is invoked with the change and a lineNumberOrNil as
arg; the lineNumber is only valid, if the underlying stream
provides line-numbers; otherwise, nil is passed."
(selector == #'categoriesForClass') ifTrue:[
^ self handleCategoriesForClass.
].
(selector == #'categoriesFor:') ifTrue:[
^ self handleCategoriesForMethod.
].
selector == #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:classInstanceVariableNames:' ifTrue:[
^ self handleClassDefinitionChange.
].
"/ selector == #'guid:' ifTrue:[
"/ ^ self handleGUIDChange.
"/ ].
^ super processChange
"/ selector == #named:superclass:indexedInstanceVariables:instanceVariableNames:classVariableNames:sharedPools:classInstanceVariableNames: ifTrue:[
"/ ^ self handleClassDefinitionChange.
"/ ].
"/ (selector == #'key:value:') ifTrue:[
"/ (self checkReceiverIsGlobalNamed:'Annotation') ifTrue:[
"/ ^ self handleAnnotation.
"/ ]
"/ ].
"/ selector == #'method' ifTrue:[
"/ ^ self handleMethodChange:false.
"/ ].
"/ selector == #'classMethod' ifTrue:[
"/ ^ self handleMethodChange:true.
"/ ].
"/
"/ selector == #'initializer' ifTrue:[
"/ ^ true
"/ ].
"/ selector == #'initialize' ifTrue:[
"/ ^ true
"/ ].
"/self halt.
"/
"/ ^ false
"Created: / 16.2.1998 / 13:42:40 / cg"
"Modified: / 15.12.1999 / 00:29:06 / cg"
! !
!ChangeSet::SIFChangeFileReader methodsFor:'reading-private'!
handleAnnotation
|key value lastChange change|
key := (arguments at:1) evaluate.
value := (arguments at:2) evaluate.
key = 'Prerequisite' ifTrue:[
"/ change := SIFPrerequisiteChange new prerequisiteFileName:value.
"/ self addChange:change.
^ true
].
lastChange := changeSet last.
key = 'package' ifTrue:[
change := ClassCategoryChange new className:(lastChange className) category:value.
self addChange:change.
^ true
].
key = 'category' ifTrue:[
"/ change := MethodCategoryChange new className:(lastChange className) selector:(lastChange selector) category:value.
"/ self addChange:change.
lastChange category:value.
^ true
].
key = 'stamp' ifTrue:[
"/ lastChange timeStamp:value.
^ true
].
^ false
!
handleClassDefinitionChange
|nameSpace change|
(self checkReceiverIsGlobalNamed:#Class) ifFalse:[
self error:'unexpected receiver in classDefinition message' mayProceed:true.
^ false.
].
className := (arguments at:1) evaluate.
nameSpace := Class nameSpaceQuerySignal query.
nameSpace ~~ Smalltalk ifTrue:[
className := nameSpace name , '::' , className
].
change := ClassDefinitionChange new.
change className:className; source:(parseTree printString).
change package:(Class packageQuerySignal query).
self addChange:change.
^ true
!
handleMethodChange:isMeta
|categoryName methodSource change parser |
className := self receiversClassName.
isMeta ifTrue:[
className := className , ' class'
].
categoryName := 'uncategorized'.
inputStream skipSeparators.
lineNumber := inputStream lineNumber.
position := inputStream position1Based.
methodSource := inputStream nextChunk.
parser := Parser
parseMethodArgAndVarSpecification:methodSource
in:nil
ignoreErrors:true
ignoreWarnings:true
parseBody:false.
parser isNil ifTrue:[
"/ something wierd ...
methodSelector := '????'.
] ifFalse:[
methodSelector := parser selector.
].
change := MethodChange new.
change
className:className
selector:methodSelector
source:methodSource
category:categoryName
privacy:nil.
self addChange:change.
^ true
!
processChange
"given a parse-tree (from parsing some changes source/chunk),
create changes and evaluate changeAction on each.
The block is invoked with the change and a lineNumberOrNil as
arg; the lineNumber is only valid, if the underlying stream
provides line-numbers; otherwise, nil is passed."
(selector == #'interchangeVersion:') ifTrue:[
^ true
].
selector == #named:superclass:indexedInstanceVariables:instanceVariableNames:classVariableNames:sharedPools:classInstanceVariableNames: ifTrue:[
^ self handleClassDefinitionChange.
].
(selector == #'key:value:') ifTrue:[
(self checkReceiverIsGlobalNamed:'Annotation') ifTrue:[
^ self handleAnnotation.
]
].
selector == #'method' ifTrue:[
^ self handleMethodChange:false.
].
selector == #'classMethod' ifTrue:[
^ self handleMethodChange:true.
].
selector == #'initializer' ifTrue:[
^ true
].
selector == #'initialize' ifTrue:[
^ true
].
^ false
"Created: / 16.2.1998 / 13:42:40 / cg"
"Modified: / 15.12.1999 / 00:29:06 / cg"
! !
!ChangeSet class methodsFor:'documentation'!
version_CVS
^ '§Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.187 2012/01/24 17:39:37 vrany Exp §'
!
version_SVN
^ '$Id: ChangeSet.st 1895 2012-03-16 16:51:41Z vranyj1 $'
! !