"{ 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 addItemLabel:'Revision...' value:[ 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 addItemLabel:'Revision...' value: [ 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>"
! !

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

    "Created: / 04-04-2013 / 19:15:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 18-03-2014 / 12:09:45 / 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 hgUpdate: nil.

    "Created: / 15-01-2013 / 09:23:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 28-03-2014 / 00:20:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

hgUpdate: changesetOrNil
    | executionBlock workdir |

    (self isKindOf: FileBrowserV2) ifTrue:[
        workdir := self currentDirectoryDisplayed.
        workdir isDirectory ifFalse:[
            workdir := workdir directory
        ].
    ] ifFalse:[
        (self currentSelectedObjects size == 1 and:[self currentSelectedObjects anElement isDirectory]) ifTrue:[
            workdir := self currentSelectedObjects anElement
        ] ifFalse:[
            workdir := Filename currentDirectory.
        ]
    ].
    
    executionBlock := [:stream |
        | cmd |

        cmd := '%1 --noninteractive %2 %3' 
                bindWith: HGCommand hgCommand
                    with: 'update'
                    with: (changesetOrNil isNil ifTrue:[''] ifFalse:['-r ' , changesetOrNil id printString]).
        stream nextPutAll: cmd; cr; cr.
        (self getExecutionBlockForCommand:cmd inDirectory: workdir) value:stream.
    ].
    self makeExecutionResultProcessFor:executionBlock withName:'Mercurial> hg update'

    "Created: / 28-03-2014 / 00:19:55 / 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 methodsFor:'menu actions-scm-hg'!

hgUpdateToRevision
    | repo cs revset dialog |

    repo := self currentHgRepository.
    revset := '!! p1()' asHGRevset.
    dialog := HGChangesetDialog new.     
    dialog repository: repo.
    dialog revset: revset.
    dialog open ifFalse:[ ^ self ].
    cs := dialog changeset.
    self hgUpdate: cs.

    "Created: / 28-03-2014 / 00:33:56 / 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: 'Browse Revision History'
            itemValue: hgLog
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Branches'
            itemValue: hgBranches
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Heads'
            itemValue: hgHeads
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Update'
            itemValue: hgUpdate
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Update To Revision'
            submenuChannel: hgMenuUpdate
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Revert'
            itemValue: hgRevert
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Revert all Changes'
            itemValue: hgUpdateClean
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Push'
            submenuChannel: hgMenuPush
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Pull'
            submenuChannel: hgMenuPull
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Merge...'
            submenuChannel: hgMenuMerge
            labelImage: (ResourceRetriever HGIconLibrary merge 'Merge...')
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            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
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: hgCloneEnabled
            label: 'Clone...'
            itemValue: hgClone
          )
         (MenuItem
            enabled: hgInitEnabled
            label: 'Create...'
            itemValue: hgInit
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: hasHGWorkingCopySelected
            label: 'Edit Repository Config (.hg/hgrc)'
            itemValue: hgEditConfigRepository
          )
         (MenuItem
            label: 'Edit User Config  (~/.hgrc)'
            itemValue: hgEditConfigUser
          )
         )
        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>"
    "Modified (comment): / 16-07-2017 / 13:20:52 / cg"
    "Modified (format): / 29-07-2018 / 14:55:31 / Claus Gittinger"
! !

!ByteArray methodsFor:'converting'!

asHGChangesetId
    ^ HGChangesetId fromBytes:self.

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

!CharacterArray methodsFor:'converting'!

asHGChangesetId
    ^ HGChangesetId fromString:self.

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

!CharacterArray methodsFor:'converting'!

asHGRevset
    ^ HGRevset fromString:self.

    "Created: / 11-03-2014 / 20:51:54 / 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>"
! !

!Object methodsFor:'converting'!

asHGRevset
    ^self shouldNotImplement

    "Created: / 11-03-2014 / 20:50:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!Object methodsFor:'testing'!

isHGChangeset
    "Return true, if receiver is sort an Mercurial changeset."

    ^false

    "Created: / 01-02-2013 / 13:42:04 / 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 - settings'!

hgEnsureCopyrightMethod
    "If true, then #copyright method is automatically compiled in each class
     (but iff project definition defines it)

     Default is true (compile such method) but if the repository is mirror of CVS and
     you want to merge back to CVS at some point, you may want to not compile them
     to keep changes against CVS minimal"

    ^true "default"

    "Created: / 09-10-2013 / 11:48:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!ProjectDefinition class methodsFor:'accessing - hg - settings'!

hgEnsureVersion_HGMethod
    "If true, then #version_HG method is automatically compiled in each class.

     Default is true (compile such method) but if the repository is mirror of CVS and
     you want to merge back to CVS at some point, you may want to not compile them
     to keep changes against CVS minimal. 

     If false, version_HG is compiled only in classes that has been modified
     and commited.

     Note that Mercurial can live without them
     just fine"

    ^true "default"

    "Created: / 09-10-2013 / 11:50:40 / 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:'accessing - hg'!

