"

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 idsOnly revsets limit'

	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

    "Returns absolute path to hg executable to use"

    HGExecutable isNil ifTrue:[

        | executable |

        executable :=  UserPreferences current hgCommand.

        executable isNil ifTrue:[ 

            OperatingSystem isMSWINDOWSlike ifTrue:[

                "/        | h |

                "/ 

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

                executable := OperatingSystem pathOfCommand:'hg'.

            ] ifFalse:[

                OperatingSystem isUNIXlike ifTrue:[

                    executable := OperatingSystem pathOfCommand:'hg'.

                ]

            ].

        ].

        executable := self hgCommandValidate: executable.            

        HGExecutable := executable. 

    ].

    ^ HGExecutable

    "

     HGExecutable := nil.

     self basicNew executable

    "

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

    "Modified: / 21-02-2014 / 08:54:52 / 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>"

!

hgCommandValidate: executable

    "/ Given a `executable`, checks whether it is a valid hg binary.

    "/ Returns absolute path to hg binary or raise an

    "/ HGInvalidExecutableError or HGInvalidVersionError 

    "/ if `executable` is not valid hg binary.

    "/ 

    | path version |

    path := executable asFilename.

    path isAbsolute ifFalse:[ 

        path := path asAbsoluteFilename.

        path exists ifFalse:[ 

            "/ Also try to find specified command along PATH, maybe somebody

            "/ just typed 'hg' in...

            (executable includes: Filename separator) ifFalse:[

                path  := (OperatingSystem pathOfCommand: executable).

                path isNil ifTrue:[

                    HGInvalidExecutableError raiseErrorString:('''hg'' executable (%1) not found!!' bindWith: executable).

                    ^ nil

                ].

                ^ path

            ].

        ].

    ].

    path exists ifFalse:[

        HGInvalidExecutableError raiseErrorString:('Specified ''hg'' executable (%1) does not exists!!' bindWith: path pathName).

        ^ nil

    ].

    path isDirectory ifTrue:[ 

        HGInvalidExecutableError raiseErrorString:('Specified ''hg'' executable (%1) is actually a directory!!' bindWith: path pathName).

        ^ nil

    ].

    path isExecutable ifFalse:[ 

        HGInvalidExecutableError raiseErrorString:('Specified ''hg'' executable (%1) is cannot be executed!!' bindWith: path pathName).

        ^ nil

    ].

    [ 

        version := self hgVersionOf: path pathName.  

    ] on: Error do:[:ex |

        HGInvalidExecutableError newException

            parameter: ex;

            messageText: 'Failed to check version: ', ex description;

            raise.

        ^ nil

    ].

    (self hgVersionIsSupported: version) ifFalse:[ 

        HGInvalidVersionError newException

            parameter: version;

            messageText: ('Unsuported Mercurial version (%1)' bindWith: (version asStringWith:$.));

            raise.

        ^ nil

    ].

    ^ path pathName

    "Created: / 21-02-2014 / 08:50:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 21-02-2014 / 10:31:02 / 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>"

!