"

stx:libscm - a new source code management library for Smalltalk/X

Copyright (C) 2012-2013 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

"{ Package: 'stx:libscm/mercurial' }"

Object subclass:#HGCommand

	instanceVariableNames:'workingDirectory result error errors blocker errorReader

		outputReader'

	classVariableNames:'HGExecutable HGVersion'

	poolDictionaries:'HGDebugFlags'

	category:'SCM-Mercurial-Internal'

!

HGCommand subclass:#add

	instanceVariableNames:'paths'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#branches

	instanceVariableNames:'active closed'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#cat

	instanceVariableNames:'path revision destination'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#clone

	instanceVariableNames:'url path update'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#commit

	instanceVariableNames:'message files author date'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#heads

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#help

	instanceVariableNames:'topic'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#init

	instanceVariableNames:'path'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#locate

	instanceVariableNames:'revision'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#log

	instanceVariableNames:'start stop path childrenOnly revsets'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#merge

	instanceVariableNames:'revision tool'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#mv

	instanceVariableNames:'source destination'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#pull

	instanceVariableNames:'url'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#push

	instanceVariableNames:'url force'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#remove

	instanceVariableNames:'force paths'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#resolve

	instanceVariableNames:'tool mark unmark files'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#resolve__list

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#showconfig

	instanceVariableNames:'key'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#status

	instanceVariableNames:'path'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#update

	instanceVariableNames:'revision'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#version

	instanceVariableNames:'executable'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

!HGCommand class methodsFor:'documentation'!

copyright

"

stx:libscm - a new source code management library for Smalltalk/X

Copyright (C) 2012-2013 Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

!

documentation

"

    A wrapper for hg command line tool. Individual commands are wrapped in

    my private classes.

    HGCommand is part of internal implementation and subject to change.

    Therefore it should not be used by user code. Use classed and APIs in

    SCM-Mercurial-Core instead.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!HGCommand class methodsFor:'accessing'!

