"{ Package: 'stx:libscm/mercurial' }"
Object subclass:#HGRepository
instanceVariableNames:'uuid path wc changesets branches'
classVariableNames:''
poolDictionaries:''
category:'SCM-Mercurial-Core'
!
HGRepositoryObject subclass:#Changesets
instanceVariableNames:'changesets revno2nodeIdMap'
classVariableNames:''
poolDictionaries:''
privateIn:HGRepository
!
!HGRepository class methodsFor:'instance creation'!
on: aStringOrFilename
^self new initializeOn: aStringOrFilename
"Created: / 17-10-2012 / 13:30:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository class methodsFor:'cloning'!
clone: aFilenameOrUrlOrString to: aStringOrFilename
"Clones repository at given URL to given directory.
Returns an instance HGRepository representing the clone."
^self clone: aFilenameOrUrlOrString to: aStringOrFilename update: true
"Created: / 14-11-2012 / 22:46:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 21-11-2012 / 00:20:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
clone: aFilenameOrUrlOrString to: aStringOrFilename update: update
"Clones repository at given URL to given directory.
Returns an instance HGRepository representing the clone."
| url dst dir |
url := aFilenameOrUrlOrString asString.
dst := aStringOrFilename asFilename.
dst exists ifTrue:[
HGError raiseErrorString: 'Cannot clone to existsing directory!!'.
^nil
].
dir := dst directory.
dir exists ifFalse:[
HGError raiseErrorString: 'Directory for clone does not exist!!'.
^nil
].
dir isWritable ifFalse:[
HGError raiseErrorString: 'Cannot clone into write-protected directory'.
^nil
].
HGCommand clone
url: url;
path: dst pathName;
update: update;
execute.
^HGRepository on: dst.
"Created: / 21-11-2012 / 00:20:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository class methodsFor:'utilities'!
discover: aStringOrFilename
"Find a Mercurial repository in given directory or super-directories
and return it (as an instance of Filename). If no repository is found,
returns nil.
Currently, it searches for presence of .hg directory"
| f |
f := aStringOrFilename.
f isDirectory ifFalse:[
f := f directory
].
[ ( f / '.hg' ) exists ] whileFalse:[
f isRootDirectory ifTrue:[ ^nil ].
f := f directory.
].
^f
"Created: / 13-11-2012 / 22:34:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 14-11-2012 / 00:02:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository methodsFor:'accessing'!
branches
"Returns a list of named branches in the repository,
including closed ones"
| current names |
current := HGCommand branches
workingDirectory: path pathName;
active: false;
closed: true;
execute.
names := branches collect:[:b|b name].
current := current reject:[:b|names includes: b name].
current do:[:b|b setRepository: self].
branches addAll: current.
^branches.
"Created: / 27-11-2012 / 19:57:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 27-11-2012 / 21:31:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
heads
"Returns a list of heads (as HGChangeset)"
| ids |
ids := HGCommand heads
workingDirectory: path pathName;
execute.
^ids collect:[:id|self changesetWithId: id].
"Created: / 27-11-2012 / 21:33:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
path
"Return path to the repository (directory with .hg store)"
^ path
"Modified (comment): / 13-11-2012 / 18:18:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
pathName
"Return path to the repository (directory with .hg store)"
^ path pathName
"Created: / 16-11-2012 / 22:36:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
uuid
"Returns unique ID identifing this concrete instance
of a repository"
^ uuid
"Modified (comment): / 14-11-2012 / 23:22:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
workingCopy
wc isNil ifTrue:[
wc := HGWorkingCopy new setRepository: self.
].
^wc
"Created: / 19-10-2012 / 15:42:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository methodsFor:'accessing-changesets'!
@ id
^self changesetWithId: id.
"Created: / 16-11-2012 / 20:29:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
changesetWithId: id
^changesets changesetWithId: id
"Created: / 13-11-2012 / 17:58:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository methodsFor:'accessing-private'!
branchWithName: name
"Returns branch with given name. If there is no such branch,
an exception is raised"
^self branchWithName: name ifAbsent:[
HGNoSuchBranchError newException
parameter: name;
messageText: 'No such branch: ', name;
raiseSignal
]
"Created: / 27-11-2012 / 13:55:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
branchWithName: name ifAbsent: block
^self branches detect:[:b|b name = name] ifNone: block
"Created: / 27-11-2012 / 14:31:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository methodsFor:'initialization'!
initializeOn: aStringOrFilename
| p |
p := aStringOrFilename asFilename.
p exists ifFalse:[
HGRepositoryError raiseSignal: 'Given path does not exists'.
^nil.
].
p isDirectory ifFalse:[
HGRepositoryError raiseSignal: 'Given path is not a directory'.
^nil.
].
(p / '.hg') isDirectory ifFalse:[
HGRepositoryError raiseSignal: 'Given path does not contain a repository (.hg subdir not found - try use #lookup:)'.
^nil.
].
path := p.
changesets := HGRepository::Changesets new setRepository: self.
branches := OrderedCollection new.
uuid := UUID new
"Created: / 17-10-2012 / 13:35:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-11-2012 / 19:56:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository methodsFor:'operations'!
cloneTo: aStringOrFilename
"Creates a clone of the receiver into given directory.
Returns an instance HGRepository representing the clone."
^self class clone: path to: aStringOrFilename
"Created: / 14-11-2012 / 22:43:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
cloneTo: aStringOrFilename update: update
"Creates a clone of the receiver into given directory.
Returns an instance HGRepository representing the clone.
If update is true, repository working copy is updated, otherwise
it's left empty"
^self class clone: path to: aStringOrFilename update: update
"Created: / 21-11-2012 / 00:21:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
pull
"Pulls changesets from default upstream repository.
See .hg/hgrc, section path"
HGCommand pull
workingDirectory: path pathName;
execute.
"Created: / 15-11-2012 / 10:00:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
push
"Pushes changesets to default upstream repository.
See .hg/hgrc, section path"
HGCommand push
workingDirectory: path pathName;
execute.
"Created: / 15-11-2012 / 09:59:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
push: url
"Pulls changesets from default upstream repository.
url can be either repository URL or alias. See
.hg/hgrc, section for configured aliases"
HGCommand pull
workingDirectory: path pathName;
url: url;
execute.
"Created: / 15-11-2012 / 10:00:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository::Changesets class methodsFor:'documentation'!
documentation
"
A simple object to maintain and load changesets metadata lazily.
[author:]
Jan Vrany <jan.vrany@fit.cvut.cz>
[instance variables:]
[class variables:]
[see also:]
"
! !
!HGRepository::Changesets class methodsFor:'instance creation'!
new
"return an initialized instance"
^ self basicNew initialize.
! !
!HGRepository::Changesets methodsFor:'accessing'!
changesetWithId: idobj
| id xid cs |
id := idobj asHGChangesetId.
"/Try to translate it...
id hasRevnoOnly ifTrue:[
xid := revno2nodeIdMap at: id revno ifAbsent:[nil].
] ifFalse:[
xid := id.
].
"/Look in cache using xlated id...
cs := changesets at: xid ifAbsent:[ nil ].
cs notNil ifTrue: [ ^ cs ].
cs := HGCommand log
workingDirectory: repository path asString;
start: (xid ? id) printString;
execute.
"/just to be defensive...
self assert: cs size == 1.
cs do:[:changeset|
changeset setRepository: repository.
changesets at: changeset id put: changeset.
revno2nodeIdMap at: changeset id revno put: changeset id.
].
^cs anElement.
"Created: / 13-11-2012 / 17:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-11-2012 / 22:04:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository::Changesets methodsFor:'initialization'!
initialize
"Invoked when a new instance is created."
"/ please change as required (and remove this comment)
changesets := Dictionary new.
revno2nodeIdMap := Dictionary new.
"/ super initialize. -- commented since inherited method does nothing
"Modified: / 16-11-2012 / 21:58:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!HGRepository class methodsFor:'documentation'!
version_HG
"Never, ever change this method. Ask JV or CG why"
^thisContext method mclass theNonMetaclass instVarNamed: #revision
!
version_SVN
^ '§Id:: §'
! !