Command server is now used by default.
All HGTests exept 2 passes. Further invesitgation on those two is
required.
"
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 := self task temporaryWorkingCopy repository execute:
(HGCommand status
workingDirectory: wcroot pathName;
yourself).
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: / 03-03-2013 / 23:08:27 / 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:: §'
! !