Upon commit, update logical revision of all packages that belongs to the same repository...
...but only if their logical revision is the same as logical revision of the package being commited.
--- a/common/Make.proto Tue Feb 18 21:41:02 2014 +0000
+++ b/common/Make.proto Thu Feb 20 00:32:41 2014 +0000
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libview2 -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic3
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic3 -I$(INCLUDE_TOP)/stx/libview2
# if you need any additional defines for embedded C code,
--- a/common/SCMAbstractPackageModel.st Tue Feb 18 21:41:02 2014 +0000
+++ b/common/SCMAbstractPackageModel.st Thu Feb 20 00:32:41 2014 +0000
@@ -178,14 +178,6 @@
^ name
!
-parent
- "Returns the parent model. See class documentation for details on parents"
-
- ^parent
-
- "Created: / 01-12-2012 / 17:56:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
repositoryRoot
"Returns relative path within the repository root where the package
content is located. Example: let's assume:
@@ -232,41 +224,6 @@
"Created: / 14-11-2012 / 23:51:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!SCMAbstractPackageModel methodsFor:'accessing - containers'!
-
-containerSuffixes
-
- ^ProgrammingLanguage all collect:[:each|each sourceFileSuffix]
-
- "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-containers
-
- | containers jextensions |
-
- containers := OrderedCollection new.
- containers addAll:
- (wcroot directoryContents select:
- [:container|self containerSuffixes anySatisfy:
- [:suffix|container endsWith:suffix]]) asSet.
- (jextensions:= wcroot / 'java' / 'extensions') exists ifTrue:[
- jextensions recursiveDirectoryContentsDo:[:each|
- (self containerSuffixes anySatisfy:[:suffix|each endsWith:suffix]) ifTrue:[
- (jextensions / each) isRegularFile ifTrue:[
- containers add: 'java/extensions/' , each.
- ].
- ].
- ]
- ].
- ^ containers
-
- "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
!SCMAbstractPackageModel methodsFor:'accessing-classes'!
commitDialogClass
@@ -348,6 +305,14 @@
"Modified: / 09-10-2013 / 08:56:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+containerSuffixes
+
+ ^ProgrammingLanguage all collect:[:each|each sourceFileSuffix]
+
+ "Created: / 23-03-2009 / 18:53:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-12-2009 / 18:15:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
containerWriteStreamFor: containerName
| filename directory |
@@ -389,6 +354,31 @@
"Modified: / 24-09-2013 / 12:07:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+containers
+
+ | containers jextensions |
+
+ containers := OrderedCollection new.
+ containers addAll:
+ (wcroot directoryContents select:
+ [:container|self containerSuffixes anySatisfy:
+ [:suffix|container endsWith:suffix]]) asSet.
+ (jextensions:= wcroot / 'java' / 'extensions') exists ifTrue:[
+ jextensions recursiveDirectoryContentsDo:[:each|
+ (self containerSuffixes anySatisfy:[:suffix|each endsWith:suffix]) ifTrue:[
+ (jextensions / each) isRegularFile ifTrue:[
+ containers add: 'java/extensions/' , each.
+ ].
+ ].
+ ]
+ ].
+ ^ containers
+
+ "Created: / 23-03-2009 / 18:52:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 12-06-2009 / 21:44:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 24-09-2013 / 12:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
containersToKeep
| containers extensions |
@@ -434,6 +424,84 @@
"Modified: / 24-09-2013 / 12:32:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!SCMAbstractPackageModel methodsFor:'accessing-hierarchy'!
+
+children
+ "Returns all my immediate children."
+
+ | childNames nameSizePlus1 |
+
+ nameSizePlus1 := name size + 1.
+ childNames := Smalltalk allProjectIDs select:[:each |
+ (each startsWith: name)
+ and:[ each ~= name
+ and:[ ((each at: nameSizePlus1) == $/ or:[ (each at: nameSizePlus1) == $: ])
+ and:[ (each indexOf: $/ startingAt: nameSizePlus1 + 1) == 0]]]].
+ ^ childNames collect:[:each | self childNamed: (each copyFrom: nameSizePlus1 + 1) ].
+
+ "
+ (HGPackageModelRegistry packageNamed: 'stx:libscm') children
+ "
+
+ "Created: / 19-02-2014 / 23:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+childrenDo: aBlock
+ "Evaluate a block for all immediate children of the receiver.
+ Does NOT recurse."
+
+ self children do: aBlock
+
+ "Created: / 19-02-2014 / 23:47:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+parent
+ "Returns the parent model. See class documentation for details on parents"
+
+ ^parent
+
+ "Created: / 01-12-2012 / 17:56:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+root
+ "Returns the root of this package model hierarchy, i.e., grand-parent which itself has no parent.
+ See class documentation for details on parents"
+
+ | p |
+
+ p := self.
+ [ p parent notNil ] whileTrue:[
+ p := p parent.
+ ].
+ ^ p
+
+ "Created: / 19-02-2014 / 23:30:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+siblings
+ "Returns all my siblings"
+
+ ^ parent notNil
+ ifTrue:[self parent children copy remove: self; yourself]
+ ifFalse:[ #() ]
+
+ "
+ (HGPackageModelRegistry packageNamed: 'stx:libscm') siblings
+ (HGPackageModelRegistry packageNamed: 'stx:libscm/common') siblings
+ "
+
+ "Created: / 20-02-2014 / 00:22:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+yourselfAndAllChildrenDo: aBlock
+ "Evaluate a block for receiver and all its children, recursively."
+
+ aBlock value: self.
+ self children do:[:each | each yourselfAndAllChildrenDo: aBlock ]
+
+ "Created: / 19-02-2014 / 23:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!SCMAbstractPackageModel methodsFor:'accessing-private'!
childNamed: aString
--- a/common/SCMAbstractTask.st Tue Feb 18 21:41:02 2014 +0000
+++ b/common/SCMAbstractTask.st Thu Feb 20 00:32:41 2014 +0000
@@ -172,42 +172,6 @@
"Created: / 15-07-2009 / 20:07:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 01-04-2013 / 12:19:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-doCompileSvnRepositoryUrlStringMethod
- |pkgDef revNr|
-
- ActivityNotification notify:'Compiling #svnRepositoryUrlString method'.
- pkgDef := self workingCopy packageDefinition.
- (pkgDef theMetaclass includesSelector:#svnRepositoryUrlString) not
- ifTrue:[
- pkgDef theMetaclass compile:(pkgDef svnRepositoryUrlString_code)
- classified:'description - svn'.
- (pkgDef theMetaclass compiledMethodAt:#svnRepositoryUrlString)
- setPackage:self package asSymbol
- ].
-
- "Created: / 08-04-2011 / 15:58:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-doCompileSvnRevisionNrMethod:compileRevision
- |pkgDef revNr|
-
- ActivityNotification notify:'Compiling #svnRevisionNr method'.
- pkgDef := self workingCopy packageDefinition.
- revNr := compileRevision ifTrue:[
- pkgDef svnRevision number
- ] ifFalse:[ nil ].
- (revNr notNil
- or:[ (pkgDef theMetaclass includesSelector:#svnRevisionNr) not ])
- ifTrue:[
- pkgDef theMetaclass compile:(pkgDef svnRevisionNr_code:revNr)
- classified:'description - svn'.
- (pkgDef theMetaclass compiledMethodAt:#svnRevisionNr)
- setPackage:self package asSymbol
- ].
-
- "Created: / 16-06-2009 / 12:16:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!SCMAbstractTask methodsFor:'notification'!
--- a/common/bc.mak Tue Feb 18 21:41:02 2014 +0000
+++ b/common/bc.mak Thu Feb 20 00:32:41 2014 +0000
@@ -39,7 +39,7 @@
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libview2 -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic3
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic3 -I$(INCLUDE_TOP)\stx\libview2
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
--- a/common/common.rc Tue Feb 18 21:41:02 2014 +0000
+++ b/common/common.rc Thu Feb 20 00:32:41 2014 +0000
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "Copyright Jan Vrany 2012\0"
VALUE "ProductName", "Smalltalk/X SCM Support Library\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Wed, 09 Oct 2013 11:09:21 GMT\0"
+ VALUE "ProductDate", "Thu, 20 Feb 2014 00:29:42 GMT\0"
END
END
--- a/mercurial/HGPackageModel.st Tue Feb 18 21:41:02 2014 +0000
+++ b/mercurial/HGPackageModel.st Thu Feb 20 00:32:41 2014 +0000
@@ -168,18 +168,36 @@
commited
"Sent by commit task once commited"
- | versionMethod |
+ | def oldRev newRev |
super commited.
- versionMethod := self definition class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.
- versionMethod isNil ifTrue:[
- self error:'Should not happen!!'.
+ def := self definition.
+ oldRev := def hgLogicalRevision.
+ newRev := wc changeset id.
+
+ self root yourselfAndAllChildrenDo:[:each|
+ each updateLogicalRevisionFrom: oldRev to: newRev
].
- versionMethod annotateWith:
- (HGRevisionAnnotation revision: wc changeset id)
+
+ self assert: (def hgLogicalRevision = newRev).
"Created: / 23-11-2012 / 22:52:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 20-02-2014 / 00:11:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateLogicalRevisionFrom: oldRev to: newRev
+ "Updates package logical revision to `newRev` but
+ only if it's current logical revision is `oldRev`"
+
+ | def |
+
+ def := self definition.
+ def hgLogicalRevision = oldRev ifTrue:[
+ def hgLogicalRevision: newRev
+ ].
+
+ "Created: / 20-02-2014 / 00:09:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGPackageModel methodsFor:'utils'!
--- a/mercurial/HGStXTests.st Tue Feb 18 21:41:02 2014 +0000
+++ b/mercurial/HGStXTests.st Thu Feb 20 00:32:41 2014 +0000
@@ -2191,14 +2191,16 @@
| repo pmP2N1 pmP2N2|
repo := self repositoryNamed: 'mocks/hg/p2'.
- Smalltalk loadPackage:'mocks:hg/p1/n1'.
- Smalltalk loadPackage:'mocks:hg/p1/n2'.
+ Smalltalk loadPackage:'mocks:hg/p2/n1'.
+ Smalltalk loadPackage:'mocks:hg/p2/n2'.
pmP2N1 := HGPackageModel named: 'mocks:hg/p2/n1'.
pmP2N2 := HGPackageModel named: 'mocks:hg/p2/n2'.
self assert: pmP2N1 parent == pmP2N2 parent.
+ self assert: pmP2N1 repository == pmP2N2 repository.
"Created: / 03-12-2012 / 15:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 19-02-2014 / 23:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGStXTests methodsFor:'utilities'!
--- a/mercurial/extensions.st Tue Feb 18 21:41:02 2014 +0000
+++ b/mercurial/extensions.st Thu Feb 20 00:32:41 2014 +0000
@@ -944,6 +944,30 @@
"Modified: / 14-01-2013 / 13:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!ProjectDefinition class methodsFor:'accessing - hg'!
+
+hgLogicalRevision: anHGChangesetId
+ "
+ Set Mercurial revision on which is this package based on logically.
+ To be called only from Mercurial support upon commit from image.
+ "
+
+ | versionMethod |
+
+ versionMethod := self definition class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.
+ versionMethod isNil ifTrue:[
+ self class compile:(self class
+ versionMethodTemplateForSourceCodeManager:HGSourceCodeManager)
+ classified:'documentation'.
+ versionMethod := self class compiledMethodAt:HGSourceCodeManager nameOfVersionMethodInClasses.
+ versionMethod setPackage:self package.
+ ].
+ versionMethod annotateWith:
+ (HGRevisionAnnotation revision: anHGChangesetId)
+
+ "Created: / 20-02-2014 / 00:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!ProjectDefinition class methodsFor:'description - actions - hg'!
hgPostLoad
--- a/mercurial/mercurial.rc Tue Feb 18 21:41:02 2014 +0000
+++ b/mercurial/mercurial.rc Thu Feb 20 00:32:41 2014 +0000
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "Copyright Jan Vrany 2012\0"
VALUE "ProductName", "Smalltalk/X Mercurial Integration\0"
VALUE "ProductVersion", "6.2.3.0\0"
- VALUE "ProductDate", "Fri, 29 Nov 2013 20:40:37 GMT\0"
+ VALUE "ProductDate", "Thu, 20 Feb 2014 00:30:12 GMT\0"
END
END
--- a/mercurial/stx_libscm_mercurial.st Tue Feb 18 21:41:02 2014 +0000
+++ b/mercurial/stx_libscm_mercurial.st Thu Feb 20 00:32:41 2014 +0000
@@ -291,6 +291,7 @@
AbstractFileBrowser hgCloneEnabled
AbstractFileBrowser hgInit
AbstractFileBrowser hgInitEnabled
+ 'ProjectDefinition class' hgLogicalRevision:
)
! !