--- a/SourceCodeManagerUtilities.st Wed Oct 12 23:14:00 2011 +0200
+++ b/SourceCodeManagerUtilities.st Thu Oct 13 13:10:39 2011 +0200
@@ -12,7 +12,7 @@
"{ Package: 'stx:libbasic3' }"
Object subclass:#SourceCodeManagerUtilities
- instanceVariableNames:'manager'
+ instanceVariableNames:'manager resources'
classVariableNames:'LastSourceLogMessage LastModule LastPackage YesToAllQuery
YesToAllNotification'
poolDictionaries:''
@@ -59,6 +59,12 @@
^self new setManager: aSourceCodeManager
"Created: / 10-10-2011 / 11:45:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
! !
!SourceCodeManagerUtilities class methodsFor:'Signal constants'!
@@ -674,6 +680,13 @@
!SourceCodeManagerUtilities methodsFor:'initialization'!
+initialize
+
+ resources := self classResources.
+
+ "Modified: / 13-10-2011 / 11:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
setManager: aSourceCodeManager
manager := aSourceCodeManager
@@ -1011,6 +1024,102 @@
"Modified: / 09-02-2011 / 13:54:01 / cg"
!
+checkinBuildSupportFilesForPackage:packageID
+
+ |anyFailure module directory mgr defClass |
+
+ mgr := self sourceCodeManagerFor: packageID.
+ defClass := ProjectDefinition definitionClassForPackage: packageID.
+
+ defClass validateDescription.
+
+ anyFailure := false.
+
+ module := packageID asPackageId module.
+ directory := packageID asPackageId directory.
+
+ self activityNotification:(resources string:'checking in build-support files...').
+ (mgr checkForExistingModule:module directory:directory) ifFalse:[
+ mgr createModule:module directory:directory
+ ].
+ defClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |
+ |realFileName realDirectory|
+
+ "/ care for subdirectories
+ (fileName includes:$/) ifTrue:[
+ realDirectory := (directory asFilename construct:(fileName asFilename directoryName)) name.
+ realFileName := fileName asFilename baseName.
+ ] ifFalse:[
+ realDirectory := directory.
+ realFileName := fileName.
+ ].
+ realDirectory := realDirectory replaceAll:$\ with:$/.
+
+ self activityNotification:(resources string:'checking in %1...' with:realFileName).
+
+ UserInformation
+ handle:[:ex | Transcript showCR:ex description ]
+ do:[
+ (mgr
+ checkForExistingContainer:realFileName inModule:module directory:realDirectory)
+ ifFalse:[
+ realDirectory ~= directory ifTrue:[
+ (mgr checkForExistingModule:module directory:realDirectory) ifFalse:[
+ mgr createModule:module directory:realDirectory
+ ].
+ ].
+ (mgr
+ createContainerForText:fileContents
+ inModule:module
+ package:realDirectory
+ container:realFileName)
+ ifFalse:[
+ Dialog warn:(resources
+ stringWithCRs:'Cannot create new container: ''%3'' (in %1:%2)'
+ with:module
+ with:realDirectory
+ with:realFileName)
+ ].
+ ] ifTrue:[
+ (mgr
+ checkin:realFileName
+ text:fileContents
+ directory:realDirectory
+ module:module
+ logMessage:'automatically generated by browser'
+ force:false)
+ ifFalse:[
+ Transcript showCR:'checkin of ' , realFileName , ' failed'.
+ anyFailure := true.
+ ].
+ ].
+ ].
+ ].
+
+ defClass instAndClassMethodsDo:[:m | m package:defClass package].
+
+ self
+ checkinClasses:(Array with:defClass)
+ withInfo:'automatic checkIn'
+ withCheck:false.
+
+
+ self activityNotification:nil.
+
+ anyFailure ifTrue:[
+ self warn:'Checkin failed - see Transcript.'.
+ self activityNotification:'Checkin of build-support files failed - see Transcript.'.
+ ] ifFalse:[
+ self activityNotification:'Build-support files checked into the repository.'.
+ ].
+
+ "Created: / 09-08-2006 / 18:59:42 / fm"
+ "Modified: / 16-08-2006 / 18:38:49 / User"
+ "Created: / 06-09-2011 / 08:00:57 / cg"
+ "Modified: / 12-10-2011 / 11:36:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 13-10-2011 / 11:15:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
checkinClass:aClass
"check a class into the source repository.
Asks interactively for a log-message."
@@ -1385,6 +1494,224 @@
"Modified: / 12-09-2006 / 14:14:49 / cg"
!
+checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages
+ |mgr classes classesToCheckIn methodsToCheckIn
+ methodsInOtherPackages looseMethods otherPackages
+ msg classesInChangeSet checkinInfo originalCheckinInfo classesToTag|
+
+ mgr := self sourceCodeManagerFor: packageToCheckIn.
+ classes := Smalltalk allClasses.
+
+ classesToCheckIn := IdentitySet new.
+ methodsToCheckIn := IdentitySet new.
+ methodsInOtherPackages := IdentitySet new.
+ looseMethods := IdentitySet new.
+
+ "/ classes ...
+ classes do:[:aClass | |owner classPackage|
+ (owner := aClass owningClass) notNil ifTrue:[
+ classPackage := aClass topOwningClass package
+ ] ifFalse:[
+ classPackage := aClass package
+ ].
+ (classPackage = packageToCheckIn) ifTrue:[
+ classesToCheckIn add:aClass.
+ ].
+ ].
+
+ "/ cg: O(n^2) algorithm
+ "/ classesInChangeSet := classesToCheckIn select:[:cls | cls hasUnsavedChanges].
+ "/ replaced by: O(n) algorithm
+ classesInChangeSet := ChangeSet current selectForWhichIncludesChangeForClassOrMetaclassOrPrivateClassFrom:classesToCheckIn.
+
+ "/ individual methods ...
+ classes do:[:aClass |
+ aClass isMeta ifFalse:[
+ "/ ... whose class is not in the chechIn-set
+ (classesToCheckIn includes:aClass) ifFalse:[
+ aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ "/ methods in this project ...
+ (mthd package = packageToCheckIn) ifTrue:[
+ methodsToCheckIn add:mthd
+ ]
+ ]
+ ].
+ ].
+ ].
+
+ doExtensions ifTrue:[
+ methodsToCheckIn notEmpty ifTrue:[
+ doClasses ifTrue:[
+ msg := '%1 classes (%4 changed) '.
+ ] ifFalse:[
+ msg := ''.
+ ].
+ doExtensions ifTrue:[
+ doClasses ifTrue:[
+ msg := msg , 'and '.
+ ].
+ msg := msg , '%2 extensions '.
+ ].
+ msg := msg , 'of project "%3"'.
+
+ checkinInfo := self
+ getCheckinInfoFor:(msg
+ bindWith:classesToCheckIn size
+ with:methodsToCheckIn size
+ with:packageToCheckIn allBold
+ with:classesInChangeSet size)
+ initialAnswer:nil
+ withQuickOption:(classesToCheckIn size > 0).
+ checkinInfo isNil ifTrue:[
+ ^ self.
+ ].
+ (self
+ checkinExtensionMethods:methodsToCheckIn
+ forPackage:packageToCheckIn
+ withInfo:checkinInfo)
+ ifFalse:[
+ Dialog warn:(resources string:'Could not check in extensions for project %1' with:packageToCheckIn).
+ ^ self.
+ ]
+ ] ifFalse:[
+ "/ there may have been extension-methods previously - if so, remove them
+ (mgr
+ checkForExistingContainer:'extensions.st' inPackage:packageToCheckIn)
+ ifTrue:[
+"/ self halt.
+ (self
+ checkinExtensionMethods:#()
+ forPackage:packageToCheckIn
+ withInfo:'No extensions any more')
+ ifFalse:[
+ Dialog warn:(resources string:'Could not check in extensions for project %1' with:packageToCheckIn).
+ ^ self.
+ ]
+ ]
+ ].
+ ].
+
+ checkinInfo isNil ifTrue:[
+ checkinInfo := self
+ getCheckinInfoFor:('%1 classes (%4 changed) and %2 extensions for project "%3"'
+ bindWith:classesToCheckIn size
+ with:methodsToCheckIn size
+ with:packageToCheckIn allBold
+ with:classesInChangeSet size)
+ initialAnswer:nil
+ withQuickOption:(classesToCheckIn size > 0).
+ checkinInfo isNil ifTrue:[
+ ^ self.
+ ].
+ ].
+
+ checkinInfo quickCheckIn ifTrue:[
+ (checkinInfo isStable or:[checkinInfo tagIt]) ifTrue:[
+ classesToTag := classesToCheckIn.
+ originalCheckinInfo := checkinInfo.
+ checkinInfo := checkinInfo copy.
+ checkinInfo isStable:false.
+ checkinInfo tag:nil.
+ ].
+ classesToCheckIn := classesInChangeSet.
+ ].
+
+ "/ check if any of the classes contains methods for other packages ...
+ classesToCheckIn do:[:eachClass |
+ eachClass instAndClassMethodsDo:[:eachMethod |
+ |mPgk|
+
+ mPgk := eachMethod package.
+ (mPgk = packageToCheckIn) ifFalse:[
+ mPgk == PackageId noProjectID ifTrue:[
+ looseMethods add:eachMethod
+ ] ifFalse:[
+ methodsInOtherPackages add:eachMethod
+ ]
+ ]
+ ].
+ ].
+
+ askForMethodsInOtherPackages ifTrue:[
+ methodsInOtherPackages notEmpty ifTrue:[
+ otherPackages := Set new.
+ methodsInOtherPackages do:[:eachMethod | otherPackages add:eachMethod package].
+
+ methodsInOtherPackages size == 1 ifTrue:[
+ msg := 'The ''%4'' method in ''%5'' is contained in the ''%2'' package.'.
+ msg := msg , '\\This method will remain in its package.'.
+ ] ifFalse:[
+ otherPackages size == 1 ifTrue:[
+ msg := 'The %1 methods from the %2 package will remain in its package.'
+ ] ifFalse:[
+ msg := 'The %1 methods from %3 other packages will remain in their packages.'
+ ].
+ msg := msg , '\\Hint: if these are meant to belong to this package,'.
+ msg := msg , '\move them first, then repeat the checkin operation.'.
+ ].
+ msg := msg withCRs.
+ msg := msg bindWith:methodsInOtherPackages size
+ with:otherPackages first allBold
+ with:otherPackages size
+ with:methodsInOtherPackages first selector allBold
+ with:methodsInOtherPackages first mclass name allBold.
+ (Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self].
+ ].
+ ].
+
+ doClasses ifTrue:[
+ classesToCheckIn notEmpty ifTrue:[
+ looseMethods notEmpty ifTrue:[
+ looseMethods size == 1 ifTrue:[
+ msg := 'The ''%2'' method in ''%3'' is unassigned (loose).'.
+ msg := msg , '\\If you proceed, this method will be moved to the ''%4'' package'.
+ msg := msg , '\\Hint: if this is meant to be an extension of another package,'.
+ msg := msg , '\cancel and move it to the appropriate package first.'.
+ ] ifFalse:[
+ msg := 'There are %1 unassigned (loose) methods in classes from this project.'.
+ msg := msg , '\\If you proceed, those will be moved to the ''%4'' package ?'.
+ msg := msg , '\\Hint: if these are meant to be extensions of another package,'.
+ msg := msg , '\cancel and move them to the appropriate package first.'.
+ ].
+ doClasses ifTrue:[
+ msg := msg , '\\If you answer with "No" here, you will be asked for each class individually.'.
+ ].
+ msg := msg withCRs.
+ msg := msg bindWith:looseMethods size
+ with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first selector allBold])
+ with:(looseMethods isEmpty ifTrue:[''] ifFalse:[looseMethods first mclass name allBold])
+ with:packageToCheckIn allBold.
+ (Dialog confirm:msg noLabel:(resources string:'Cancel')) ifFalse:[^ self].
+
+ looseMethods do:[:mthd |
+ mthd package:packageToCheckIn
+ ].
+ ].
+ self checkinClasses:classesToCheckIn withInfo:checkinInfo.
+ ].
+
+ originalCheckinInfo notNil ifTrue:[
+ originalCheckinInfo isStable ifTrue:[
+ classesToTag do:[:eachClass |
+ self tagClass:eachClass as:#stable
+ ].
+ ].
+ originalCheckinInfo tagIt ifTrue:[
+ classesToTag do:[:eachClass |
+ self tagClass:eachClass as:(originalCheckinInfo tag)
+ ].
+ ].
+ ].
+ ].
+
+ doBuild ifTrue:[
+ self checkinBuildSupportFilesForPackage:packageToCheckIn
+ ].
+
+ "Modified: / 08-09-2011 / 04:42:38 / cg"
+ "Created: / 13-10-2011 / 11:15:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
checkoutClass:aClass askForMerge:askForMerge
"check-out a class from the source repository."
@@ -3934,9 +4261,9 @@
!SourceCodeManagerUtilities class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.227 2011-10-12 21:14:00 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.228 2011-10-13 11:10:39 vrany Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.227 2011-10-12 21:14:00 vrany Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.228 2011-10-13 11:10:39 vrany Exp $'
! !