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

hasHGWorkingCopyNotSelected

    ^ self hasHGWorkingCopySelected not

    "Created: / 13-02-2014 / 12:01:08 / 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'!

hgClone

    | selectedDirectories dialog repoUrlHolder repoDirHolder repodirName repoDir  |

    selectedDirectories := self currentSelectedDirectories.

    repoUrlHolder := nil asValue.

    repoDirHolder := (selectedDirectories size = 1 and:[ selectedDirectories anElement directoryContents isEmpty])

                ifTrue:[ selectedDirectories anElement baseName asValue ]

                ifFalse:[ nil asValue ].

    dialog := DialogBox new.

    dialog title: (resources string: 'Clone repository...').

    dialog addLabelledInputField:(resources string: 'Repository URL:') 

                    adjust:#left 

                    on:repoUrlHolder 

                    tabable:true 

                    separateAtX:0.3.    

    dialog addLabelledInputField:(resources string: 'Directory:') 

                    adjust:#left 

                    on:repoDirHolder 

                    tabable:true 

                    separateAtX:0.3.  

    dialog addAbortButton; addOkButton.

    dialog open.

    dialog accepted ifFalse:[ ^ self ].

    repoUrlHolder value isEmptyOrNil ifTrue:[ 

        Dialog warn: (resources string: 'Empty repository URL')

    ].

    repoDir := self currentDirectoryDisplayed / repoDirHolder value.

    repoDir exists ifTrue:[ 

        repoDir isDirectory ifTrue:[ 

            repoDir directoryContents notEmpty ifTrue:[ 

                Dialog error: (resources string:'Cannot clone repository. Directory %1 is not empty.' with: repodirName).

                ^ self.

            ].

        ] ifFalse:[ 

            Dialog error: (resources string:'Cannot clone repository. %1 is not an empty directory' with: repodirName).

            ^ self.

        ].

    ].

    ProgressIndicator

        displayBusyIndicator: (resources string: 'Cloning %1 to %2...' with: repoUrlHolder value with: repoDirHolder value)

        at:(Screen default center)

        during:[  

            HGRepository clone: repoUrlHolder value to: repoDir.

            self updateCurrentDirectory

        ].

    "Created: / 13-02-2014 / 11:57:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-02-2014 / 16:11:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgCloneEnabled

    ^ self hasHGWorkingCopyNotSelected

    "Created: / 13-02-2014 / 11:57:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgCommit

    | wc task |

    wc := self currentHgRepository workingCopy.

    task := wc commitTask.

    HGCommitDialog new

        task: task;

        open

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

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

! !

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

hgEditConfig: file

    self 

        applicationNamed:#FileApplicationNoteBook

        ifPresentDo:[:appl |

            appl openTextEditorForFile: file pathName 

        ].

    "Created: / 04-04-2013 / 19:40:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgEditConfigRepository

    | repo |

    repo := self currentHgRepository.

    self hgEditConfig: repo path / '.hg' / 'hgrc'

    "Modified: / 04-04-2013 / 19:42:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgEditConfigUser

    self hgEditConfig: Filename homeDirectory / '.hgrc'

    "Modified: / 04-04-2013 / 19:42:59 / 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 actions-scm-hg'!

