"

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

Copyright (C) 2012-2015 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' }"

"{ NameSpace: Smalltalk }"

Object subclass:#HGCommand

	instanceVariableNames:'workingDirectory result error errors blocker errorReader

		outputReader'

	classVariableNames:'HGCommandString HGExecutable HGExecutableArguments HGVersion

		HGVersionIsGreaterThan_2_4'

	poolDictionaries:'HGDebugFlags'

	category:'SCM-Mercurial-Internal'

!

HGCommand subclass:#add

	instanceVariableNames:'paths'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#bookmark

	instanceVariableNames:'revision name'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

HGCommand subclass:#bookmark_delete

	instanceVariableNames:'revision name'

	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

	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:#share

	instanceVariableNames:'source destination update'

	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 arguments'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommand

!

!HGCommand class methodsFor:'documentation'!

copyright

"

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

Copyright (C) 2012-2015 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 hg command to use"

    | command |

    HGCommandString notNil ifTrue:[ 

        command := HGCommandString 

    ] ifFalse:[

        command := UserPreferences current hgCommand.

        command notNil ifTrue:[

            command := command asString.

        ]

    ].

    command 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]

            command := OperatingSystem pathOfCommand:'hg'.

        ] ifFalse:[

            OperatingSystem isUNIXlike ifTrue:[

                command := OperatingSystem pathOfCommand:'hg'.

            ]

        ].

    ].

    ^ command

    "

     HGExecutable := nil.

     self basicNew executable

    "

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

    "Modified: / 17-07-2014 / 11:21:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgCommand: command

    HGCommandString := command notNil ifTrue:[ command asString ] ifFalse:[ nil ].

    HGExecutable := HGExecutableArguments := HGVersion := HGVersionIsGreaterThan_2_4 := nil.

    "

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

    HGCommand hgCommand: '/usr/bin/hg'

    HGCommand hgCommand: 'hg'

    HGCommand hgCommand: nil

    "

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

    "Modified: / 01-12-2014 / 20:38:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgCommandValidate: command

    "Given a `command`, checks whether it is a valid hg command.

     Returns absolute path to hg binary and global arguments (if any)

     or raise an HGInvalidExecutableError or HGInvalidVersionError

     if `command` is not valid hg command."

    | tokens executable executableAsFilename arguments version |

    command asFilename exists ifTrue:[

        executable := command.

        arguments := #().   

    ] ifFalse:[

        tokens := (HGCommandParser on: command readStream) parseShellCommand.

        executable := tokens first.

        arguments := tokens copyFrom: 2.

    ].

    executableAsFilename := executable asFilename.

    executableAsFilename isAbsolute ifFalse:[

        executableAsFilename := executableAsFilename asAbsoluteFilename.

        executableAsFilename exists ifTrue:[

            executable := executableAsFilename pathName.

        ] ifFalse:[

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

            "/ just typed 'hg' in...

            executable  := (OperatingSystem pathOfCommand: executable).

            executable isNil ifTrue:[

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

                ^ nil

            ] ifFalse:[

                executableAsFilename := executable asFilename.

            ].

        ]

    ].

    executableAsFilename exists ifFalse:[

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

        ^ nil

    ].

    executableAsFilename isDirectory ifTrue:[

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

        ^ nil

    ].

    executableAsFilename isExecutable ifFalse:[

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

        ^ nil

    ].

    [

        version := self hgVersionOf: executable arguments: arguments.

    ] 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 collect:[:e|e printString]) asStringWith:$.));

            raise.

        ^ nil

    ].

    ^ { executable . arguments }

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

    "Modified: / 17-07-2014 / 15:10:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 17-07-2014 / 20:00:56 / jv"

!

hgVersion

    "Return mercurial version installed on this compiter"

    HGVersion isNil ifTrue:[

        HGVersion := self hgVersionOf: self hgExecutable arguments: self hgExecutableArguments

    ].

    ^ 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"

    "Modified: / 17-07-2014 / 15:09:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersion: versionA isGreaterOrEqualThan: versionB

    1 to: (versionA size min: versionB size) do:[:i | 

        (versionA at: i) < (versionB at: i) ifTrue:[ 

            ^ false.

        ].

        (versionA at: i) > (versionB at: i) ifTrue:[ 

            ^ true.

        ].

    ].

    ^ versionA size >= versionB size

    "

     HGCommand hgVersion: #(3 0) isGreaterOrEqualThan: #(2 5).

     HGCommand hgVersion: #(3 0) isGreaterOrEqualThan: #(2 5 1).

     HGCommand hgVersion: #(3 0) isGreaterOrEqualThan: #(3 0).

     HGCommand hgVersion: #(3 0 1) isGreaterOrEqualThan: #(3 0). 

     HGCommand hgVersion: #(3 0)  isGreaterOrEqualThan: #(3 0 1).

     HGCommand hgVersion: #(2 3)  isGreaterOrEqualThan: #(2 4).     

    "

    "Created: / 04-11-2014 / 14:12:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 01-12-2014 / 20:37:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersionIsGreaterOrEqualThan: versionB

    ^ self hgVersion: self hgVersion isGreaterOrEqualThan: versionB

    "Created: / 04-11-2014 / 14:16:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersionIsGreaterOrEqualThan_2_4

    HGVersionIsGreaterThan_2_4 isNil ifTrue:[

        HGVersionIsGreaterThan_2_4 := self hgVersionIsGreaterOrEqualThan:#( 2 4 ).

    ].

    ^ HGVersionIsGreaterThan_2_4

    "Created: / 27-11-2014 / 23:16:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 01-12-2014 / 20:39:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

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: executable arguments: arguments

    "Return mercurial version if passed executable "

    ^version new

        executable: executable;

        arguments: arguments;

        execute

    "

     HGCommand hgVersion

    "

    "Created: / 17-07-2014 / 15:08:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hgVersionsSupported

    "Return a list of mercurial version supported bu this

     implementation"

    ^ #( 

        (1 9 #'*')     "1.9 - will wanish"

        (2 #'*' #'*')  "2.x"

        (3 #'*' #'*')  "3.x"

    )

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