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

!AbstractFileBrowser methodsFor:'aspects-hg'!

currentHgRepository

    | root |

    root := HGRepository discover: self currentDirectoryDisplayed.

    root isNil ifTrue:[ ^ self ].

    ^HGRepository on: root cached: true

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

    "Modified: / 15-01-2013 / 10:04:07 / 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'!

hgBranches  

    self hgExecuteCommand: 'branches' objects: #()

    "Created: / 25-01-2013 / 20:14:40 / 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'!

hgHeads  

    self hgExecuteCommand: 'heads' objects: #()

    "Created: / 25-01-2013 / 20:14:28 / 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'!

hgMenuMerge:anHGChangeset

    | repo wc appl stream|

    appl := self openCommandResultApplication.

    stream := appl resultStream.

    appl changeTabTo:((resources string: 'Merging with %1') bindWith: anHGChangeset id printString).

    [

        repo := self currentHgRepository.

        wc := repo workingCopy.

        stream nextPutAll:(resources string: 'Running ''hg merge''...').

        wc merge: anHGChangeset.

        stream nextPutAll:(resources string: 'done'); cr.

        (wc conflicts asSortedCollection:[:a :b|a pathName < b pathName]) do:[:each|

            each isUnresolved ifTrue:[

                | merger |

                stream nextPutAll: ((resources string: 'Resolving conflicts %1...') bindWith: each pathNameRelative).

                merger := HGMergeTool for: each.

                merger premerge ifTrue:[

                    stream nextPutLine:(resources string: 'resolved').

                    each markResolved.

                ] ifFalse:[

                    stream nextPutLine:(resources string: 'UNRESOLVED')

                ]

            ]

        ]

    ] forkAt: Processor userBackgroundPriority

    "Created: / 14-01-2013 / 21:59:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-01-2013 / 10:48:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgResolve

    | wc prefixsz files |

    wc := self currentHgRepository workingCopy.

    prefixsz := wc pathName size + 1.

    files := self currentSelectedObjects.

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

        files := wc conflicts asSortedCollection:[:a :b|a pathName < b pathName].

        files := files select:[:e|e isUnresolved].

    ] ifFalse:[

        files := files collect:[:file|

            | path |

            path := file pathName.

            path := path copyFrom: prefixsz.

            wc / path.

        ].

    ].

    files do:[:entry|

        (HGMergeTool for: entry) merge ifTrue:[

            entry markResolved.

        ].

    ]

    "Modified: / 16-01-2013 / 09:19:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgResolveList

    self hgExecuteCommand: 'resolve --list' objects: #()

    "Modified: / 14-01-2013 / 21:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgResolveListUnresolved

    | repo wc appl stream|

    appl := self openCommandResultApplication.

    stream := appl resultStream.

    appl changeTabTo:(resources string: 'Unresolved conflicts').

    repo := self currentHgRepository.

    wc := repo workingCopy.

    (wc conflicts asSortedCollection:[:a :b|a pathName < b pathName]) do:[:each|

        each isUnresolved ifTrue:[

            stream nextPutLine: each pathNameRelative

        ].

    ].

    "Modified: / 15-01-2013 / 10:47:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgResolveMark

    self hgExecuteCommand: 'resolve --mark' objects: self currentSelectedObjects.

    "Created: / 14-01-2013 / 21:37:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgRevert

    self hgExecuteCommand: 'revert'

    "Created: / 15-01-2013 / 09:23:38 / 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 methodsFor:'menu actions-scm-hg'!

hgSummary       

    self hgExecuteCommand: 'summary' objects: #()

    "Created: / 25-01-2013 / 17:40:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgUpdate

    self hgExecuteCommand: 'update'

    "Created: / 15-01-2013 / 09:23:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgUpdateClean

    self hgExecuteCommand: 'update -C' objects: #()

    "Created: / 15-01-2013 / 09:23:19 / 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: 'Summary'

            itemValue: hgSummary

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Status'

            itemValue: hgStatus

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Branches'

            itemValue: hgBranches

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Heads'

            itemValue: hgHeads

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            label: 'Update'

            itemValue: hgUpdate

          )

         (MenuItem

            label: 'Revert'

            itemValue: hgRevert

          )

         (MenuItem

            label: 'Revert all Changes'

            itemValue: hgUpdateClean

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Merge...'

            submenuChannel: hgMenuMerge

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

          )

         (MenuItem

            label: 'Resolve'

            itemValue: hgResolve

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Mark as Resolved'

            itemValue: hgResolveMark

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Mark as Unresolved'

            itemValue: hgResolveUnmark

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Show Conflicts'

            itemValue: hgResolveList

          )

         (MenuItem

            enabled: hasHGWorkingCopySelected

            label: 'Show Unresolved'

            itemValue: hgResolveListUnresolved

          )

         )

        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