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

!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>"

! !

!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

        ].

    ].

    "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:[

            repo := HGRepository on: repoDir.

            ^repo workingCopy changeset id

        ]

    ].

    "4 --- "

    self breakPoint: #jv.

    ^nil

    "

        stx_libbasic hgLogicalRevision

        stx_libsvn hgLogicalRevision

        stx_libscm_mercurial hgLogicalRevision

    "

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

    "Modified: / 23-11-2012 / 23:02:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!ProjectDefinition class methodsFor:'description - actions - hg'!

hgPostLoad

    <postLoad>

    | dir repo versionMethod |

    "Eventually update an version_HG"

    self binaryRevisionString isNil ifTrue:[

        dir := Smalltalk getPackageDirectoryForPackage: self package.

        dir := HGRepository discover: dir.

        dir notNil ifTrue:[

            repo := HGRepository on: dir.

            versionMethod := HGSourceCodeManager ensureVersionMethodInClass: self package: self package.

            versionMethod annotateWith: 

                (HGRevisionAnnotation revision: repo workingCopy changeset id)

        ].

    ].

    "Created: / 26-11-2012 / 13:06:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-11-2012 / 22:14:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!String methodsFor:'converting'!

asHGChangesetId

    ^ HGChangesetId fromString:self.

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

! !

!Tools::NewSystemBrowser methodsFor:'menu actions-hg'!

commonMenuHGBrowseWorkingCopy

    self selectedProjectsForHG value do:[:package|

        ].

    ].

! !

!Tools::NewSystemBrowser methodsFor:'menus-dynamic-hg'!

commonMenuHGPushSlice

    | menu push submenu packages package remotes default |

    menu := Menu new.

    push := MenuItem new

                label: (resources string: 'Push...');

                yourself.

    menu addItem: push.

    packages := self selectedProjectsForHG value collect:[:id|HGPackageModel named:id].

    packages size ~~ 1 ifTrue:[

        push enabled: false.

        ^menu.

    ].

    package := packages anElement.

    remotes := package repository remotes.

    remotes isEmpty ifTrue:[

        push enabled: false.

        ^menu.

    ].

"/    default := package repository remoteDefault.

"/    default notNil ifTrue:[

"/        menu addItem: (MenuItem new

"/                            label:((resources string: 'Push to ') , 'default' asText allBold);

"/                            value:[package repository push: default];

"/                            yourself).

"/    ].

    (remotes size ~~ 1 or:[remotes anElement ~~ default]) ifTrue:[

        submenu := Menu new.

        push submenu: submenu.

        remotes do:[:remote|

            submenu addItem: (MenuItem new

                            label: remote displayString;

                            value:[package repository push: remote];

                            yourself).

        ].

    ].

    ^menu.

    "Created: / 10-12-2012 / 03:56:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Tools::NewSystemBrowser methodsFor:'aspects-navigation-hg'!

selectedProjectsForHG

    self selectedProjects value notNil

        ifTrue:[^self selectedProjects value].

    self selectedClasses value notNil

        ifTrue:[^(self selectedClasses value collect:[:cls|cls package]) asSet].

    ^nil

    "Created: / 10-12-2012 / 03:58:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!Tools::NewSystemBrowser class methodsFor:'menu specs-SCM-class'!

classMenuSCMExtra_HG

    "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:Tools::NewSystemBrowser andSelector:#classMenuSCMExtra_HG

     (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser classMenuSCMExtra_HG)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            label: 'Push Slice'

            submenuChannel: commonMenuHGPushSlice

            isMenuSlice: true

          )

         (MenuItem

            label: 'Browse working copy'

            itemValue: commonMenuHGBrowseWorkingCopy

          )

         )

        nil

        nil

      )

! !

!Tools::NewSystemBrowser class methodsFor:'menu specs'!

projectMenuSCMExtra_HG

    "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:Tools::NewSystemBrowser andSelector:#projectMenuSCMExtra_HG

     (Menu new fromLiteralArrayEncoding:(Tools::NewSystemBrowser projectMenuSCMExtra_HG)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            label: 'Push Slice'

            submenuChannel: commonMenuHGPushSlice

            isMenuSlice: true

          )

         (MenuItem

            label: 'Browse working copy'

            itemValue: commonMenuHGBrowseWorkingCopy

          )

         )

        nil

        nil

      )

! !

!UserPreferences methodsFor:'accessing-scm-mercurial'!

hgAutopush

    "Return true, if changes should be automatically pushed

     to an upstream repository (autopush),  false otherwise"

    ^self at: #hgAutopush ifAbsent:[ false "or true?" ].

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

! !

!UserPreferences methodsFor:'accessing-scm-mercurial'!

hgAutopush: aBoolean

    "Set whether changes should be automatically pushed

     to an upstream repository (autopush)"

    ^self at: #hgAutopush put: aBoolean.

    "

    UserPreferences current hgAutopush

    UserPreferences current hgAutopush: true

    UserPreferences current hgAutopush: false

    "

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

! !

!UserPreferences methodsFor:'accessing-scm-mercurial'!

hgCommand

    "Returns path svn executable"

    | cmd |

    cmd := self at:#hgCommand ifAbsent:[ nil ].

    ^cmd isEmptyOrNil ifTrue:[ nil ] ifFalse:[ cmd ]

    "Created: / 19-11-2012 / 21:39:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!UserPreferences methodsFor:'accessing-scm-mercurial'!

hgCommand: aString

    "Set the command to 'hg' executable"

    self at:#hgCommand put: aString.

    HGCommand hgCommand: aString.

    "

        UserPreferences current hgCommand

        UserPreferences current hgCommand:'hg'

        UserPreferences current hgCommand:nil

    "

    "Created: / 19-11-2012 / 21:39:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!stx_libscm_mercurial class methodsFor:'documentation'!

extensionsVersion_HG

    ^ '$Changeset: <not expanded> $'

! !