hgLogicalRevision: anHGChangesetId
    "
    Set Mercurial revision on which is this package based on logically.
    To be called only from Mercurial support upon commit from image.
    "

    | versionMethod |

    versionMethod := self class compiledMethodAt: HGSourceCodeManager nameOfVersionMethodInClasses.
    versionMethod isNil ifTrue:[ 
        self class compile:(self class 
                                    versionMethodTemplateForSourceCodeManager:HGSourceCodeManager)
                                    classified:'documentation'.
        versionMethod := self class compiledMethodAt:HGSourceCodeManager nameOfVersionMethodInClasses.
        versionMethod setPackage:self package.
    ].
    versionMethod annotateWith: 
        (HGRevisionAnnotation revision: anHGChangesetId)

    "Created: / 20-02-2014 / 00:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-02-2014 / 22:16:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

hgPostLoad
    "possibly update an version_HG"

    <postLoad>

    | dir repo versionMethod |

    HGRepository notNil ifTrue:[
        self binaryRevisionString isNil ifTrue:[
            dir := Smalltalk getPackageDirectoryForPackage: self package.
            dir notNil ifTrue:[  
                dir := HGRepository discover: dir.
                dir notNil ifTrue:[
                    repo := HGRepository on: dir.
                    versionMethod := HGSourceCodeManager ensureVersionMethodInClass: self package: self package.
                    versionMethod annotateWith: 
                        (HGRevisionAnnotation revision: repo workingCopy changesetId)
                ].
            ]
        ].
    ].

    "Created: / 26-11-2012 / 13:06:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-02-2014 / 10:59:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!ProjectDefinition class methodsFor:'accessing - hg - settings'!

hgRemoveContainesForDeletedClasses
    "If true, then containers for removed classes are __AUTOMATICALLY__ removed from the
     repositoru. If false, obsolete containes are kept.

     Default is true (remove obsolete containers) but if the repository is mirror of CVS and
     you want to merge back to CVS at some point, you may want to return false to avoid deletions
     of obsolete files. Usefull when branching off an old CVS repo with loads of mess."

    ^true "default"

    "Created: / 21-05-2013 / 16:44:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

commonMenuHGBrowseTemporaryWorkingCopy
    self selectedProjectsForHG value do:[:package|
        | pkg  |

        pkg := HGPackageWorkingCopy named: package.
        pkg notNil ifTrue:[
            pkg temporaryWorkingCopy browse 
        ].
    ].

    "Created: / 11-01-2013 / 18:47:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 05-03-2014 / 21:45:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

commonMenuHGBrowseWorkingCopy
    self selectedProjectsForHG value do:[:package|
        | pkg  |

        pkg := HGPackageWorkingCopy named: package.
        pkg notNil ifTrue:[
            pkg repository workingCopy browse 
        ].
    ].

    "Modified: / 05-03-2014 / 21:45:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

commonMenuHGPush:repository to: remote
    self 
        showMessage: (resources string: 'Pushing to %1' with: remote url asString) 
        while: [ 
            [ 
                [ 
                    repository push: remote 
                ] on: HGPushWouldCreateNewHeadError do:[:ex1 |  
                    (Dialog confirm: (resources string: 'Push would create a new head (%1)\\Push anyway?' with: ex1 parameter) withCRs) ifTrue:[ 
                        repository push: remote force: true.
                    ].
                ].
            ] on: HGError do:[:ex2 |  
                self inlineMessageApp
                    reset;
                    beWarning;
                    message: (resources string: 'Push failed: %1' with: ex2 description);
                    addButtonOK.                    
            ]
        ]
        inBackground: true.

    "Created: / 26-03-2014 / 15:21:31 / 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|HGPackageWorkingCopy named:id string].
    ((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:[self commonMenuHGPush: package repository to: remote  ];
                            yourself).
        ].
    ].
    ^menu.

    "Created: / 10-12-2012 / 03:56:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 26-03-2014 / 15:22:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

projectMenuHGBrowseRevisionHistory
    self selectedProjectsForHG value do:[:package|
        | pkg  |

        pkg := HGPackageWorkingCopy named: package.
        pkg notNil ifTrue:[
            | browser |

            self withWaitCursorDo:[  
                browser := HGChangesetBrowser new.
                browser repository: pkg repository.
                browser open. 
            ]
        ].
    ].

    "Created: / 17-04-2014 / 09:41:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

selectedProjectsForHG
    |sel|
    
    (sel := self selectedProjects value) notNil
        ifTrue:[^sel].

    (sel := self selectedClasses value) notNil
        ifTrue:[^(sel 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 package working copy'
            itemValue: commonMenuHGBrowseWorkingCopy
          )
         (MenuItem
            label: 'Browse temporary working copy (for commits & merges)'
            itemValue: commonMenuHGBrowseTemporaryWorkingCopy
          )
         )
        nil
        nil
      )

    "Modified: / 14-12-2012 / 18:05:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

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

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 Revision History'
            itemValue: projectMenuHGBrowseRevisionHistory
          )
         (MenuItem
            label: 'Browse Package''s Working Copy'
            itemValue: commonMenuHGBrowseWorkingCopy
          )
         (MenuItem
            label: 'Browse Temporary Working Copy (for commits & merges)'
            itemValue: commonMenuHGBrowseTemporaryWorkingCopy
          )
         )
        nil
        nil
      )

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

!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: nil.

    "
        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_CVS
    ^ '$Header$'
! !

!stx_libscm_mercurial class methodsFor:'documentation'!

extensionsVersion_HG

    ^ '$Changeset: <not expanded> $'
! !