"{ Package: 'stx:libscm/mercurial' }"

Object subclass:#HGRepository

	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.

    "Created: / 17-10-2012 / 13:35:59 / 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"

    ^self push: nil force: false

    "Created: / 15-11-2012 / 09:59:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-11-2012 / 21:58:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

push: url

    "Push changesets to given repository. url can be either repository URL or alias. 

    See .hg/hgrc, section for configured aliases"

    ^self push: url force: false

    "Created: / 15-11-2012 / 10:00:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-11-2012 / 21:59:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

push: urlOrNil force: force

    "Pushes changesets to url. If url is nil, then changes are pushed to

     a default repository. If force is true, push is forced (allowing creation

     of new heads in remote repo),

     See .hg/hgrc, section path"

    HGCommand push

        workingDirectory: path pathName;

        url: urlOrNil;

        force: force;

        execute.

    "Created: / 27-11-2012 / 21:58:06 / 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

    ^ '$Changeset: <not expanded> $'

!

version_SVN

    ^ '§Id::                                                                                                                        §'

! !