hgInit

    | selectedDirectories initial repodirName repodir  |

    selectedDirectories := self currentSelectedDirectories.

    initial := (selectedDirectories size = 1 and:[ selectedDirectories anElement directoryContents isEmpty])

                ifTrue:[ selectedDirectories anElement baseName ]

                ifFalse:[ 'repository' ].

    repodirName := Dialog request: (resources string: 'Enter name of the repository to create') initialAnswer: initial.

    repodir := self currentDirectoryDisplayed / repodirName.

    repodir exists ifTrue:[ 

        repodir isDirectory ifTrue:[ 

            repodir directoryContents notEmpty ifTrue:[ 

                Dialog error: (resources string:'Cannot initialize repository. Directory %1 is not empty.' with: repodirName).

                ^ self.

            ].

        ] ifFalse:[ 

            Dialog error: (resources string:'Cannot initialize repository. %1 is not an empty directory' with: repodirName).

            ^ self.

        ].

    ].

    HGRepository init: repodir.

    self updateCurrentDirectory

    "Created: / 13-02-2014 / 11:59:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-02-2014 / 16:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgInitEnabled

    ^ self hasHGWorkingCopyNotSelected

    "Created: / 13-02-2014 / 11:59:32 / 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: 'Mercurial > hg merge'); space; nextPutLine: anHGChangeset id printString.

        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')

                ]

            ]

        ].

        stream nextPutAll:(resources string: 'Merge finisged.')

    ] forkAt: Processor userBackgroundPriority

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

    "Modified: / 04-04-2013 / 19:22:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgMenuPull

    | menu repo remotes |

    menu := Menu new.

    repo := self currentHgRepository.

    remotes := repo remotes.

    remotes notEmptyOrNil ifTrue:[

        remotes do:[:remote|

                menu addItem: (MenuItem new

                                label: remote displayString;

                                value:[ self hgPullFrom: remote repository: repo];

                                yourself).

        ].

        menu addSeparator.

    ].

    menu addItem:

        (MenuItem new

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

            value: [self hgPullFromURLRepository: repo];

            yourself).

    ^menu.

    "Created: / 04-04-2013 / 19:16:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgMenuPush

    | menu repo remotes |

    menu := Menu new.

    repo := self currentHgRepository.

    remotes := repo remotes.

    remotes notEmptyOrNil ifTrue:[

        remotes do:[:remote|

                menu addItem: (MenuItem new

                                label: remote displayString;

                                value:[ self hgPushTo: remote repository: repo];

                                yourself).

        ].

        menu addSeparator.

    ].

    menu addItem:

        (MenuItem new

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

            value: [self hgPushToURLRepository: repo];

            yourself).

    ^menu.

    "Created: / 04-04-2013 / 19:15:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgPullFrom: remote repository:repo

    | appl stream|

    appl := self openCommandResultApplication.

    stream := appl resultStream.

    appl changeTabTo:((resources string: 'Pulling from %1') bindWith: remote printString).

    [

        stream nextPutAll:(resources string: 'Mercurial > hg pull'); space; nextPutLine: remote name.

        [

            | summary |                

            summary := repo pull: remote.

            summary printOn: stream.

            stream cr.

        ] on: Notification do:[:ex|

            stream nextPutLine: ex messageText.

            ex proceed.

        ]

    ] forkAt: Processor userBackgroundPriority

    "Created: / 04-04-2013 / 19:27:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgPullFromURLRepository:repo

    | url options |

    options := repo remotes collect:[:r|r url asString].

    url :=  Dialog 

                request:'Enter an URL from which to pull:' 

                initialAnswer:'http://...'  

                list: options. 

    url notEmptyOrNil ifTrue:[

        self hgPullFrom: url repository: repo.

    ]

    "Created: / 04-04-2013 / 19:16:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgPushTo: remote repository:repo

    | appl stream|

    appl := self openCommandResultApplication.

    stream := appl resultStream.

    appl changeTabTo:((resources string: 'Pushing to %1') bindWith: remote printString).

    [

        stream nextPutAll:(resources string: 'Mercurial > hg push'); space; nextPutLine: remote name.

        [

            | summary |                

            summary := repo push: remote.

            summary printOn: stream.

            stream cr.

        ] on: Notification do:[:ex|

            stream nextPutLine: ex messageText.

            ex proceed.

        ]

    ] forkAt: Processor userBackgroundPriority

    "Created: / 04-04-2013 / 19:23:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgPushToURLRepository:repo

    | url options |

    options := repo remotes collect:[:r|r url asString].

    url :=  Dialog 

                request:'Enter an URL where to push:' 

                initialAnswer:'http://...'  

                list: options. 

    url notEmptyOrNil ifTrue:[

        self hgPushTo: url repository: repo.

    ]

    "Created: / 04-04-2013 / 19:15:41 / 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'!