hgCommand

    | h |

    HGExecutable notNil ifTrue:[

        ^ HGExecutable

    ].

    HGExecutable := UserPreferences current hgCommand.

    HGExecutable isNil ifTrue:[

        OperatingSystem isMSWINDOWSlike ifTrue:[

            "/        h := Win32OperatingSystem registryEntry

            "/                key:'HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\App Paths\svn.exe'.

            "/        h notNil ifTrue:[HGExecutable := h valueNamed:''].

            "/        HGExecutable notEmptyOrNil ifTrue:[^HGExecutable]

            HGExecutable := OperatingSystem pathOfCommand:'hg'.

        ] ifFalse:[

            OperatingSystem isUNIXlike ifTrue:[

                HGExecutable := OperatingSystem pathOfCommand:'hg'.

            ]

        ].

    ].

    HGExecutable isNil ifTrue:[

        self error:'''hg'' executable not found!!'.

    ].

    ^ HGExecutable

    "

     HGExecutable := nil.

     self basicNew executable"

    "Created: / 19-11-2012 / 21:48:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 19-11-2012 / 23:21:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgCommand: command

    HGExecutable := command

    "

    HGCommand hgCommand: '/usr/src/mercurial-2.4/hg'

    HGCommand hgCommand: '/usr/bin/hg'

    "

    "Created: / 19-11-2012 / 21:49:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 03-03-2013 / 12:24:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersion

    "Return mercurial version installed on this compiter"

    HGVersion isNil ifTrue:[

        HGVersion := self hgVersionOf: self hgCommand

    ].

    ^ HGVersion

    "

     HGCommand hgVersion

    "

    "Created: / 19-11-2012 / 20:14:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 21-01-2013 / 05:07:58 / jv"

!

hgVersionIsSupported

    ^ self hgVersionIsSupported:self hgVersion

    "

     HGCommand mercurialVersionIsSupported"

    "Created: / 19-11-2012 / 20:34:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersionIsSupported:version

    ^ self hgVersionsSupported

        anySatisfy:[:vsn |

            ((vsn at:1) == #'*' or:[ (vsn at:1) == (version at:1) ])

                and:[

                    ((vsn at:2) == #'*' or:[ (vsn at:2) == (version at:2) ])

                        and:[ ((vsn at:3) == #'*' or:[ (vsn at:1) == (version at:3) ]) ]

                ]

        ].

    "

     HGCommand mercurialVersionIsSupported: #(2 3 2)

     HGCommand mercurialVersionIsSupported: #(2 0 1)

     HGCommand mercurialVersionIsSupported: #(1 9 1)

     HGCommand mercurialVersionIsSupported: #(1 0 0)

     HGCommand mercurialVersionIsSupported: #(2 4 nil)"

    "Created: / 19-11-2012 / 20:31:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersionOf: hgcommand

    "Return mercurial version installed on this compiter"

    ^version new

        executable: hgcommand;

        execute

    "

     HGCommand hgVersion

    "

    "Created: / 21-01-2013 / 05:05:01 / jv"

!

hgVersionsSupported

    "Return a list of mercurial version supported bu this

     implementation"

    ^ #( #(1 9 #'*')

     #(2 #'*' #'*') )

    "Created: / 19-11-2012 / 20:26:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

verbose

    ^ UserPreferences current hgVerbose

    "Created: / 19-03-2008 / 12:29:47 / janfrog"

    "Modified: / 19-03-2009 / 14:00:50 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified (format): / 27-12-2011 / 16:00:06 / dundee"

    "Modified: / 17-10-2012 / 13:05:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

verbose:aBoolean

    UserPreferences current hgVerbose:aBoolean

    "Created: / 19-03-2008 / 12:29:59 / janfrog"

    "Modified: / 19-03-2009 / 14:00:59 / Jan Vrany <vranyj1@fel.cvut.cz>"

    "Modified (format): / 27-12-2011 / 16:00:13 / dundee"

    "Modified: / 17-10-2012 / 13:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommand class methodsFor:'commands'!

add

    ^add new

    "Created: / 15-11-2012 / 00:06:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

branches

    ^branches new

    "Created: / 27-11-2012 / 19:56:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

cat

    ^cat new

    "Created: / 17-11-2012 / 00:16:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

clone

    ^clone new

    "Created: / 01-10-2012 / 00:09:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

commit

    ^commit new

    "Created: / 12-11-2012 / 22:40:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

heads

    ^heads new

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

!

init

    ^init new

    "Created: / 13-02-2014 / 12:37:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

locate

    ^locate new

    "Created: / 16-11-2012 / 22:36:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

log

    ^log new

    "Created: / 13-11-2012 / 09:00:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

merge

    ^merge new

    "Created: / 14-01-2013 / 16:03:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

mv

    ^mv new

    "Created: / 15-11-2012 / 00:22:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

pull

    ^pull new

    "Created: / 27-11-2012 / 23:30:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

push

    ^push new

    "Created: / 30-09-2012 / 23:46:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

remove

    ^remove new

    "Created: / 15-11-2012 / 00:06:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

resolve

    ^resolve new

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

!

resolve__list

    ^resolve__list new

    "Created: / 14-01-2013 / 16:42:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

showconfig

    ^showconfig new

    "Created: / 06-12-2012 / 20:24:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

status

    ^status new

    "Created: / 23-10-2012 / 11:10:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

update

    ^update new

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

! !

!HGCommand class methodsFor:'commands-shortcuts'!

clone: url to: stringOfFilename

    self clone

        url: url;

        path: stringOfFilename asFilename asAbsoluteFilename pathName;

        execute

    "Created: / 01-10-2012 / 00:06:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

init: aStringOrFilename

    ^ self init path: aStringOrFilename; yourself

    "Created: / 13-02-2014 / 12:37:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommand methodsFor:'accessing'!

result

    ^ result

!

workingDirectory

    ^workingDirectory notNil ifTrue:[

        workingDirectory

    ] ifFalse: [

        Filename currentDirectory pathName

    ]

    "Created: / 11-05-2011 / 08:26:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 27-12-2011 / 15:54:08 / dundee"

    "Modified: / 01-10-2012 / 14:38:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

workingDirectory:aStringOrFilename

    aStringOrFilename asFilename isDirectory ifFalse:[

        self error:'Working directory does not exist'.

        ^self.

    ].

    workingDirectory := aStringOrFilename asString.

    "Modified: / 01-10-2012 / 14:38:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

workingDirectoryOrNil

    ^workingDirectory

    "Created: / 04-03-2013 / 10:04:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommand methodsFor:'accessing-internal'!

blocker

    ^ blocker

!

errorReader

    ^ errorReader