Add comment `HGWorkingCopy >> statusesOf:`
...to ease debugging when assertion fails.
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2015 Jan Vrany
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
"
"{ Package: 'stx:libscm/mercurial' }"
SCMAbstractPackageRevision subclass:#HGPackageRevision
instanceVariableNames:'changeset changesetRoot'
classVariableNames:''
poolDictionaries:''
category:'SCM-Mercurial-StX'
!
!HGPackageRevision class methodsFor:'documentation'!
copyright
"
stx:libscm - a new source code management library for Smalltalk/X
Copyright (C) 2012-2015 Jan Vrany
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
"
! !
!HGPackageRevision class methodsFor:'instance creation'!
changeset:anHGChangeset root:anHGChangesetFile
"Creates a new HGPackageRevision for given changeset and changeset file
(assuming that changeset file is root of the package).
Raises an HGError when repositoru doesn't contain a Smalltalk/X package."
^ self new setChangeset: anHGChangeset root: anHGChangesetFile.
"Created: / 06-03-2014 / 09:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-03-2014 / 10:35:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changeset:anHGChangeset root:anHGChangesetFile name: aString
"Creates a new HGPackageRevision for given changeset, root and name.
(assuming that changeset file is root of the package).
Raises an HGError when root doesn't contain a Smalltalk/X package."
^ self new setChangeset: anHGChangeset root: anHGChangesetFile name: aString
"Created: / 07-03-2014 / 12:52:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGPackageRevision methodsFor:'accessing'!
revision
"Return a logical revision package model"
^ changeset id
"Created: / 05-03-2014 / 23:45:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGPackageRevision methodsFor:'accessing-containers'!
containerFor: aString ifAbsent: aBlock
"Return a container as Filename with given name. If there's no such
container, evaluates a block"
^ (changesetRoot children includesKey: aString)
ifTrue:[ changesetRoot / aString ]
ifFalse:[ aBlock value ]
"Created: / 14-03-2014 / 22:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGPackageRevision methodsFor:'accessing-hierarchy'!
children
children isNil ifTrue:[
children := Dictionary new.
changesetRoot children do:[:each |
each isDirectory ifTrue:[
| childPackageName child |
childPackageName := (name includes: $:)
ifTrue:[ name , '/' , each baseName ]
ifFalse:[ name , ':' , each baseName ].
[
child := self class changeset: changeset root: each name: childPackageName.
child setParent: self.
children at: each baseName put: child.
] on: HGError do:[:ex |
"/ OK, directory does not contain a package...
].
].
].
].
^ children values
"Created: / 07-03-2014 / 12:47:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-03-2014 / 14:24:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGPackageRevision methodsFor:'initialization'!
setChangeset: anHGChangeset root: anHGChangesetFile
"Initializes a package rev for given changeset and root.
Raises an exception, if given root does not contain
a Smalltalk/X package"
| make_spec |
"/ Look for Make.spec and extract package name from there
"/ Hmm...stupid, / raises an error when file does not exist.
"/ Maybe I should change it...
[
make_spec := anHGChangesetFile / 'Make.spec'
] on: HGError do:[
make_spec := nil.
].
make_spec notNil ifTrue:[
| module module_dir |
make_spec readingLinesDo:[:line|
(line startsWith:'MODULE_DIR=') ifTrue:[
module_dir := line copyFrom: "'MODULE_DIR=' size"11 + 1.
] ifFalse:[
(line startsWith:'MODULE=') ifTrue:[
module := line copyFrom: "'MODULE=' size"7 + 1.
]
].
].
(module notNil and:[ module_dir notNil ]) ifTrue:[
self setChangeset: anHGChangeset root: anHGChangesetFile name: (module , ':' , module_dir) virtual: false.
^ self.
].
].
"/ Make.spec not found or failed to extract packagename from there.
"/ Maybe this is a virtual package container such as stx:libscm.
"/ Search directories, if any package is found there, derive my name
"/ child's name.
children := Dictionary new.
anHGChangesetFile children do:[:each |
each isDirectory ifTrue:[
| child |
[
child := self class changeset: anHGChangeset root: each.
child setParent: self.
children at: each baseName put: child.
] on: HGError do:[:ex |
"/ OK, directory does not contain a package...
].
].
].
children notEmpty ifTrue:[
| myName |
myName := children anElement name asPackageId parentPackage asString.
self setChangeset: anHGChangeset root: anHGChangesetFile name: myName virtual: true.
^ self.
].
"/ None of my subdirectories is a valid Smalltalk/X package,
"/ so not I'am.
HGError raise.
"Created: / 07-03-2014 / 10:38:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2014 / 10:06:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setChangeset: anHGChangeset root: anHGChangesetFile name: aString
"Initializes a package rev with given changeset and root and name."
| v |
[
anHGChangesetFile / 'Make.spec'.
anHGChangesetFile / ((ProjectDefinition initialClassNameForDefinitionOf: aString) , '.' , SmalltalkLanguage instance sourceFileSuffix).
v := false
] on: HGError do:[
v := true.
].
self setChangeset: anHGChangeset root: anHGChangesetFile name: aString virtual: v.
"Created: / 07-03-2014 / 23:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setChangeset: anHGChangeset root: anHGChangesetFile name: aString virtual: aBoolean
"Initializes a package rev with given changeset and root and name."
name := aString.
changeset := anHGChangeset.
changesetRoot := anHGChangesetFile.
repository := anHGChangeset repository.
repositoryRoot := anHGChangesetFile pathName.
virtual := aBoolean.
virtual ifFalse:[
"/ Check, whether the project definition class really exists
[
anHGChangesetFile / ((ProjectDefinition initialClassNameForDefinitionOf: aString) , '.' , SmalltalkLanguage instance sourceFileSuffix)
] on: HGError do:[
^ HGError newException
parameter: (Array with: anHGChangeset with: anHGChangesetFile with: aString);
messageText: ('No project definition class found for %1' bindWith: aString);
raise.
].
].
"Created: / 07-03-2014 / 23:03:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-03-2014 / 10:06:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !