mercurial/HGCommitDialog.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Fri, 01 Feb 2013 12:02:22 +0000
changeset 210 54a73fa50d40
parent 185 b566a1c31bc8
child 235 3d8ef499d7d9
permissions -rw-r--r--
Added copyright notice.

"
 COPYRIGHT (c) 2012-2013 by Jan Vrany
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libscm/mercurial' }"

SCMAbstractCommitDialog subclass:#HGCommitDialog
	instanceVariableNames:'remoteHolder remoteListHolder remotePushHolder branchCreateHolder
		branchHolder moreOptionsHolder'
	classVariableNames:''
	poolDictionaries:''
	category:'SCM-Mercurial-StX-Interface'
!

!HGCommitDialog class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2012-2013 by Jan Vrany
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
! !

!HGCommitDialog class methodsFor:'image specs'!

dialogIcon
    ^ HGIconLibrary hgLogo2

    "Created: / 14-11-2012 / 00:14:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 16-11-2012 / 11:01:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommitDialog class methodsFor:'interface specs'!

contentSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:HGCommitDialog andSelector:#contentSpec
     HGCommitDialog new openInterface:#contentSpec
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: contentSpec
        window: 
       (WindowSpec
          label: 'Commit...'
          name: 'Commit...'
          min: (Point 10 10)
          bounds: (Rectangle 0 0 698 603)
        )
        component: 
       (SpecCollection
          collection: (
           (VariableVerticalPanelSpec
              name: 'VariablePanel'
              layout: (LayoutFrame 0 0 0 0 0 1 0 1)
              component: 
             (SpecCollection
                collection: (
                 (VerticalPanelViewSpec
                    name: 'VerticalPanel1'
                    horizontalLayout: fit
                    verticalLayout: bottomSpaceFit
                    horizontalSpace: 3
                    verticalSpace: 3
                    elementsChangeSize: true
                    component: 
                   (SpecCollection
                      collection: (
                       (ViewSpec
                          name: 'MessageAndInfoPane'
                          component: 
                         (SpecCollection
                            collection: (
                             (SubCanvasSpec
                                name: 'InfoPanel'
                                layout: (LayoutFrame 0 0 0 0 0 1 40 0)
                                level: 0
                                initiallyInvisible: true
                                hasHorizontalScrollBar: false
                                hasVerticalScrollBar: false
                                clientKey: infoPanel
                                createNewBuilder: false
                              )
                             (ViewSpec
                                name: 'MessagePane'
                                layout: (LayoutFrame 0 0 0 0 0 1 0 1)
                                component: 
                               (SpecCollection
                                  collection: (
                                   (LabelSpec
                                      label: 'Commit message:'
                                      name: 'MessageLabel'
                                      layout: (LayoutFrame 0 0 0 0 0 1 25 0)
                                      translateLabel: true
                                      adjust: left
                                    )
                                   (LinkButtonSpec
                                      label: 'More Options'
                                      name: 'MoreOptions'
                                      layout: (LayoutFrame -100 1 0 0 0 1 30 0)
                                      visibilityChannel: moreOptionsHiddenHolder
                                      translateLabel: true
                                      labelChannel: moreOptionsLabel
                                      adjust: right
                                      model: doShowMoreOptions
                                    )
                                   (TextEditorSpec
                                      name: 'Message'
                                      layout: (LayoutFrame 0 0 30 0 0 1 0 1)
                                      enableChannel: enabledHolder
                                      hasHorizontalScrollBar: true
                                      hasVerticalScrollBar: true
                                      modifiedChannel: messageModifiedHolder
                                      hasKeyboardFocusInitially: false
                                      postBuildCallback: messageView:
                                    )
                                   )
                                 
                                )
                              )
                             )
                           
                          )
                          extent: (Point 698 239)
                        )
                       (ViewSpec
                          name: 'BranchBox'
                          visibilityChannel: moreOptionsVisibleHolder
                          component: 
                         (SpecCollection
                            collection: (
                             (InputFieldSpec
                                name: 'EntryField1'
                                layout: (LayoutFrame 215 0 0 0 0 1 0 1)
                                visibilityChannel: branchCreateHolder
                                model: branchHolder
                                emptyFieldReplacementText: 'Branch name'
                              )
                             (CheckBoxSpec
                                label: 'Commit into new branch'
                                name: 'BranchCheckBox'
                                layout: (LayoutFrame 0 0 2 0 215 0 25 0)
                                model: branchCreateHolder
                                translateLabel: true
                              )
                             )
                           
                          )
                          extent: (Point 698 25)
                        )
                       (ViewSpec
                          name: 'PushBox'
                          visibilityChannel: moreOptionsVisibleHolder
                          component: 
                         (SpecCollection
                            collection: (
                             (CheckBoxSpec
                                label: 'Push to upstream repository'
                                name: 'CheckBox1'
                                layout: (LayoutFrame 0 0 2 0 215 0 25 0)
                                model: remotePushHolder
                                translateLabel: true
                              )
                             (ComboListSpec
                                name: 'ComboList2'
                                layout: (LayoutFrame 215 0 0 0 0 1 0 1)
                                visibilityChannel: remotePushHolder
                                model: remoteHolder
                                comboList: remoteListHolder
                              )
                             )
                           
                          )
                          extent: (Point 698 25)
                        )
                       )
                     
                    )
                  )
                 (ViewSpec
                    name: 'FilePane'
                    component: 
                   (SpecCollection
                      collection: (
                       (UISubSpecification
                          name: 'FilePaneSpec'
                          layout: (LayoutFrame 0 0 0 0 0 1 0 1)
                          minorKey: filePaneSpec
                        )
                       )
                     
                    )
                  )
                 )
               
              )
              handles: (Any 0.5 1.0)
            )
           )
         
        )
      )
!

fileListColumnSpec
    "This resource specification was automatically generated
     by the DataSetBuilder of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the DataSetBuilder may not be able to read the specification."

    "
     DataSetBuilder new openOnClass:SVN::CommitDialog2 andSelector:#fileListColumnSpec
    "

    <resource: #tableColumns>

    ^#(
      (DataSetColumnSpec
         label: ''
         activeHelpKey: ''
         activeHelpKeyForLabel: ''
         labelButtonType: None
         width: 22
         minWidth: 22
         editorType: CheckToggle
         rendererType: CheckToggle
         model: include
         menuFromApplication: false
         printSelector: include
         showRowSeparator: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: ''
         activeHelpKey: ''
         activeHelpKeyForLabel: ''
         labelButtonType: Button
         width: 22
         minWidth: 22
         menuFromApplication: false
         printSelector: statusIcon
         canSelect: false
         showRowSeparator: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: 'Container'
         labelAlignment: left
         activeHelpKey: ''
         activeHelpKeyForLabel: ''
         labelButtonType: Button
         menuFromApplication: false
         printSelector: pathText
         canSelect: false
         showRowSeparator: false
         showColSeparator: false
       )
    "
      (DataSetColumnSpec
         label: 'Rev'
         activeHelpKey: ''
         activeHelpKeyForLabel: ''
         labelButtonType: Button
         usePreferredWidth: true
         menuFromApplication: false
         printSelector: revision
         canSelect: false
         showRowSeparator: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: 'Author'
         labelAlignment: left
         activeHelpKey: ''
         activeHelpKeyForLabel: ''
         labelButtonType: Button
         usePreferredWidth: true
         menuFromApplication: false
         printSelector: author
         canSelect: false
         showRowSeparator: false
         showColSeparator: false
       )
      (DataSetColumnSpec
         label: 'Date'
         activeHelpKey: ''
         activeHelpKeyForLabel: ''
         labelButtonType: Button
         usePreferredWidth: true
         menuFromApplication: false
         printSelector: date
         canSelect: false
         showRowSeparator: false
         showColSeparator: false
       )
        "
      )

    "Created: / 15-11-2012 / 09:28:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommitDialog methodsFor:'actions'!

doAccept
    self remotePushHolder value 
        ifTrue:[self task remote: self remoteHolder value] 
        ifFalse:[self task remote: nil].
    self branchCreateHolder value 
        ifTrue:[self task branch: self branchHolder value] 
        ifFalse:[self task branch: nil].
    [
        super doAccept.
    ] on: HGPushWouldCreateNewHeadError do:[:ex|
        self infoPanel 
                reset;
                beWarning;
                message: (self resources string:'Push to upstream would create a new head. Changes were not pushed.');
                addButtonOK;
                show.
    ]

    "Created: / 10-12-2012 / 01:46:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 10-12-2012 / 02:56:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doEditUserConfig
    | hgrc |

    hgrc := HGConfig userConfigFiles first.
    hgrc exists ifFalse:[hgrc writingFileDo:[:s|s cr]].
    WorkspaceApplication openOnFile: hgrc.
    self doCancel.

    "Created: / 07-12-2012 / 16:08:02 / jv"
!

doShowDiffsForEntry

    self fileSelectionHolder value do:[:each|
        self doShowDiffsForEntry: each entry against: each entry changeset
    ].

    "Created: / 09-02-2012 / 14:51:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 06-12-2012 / 17:00:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doShowDiffsForEntry: wcentry against: rev
    |wc wcChangeSet repoentry repoChangeSet diffset |

    wc := self task temporaryWorkingCopy.
    repoentry := [ rev / wcentry pathNameRelativeSlashed ] on: HGError do: [
        Dialog warn: 'File does not exists in changeset ' , rev id printString.
    ].
    wcentry suffix = SmalltalkLanguage instance sourceFileSuffix ifTrue:[
        wcChangeSet := ChangeSet fromFile: wcentry .
        wcChangeSet name: wcChangeSet name, (resources string: ' (working copy - to be commited)').
        repoChangeSet := ChangeSet fromStream: repoentry contents asString readStream.
        repoChangeSet name: wcentry baseName,  ' (' , rev id printString , ')'.
        diffset := ChangeSetDiff versionA:wcChangeSet versionB:repoChangeSet.
        (Tools::ChangeSetDiffTool new)
            beSingleColumn;
            diffset:diffset;
            title:('%1: Diffbetween working copy and rev. %2 ' bindWith: wcentry pathNameRelative with: rev printString);
            showVersionMethodDiffs: false;
            open
    ] ifFalse:[
        | text1 text2 |
        text1 := wcentry contents asString.
        text2 := repoentry contents asString.
        "/Argh...backward compatibility..."
        (Tools::TextDiff2Tool ? Tools::TextDiffTool) new
            labelA: 'Working copy';
            labelB: ('r %1' bindWith: rev printString);
            textA: text1; textB: text2;
            title:('%1: Diffbetween working copy and rev. %2 ' bindWith: wcentry pathNameRelative with: rev printString);
            open
    ]

    "Created: / 09-02-2012 / 14:53:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 21-01-2013 / 19:37:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doShowDiffsForEntryAgainstHEAD

    self fileSelectionHolder value do:[:each|
        self doShowDiffsForEntry: each entry against: self workingCopy heads anElement
    ].

    "Created: / 10-02-2012 / 10:00:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 06-12-2012 / 17:04:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

doShowMoreOptions
    self moreOptionsHolder value: true

    "Created: / 10-12-2012 / 11:39:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommitDialog methodsFor:'aspects'!

branchCreateHolder
    <resource: #uiAspect>

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    branchCreateHolder isNil ifTrue:[
        branchCreateHolder := false asValue.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/       branchCreateHolder addDependent:self.
"/       branchCreateHolder onChangeSend:#branchCreateHolderChanged to:self.
    ].
    ^ branchCreateHolder.

    "Modified: / 10-12-2012 / 02:54:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

branchHolder
    <resource: #uiAspect>

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    branchHolder isNil ifTrue:[
        branchHolder := ValueHolder new.
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/       branchHolder addDependent:self.
"/       branchHolder onChangeSend:#branchHolderChanged to:self.
    ].
    ^ branchHolder.
!

moreOptionsHiddenHolder
    ^BlockValue forLogicalNot: self moreOptionsVisibleHolder

    "Created: / 10-12-2012 / 11:37:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

moreOptionsHolder
    "return/create the 'moreOptionsHolder' value holder (automatically generated)"

    moreOptionsHolder isNil ifTrue:[
        moreOptionsHolder := false asValue
    ].
    ^ moreOptionsHolder

    "Modified: / 10-12-2012 / 11:38:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

moreOptionsLabel

    ^(resources string: 'More Options') asText
        colorizeAllWith: Color blue;
        actionForAll:[ self doShowMoreOptions ];
        yourself

    "Created: / 10-12-2012 / 11:39:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

