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

Object subclass:#HGRepository
	instanceVariableNames:'uuid path wc changesets branches config lock'
	classVariableNames:'Cache'
	poolDictionaries:''
	category:'SCM-Mercurial-Core'
!

HGRepositoryObject subclass:#Changesets
	instanceVariableNames:'changesets revno2nodeIdMap'
	classVariableNames:''
	poolDictionaries:''
	privateIn:HGRepository
!


!HGRepository class methodsFor:'initialization'!

initialize
    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    Cache := CacheDictionary new: 8

    "Modified: / 14-12-2012 / 19:31:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository class methodsFor:'instance creation'!

on: aStringOrFilename
    | path |

    path := aStringOrFilename asFilename.
    ^Cache at: path ifAbsentPut:[self new initializeOn: path]

    "Created: / 17-10-2012 / 13:30:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 14-12-2012 / 19:33:30 / 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>"
!

config
    ^config

    "Created: / 06-12-2012 / 21:40:36 / 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>"
!

remoteDefault
    "Return default remote (upstream) repository or nil if none"

    ^self remotes detect:[:e|e isDefault] ifNone:[nil]

    "Created: / 10-12-2012 / 01:26:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remotes
    "Returns a collection of configured remote (upstream) repositories"

    | paths remotes |

    paths := self config get: #paths default: nil.
    paths isNil ifTrue:[ ^ #() ].
    paths isEmpty ifTrue:[ ^ #() ].
    remotes := OrderedCollection new.
    paths keysAndValuesDo:[:name :url|
        remotes add: (HGRemote new setRepository: self; setName: name url:url value).
    ].
    ^remotes

    "Created: / 09-12-2012 / 22:51:13 / 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 createIfAbsent: create

    ^self branchWithName: name ifAbsent:[
        | b |
        b := HGBranch new setRepository: self.
        b setName: name.
        branches add: b.
        b
    ]

    "Created: / 10-12-2012 / 03:14:45 / 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>"
!

changesetWithId: id into: cs
    changesets load: id into: cs

    "Created: / 16-12-2012 / 01:26:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

lock
    ^lock

    "Created: / 16-12-2012 / 00:39:12 / 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.
    config := HGConfig new setRepository: self.
    lock := RecursionLock new.

    "Created: / 17-10-2012 / 13:35:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-12-2012 / 00:38:53 / 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 methodsFor:'synchronized evaluation'!

synchronizationSemaphore
    ^lock

    "Created: / 16-12-2012 / 00:40:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

synchronizationSemaphore: aRecursionLock
    lock := aRecursionLock

    "Created: / 16-12-2012 / 00:40:21 / 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].
    ].
    xid := xid ? id.


    "/Look in cache using xlated id...
    cs := changesets at: xid ifAbsent:[ nil ].
    cs notNil ifTrue: [ ^ cs ].

    self synchronized:[
        "/Look in cache using xlated id...
        cs := changesets at: xid ifAbsent:[ nil ].
        cs notNil ifTrue: [ ^ cs ].

        cs := (xid isShort or:[xid hasRevnoOnly not]) 
                ifTrue:[
                    self load: xid into: nil]"/Short id, we have to load it
                ifFalse:[
                    HGChangeset new setId: xid; setRepository: repository]."/Full id, can make it lazy

        changesets at: cs id put: cs.
        revno2nodeIdMap  at: cs id revno put: cs id.
    ].
    ^cs .

    "Created: / 13-11-2012 / 17:52:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-12-2012 / 01:14:24 / 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::Changesets methodsFor:'private'!

load: id into: changesetOrNil
    "Load all data for changeset with given id.
     If changesetOrNil is not nil, then update given
     changeset.

     Return changeset with filled data, i.e,, changeset is
     non-lazy"

     | cs |
     cs := HGCommand log
                    workingDirectory: repository path asString;
                    start: id printString;
                    execute.
     "/just to be defensive...
     self assert: cs size == 1.
     cs := cs anElement.
     cs setRepository: repository.

     changesetOrNil notNil ifTrue:[
        changesetOrNil setSlotsFrom: cs.
        self assert: id isShort not.
        cs := changesetOrNil.
    ].
    ^cs.

    "Created: / 16-12-2012 / 00:57:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGRepository class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '§Id::                                                                                                                        §'
! !

HGRepository initialize!