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

hgLog  

    | browser |

    self withWaitCursorDo:[ 

        browser := HGChangesetBrowser new.

        browser repository: self currentHgRepository.

        browser open.

    ]

    "Created: / 25-03-2014 / 09:31:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 17-04-2014 / 09:51:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgMenuMerge

    | menu repo wc heads |

    menu := Menu new.

    repo := self currentHgRepository.

    wc := repo workingCopy.

    heads := repo log: 'head() and !! closed() and !! p1() and !! ancestor(p1())' limit: nil.

    heads do:[:head|

        | item label |

        "/ label := head branch name , ' - ' , head id printString.

        label := HGChangesetPresenter new changeset: head.

        item := MenuItem 

                    label: label

                    itemValue: [self hgMerge:head ].

        menu addItem: item.

    ].

    menu addItem:

        (MenuItem 

            label:'Revision...'

            itemValue: [ self hgMergeWithRevision ]).          

    ^menu.

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

    "Modified: / 28-03-2014 / 00:34:32 / 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-dynamic-hg'!

hgMenuUpdate

    | menu repo wc heads |

    menu := Menu new.

    repo := self currentHgRepository.

    wc := repo workingCopy.

    heads := repo log: 'head() and !! closed() and !! p1()' limit: nil.

    heads do:[:head|

        | item label |

        "/ label := head branch name , ' - ' , head id printString.

        label := HGChangesetPresenter new changeset: head.

        item := MenuItem 

                    label: label

                    itemValue: [self hgUpdate: head ].

        menu addItem: item.

    ].  

    menu addSeparator.

    menu addItem:

        (MenuItem 

            label:'Revision...'

            itemValue: [ self hgUpdateToRevision ]).

    ^menu.

    "Created: / 28-03-2014 / 00:00:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 14-04-2014 / 11:49:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

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

hgMerge: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 actions-scm-hg'!

hgMergeWithRevision

    | repo cs revset dialog |

    repo := self currentHgRepository.

    revset := '!! ancestor(p1())' asHGRevset.

    dialog := HGChangesetDialog new.     

    dialog repository: repo.

    dialog revset: revset.

    dialog open ifFalse:[ ^ self ].

    cs := dialog changeset.

    self hgMerge: cs.

    "Created: / 28-03-2014 / 00:34:32 / 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 asString).

    [

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

    "Modified: / 18-03-2014 / 12:10:26 / 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: (HGRemote url: url) repository: repo.

    ]

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

    "Modified: / 18-03-2014 / 12:09:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !