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

!AbstractFileBrowser methodsFor:'aspects-hg'!

currentHgRepository

    | root |

    root := HGRepository discover: self currentDirectoryDisplayed.

    root isNil ifTrue:[ ^ self ].

    ^HGRepository on: root.

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

            label: 'Status'

            itemValue: hgStatus

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            submenuChannel: hgMenuMerge

          )

         )

        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.

            versionMethod annotateWith: (HGRevisionAnnotation revision: id).

            ^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: / 14-01-2013 / 13:42:56 / 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'!

commonMenuHGBrowseTemporaryWorkingCopy

    self selectedProjectsForHG value do:[:package|

        | pkg  |

        pkg := HGPackageModel named: package.

        pkg notNil ifTrue:[

            pkg temporaryWorkingCopy browse 

        ].

    ].

    "Created: / 11-01-2013 / 18:47:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

commonMenuHGBrowseWorkingCopy

    self selectedProjectsForHG value do:[:package|

        | pkg  |

        pkg := HGPackageModel named: package.

        pkg notNil ifTrue:[

            pkg repository workingCopy browse 

        ].

    ].

    "Modified: / 14-12-2012 / 17:51:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!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) or:[packages anElement isNil]) 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>"

    "Modified: / 14-12-2012 / 18:09:07 / 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