moreOptionsVisibleHolder
    ^self moreOptionsHolder

    "Created: / 10-12-2012 / 11:36:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remoteHolder
    <resource: #uiAspect>

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    remoteHolder isNil ifTrue:[
        | remote |

        remote := self task isPackageCommit ifTrue:[self task package repository remoteDefault] ifFalse:[nil].
        remoteHolder := remote asValue.
    ].
    ^ remoteHolder.

    "Modified: / 12-01-2013 / 12:05:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remoteListHolder
    <resource: #uiAspect>

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"

    remoteListHolder isNil ifTrue:[
        | remoteList |

        remoteList := self task isPackageCommit ifTrue:[self task package repository remotes] ifFalse:[nil].
        remoteListHolder := remoteList asValue
    ].
    ^ remoteListHolder.

    "Modified: / 12-01-2013 / 12:06:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

remotePushHolder
    <resource: #uiAspect>
    "automatically generated by UIPainter ..."
    "*** the code below creates a default model when invoked."
    "*** (which may not be the one you wanted)"
    "*** Please change as required and accept it in the browser."
    "*** (and replace this comment by something more useful ;-)"
    
    remotePushHolder isNil ifTrue:[
        remotePushHolder := UserPreferences current hgAutopush asValue.
        
"/ if your app needs to be notified of changes, uncomment one of the lines below:
"/       pushHolder addDependent:self.
"/       pushHolder onChangeSend:#pushHolderChanged to:self.
    ].
    ^ remotePushHolder.

    "Modified: / 10-12-2012 / 01:25:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommitDialog methodsFor:'change & update'!

updateFileList
    | wcroot statuses entries showOnlyModified wcrootPathNameRelative wcrootPathNameRelativeLen |

    showOnlyModified := fileListShowOnlyModifiedHolder value.
    "HACK..."

    wcroot := self task temporaryWorkingCopyRoot.
    wcrootPathNameRelative := wcroot pathNameRelative.
    wcrootPathNameRelativeLen := wcrootPathNameRelative size.

    statuses := HGCommand status
                    workingDirectory: wcroot pathName;
                    execute.
    entries := OrderedCollection new: statuses size.
    statuses do:[:statusAndPath|
        (fileListShowOnlyModifiedHolder value not
            or:[statusAndPath first isCleanOrIgnored not]) ifTrue:[
            | nm entry |

            (statusAndPath second startsWith: wcrootPathNameRelative) ifTrue:[
                nm := statusAndPath second.
                wcrootPathNameRelativeLen ~~ 0 ifTrue:[
                    nm := nm copyFrom:wcrootPathNameRelativeLen + 2.
                ].
                entry := SCMAbstractCommitDialog::FileEntry application: self entry: wcroot / nm name: nm.
                entries add: entry
            ].
        ].
    ].
    self fileListHolder value: entries

    "Created: / 08-02-2012 / 18:05:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 12-01-2013 / 13:58:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!HGCommitDialog methodsFor:'private'!

doCheckAuthor
    "Checks whether commit author is defined"

    self task author isNil ifTrue:[
        self infoPanel 
            reset;
            beWarning;
            message: 'Commit author signature not configured';
            addButtonWithLabel: (self resources string:'Edit')
                action: [self doEditUserConfig];
            addButtonWithLabel: (self resources string:'Cancel')
                action: [self doCancel].
        self acceptEnabled:false. 
        ^self.
    ].
    self doCheckHead.

    "Created: / 07-12-2012 / 15:56:36 / jv"
!

doCheckHead
    "Checks whether commit would create a new head"

    | heads changeset |

    heads := self task package temporaryWorkingCopy heads.
    changeset := self task package temporaryWorkingCopy changeset.
    (heads includes: changeset) ifFalse:[
        self infoPanel 
            reset;
            beInformation;
            message: (self resources string:'Comitting a new head.');
            addButtonWithLabel: (self resources string:'Proceed') action: [self infoPanel hide];
            "/addButtonWithLabel: (self resources string:'Cancel') action:[self doCancel];
            show.
    ]

    "Created: / 07-12-2012 / 15:52:18 / jv"
!

doUpdateWorkingCopy
    super doUpdateWorkingCopy.
    self doCheckAuthor.

    "Created: / 27-11-2012 / 23:36:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-12-2012 / 00:49:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 07-12-2012 / 15:53:43 / jv"
! !

!HGCommitDialog class methodsFor:'documentation'!

version_HG

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

version_SVN
    ^ '§Id::                                                                                                                        §'
! !