--- a/common/SCMAbstractPackageWorkingCopy.st Wed Mar 05 22:47:58 2014 +0000
+++ b/common/SCMAbstractPackageWorkingCopy.st Sat Mar 08 10:29:38 2014 +0000
@@ -19,9 +19,8 @@
"{ Package: 'stx:libscm/common' }"
SCMAbstractPackageModel subclass:#SCMAbstractPackageWorkingCopy
- instanceVariableNames:'name parent children repository repositoryRoot wc wcroot changed
- classesHasChanged extensionsHasChanged virtual lastSequenceNumber
- lastSequenceNumberForChildren'
+ instanceVariableNames:'wc wcroot changed classesHasChanged extensionsHasChanged
+ lastSequenceNumber lastSequenceNumberForChildren'
classVariableNames:''
poolDictionaries:''
category:'SCM-Common-StX'
@@ -138,25 +137,6 @@
"Modified: / 13-11-2012 / 23:22:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-construct: aString
- "Create a package model for subpackage named aString"
-
- | normalizedName components package |
-
- normalizedName := (aString includes: $:) ifTrue:[aString copyReplaceAll:$: with:$/] ifFalse:[aString].
- ( normalizedName includes: $/) ifFalse:[
- ^self childNamed: normalizedName.
- ].
-
- components := normalizedName tokensBasedOn: $/.
- package := self.
- components do:[:each|package := package childNamed: each].
- ^package
-
- "Created: / 16-11-2012 / 23:47:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 03-12-2012 / 14:04:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
definition
^LibraryDefinition definitionClassForPackage:self name createIfAbsent:true
@@ -184,32 +164,6 @@
"Created: / 14-11-2012 / 01:02:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-name
- ^ name
-!
-
-repositoryRoot
- "Returns relative path within the repository root where the package
- content is located. Example: let's assume:
-
- <repo>/.hg
- <repo>/mercurial/...
- <repo>/mercurial/tests/...
- <repo>/common/..
-
- then
-
- (HGPackageModelRegistry packageNamed: 'stx:libscm/mercurial/tests') path
- == 'mercurial/tests'
- "
-
- self assert: repositoryRoot notNil.
-
- ^repositoryRoot
-
- "Created: / 01-12-2012 / 02:03:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
revision
"Return a logical revision of the package, i.e., a revision
on which the next commit will be based on"
@@ -292,62 +246,6 @@
"Modified: / 15-11-2012 / 00:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-containerNameForClassNamed: nm language: lang
- ^String streamContents:[:s|
- s nextPutAll: (nm copyReplaceAll:$: with: $_).
- s nextPut: $..
- s nextPutAll: lang sourceFileSuffix
- ]
-
- "Created: / 15-11-2012 / 00:45:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-containerNameForExtensions
- ^self containerNameForExtensions: SmalltalkLanguage instance
-
- "Created: / 07-10-2012 / 10:37:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-containerNameForExtensions: aProgrammingLanguage
- ^'extensions.' , aProgrammingLanguage sourceFileSuffix
-
- "Created: / 07-10-2012 / 10:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-containerNameForExtensions: aProgrammingLanguage javaClass: aJavaClass
- | class classBinaryName comps |
-
- class := aJavaClass theNonMetaClass.
- "Sigh, make it compatible with old and new naming of Java classes
-
- old -> aJavaClass name == #'java/lang/Object'
- new -> aJavaClass name == JAVA::java::lang::Object
- aJavaClass binaryName == #'java/lang/Object'
- "
- classBinaryName := (class respondsTo: #binaryName)
- ifTrue:[ class binaryName ]
- ifFalse:[ class name ].
- self assert: (classBinaryName includes: $:) not.
-
- ^ String streamContents:[:s|
- s nextPutAll: 'java/extensions'.
- comps := classBinaryName tokensBasedOn: $/.
- comps do:[:each| s nextPut: $/; nextPutAll: each ].
- s nextPut: $.; nextPutAll: aProgrammingLanguage sourceFileSuffix.
- ].
-
- "Created: / 24-09-2013 / 11:31:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "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 |
@@ -390,12 +288,11 @@
!
containers
-
| containers jextensions |
containers := OrderedCollection new.
containers addAll:
- (wcroot directoryContents select:
+ (wcroot directoryContents select:
[:container|self containerSuffixes anySatisfy:
[:suffix|container endsWith:suffix]]) asSet.
(jextensions:= wcroot / 'java' / 'extensions') exists ifTrue:[
@@ -411,7 +308,7 @@
"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>"
+ "Modified: / 05-03-2014 / 23:29:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
containersToKeep
@@ -473,62 +370,6 @@
"Created: / 19-02-2014 / 23:43:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-02-2014 / 23:54:57 / 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>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'accessing-private'!
@@ -694,22 +535,10 @@
!SCMAbstractPackageWorkingCopy methodsFor:'initialization'!
initialize
- "Invoked when a new instance is created."
+ super initialize.
+ children := Dictionary new
- "/ please change as required (and remove this comment)
- "/ name := nil.
- "/ parent := nil.
- children := Dictionary new.
- "/ repository := nil.
- "/ repositoryRoot := nil.
- "/ wc := nil.
- "/ wcroot := nil.
- "/ classesHasChanged := nil.
- "/ extensionsHasChanged := nil.
-
- "/ super initialize. -- commented since inherited method does nothing
-
- "Modified: / 01-12-2012 / 18:02:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 07-03-2014 / 12:57:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setName: aSymbolOrPackageId repository: aRepository
@@ -746,13 +575,6 @@
setParent: parentModel
"Sets the parent model. See class documentation for details on parents models"
- | topModel |
-
- topModel := parentModel.
- topModel parent notNil ifTrue:[
- topModel := topModel parent
- ].
-
parent := parentModel.
(parent repositoryRoot = '.') ifTrue:[
repositoryRoot := (self name copyFrom: parent name size + 2).
@@ -761,7 +583,7 @@
]
"Created: / 01-12-2012 / 17:54:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 21-06-2013 / 23:45:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-03-2014 / 10:04:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setWorkingCopy: aSCMAbstractWorkingCopy
@@ -785,21 +607,28 @@
!
computeChildren
- | childNames nameSizePlus1 |
+ | newChildren newChildNames nameSizePlus1 |
nameSizePlus1 := name size + 1.
- childNames := Smalltalk allLoadedProjectIDs select:[:each |
+ newChildNames := Smalltalk allLoadedProjectIDs select:[:each |
(each startsWith: name)
and:[ each ~= name
and:[ ((each at: nameSizePlus1) == $/ or:[ (each at: nameSizePlus1) == $: ])
and:[ (each indexOf: $/ startingAt: nameSizePlus1 + 1) == 0]]]].
- childNames do:[:each | self childNamed: (each copyFrom: nameSizePlus1 + 1) ].
+ newChildren := Dictionary new.
+ newChildNames do:[:each |
+ | nm |
+ nm := (each copyFrom: nameSizePlus1 + 1).
+ newChildren at: nm put: (self childNamed: nm).
+ ].
+ ^ newChildren.
"
(HGPackageModelRegistry packageNamed: 'stx:libscm') children
"
"Created: / 28-02-2014 / 23:53:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-03-2014 / 22:47:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
computeClassesHasChanged
@@ -898,11 +727,10 @@
!
computeIsVirtual
- "raise an error: this method should be implemented (TODO)"
-
^ self classes isEmpty and:[ self extensions isEmpty ].
"Created: / 28-02-2014 / 23:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 05-03-2014 / 23:21:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
updateCachedValues
@@ -923,11 +751,11 @@
extensionsHasChanged := (extensionsHasChanged == true) or:[ self computeExtensionsHasChanged ].
changed := self computeHasChanges.
].
- self computeChildren.
+ children := self computeChildren.
].
"Created: / 28-02-2014 / 23:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 03-03-2014 / 09:23:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-03-2014 / 22:44:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SCMAbstractPackageWorkingCopy methodsFor:'queries'!
@@ -998,23 +826,6 @@
!SCMAbstractPackageWorkingCopy methodsFor:'testing'!
-isChildOf: anotherPackageModel
- ^ anotherPackageModel isParentOf: self.
-
- "Created: / 25-02-2014 / 22:51:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-isParentOf: anotherPackageModel
- | anotherName |
-
- anotherName := anotherPackageModel name.
- ^ (anotherName size) > (name size + 1)
- and:[ (anotherName startsWith: name)
- and:[ ':/' includes: (anotherName at: name size + 1) ]].
-
- "Created: / 25-02-2014 / 22:50:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
isVirtual
"Return true, if the package is virtual, i.e., there's no code in
the package. False otherwise.