--- a/SourceCodeManagerUtilities.st Fri Oct 13 00:51:27 2006 +0200
+++ b/SourceCodeManagerUtilities.st Fri Oct 13 00:52:37 2006 +0200
@@ -1453,6 +1453,207 @@
"Modified: / 12-10-2006 / 17:37:21 / cg"
!
+compareProjectWithRepository:aProject
+ |classesInImage filesInImage module directory perProjectInfo
+ classesNotInRepository filesNotInImage classesDeletedInRepository
+ classesModifiedInImage classesNotReallyModified classesReallyModified classesModifiedInRepository
+ classesDeletedInImage classesAddedInImage
+ extensionsInImage extensionsInRepository extensionDiffs
+ anyDifference box doRemove doCleanup classDefs changeSets filePerClassDefintion
+ classesToCheckIn resources diffSet def autoloadedFilesNotInImage|
+
+ resources := self classResources.
+
+ module := aProject asPackageId module.
+ directory := aProject asPackageId directory.
+ perProjectInfo := SourceCodeManager newestRevisionsInModule:module directory:directory.
+ perProjectInfo := perProjectInfo ? #().
+ perProjectInfo := perProjectInfo select:[:info | info key asFilename hasSuffix:'st'].
+ perProjectInfo := Dictionary withAssociations:perProjectInfo.
+
+ classesInImage := Smalltalk allClassesInPackage:aProject.
+ classesInImage := classesInImage reject:[:cls | cls isPrivate].
+ filesInImage := (classesInImage collect:[:cls | cls classBaseFilename]) asSet.
+ "/ any differences ?
+ classesNotInRepository := classesInImage reject:[:cls | (perProjectInfo includesKey:cls classBaseFilename)].
+ classesDeletedInRepository := classesInImage select:[:cls | (perProjectInfo at:cls classBaseFilename ifAbsent:nil) == #deleted].
+ perProjectInfo := perProjectInfo reject:[:v | v == #deleted].
+ filesNotInImage := perProjectInfo keys reject:[:file | (filesInImage includes:file)].
+ filesNotInImage remove:'extensions.st' ifAbsent:[].
+
+ classesModifiedInImage := classesInImage select:[:cls |ChangeSet current includesChangeForClassOrMetaclass:cls].
+ classesModifiedInImage := classesModifiedInImage \ classesNotInRepository.
+
+ classesModifiedInRepository := classesInImage select:[:cls | |v|
+ v := (perProjectInfo at:cls classBaseFilename ifAbsent:nil).
+ v notNil and:[ cls isLoaded and:[ v > cls revision ]]].
+
+ "/ stupid: as we do not have any revision information for extensions (sigh);
+ "/ we must checkout and look at the extension.st contents, to see if it has changed.
+
+ extensionsInImage := OrderedCollection new.
+ Smalltalk allClasses do:[:eachClass |
+ extensionsInImage addAll:(eachClass extensionsFrom:aProject)
+ ].
+ extensionsInImage := ChangeSet forExistingMethods:extensionsInImage.
+
+ [
+ |s|
+
+ s := SourceCodeManager
+ streamForClass:nil fileName:'extensions.st' revision:#newest directory:directory module:module cache:true.
+ s isNil ifTrue:[
+ extensionsInRepository := ChangeSet new.
+ ] ifFalse:[
+ extensionsInRepository := ChangeSet fromStream:s.
+ s close.
+ ].
+ ] value.
+ extensionDiffs := extensionsInRepository diffSetsAgainst:extensionsInImage.
+
+ diffSet := extensionDiffs copy.
+
+ "/ we could do the same as above for each class.
+ "/ however - as we do have change-info and revision info, we can avoid checking out
+ "/ for all classes which are not changed and which have the same version info.
+
+ classesModifiedInImage notEmpty ifTrue:[
+ classesReallyModified :=
+ classesModifiedInImage select:[:eachChangedClass |
+ |currentVersion repositoryVersion s stFile diffs|
+
+ stFile := eachChangedClass classBaseFilename.
+ s := SourceCodeManager
+ streamForClass:nil fileName:stFile revision:#newest directory:directory module:module cache:true.
+ repositoryVersion := ChangeSet fromStream:s.
+ s close.
+
+ currentVersion := ChangeSet forExistingClass:eachChangedClass.
+ diffs := repositoryVersion diffSetsAgainst:currentVersion .
+ diffSet addDiffSet:diffs.
+ diffs notEmpty
+ ].
+
+ classesNotReallyModified := classesModifiedInImage \ classesReallyModified.
+ ].
+
+ filesNotInImage notEmpty ifTrue:[
+ "/ first, check if these are autoloaded classes which have NOT been installed
+ "/ (for example, due to a --quick argument during startup)
+ autoloadedFilesNotInImage := OrderedCollection new.
+
+ def := ProjectDefinition definitionClassForPackage:aProject createIfAbsent:false projectType:nil.
+ def notNil ifTrue:[
+ def classNamesAndAttributesDo:[:eachClassname :eachAttributes |
+ |cls eachFileName isAutoload|
+
+ cls := Smalltalk classNamed:eachClassname.
+ cls isNil ifTrue:[
+ isAutoload := eachAttributes includes:#autoload.
+ isAutoload ifTrue:[
+ eachFileName := Smalltalk fileNameForClass:eachClassname.
+ autoloadedFilesNotInImage add:(eachFileName , '.st')
+ ]
+ ]
+ ].
+ ].
+
+ (filesNotInImage \ autoloadedFilesNotInImage) do:[:eachSTFile |
+ |s chgSet classDefinitions|
+
+ s := SourceCodeManager
+ streamForClass:nil fileName:eachSTFile revision:#newest directory:directory module:module cache:true.
+ chgSet := ChangeSet fromStream:s.
+ s close.
+
+ diffSet onlyInReceiver addAll:chgSet
+ ].
+ ].
+
+ classesModifiedInRepository notEmpty ifTrue:[
+ classesModifiedInRepository do:[:eachClass|
+ |s diffs repositoryVersion currentVersion|
+
+ s := SourceCodeManager
+ streamForClass:eachClass fileName:nil revision:#newest directory:directory module:module cache:true.
+ repositoryVersion := ChangeSet fromStream:s.
+ s close.
+
+ currentVersion := ChangeSet forExistingClass:eachClass.
+ diffs := repositoryVersion diffSetsAgainst:currentVersion .
+ diffSet addDiffSet:diffs.
+ ].
+ ].
+ classesDeletedInRepository notEmpty ifTrue:[
+self halt.
+ ].
+ classesNotInRepository notEmpty ifTrue:[
+ "/ if there are no changeSet entries for those classes, they seem to be
+ "/ no longer in the repository (possibly moved ?)
+ "/ If there are entries, these might have been added in the image and need a check-in
+
+ classesAddedInImage := classesNotInRepository \ classesDeletedInRepository.
+ classesAddedInImage do:[:eachAddedClass |
+ |currentVersion|
+
+ currentVersion := ChangeSet forExistingClass:eachAddedClass.
+ diffSet onlyInArg addAll:currentVersion.
+ ].
+ ].
+
+ diffSet isEmpty ifTrue:[
+ "/ Dialog information:(resources string:'%1 is up-to-date.' with:eachProject allBold).
+ Transcript showCR:('%1 is up-to-date.' bindWith:aProject allBold).
+ (Dialog confirm:('%1 is up-to-date.\\Cleanup ChangeSet ?' bindWith:aProject allBold)) ifTrue:[
+ self halt.
+ ChangeSet current condenseChangesForPackage:aProject.
+ ].
+ ^ self.
+ ].
+
+ classesNotReallyModified notEmpty ifTrue:[
+self halt.
+ doCleanup := false.
+ box := Dialog
+ forRequestText:(resources
+ stringWithCRs:'The following classes from %1 are equal to the repository version.\\Remove entries from the changeSet ?'
+ with:aProject allBold)
+ editViewClass:ListView
+ lines:10 columns:20
+ initialAnswer:nil model:nil
+ setupWith:
+ [:v :d |
+ |removeButton|
+
+ v list:classesNotReallyModified.
+ removeButton := Button label:(resources string:'Cleanup ChangeSet').
+ removeButton action:[ doCleanup := true. box okPressed. ].
+ d addButton:removeButton after:(d okButton).
+ d okButton label:(resources string:'Continue').
+ d okButton isReturnButton:false.
+ removeButton isReturnButton:true.
+ ].
+ box open.
+ box accepted ifFalse:[
+ ^ self
+ ].
+ doCleanup ifTrue:[
+ classesNotReallyModified do:[
+ ChangeSet current condenseChangesForClass:classesNotReallyModified.
+ ]
+ ].
+ ].
+
+ VersionDiffBrowser
+ openOnDiffSet:diffSet
+ labelA:'Repository'
+ labelB:'Image'
+ title:('Differences of %1' bindWith:aProject).
+
+ "Created: / 12-10-2006 / 21:44:54 / cg"
+ "Modified: / 13-10-2006 / 00:40:29 / cg"
+!
+
createSourceContainerForClass:aClass
"let user specify the source-repository values for aClass"
@@ -2625,5 +2826,5 @@
!SourceCodeManagerUtilities class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.146 2006-10-12 19:32:13 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.147 2006-10-12 22:52:37 cg Exp $'
! !