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

!AbstractFileBrowser methodsFor:'aspects-hg'!

currentHgRepository

    | root |

    root := HGRepository discover: self currentDirectoryDisplayed.

    root isNil ifTrue:[ ^ self ].

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

! !

!AbstractFileBrowser methodsFor:'menu-queries-hg'!

hasHGWorkingCopySelected

    ^ self hgMenusAreShown 

        and:[((Smalltalk at:#HGRepository) discover:self currentDirectoryDisplayed) notNil]

    "Created: / 14-12-2012 / 18:26:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractFileBrowser methodsFor:'menu actions-scm-hg'!

hgCommit

    | wc task |

    wc := self currentHgRepository workingCopy.

    task := HGCommitTask new temporaryWorkingCopy: wc.

    HGCommitDialog new

        task: task;

        open

    "Created: / 11-01-2013 / 19:27:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 12-01-2013 / 13:57:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractFileBrowser methodsFor:'menu actions-scm-hg'!

hgExecuteCommand: command

    "Executes svn command on currently selected objects"

    self hgExecuteCommand: command objects: self currentSelectedObjects.

    "Created: / 12-01-2013 / 12:08:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractFileBrowser methodsFor:'menu actions-scm-hg'!

hgExecuteCommand: command objects: givenObjects

    "Executes svn command on given objects (files/dirs)"

    | objects workdir objectsAsString executionBlock |

    objects := givenObjects.

    (self isKindOf: FileBrowserV2) ifTrue:[

        workdir := self currentDirectoryDisplayed.

        workdir isDirectory ifFalse:[

            workdir := workdir directory

        ].

    ] ifFalse:[

        (objects size == 1 and:[objects anElement isDirectory]) ifTrue:[

            workdir := objects anElement

        ] ifFalse:[

            workdir := Filename currentDirectory.

        ]

    ].

    objectsAsString := String streamContents:[:s|

        objects size == 1 ifTrue:[

            workdir asString = objects anElement asString ifTrue:[

                s nextPut:$.

            ] ifFalse:[

                s nextPutAll: objects anElement asString.

            ]

        ] ifFalse:[

            objects do:[:each|s nextPut:$"; nextPutAll:each asString; nextPut:$"]

                separatedBy:[s space]

        ]

    ].

    executionBlock := [:stream |

        | cmd |

        cmd := '%1 --noninteractive %2 %3' 

                bindWith: HGCommand hgCommand

                    with: command

                    with: objectsAsString.

        stream nextPutAll: cmd; cr; cr.

        (self getExecutionBlockForCommand:cmd inDirectory: workdir) value:stream.

    ].

    self makeExecutionResultProcessFor:executionBlock withName:'Mercurial> hg ', command.

    "Created: / 12-01-2013 / 12:09:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractFileBrowser methodsFor:'menu-dynamic-hg'!

hgMenuMerge

    | menu repo wc cs |

    menu := Menu new.

    repo := self currentHgRepository.

    wc := repo workingCopy.

    cs := wc changeset.

    repo branches do:[:branch|

        branch heads do:[:head|

            head ~~ cs ifTrue:[

                | item |

                item := MenuItem 

                            label: (head branch name , ' - ' , head id printString)

                            itemValue: [self hgMenuMerge: head ].

                menu addItem: item.

            ].

        ]

    ].

    ^menu.

    "Created: / 14-12-2012 / 19:14:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractFileBrowser methodsFor:'menu actions-scm-hg'!

hgStatus

    self hgExecuteCommand: 'status'

    "Modified: / 12-01-2013 / 12:09:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!AbstractFileBrowser class methodsFor:'menu specs-scm'!

hgMenu

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:AbstractFileBrowser andSelector:#hgMenu

     (Menu new fromLiteralArrayEncoding:(AbstractFileBrowser hgMenu)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Commit'

            itemValue: hgCommit

            labelImage: (ResourceRetriever HGIconLibrary commit 'Commit')

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Status'

            itemValue: hgStatus

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Merge...'

            submenuChannel: hgMenuMerge

            labelImage: (ResourceRetriever HGIconLibrary merge 'Merge...')

          )

         (MenuItem

            itemValue: hgResolve

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            itemValue: hgResolveMark

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            itemValue: hgResolveUnmark

          )

         )

        nil

        nil

      )

! !

!Annotation class methodsFor:'instance creation'!

HGRevision: aString

    "Used by Mercurial to internally store revision info. Should never appear in source code!!"

    ^HGRevisionAnnotation revision: aString

    "Created: / 20-11-2012 / 23:34:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ByteArray methodsFor:'converting'!

asHGChangesetId

    ^ HGChangesetId fromBytes:self.

    "Created: / 16-11-2012 / 21:33:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ConfigurableFeatures class methodsFor:'queries-features'!

hasHGSupport

    "/ use Smalltalk-at to trick the dependency/prerequisite generator

    ^ (Smalltalk at: #'HGSourceCodeManager' ifAbsent:nil) notNil

    "

     ConfigurableFeatures hasGitSupport

    "

    "Created: / 14-12-2012 / 15:38:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ConfigurableFeatures class methodsFor:'queries-features'!

hasHGSupportEnabled

    ^ self hasSCMSupportEnabledFor:#'HGSourceCodeManager'

    "

     self hasGitSupportEnabled

    "

    "Created: / 14-12-2012 / 15:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Integer methodsFor:'converting'!

asHGChangesetId

    ^ (HGChangesetId new:0) revno:self.

    "Created: / 16-11-2012 / 21:23:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Object methodsFor:'converting'!

asHGChangesetId

    HGError 

        raiseErrorString:'Cannot convert arbitrary object to Mercurial nodeid'

    "Created: / 16-11-2012 / 21:23:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Object methodsFor:'converting'!

asHGRevision

    ^self asHGChangesetId

    "Created: / 20-11-2012 / 23:32:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-11-2012 / 17:56:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'accessing - hg'!

hgBinaryRevision

    "

    Answers Mercurial revision from which the package was compiled.

    If no binary revision is available, returns nil."

    | revInfo |

    self binaryRevisionString notNil ifTrue:[

        revInfo := HGRevisionInfo readFrom: self binaryRevisionString onError:[nil].

        revInfo notNil ifTrue:[

            ^revInfo changesetId

        ].

    ].

    ^nil

    "

        stx_libbasic hgBinaryRevision

        stx_libsvn hgBinaryRevision

        stx_libscm_mercurial hgBinaryRevision

    "

    "Created: / 20-11-2012 / 23:58:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'accessing - hg'!

hgLogicalRevision

    "

    Answers Mercurial revision on which is this package based on logically.

    Revision is computed as follows:

        1) Look, if receiver's version_HG method has a (hidden) annotation HGRevision:, 

           if so, return its value.

        2) If receiver's binary revision is not nil, return it.

        3) Look into a package directory and if there is a Mercurial repository,

           return working copy's revision"

    | versionMethod versionAnnotation revInfo pkgDir repoDir repo |

    "1 --- "

    versionMethod := self class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.

    versionMethod notNil ifTrue:[

        versionAnnotation := versionMethod annotationAt: #HGRevision:.

        versionAnnotation notNil ifTrue:[

            ^versionAnnotation revision

        ].

    ] ifFalse:[

        HGSourceCodeManager compileVersionMethod:HGSourceCodeManager nameOfVersionMethodInClasses of:self for:'$Changeset: <not expanded> $'.

        versionMethod := self class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.

    ].

    "2 --- "

    self binaryRevisionString notNil ifTrue:[

        revInfo := HGRevisionInfo readFrom: self binaryRevisionString onError:[nil].

        revInfo notNil ifTrue:[

            ^revInfo changesetId

        ].

    ].

    "3 --- "

    pkgDir := Smalltalk getPackageDirectoryForPackage: self package.

    pkgDir notNil ifTrue:[

        repoDir := HGRepository discover: pkgDir.

        repoDir notNil ifTrue:[

            | id |

            repo := HGRepository on: repoDir.

            id := repo workingCopy changeset id.