--- a/SVNSourceCodeManager.st Wed Jan 18 00:14:33 2012 +0100
+++ b/SVNSourceCodeManager.st Wed Jan 18 15:25:26 2012 +0100
@@ -26,10 +26,17 @@
"{ Package: 'stx:libsvn' }"
AbstractSourceCodeManager subclass:#SVNSourceCodeManager
- instanceVariableNames:''
- classVariableNames:'LoadInProgressQuery'
- poolDictionaries:''
- category:'System-SourceCodeManagement'
+ instanceVariableNames:''
+ classVariableNames:'LoadInProgressQuery'
+ poolDictionaries:''
+ category:'System-SourceCodeManagement'
+!
+
+SourceCodeManagerUtilities subclass:#Utilities
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:SVNSourceCodeManager
!
!SVNSourceCodeManager class methodsFor:'documentation'!
@@ -73,22 +80,93 @@
"
! !
+!SVNSourceCodeManager class methodsFor:'* As yet uncategorized *'!
+
+checkin:filename text:contents directory:directory module:module logMessage: message force: force
+
+ | branch wc status |
+
+ self shouldImplement.
+
+ branch := self branchForModule: module directory: directory.
+ wc := branch repository workingCopy.
+ wc ensureIsValid.
+ (wc path / filename) writingFileDo:[:s|s nextPutAll: contents].
+ status := wc status: { filename }.
+
+ "Created: / 27-11-2011 / 22:51:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+removeContainer:container inModule:module directory:directory
+
+ | repo wc |
+ repo := self repositoryForModule: module directory: directory.
+ repo isNil ifTrue:[
+ self error:'No SVN repository'.
+ ^self
+ ].
+ wc := repo workingCopy.
+ wc delete: container
+
+ "Created: / 23-12-2011 / 18:20:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+savePreferencesOn:aFileStream
+
+ "Nothing to do, since my preferences are stored in
+ UserPreferences dictionary"
+
+ "Created: / 10-06-2011 / 14:15:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SVNSourceCodeManager class methodsFor:'Signal constants'!
loadInProgressQuery
LoadInProgressQuery ifNil:
- [LoadInProgressQuery := QuerySignal new].
+ [LoadInProgressQuery := QuerySignal new].
^LoadInProgressQuery
! !
+!SVNSourceCodeManager class methodsFor:'accessing'!
+
+repositoryNameForPackage:packageId
+ "superclass AbstractSourceCodeManager class says that I am responsible to implement this method"
+
+ |repo|
+
+ repo := SVN::RepositoryManager current repositoryForPackage:packageId.
+ repo isNil ifTrue:[
+ ^ 'N/A'
+ ] ifFalse:[
+ ^ repo url asString
+ ]
+
+ "Modified: / 10-10-2011 / 19:49:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+utilities
+
+ ^Utilities forManager: self.
+
+ "Created: / 11-10-2011 / 11:24:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SVNSourceCodeManager class methodsFor:'basic access'!
checkinClass:aClass fileName:classFileName directory:packageDir module:moduleDir source:sourceFile logMessage:logMessage force:force
"checkin of a class into the source repository.
Return true if ok, false if not."
- ^ self shouldImplement
+ | repo |
+ repo := SVN::RepositoryManager repositoryForModule: moduleDir directory: packageDir.
+ repo ifNil:[^false].
+
+ self shouldImplement: 'Not yet finished'.
+
+ ^false
+
+ "Modified: / 12-10-2011 / 18:50:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
checkoutModule:aModule directory:aPackage andDo:aBlock
@@ -107,12 +185,12 @@
workingCopy checkout.
ok := true.
aBlock value: tempDir] ensure:
- [[tempDir recursiveRemove]
- on: Error do:
- [:ex|
- OperatingSystem isMSWINDOWSlike
- ifTrue:[Delay waitForSeconds: 3.[tempDir recursiveRemove] on: Error do:["nothing"]]
- ifFalse:[ex pass]]].
+ [[tempDir recursiveRemove]
+ on: Error do:
+ [:ex|
+ OperatingSystem isMSWINDOWSlike
+ ifTrue:[Delay waitForSeconds: 3.[tempDir recursiveRemove] on: Error do:["nothing"]]
+ ifFalse:[ex pass]]].
^ok
"Modified: / 19-04-2010 / 20:13:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -127,11 +205,45 @@
| pkg repo rev |
pkg := moduleDir , ':' , packageDir.
repo := SVN::RepositoryManager repositoryForPackage: pkg.
- repo ifNil:[^self error:'No repository for package ', pkg].
- rev := SVN::Revision fromString: revisionString.
- ^(repo cat: classFileName revision: rev) readStream
+ repo ifNil:[^nil].
+ (revisionString notNil and:[revisionString ~~ #newest]) ifTrue:[
+ rev := SVN::Revision fromString: revisionString.
+ ] ifFalse:[
+ rev := SVN::Revision head.
+ ].
+ doCache ifTrue:[
+ ^SourceCodeCache default
+ streamForClass:aClass
+ fileName:classFileName
+ revision:revisionString
+ repository: 'svn' "TODO: Use repository ID here"
+ module:moduleDir
+ directory:packageDir
+ ifAbsent: [:destination|
+ [SVN::ExportCommand new
+ branch: repo branch;
+ path: classFileName;
+ revision: rev;
+ destination: destination pathName;
+ execute.
+ destination exists ifTrue:[
+ destination readStream
+ ] ifFalse:[
+ nil
+ ]
+ ] on: SVN::SVNError do:[
+ nil
+ ]
+ ]
+ ] ifFalse:[
+ ^[
+ (repo cat: classFileName revision: rev) readStream
+ ] on: SVN::SVNError do:[
+ nil
+ ]
+ ]
- "Modified: / 02-01-2010 / 13:25:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 13-10-2011 / 10:28:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SVNSourceCodeManager class methodsFor:'basic administration'!
@@ -139,7 +251,12 @@
checkForExistingContainer:fileName inModule:moduleName directory:dirName
"check for a container to be present"
- ^ self shouldImplement
+ | repo |
+ repo := SVN::RepositoryManager repositoryForModule: moduleName directory: dirName.
+ repo isNil ifTrue:[^self].
+ ^repo branch exists: fileName.
+
+ "Modified: / 11-10-2011 / 11:15:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
checkForExistingModule:moduleName
@@ -151,7 +268,12 @@
checkForExistingModule:moduleDir directory:packageDir
"check for a package directory to be present"
- ^ self shouldImplement
+ | pkg repo |
+ pkg := moduleDir , ':' , packageDir.
+ repo := SVN::RepositoryManager repositoryForPackage: pkg.
+ ^repo exists
+
+ "Modified: / 27-11-2011 / 22:46:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
createContainerFor:aClass inModule:moduleName directory:dirName container:fileName
@@ -179,10 +301,145 @@
!
revisionLogOf:clsOrNil fromRevision:rev1OrNil toRevision:rev2OrNil numberOfRevisions:limitOrNil fileName:classFileName directory:packageDir module:moduleDir
- "actually do return a revisionLog. The main worker method.
- This must be implemented by a concrete source-code manager"
+ "Actually do return a revisionLog. The main worker method."
+ "
+ If numRevisionsOrNil is notNil, it limits the number of revision records returned -
+ only numRevions of the newest revision infos will be collected.
+
+ The returned information is a structure (IdentityDictionary)
+ filled with:
+ #container -> the RCS/CVS container file name
+ #cvsRoot -> the CVS root (repository)
+ #filename -> the actual source file name
+ #newestRevision -> the revisionString of the newest revision
+ #numberOfRevisions -> the number of revisions in the container (nil for all)
+ #revisions -> collection of per-revision info (see below)
+
+ firstRevOrNil / lastRevOrNil specify from which revisions a logEntry is wanted:
+ -If firstRevOrNil is nil, the first revision is the initial revision
+ otherwise, the log starts with that revision.
+ -If lastRevOrNil is nil, the last revision is the newest revision
+ otherwise, the log ends with that revision.
+
+ -If both are nil, all logEntries are extracted.
+ -If both are 0 (not nil), no logEntries are extracted (i.e. only the header).
+
+ per revision info consists of one record per revision:
+
+ #revision -> the revision string
+ #author -> who checked that revision into the repository
+ #date -> when was it checked in
+ #state -> the RCS state
+ #numberOfChangedLines -> the number of changed line w.r.t the previous
+ #logMessage -> the checkIn log message
+
+ revisions are ordered newest first
+ (i.e. the last entry is for the initial revision; the first for the most recent one)
+ Attention: if state = 'dead' that revision is no longer valid.
+ "
+
+ | repo log rev1 rev2 limit branch info |
+
+ repo := SVN::RepositoryManager repositoryForModule: moduleDir directory: packageDir.
+ repo isNil ifTrue:[^nil"No repository..."].
+
+ (rev1OrNil == 0 and:[rev2OrNil == 0]) ifTrue:[
+ rev1 := SVN::Revision number:0.
+ rev2 := SVN::Revision head.
+ limit := 1.
+ ] ifFalse:[
+ (rev1OrNil == nil and:[rev2OrNil == nil]) ifTrue:[
+ rev1 := SVN::Revision number:0.
+ rev2 := SVN::Revision head.
+ limit := limitOrNil.
+ ] ifFalse:[
+ rev1 := SVN::Revision number: rev1OrNil ? 0.
+ rev2 := rev1OrNil isNil ifTrue:[SVN::Revision head] ifFalse:[SVN::Revision number: rev2OrNil].
+ limit := limitOrNil.
+ self breakPoint: #jv info: 'Review'.
+ ]
+ ].
+ branch := self branchForModule: moduleDir directory: packageDir.
+ branch isNil ifTrue:[
+ self breakPoint: #jv.
+ self error:('No branch for package %1:%2' bindWith: moduleDir with: packageDir) mayProceed: true.
+ ^self
+ ].
- ^ self shouldImplement
+ log := branch log: classFileName limit: limit revisions: (rev2 to: rev1).
+ info := IdentityDictionary new.
+ info at:#container put: classFileName. "/ -> the revision string
+ info at:#cvsRoot put: branch url asString. "/ -> the CVS root (repository)
+ info at:#filename put: classFileName. "/ -> the actual source file name
+ info at:#newestRevision put: log first revision asString. "/-> the revisionString of the newest revision
+ info at:#numberOfRevisions put: log size. "/-> the number of revisions in the container (nil for all)
+ info at:#revisions put: (log collect:[:entry|
+
+ | info |
+ info := IdentityDictionary new.
+ info at:#revision put: entry revision asString."/ -> the revision string
+ info at:#author put: entry author."/ -> who checked that revision into the repository
+ info at:#date put: entry date printString."/ -> when was it checked in
+ info at:#state put: 'Exp'. "/ -> the RCS state
+ info at:#numberOfChangedLines put: 'N/A'. "/ -> the number of changed line w.r.t the previous
+ info at:#logMessage put: entry message."/ -> the checkIn log message.
+ info
+ ]).
+
+
+ ^info
+
+ "
+ SVNSourceCodeManager revisionLogOf:Array fromRevision:0 toRevision:0.
+ SVNSourceCodeManager revisionLogOf:Array fromRevision:'10000' toRevision:'10005'
+ "
+
+ "Modified: / 18-11-2011 / 16:11:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!SVNSourceCodeManager class methodsFor:'private'!
+
+branchForModule: module directory: directory
+
+ | repo |
+ repo := self repositoryForModule: module directory: directory .
+ ^repo notNil ifTrue:[
+ repo branch
+ ] ifFalse:[
+ nil
+ ]
+
+ "Created: / 15-10-2011 / 16:26:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+branchForPackage: package
+
+ | repo |
+ repo := SVN::RepositoryManager repositoryForPackage: package.
+ ^repo notNil ifTrue:[
+ repo branch
+ ] ifFalse:[
+ nil
+ ]
+
+ "Created: / 15-10-2011 / 23:26:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+pathInRepositoryFrom:containerPath forPackage:packageID
+
+ ^nil
+
+ "Created: / 13-10-2011 / 11:32:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+
+repositoryForModule: module directory: directory
+
+ | repo |
+ repo := SVN::RepositoryManager repositoryForModule: module directory: directory.
+ ^repo
+
+ "Created: / 23-12-2011 / 18:57:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SVNSourceCodeManager class methodsFor:'misc'!
@@ -193,6 +450,7 @@
UserPreferences dictionary"
"Created: / 10-06-2011 / 14:15:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+
! !
!SVNSourceCodeManager class methodsFor:'queries'!
@@ -249,7 +507,6 @@
!
versionMethodKeyword
-
"Answers the keyword used by the version management system to
expand a current version in a file (_without_ dollars). For
CVS it is 'Header', for SVN 'Id', others may use different
@@ -270,41 +527,41 @@
| retval loadBlock |
loadBlock := [
- | repo packageDir manager|
- manager := SVN::RepositoryManager current.
- repo := manager repositoryForPackage: aPackageId.
- retval := (repo notNil and:[repo exists]) ifTrue:[
- repo workingCopy checkout: SVN::Revision head full: true.
- packageDir := Smalltalk packageDirectoryForPackageId:aPackageId.
- "Quick and dirty hack to support old version of Smalltalk/X"
- (Smalltalk respondsTo: #loadPackage:fromDirectory:asAutoloaded:)
- ifTrue:
- ["New API"
- Smalltalk
- loadPackage:aPackageId
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded]
- ifFalse:
- ["Old API"
- Smalltalk
- loadPackageWithId:aPackageId
- fromDirectory:packageDir
- asAutoloaded:doLoadAsAutoloaded
- ].
- ] ifFalse:[false]
+ | repo packageDir manager|
+ manager := SVN::RepositoryManager current.
+ repo := manager repositoryForPackage: aPackageId.
+ retval := (repo notNil and:[repo exists]) ifTrue:[
+ repo workingCopy checkout: SVN::Revision head full: true.
+ packageDir := Smalltalk packageDirectoryForPackageId:aPackageId.
+ "Quick and dirty hack to support old version of Smalltalk/X"
+ (Smalltalk respondsTo: #loadPackage:fromDirectory:asAutoloaded:)
+ ifTrue:
+ ["New API"
+ Smalltalk
+ loadPackage:aPackageId
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded]
+ ifFalse:
+ ["Old API"
+ Smalltalk
+ loadPackageWithId:aPackageId
+ fromDirectory:packageDir
+ asAutoloaded:doLoadAsAutoloaded
+ ].
+ ] ifFalse:[false]
].
(SVNSourceCodeManager loadInProgressQuery query == true)
- ifTrue:[loadBlock value]
- ifFalse:[
- SVNSourceCodeManager loadInProgressQuery
- answer: true
- do:[
- SVN::ProgressDialog
- openOn: loadBlock
- title: ' Loading...'
- subtitle: aPackageId asText allItalic
- ]
+ ifTrue:[loadBlock value]
+ ifFalse:[
+ SVNSourceCodeManager loadInProgressQuery
+ answer: true
+ do:[
+ SVN::ProgressDialog
+ openOn: loadBlock
+ title: ' Loading...'
+ subtitle: aPackageId asText allItalic
+ ]
].
^ retval
@@ -370,6 +627,108 @@
^ true
! !
+!SVNSourceCodeManager::Utilities methodsFor:'utilities-cvs'!
+
+checkinClass:aClass withInfo:aLogInfoOrNil withCheck:doCheckClass usingManager:aManagerOrNil
+ "check a class into the source repository.
+ If the argument, aLogInfoOrNil isNil, ask interactively for log-message.
+ If doCheckClass is true, the class is checked for send of halts etc."
+
+ ^self checkinClasses:(Array with: aClass) withInfo:aLogInfoOrNil withCheck:doCheckClass usingManager:aManagerOrNil
+
+ "Created: / 25-12-2011 / 23:45:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+checkinClasses:classes withInfo:aLogInfoOrNil withCheck:doCheckClass usingManager:aManagerOrNil
+
+ | classesPerPackage |
+
+ doCheckClass value ifTrue:[
+ classes do:[:cls|
+ "/ check if the class contains halts, error-sends etc.
+ (self checkAndWarnAboutBadMessagesInClass:cls checkAgainHolder:doCheckClass) ifFalse:[
+ ^ false
+ ].
+ ].
+ ].
+
+ classesPerPackage := Dictionary new.
+ classes do:
+ [:class|
+ (classesPerPackage at: class theNonMetaclass package ifAbsentPut:[Set new])
+ add: class theNonMetaclass].
+ classesPerPackage keysAndValuesDo:
+ [:package :classes| | repo |
+ repo := SVN::RepositoryManager repositoryForPackage:package.
+ SVN::CommitWizard new
+ task: (repo workingCopy commitTask
+ classes: classes;
+ message: aLogInfoOrNil;
+ extensionMethods: #()
+ yourself);
+ open].
+ ^ true
+
+ "Modified: / 06-05-2011 / 10:32:55 / cg"
+ "Created: / 25-12-2011 / 23:46:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+checkinPackage:packageToCheckIn classes:doClasses extensions:doExtensions buildSupport:doBuild askForMethodsInOtherPackages:askForMethodsInOtherPackages
+
+ | repo task |
+ repo := SVN::RepositoryManager repositoryForPackage:packageToCheckIn.
+ repo isNil ifTrue:[
+ Dialog warn: (resources string: 'No repository for package %1' with: packageToCheckIn).
+ ^self
+ ].
+ task := repo workingCopy commitTask.
+ task suppressClasses: doClasses not.
+ task suppressExtensions: doExtensions not.
+ task suppresBuildSupportFiles: doBuild not.
+
+ SVN::CommitWizard new
+ task: task;
+ open
+
+ "Created: / 13-10-2011 / 11:16:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+diffSetOfProject: package againstRepositoryVersionFrom:dateOrNil
+
+ | rev branch |
+
+ rev := dateOrNil isNil ifTrue:[SVN::Revision head] ifFalse:[SVN::Revision date: dateOrNil].
+ branch := SVNSourceCodeManager branchForPackage: package.
+ branch isNil ifTrue:[^nil].
+ ^branch diffSetBetweenImageAndRevision: rev.
+
+ "Created: / 15-10-2011 / 23:26:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tagClass:aClass as:tag
+
+ Dialog warn: 'Individual class tagging not supported by SubVersion. Tag whole package instead'.
+
+ "Modified: / 12-09-2006 / 13:03:59 / cg"
+ "Created: / 15-10-2011 / 22:48:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tagClasses:classes as:tag
+
+ Dialog warn: 'Individual class tagging not supported by SubVersion. Tag whole package instead'.
+
+ "Modified: / 12-09-2006 / 13:03:59 / cg"
+ "Created: / 15-10-2011 / 22:49:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tagPackage: package as:tag
+
+ Dialog warn: 'Not yet implemented'
+
+ "Created: / 12-09-2006 / 13:04:29 / cg"
+ "Created: / 15-10-2011 / 22:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SVNSourceCodeManager class methodsFor:'documentation'!
version
@@ -381,5 +740,5 @@
!
version_SVN
- ^ '§Id§'
+ ^ '§Id: SVNSourceCodeManager.st 467 2011-12-25 22:47:17Z vranyj1 §'
! !